This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Convert t/op/inc.t to test.pl and use strict.
authorNicholas Clark <nick@ccl4.org>
Sat, 12 Mar 2011 22:33:01 +0000 (22:33 +0000)
committerNicholas Clark <nick@ccl4.org>
Sat, 12 Mar 2011 22:33:01 +0000 (22:33 +0000)
t/op/inc.t

index 5b6ede2..d750187 100644 (file)
@@ -1,33 +1,7 @@
 #!./perl -w
 
-# use strict;
-
-print "1..56\n";
-
-my $test = 1;
-
-sub ok ($;$$) {
-  my ($pass, $wrong, $err) = @_;
-  if ($pass) {
-    print "ok $test\n";
-    $test = $test + 1; # Would be doubleplusbad to use ++ in the ++ test.
-    return 1;
-  } else {
-    if ($err) {
-      chomp $err;
-      print "not ok $test # $err\n";
-    } else {
-      if (defined $wrong) {
-        $wrong = ", got $wrong";
-      } else {
-        $wrong = '';
-      }
-      printf "not ok $test # line %d$wrong\n", (caller)[2];
-    }
-  }
-  $test = $test + 1;
-  return;
-}
+require './test.pl';
+use strict;
 
 # Verify that addition/subtraction properly upgrade to doubles.
 # These tests are only significant on machines with 32 bit longs,
@@ -35,63 +9,63 @@ sub ok ($;$$) {
 
 my $a = 2147483647;
 my $c=$a++;
-ok ($a == 2147483648, $a);
+cmp_ok($a, '==', 2147483648);
 
 $a = 2147483647;
 $c=++$a;
-ok ($a == 2147483648, $a);
+cmp_ok($a, '==', 2147483648);
 
 $a = 2147483647;
 $a=$a+1;
-ok ($a == 2147483648, $a);
+cmp_ok($a, '==', 2147483648);
 
 $a = -2147483648;
 $c=$a--;
-ok ($a == -2147483649, $a);
+cmp_ok($a, '==', -2147483649);
 
 $a = -2147483648;
 $c=--$a;
-ok ($a == -2147483649, $a);
+cmp_ok($a, '==', -2147483649);
 
 $a = -2147483648;
 $a=$a-1;
-ok ($a == -2147483649, $a);
+cmp_ok($a, '==', -2147483649);
 
 $a = 2147483648;
 $a = -$a;
 $c=$a--;
-ok ($a == -2147483649, $a);
+cmp_ok($a, '==', -2147483649);
 
 $a = 2147483648;
 $a = -$a;
 $c=--$a;
-ok ($a == -2147483649, $a);
+cmp_ok($a, '==', -2147483649);
 
 $a = 2147483648;
 $a = -$a;
 $a=$a-1;
-ok ($a == -2147483649, $a);
+cmp_ok($a, '==', -2147483649);
 
 $a = 2147483648;
 $b = -$a;
 $c=$b--;
-ok ($b == -$a-1, $a);
+cmp_ok($b, '==', -$a-1);
 
 $a = 2147483648;
 $b = -$a;
 $c=--$b;
-ok ($b == -$a-1, $a);
+cmp_ok($b, '==', -$a-1);
 
 $a = 2147483648;
 $b = -$a;
 $b=$b-1;
-ok ($b == -(++$a), $a);
+cmp_ok($b, '==', -(++$a));
 
 $a = undef;
-ok ($a++ eq '0', do { $a=undef; $a++ }, "postinc undef returns '0'");
+is($a++, '0', "postinc undef returns '0'");
 
 $a = undef;
-ok (!defined($a--), do { $a=undef; $a-- }, "postdec undef returns undef");
+is($a--, undef, "postdec undef returns undef");
 
 # Verify that shared hash keys become unshared.
 
@@ -126,7 +100,8 @@ foreach (keys %inc) {
   my $ans = $up{$_};
   my $up;
   eval {$up = ++$_};
-  ok ((defined $up and $up eq $ans), $up, $@);
+  is($up, $ans);
+  is($@, '');
 }
 
 check_same (\%orig, \%inc);
@@ -135,7 +110,8 @@ foreach (keys %dec) {
   my $ans = $down{$_};
   my $down;
   eval {$down = --$_};
-  ok ((defined $down and $down eq $ans), $down, $@);
+  is($down, $ans);
+  is($@, '');
 }
 
 check_same (\%orig, \%dec);
@@ -144,7 +120,8 @@ foreach (keys %postinc) {
   my $ans = $postinc{$_};
   my $up;
   eval {$up = $_++};
-  ok ((defined $up and $up eq $ans), $up, $@);
+  is($up, $ans);
+  is($@, '');
 }
 
 check_same (\%orig, \%postinc);
@@ -153,7 +130,8 @@ foreach (keys %postdec) {
   my $ans = $postdec{$_};
   my $down;
   eval {$down = $_--};
-  ok ((defined $down and $down eq $ans), $down, $@);
+  is($down, $ans);
+  is($@, '');
 }
 
 check_same (\%orig, \%postdec);
@@ -165,34 +143,34 @@ check_same (\%orig, \%postdec);
        $y ="$x\n";
        ++$x;
     };
