t/op/inc.t

   1 #!./perl -w
   2
   3 # use strict;
   4
   5 print "1..26\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 $a = undef;
  91 ok ($a++ eq '0', do { $a=undef; $a++ }, "postinc undef returns '0'");
  92
  93 $a = undef;
  94 ok (!defined($a--), do { $a=undef; $a-- }, "postdec undef returns undef");
  95
  96 # Verify that shared hash keys become unshared.
  97
  98 sub check_same {
  99   my ($orig, $suspect) = @_;
 100   my $fail;
 101   while (my ($key, $value) = each %$suspect) {
 102     if (exists $orig->{$key}) {
 103       if ($orig->{$key} ne $value) {
 104         print "# key '$key' was '$orig->{$key}' now '$value'\n";
 105         $fail = 1;
 106       }
 107     } else {
 108       print "# key '$key' is '$orig->{$key}', unexpect.\n";
 109       $fail = 1;
 110     }
 111   }
 112   foreach (keys %$orig) {
 113     next if (exists $suspect->{$_});
 114     print "# key '$_' was '$orig->{$_}' now missing\n";
 115     $fail = 1;
 116   }
 117   ok (!$fail);
 118 }
 119
 120 my (%orig) = my (%inc) = my (%dec) = my (%postinc) = my (%postdec)
 121   = (1 => 1, ab => "ab");
 122 my %up = (1=>2, ab => 'ac');
 123 my %down = (1=>0, ab => -1);
 124
 125 foreach (keys %inc) {
 126   my $ans = $up{$_};
 127   my $up;
 128   eval {$up = ++$_};
 129   ok ((defined $up and $up eq $ans), $up, $@);
 130 }
 131
 132 check_same (\%orig, \%inc);
 133
 134 foreach (keys %dec) {
 135   my $ans = $down{$_};
 136   my $down;
 137   eval {$down = --$_};
 138   ok ((defined $down and $down eq $ans), $down, $@);
 139 }
 140
 141 check_same (\%orig, \%dec);
 142
 143 foreach (keys %postinc) {
 144   my $ans = $postinc{$_};
 145   my $up;
 146   eval {$up = $_++};
 147   ok ((defined $up and $up eq $ans), $up, $@);
 148 }
 149
 150 check_same (\%orig, \%postinc);
 151
 152 foreach (keys %postdec) {
 153   my $ans = $postdec{$_};
 154   my $down;
 155   eval {$down = $_--};
 156   ok ((defined $down and $down eq $ans), $down, $@);
 157 }
 158
 159 check_same (\%orig, \%postdec);