#!./perl -w # use strict; print "1..24\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; } # Verify that addition/subtraction properly upgrade to doubles. # These tests are only significant on machines with 32 bit longs, # and two's complement negation, but shouldn't fail anywhere. my $a = 2147483647; my $c=$a++; ok ($a == 2147483648, $a); $a = 2147483647; $c=++$a; ok ($a == 2147483648, $a); $a = 2147483647; $a=$a+1; ok ($a == 2147483648, $a); $a = -2147483648; $c=$a--; ok ($a == -2147483649, $a); $a = -2147483648; $c=--$a; ok ($a == -2147483649, $a); $a = -2147483648; $a=$a-1; ok ($a == -2147483649, $a); $a = 2147483648; $a = -$a; $c=$a--; ok ($a == -2147483649, $a); $a = 2147483648; $a = -$a; $c=--$a; ok ($a == -2147483649, $a); $a = 2147483648; $a = -$a; $a=$a-1; ok ($a == -2147483649, $a); $a = 2147483648; $b = -$a; $c=$b--; ok ($b == -$a-1, $a); $a = 2147483648; $b = -$a; $c=--$b; ok ($b == -$a-1, $a); $a = 2147483648; $b = -$a; $b=$b-1; ok ($b == -(++$a), $a); # Verify that shared hash keys become unshared. sub check_same { my ($orig, $suspect) = @_; my $fail; while (my ($key, $value) = each %$suspect) { if (exists $orig->{$key}) { if ($orig->{$key} ne $value) { print "# key '$key' was '$orig->{$key}' now '$value'\n"; $fail = 1; } } else { print "# key '$key' is '$orig->{$key}', unexpect.\n"; $fail = 1; } } foreach (keys %$orig) { next if (exists $suspect->{$_}); print "# key '$_' was '$orig->{$_}' now missing\n"; $fail = 1; } ok (!$fail); } my (%orig) = my (%inc) = my (%dec) = my (%postinc) = my (%postdec) = (1 => 1, ab => "ab"); my %up = (1=>2, ab => 'ac'); my %down = (1=>0, ab => -1); foreach (keys %inc) { my $ans = $up{$_}; my $up; eval {$up = ++$_}; ok ((defined $up and $up eq $ans), $up, $@); } check_same (\%orig, \%inc); foreach (keys %dec) { my $ans = $down{$_}; my $down; eval {$down = --$_}; ok ((defined $down and $down eq $ans), $down, $@); } check_same (\%orig, \%dec); foreach (keys %postinc) { my $ans = $postinc{$_}; my $up; eval {$up = $_++}; ok ((defined $up and $up eq $ans), $up, $@); } check_same (\%orig, \%postinc); foreach (keys %postdec) { my $ans = $postdec{$_}; my $down; eval {$down = $_--}; ok ((defined $down and $down eq $ans), $down, $@); } check_same (\%orig, \%postdec);