t/op/inc.t

   1 #!./perl -w
   2
   3 # use strict;
   4
   5 print "1..24\n";
   6
   7 my $test = 1;
   8
   9 sub ok {
  10   my ($pass, $wrong, $err) = @_;
  11   if ($pass) {
  12     print "ok $test\n";
  13     $test = $test + 1; # Would be doubleplusbad to use ++ in the ++ test.
  14     return 1;
  15   } else {
  16     if ($err) {
  17       chomp $err;
  18       print "not ok $test # $err\n";
  19     } else {
  20       if (defined $wrong) {
  21         $wrong = ", got $wrong";
  22       } else {
  23         $wrong = '';
  24       }
  25       printf "not ok $test # line %d$wrong\n", (caller)[2];
  26     }
  27   }
  28   $test = $test + 1;
  29   return;
  30 }
  31
  32 # Verify that addition/subtraction properly upgrade to doubles.
  33 # These tests are only significant on machines with 32 bit longs,
  34 # and two's complement negation, but shouldn't fail anywhere.
  35
  36 my $a = 2147483647;
  37 my $c=$a++;
  38 ok ($a == 2147483648, $a);
  39
  40 $a = 2147483647;
  41 $c=++$a;
  42 ok ($a == 2147483648, $a);
  43
  44 $a = 2147483647;
  45 $a=$a+1;
  46 ok ($a == 2147483648, $a);
  47
  48 $a = -2147483648;
  49 $c=$a--;
  50 ok ($a == -2147483649, $a);
  51
  52 $a = -2147483648;
  53 $c=--$a;
  54 ok ($a == -2147483649, $a);
  55
  56 $a = -2147483648;
  57 $a=$a-1;
  58 ok ($a == -2147483649, $a);
  59
  60 $a = 2147483648;
  61 $a = -$a;
  62 $c=$a--;
  63 ok ($a == -2147483649, $a);
  64
  65 $a = 2147483648;
  66 $a = -$a;
  67 $c=--$a;
  68 ok ($a == -2147483649, $a);
  69
  70 $a = 2147483648;
  71 $a = -$a;
  72 $a=$a-1;
  73 ok ($a == -2147483649, $a);
  74
  75 $a = 2147483648;
  76 $b = -$a;
  77 $c=$b--;
  78 ok ($b == -$a-1, $a);
  79
  80 $a = 2147483648;
  81 $b = -$a;
  82 $c=--$b;
  83 ok ($b == -$a-1, $a);
  84
  85 $a = 2147483648;
  86 $b = -$a;
  87 $b=$b-1;
  88 ok ($b == -(++$a), $a);
  89
  90 # Verify that shared hash keys become unshared.
  91
  92 sub check_same {
  93   my ($orig, $suspect) = @_;
  94   my $fail;
  95   while (my ($key, $value) = each %$suspect) {
  96     if (exists $orig->{$key}) {
  97       if ($orig->{$key} ne $value) {
  98         print "# key '$key' was '$orig->{$key}' now '$value'\n";
  99         $fail = 1;
 100       }
 101     } else {
 102       print "# key '$key' is '$orig->{$key}', unexpect.\n";
 103       $fail = 1;
 104     }
 105   }
 106   foreach (keys %$orig) {
 107     next if (exists $suspect->{$_});
 108     print "# key '$_' was '$orig->{$_}' now missing\n";
 109     $fail = 1;
 110   }
 111   ok (!$fail);
 112 }
 113
 114 my (%orig) = my (%inc) = my (%dec) = my (%postinc) = my (%postdec)
 115   = (1 => 1, ab => "ab");
 116 my %up = (1=>2, ab => 'ac');
 117 my %down = (1=>0, ab => -1);
 118
 119 foreach (keys %inc) {
 120   my $ans = $up{$_};
 121   my $up;
 122   eval {$up = ++$_};
 123   ok ((defined $up and $up eq $ans), $up, $@);
 124 }
 125
 126 check_same (\%orig, \%inc);
 127
 128 foreach (keys %dec) {
 129   my $ans = $down{$_};
 130   my $down;
 131   eval {$down = --$_};
 132   ok ((defined $down and $down eq $ans), $down, $@);
 133 }
 134
 135 check_same (\%orig, \%dec);
 136
 137 foreach (keys %postinc) {
 138   my $ans = $postinc{$_};
 139   my $up;
 140   eval {$up = $_++};
 141   ok ((defined $up and $up eq $ans), $up, $@);
 142 }
 143
 144 check_same (\%orig, \%postinc);
 145
 146 foreach (keys %postdec) {
 147   my $ans = $postdec{$_};
 148   my $down;
 149   eval {$down = $_--};
 150   ok ((defined $down and $down eq $ans), $down, $@);
 151 }
 152
 153 check_same (\%orig, \%postdec);