From: Vincent Pit Date: Wed, 17 Jun 2009 14:15:11 +0000 (+0200) Subject: A crude warning test X-Git-Tag: v0.02~2 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;ds=sidebyside;h=4ccff394a949fe8d99359c5ea6d154f85191f731;p=perl%2Fmodules%2Fautovivification.git A crude warning test --- diff --git a/autovivification.xs b/autovivification.xs index c2bb408..68bc217 100644 --- a/autovivification.xs +++ b/autovivification.xs @@ -309,9 +309,6 @@ STATIC OP *a_pp_rv2hv(pTHX) { /* ... pp_deref (aelem,helem,rv2sv,padsv) .................................. */ -STATIC const char a_msg_forbidden[] = "Reference vivification forbidden"; -STATIC const char a_msg_impossible[] = "Can't vivify reference"; - STATIC OP *a_pp_deref(pTHX) { a_op_info oi; UV flags; @@ -334,11 +331,11 @@ deref: SPAGAIN; if (!SvOK(TOPs)) { if (flags & A_HINT_STRICT) - croak(a_msg_forbidden); + croak("Reference vivification forbidden"); else if (flags & A_HINT_WARN) - warn(a_msg_forbidden); + warn("Reference was vivified"); else /* A_HINT_STORE */ - croak(a_msg_impossible); + croak("Can't vivify reference"); } } diff --git a/t/30-scope.t b/t/30-scope.t index 2e951cf..857a780 100644 --- a/t/30-scope.t +++ b/t/30-scope.t @@ -3,10 +3,25 @@ use strict; use warnings; -use Test::More tests => 4; +use Test::More tests => 8; use lib 't/lib'; +{ + my @w; + my $x; + my $res = eval { + local $SIG{__WARN__} = sub { push @w, join '', 'warn:', @_ }; + no autovivification qw/warn fetch/; + $x->{a}; + }; + is @w, 1, 'warned only once'; + like $w[0], qr/^warn:Reference was vivified at \Q$0\E line ${\(__LINE__-3)}/, + 'warning looks correct'; + is_deeply $x, undef, 'didn\'t vivified'; + is $res, undef, 'returned undef'; +} + our $blurp; { @@ -26,4 +41,3 @@ our $blurp; $expect->{r2_eval} = { } if $] < 5.009005; is_deeply $blurp, $expect, 'second require test didn\'t vivify'; } -