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