X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=blobdiff_plain;f=xt%2Fextra%2Finternals%2Fquote_sub.t;h=23fb057525abaca6be69f0d52dda6532e8d0ff5d;hp=77b490507377dc14ed233f08974f3fd9df5cfdd0;hb=e85eb407cd475abef6c489dfd36b4866785e00be;hpb=b46b85376ad7ff53fa4ec4350a19b4514c4e0d3b diff --git a/xt/extra/internals/quote_sub.t b/xt/extra/internals/quote_sub.t index 77b4905..23fb057 100644 --- a/xt/extra/internals/quote_sub.t +++ b/xt/extra/internals/quote_sub.t @@ -6,9 +6,11 @@ use Test::Warn; use DBIx::Class::_Util 'quote_sub'; +### Test for strictures leakage my $q = do { no strict 'vars'; - quote_sub '$x = $x . "buh"; $x += 42'; + quote_sub 'DBICTest::QSUB::nostrict' + => '$x = $x . "buh"; $x += 42'; }; warnings_exist { @@ -23,10 +25,10 @@ warnings_exist { } ; -my $no_nothing_q = do { +my $no_nothing_q = sub { no strict; no warnings; - quote_sub <<'EOC'; + quote_sub 'DBICTest::QSUB::nowarn', <<'EOC'; BEGIN { warn "-->${^WARNING_BITS}<--\n" }; my $n = "Test::Warn::warnings_exist"; warn "-->@{[ *{$n}{CODE} ]}<--\n"; @@ -35,7 +37,7 @@ EOC my $we_cref = Test::Warn->can('warnings_exist'); -warnings_exist { $no_nothing_q->() } [ +warnings_exist { $no_nothing_q->()->() } [ qr/^\-\-\>\0+\<\-\-$/m, qr/^\Q-->$we_cref<--\E$/m, ], 'Expected warnings, strict did not leak inside the qsub'