This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Get t/uni/cache.t working under minitest
[perl5.git] / t / op / hashwarn.t
old mode 100755 (executable)
new mode 100644 (file)
index 7419826..b14e9c2
@@ -1,70 +1,73 @@
 #!./perl
 
-use strict;
-
 BEGIN {
     chdir 't' if -d 't';
+    @INC = qw(. ../lib);
 }
 
+require 'test.pl';
+plan( tests => 16 );
+
+use strict;
+use warnings;
+
 use vars qw{ @warnings };
 
 BEGIN {
-    $^W |= 1;          # Insist upon warnings
-    # ...and save 'em as we go
     $SIG{'__WARN__'} = sub { push @warnings, @_ };
     $| = 1;
-    print "1..7\n";
 }
 
-END { print "not ok\n# Uncaught warnings:\n@warnings\n" if @warnings }
-
-sub test ($$;$) {
-    my($num, $bool, $diag) = @_;
-    if ($bool) {
-       print "ok $num\n";
-       return;
-    }
-    print "not ok $num\n";
-    return unless defined $diag;
-    $diag =~ s/\Z\n?/\n/;                      # unchomp
-    print map "# $num : $_", split m/^/m, $diag;
-}
-
-sub test_warning ($$$) {
-    my($num, $got, $expected) = @_;
-    my($pattern, $ok);
-    if (($pattern) = ($expected =~ m#^/(.+)/$#s) or
-       (undef, $pattern) = ($expected =~ m#^m([^\w\s])(.+)\1$#s)) {
-           # it's a regexp
-           $ok = ($got =~ /$pattern/);
-           test $num, $ok, "Expected pattern /$pattern/, got '$got'\n";
-    } else {
-       $ok = ($got eq $expected);
-       test $num, $ok, "Expected string '$expected', got '$got'\n";
-    }
-#   print "# $num: $got\n";
-}
-
-my $odd_msg = '/^Odd number of elements in hash/';
-my $ref_msg = '/^Reference found where even-sized list expected/';
+my $fail_odd      = 'Odd number of elements in hash assignment at ';
+my $fail_odd_anon = 'Odd number of elements in anonymous hash at ';
+my $fail_ref      = 'Reference found where even-sized list expected at ';
+my $fail_not_hr   = 'Not a HASH reference at ';
 
 {
+    @warnings = ();
     my %hash = (1..3);
-    test_warning 1, shift @warnings, $odd_msg;
+    cmp_ok(scalar(@warnings),'==',1,'odd count');
+    cmp_ok(substr($warnings[0],0,length($fail_odd)),'eq',$fail_odd,'odd msg');
 
+    @warnings = ();
     %hash = 1;
-    test_warning 2, shift @warnings, $odd_msg;
+    cmp_ok(scalar(@warnings),'==',1,'scalar count');
+    cmp_ok(substr($warnings[0],0,length($fail_odd)),'eq',$fail_odd,'scalar msg');
 
+    @warnings = ();
     %hash = { 1..3 };
-    test_warning 3, shift @warnings, $odd_msg;
-    test_warning 4, shift @warnings, $ref_msg;
+    cmp_ok(scalar(@warnings),'==',2,'odd hashref count');
+    cmp_ok(substr($warnings[0],0,length($fail_odd_anon)),'eq',$fail_odd_anon,'odd hashref msg 1');
+    cmp_ok(substr($warnings[1],0,length($fail_ref)),'eq',$fail_ref,'odd hashref msg 2');
 
+    @warnings = ();
     %hash = [ 1..3 ];
-    test_warning 5, shift @warnings, $ref_msg;
+    cmp_ok(scalar(@warnings),'==',1,'arrayref count');
+    cmp_ok(substr($warnings[0],0,length($fail_ref)),'eq',$fail_ref,'arrayref msg');
 
-    %hash = sub { print "ok" };
-    test_warning 6, shift @warnings, $odd_msg;
+    @warnings = ();
+    %hash = sub { print "fenice" };
+    cmp_ok(scalar(@warnings),'==',1,'coderef count');
+    cmp_ok(substr($warnings[0],0,length($fail_odd)),'eq',$fail_odd,'coderef msg');
 
+    @warnings = ();
     $_ = { 1..10 };
-    test 7, ! @warnings, "Unexpected warning";
+    cmp_ok(scalar(@warnings),'==',0,'hashref assign');
+
+    # Old pseudo-hash syntax, now removed.
+
+    @warnings = ();
+    my $avhv = [{x=>1,y=>2}];
+    eval {
+        %$avhv = (x=>13,'y');
+    };
+    cmp_ok(scalar(@warnings),'==',0,'pseudo-hash 1 count');
+    cmp_ok(substr($@,0,length($fail_not_hr)),'eq',$fail_not_hr,'pseudo-hash 1 msg');
+
+    @warnings = ();
+    eval {
+        %$avhv = 'x';
+    };
+    cmp_ok(scalar(@warnings),'==',0,'pseudo-hash 2 count');
+    cmp_ok(substr($@,0,length($fail_not_hr)),'eq',$fail_not_hr,'pseudo-hash 2 msg');
 }