1#!./perl -w 2 3# use strict; 4 5print "1..34\n"; 6 7my $test = 1; 8 9sub 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 36my $a = 2147483647; 37my $c=$a++; 38ok ($a == 2147483648, $a); 39 40$a = 2147483647; 41$c=++$a; 42ok ($a == 2147483648, $a); 43 44$a = 2147483647; 45$a=$a+1; 46ok ($a == 2147483648, $a); 47 48$a = -2147483648; 49$c=$a--; 50ok ($a == -2147483649, $a); 51 52$a = -2147483648; 53$c=--$a; 54ok ($a == -2147483649, $a); 55 56$a = -2147483648; 57$a=$a-1; 58ok ($a == -2147483649, $a); 59 60$a = 2147483648; 61$a = -$a; 62$c=$a--; 63ok ($a == -2147483649, $a); 64 65$a = 2147483648; 66$a = -$a; 67$c=--$a; 68ok ($a == -2147483649, $a); 69 70$a = 2147483648; 71$a = -$a; 72$a=$a-1; 73ok ($a == -2147483649, $a); 74 75$a = 2147483648; 76$b = -$a; 77$c=$b--; 78ok ($b == -$a-1, $a); 79 80$a = 2147483648; 81$b = -$a; 82$c=--$b; 83ok ($b == -$a-1, $a); 84 85$a = 2147483648; 86$b = -$a; 87$b=$b-1; 88ok ($b == -(++$a), $a); 89 90$a = undef; 91ok ($a++ eq '0', do { $a=undef; $a++ }, "postinc undef returns '0'"); 92 93$a = undef; 94ok (!defined($a--), do { $a=undef; $a-- }, "postdec undef returns undef"); 95 96# Verify that shared hash keys become unshared. 97 98sub 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 120my (%orig) = my (%inc) = my (%dec) = my (%postinc) = my (%postdec) 121 = (1 => 1, ab => "ab"); 122my %up = (1=>2, ab => 'ac'); 123my %down = (1=>0, ab => -1); 124 125foreach (keys %inc) { 126 my $ans = $up{$_}; 127 my $up; 128 eval {$up = ++$_}; 129 ok ((defined $up and $up eq $ans), $up, $@); 130} 131 132check_same (\%orig, \%inc); 133 134foreach (keys %dec) { 135 my $ans = $down{$_}; 136 my $down; 137 eval {$down = --$_}; 138 ok ((defined $down and $down eq $ans), $down, $@); 139} 140 141check_same (\%orig, \%dec); 142 143foreach (keys %postinc) { 144 my $ans = $postinc{$_}; 145 my $up; 146 eval {$up = $_++}; 147 ok ((defined $up and $up eq $ans), $up, $@); 148} 149 150check_same (\%orig, \%postinc); 151 152foreach (keys %postdec) { 153 my $ans = $postdec{$_}; 154 my $down; 155 eval {$down = $_--}; 156 ok ((defined $down and $down eq $ans), $down, $@); 157} 158 159check_same (\%orig, \%postdec); 160 161{ 162 no warnings 'uninitialized'; 163 my ($x, $y); 164 eval { 165 $y ="$x\n"; 166 ++$x; 167 }; 168 ok($x == 1, $x); 169 ok($@ eq '', $@); 170 171 my ($p, $q); 172 eval { 173 $q ="$p\n"; 174 --$p; 175 }; 176 ok($p == -1, $p); 177 ok($@ eq '', $@); 178} 179 180$a = 2147483648; 181$c=--$a; 182ok ($a == 2147483647, $a); 183 184 185$a = 2147483648; 186$c=$a--; 187ok ($a == 2147483647, $a); 188 189{ 190 use integer; 191 my $x = 0; 192 $x++; 193 ok ($x == 1, "(void) i_postinc"); 194 $x--; 195 ok ($x == 0, "(void) i_postdec"); 196} 197