From: Vincent Pit <vince@profvince.com>
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/?p=perl%2Fmodules%2Fautovivification.git;a=commitdiff_plain;h=4ccff394a949fe8d99359c5ea6d154f85191f731

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';
 }
-