-    ok($x == 1, $x);
-    ok($@ eq '', $@);
+    cmp_ok($x, '==', 1);
+    is($@, '');
 
     my ($p, $q);
     eval {
        $q ="$p\n";
        --$p;
     };
-    ok($p == -1, $p);
-    ok($@ eq '', $@);
+    cmp_ok($p, '==', -1);
+    is($@, '');
 }
 
 $a = 2147483648;
 $c=--$a;
-ok ($a == 2147483647, $a);
+cmp_ok($a, '==', 2147483647);
 
 
 $a = 2147483648;
 $c=$a--;
-ok ($a == 2147483647, $a);
+cmp_ok($a, '==', 2147483647);
 
 {
     use integer;
     my $x = 0;
     $x++;
-    ok ($x == 1, "(void) i_postinc");
+    cmp_ok($x, '==', 1, "(void) i_postinc");
     $x--;
-    ok ($x == 0, "(void) i_postdec");
+    cmp_ok($x, '==', 0, "(void) i_postdec");
 }
 
 # I'm sure that there's an IBM format with a 48 bit mantissa
@@ -229,39 +207,30 @@ for my $n (47..113) {
             [$start_n, '--$i', 'pre-dec', 'dec'],
             [$start_n, '$i--', 'post-dec', 'dec']) {
        my ($start, $action, $description, $act) = @$_;
-       foreach my $warn (0, 1) {
-           my $warn_line = ($warn ? 'use' : 'no') . " warnings 'imprecision';";
-
-           print "# checking $action under $warn_line\n";
-           my $code = <<"EOC";
-$warn_line
-my \$i = \$start;
-for(0 .. 3) {
-    my \$a = $action;
+       my $code = eval << "EOC" or die $@;
+sub {
+    no warnings 'imprecision';
+    my \$i = \$start;
+    for(0 .. 3) {
+        my \$a = $action;
+    }
 }
-1;
 EOC
-           my @warnings;
-           {
-               local $SIG{__WARN__} = sub {push @warnings, "@_"};
-               eval $code or die "# $@\n$code";
-           }
-
-           if ($warn) {
-               unless (ok (scalar @warnings == 2, scalar @warnings)) {
-                   print STDERR "# $_" foreach @warnings;
-               }
-               foreach (@warnings) {
-                   unless (ok (/Lost precision when ${act}rementing -?\d+/, $_)) {
-                       print STDERR "# $_"
-                   }
-               }
-           } else {
-               unless (ok (scalar @warnings == 0)) {
-                   print STDERR "# @$_" foreach @warnings;
-               }
-           }
-       }
+
+       warning_is($code, undef, "$description under no warnings 'imprecision'");
+
+       $code = eval << "EOC" or die $@;
+sub {
+    use warnings 'imprecision';
+    my \$i = \$start;
+    for(0 .. 3) {
+        my \$a = $action;
+    }
+}
+EOC
+
+       warnings_like($code, [(qr/Lost precision when ${act}rementing -?\d+/) x 2],
+                     "$description under use warnings 'imprecision'");
     }
 
     $found = 1;
@@ -274,10 +243,10 @@ die "Could not find a value which overflows the mantissa" unless $found;
 sub PVBM () { 'foo' }
 { my $dummy = index 'foo', PVBM }
 
-ok (scalar eval { my $pvbm = PVBM; $pvbm++ });
-ok (scalar eval { my $pvbm = PVBM; $pvbm-- });
-ok (scalar eval { my $pvbm = PVBM; ++$pvbm });
-ok (scalar eval { my $pvbm = PVBM; --$pvbm });
+isnt(scalar eval { my $pvbm = PVBM; $pvbm++ }, undef);
+isnt(scalar eval { my $pvbm = PVBM; $pvbm-- }, undef);
+isnt(scalar eval { my $pvbm = PVBM; ++$pvbm }, undef);
+isnt(scalar eval { my $pvbm = PVBM; --$pvbm }, undef);
 
 # #9466
 
@@ -292,6 +261,8 @@ ok (scalar eval { my $pvbm = PVBM; --$pvbm });
        my $a = bless {};
        my $b = $_ ? $a++ : $a--;
        undef $a; undef $b;
-       ::ok ($x, $x, "9466 case $_");
+       ::is($x, 1, "9466 case $_");
     }
 }
+
+done_testing();