X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fconstant.t;h=b97c688e5b77f1d0be3bcbddb2220868394a3117;hb=dfa4e5d386dd8c5329351699b02085856cdd140e;hp=1f1d0be3d938906d3e525acef94f2b8d97b36ce3;hpb=8c31f2f2bdae21a003f2d57f25c1b984e764a986;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/constant.t b/lib/constant.t
index 1f1d0be..b97c688 100644
--- a/lib/constant.t
+++ b/lib/constant.t
@@ -6,7 +6,7 @@ BEGIN {
 }
 
 use warnings;
-use vars qw{ @warnings };
+use vars qw{ @warnings $fagwoosh $putt $kloong};
 BEGIN {				# ...and save 'em for later
     $SIG{'__WARN__'} = sub { push @warnings, @_ }
 }
@@ -14,7 +14,7 @@ END { print STDERR @warnings }
 
 
 use strict;
-use Test::More tests => 75;
+use Test::More tests => 96;
 my $TB = Test::More->builder;
 
 BEGIN { use_ok('constant'); }
@@ -182,6 +182,7 @@ eval q{
     use constant 'BEGIN' => 1 ;
     use constant 'INIT' => 1 ;
     use constant 'CHECK' => 1 ;
+    use constant 'UNITCHECK' => 1;
     use constant 'END' => 1 ;
     use constant 'DESTROY' => 1 ;
     use constant 'AUTOLOAD' => 1 ;
@@ -195,13 +196,14 @@ eval q{
     use constant 'SIG' => 1 ;
 };
 
-is @warnings, 15 ;
+is @warnings, 16 ;
 my @Expected_Warnings = 
   (
    qr/^Constant name 'BEGIN' is a Perl keyword at/,
    qr/^Constant subroutine BEGIN redefined at/,
    qr/^Constant name 'INIT' is a Perl keyword at/,
    qr/^Constant name 'CHECK' is a Perl keyword at/,
+   qr/^Constant name 'UNITCHECK' is a Perl keyword at/,
    qr/^Constant name 'END' is a Perl keyword at/,
    qr/^Constant name 'DESTROY' is a Perl keyword at/,
    qr/^Constant name 'AUTOLOAD' is a Perl keyword at/,
@@ -242,3 +244,73 @@ is THREE**3, SPIT->(@{+FAMILY}**3);
     };
     ok( $@ eq '' );
 }
+
+sub slotch ();
+
+{
+    my @warnings;
+    local $SIG{'__WARN__'} = sub { push @warnings, @_ };
+    eval 'use constant slotch => 3; 1' or die $@;
+
+    is ("@warnings", "", "No warnings if a prototype exists");
+
+    my $value = eval 'slotch';
+    is ($@, '');
+    is ($value, 3);
+}
+
+sub zit;
+
+{
+    my @warnings;
+    local $SIG{'__WARN__'} = sub { push @warnings, @_ };
+    eval 'use constant zit => 4; 1' or die $@;
+
+    is(scalar @warnings, 1, "1 warning");
+    like ($warnings[0], qr/^Prototype mismatch: sub main::zit: none vs \(\)/,
+	  "about the prototype mismatch");
+
+    my $value = eval 'zit';
+    is ($@, '');
+    is ($value, 4);
+}
+
+$fagwoosh = 'geronimo';
+$putt = 'leutwein';
+$kloong = 'schlozhauer';
+
+{
+    my @warnings;
+    local $SIG{'__WARN__'} = sub { push @warnings, @_ };
+    eval 'use constant fagwoosh => 5; 1' or die $@;
+
+    is ("@warnings", "", "No warnings if the typeglob exists already");
+
+    my $value = eval 'fagwoosh';
+    is ($@, '');
+    is ($value, 5);
+
+    my @value = eval 'fagwoosh';
+    is ($@, '');
+    is_deeply (\@value, [5]);
+
+    eval 'use constant putt => 6, 7; 1' or die $@;
+
+    is ("@warnings", "", "No warnings if the typeglob exists already");
+
+    @value = eval 'putt';
+    is ($@, '');
+    is_deeply (\@value, [6, 7]);
+
+    eval 'use constant "klong"; 1' or die $@;
+
+    is ("@warnings", "", "No warnings if the typeglob exists already");
+
+    $value = eval 'klong';
+    is ($@, '');
+    is ($value, undef);
+
+    @value = eval 'klong';
+    is ($@, '');
+    is_deeply (\@value, []);
+}