Commit | Line | Data |
---|---|---|
3510b4a1 | 1 | #!./perl -w |
760ac839 | 2 | |
3510b4a1 NC |
3 | # use strict; |
4 | ||
679d6c4e | 5 | print "1..34\n"; |
3510b4a1 NC |
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 | } | |
760ac839 LW |
31 | |
32 | # Verify that addition/subtraction properly upgrade to doubles. | |
1eb770ff | 33 | # These tests are only significant on machines with 32 bit longs, |
34 | # and two's complement negation, but shouldn't fail anywhere. | |
760ac839 | 35 | |
3510b4a1 NC |
36 | my $a = 2147483647; |
37 | my $c=$a++; | |
38 | ok ($a == 2147483648, $a); | |
760ac839 LW |
39 | |
40 | $a = 2147483647; | |
41 | $c=++$a; | |
3510b4a1 | 42 | ok ($a == 2147483648, $a); |
760ac839 LW |
43 | |
44 | $a = 2147483647; | |
45 | $a=$a+1; | |
3510b4a1 | 46 | ok ($a == 2147483648, $a); |
760ac839 LW |
47 | |
48 | $a = -2147483648; | |
49 | $c=$a--; | |
3510b4a1 | 50 | ok ($a == -2147483649, $a); |
760ac839 LW |
51 | |
52 | $a = -2147483648; | |
53 | $c=--$a; | |
3510b4a1 | 54 | ok ($a == -2147483649, $a); |
760ac839 LW |
55 | |
56 | $a = -2147483648; | |
57 | $a=$a-1; | |
3510b4a1 | 58 | ok ($a == -2147483649, $a); |
9b0e499b GS |
59 | |
60 | $a = 2147483648; | |
61 | $a = -$a; | |
62 | $c=$a--; | |
3510b4a1 | 63 | ok ($a == -2147483649, $a); |
9b0e499b GS |
64 | |
65 | $a = 2147483648; | |
66 | $a = -$a; | |
67 | $c=--$a; | |
3510b4a1 | 68 | ok ($a == -2147483649, $a); |
9b0e499b GS |
69 | |
70 | $a = 2147483648; | |
71 | $a = -$a; | |
72 | $a=$a-1; | |
3510b4a1 | 73 | ok ($a == -2147483649, $a); |
9b0e499b GS |
74 | |
75 | $a = 2147483648; | |
76 | $b = -$a; | |
77 | $c=$b--; | |
3510b4a1 | 78 | ok ($b == -$a-1, $a); |
9b0e499b GS |
79 | |
80 | $a = 2147483648; | |
81 | $b = -$a; | |
82 | $c=--$b; | |
3510b4a1 | 83 | ok ($b == -$a-1, $a); |
9b0e499b GS |
84 | |
85 | $a = 2147483648; | |
86 | $b = -$a; | |
87 | $b=$b-1; | |
3510b4a1 NC |
88 | ok ($b == -(++$a), $a); |
89 | ||
f9b9d3d6 HS |
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 | ||
3510b4a1 NC |
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); | |
ef088171 NC |
160 | |
161 | { | |
162 | no warnings 'uninitialized'; | |
840378f5 | 163 | my ($x, $y); |
ef088171 NC |
164 | eval { |
165 | $y ="$x\n"; | |
166 | ++$x; | |
167 | }; | |
168 | ok($x == 1, $x); | |
169 | ok($@ eq '', $@); | |
170 | ||
840378f5 | 171 | my ($p, $q); |
ef088171 NC |
172 | eval { |
173 | $q ="$p\n"; | |
174 | --$p; | |
175 | }; | |
176 | ok($p == -1, $p); | |
177 | ok($@ eq '', $@); | |
178 | } | |
f4eee32f NC |
179 | |
180 | $a = 2147483648; | |
181 | $c=--$a; | |
182 | ok ($a == 2147483647, $a); | |
183 | ||
184 | ||
185 | $a = 2147483648; | |
186 | $c=$a--; | |
187 | ok ($a == 2147483647, $a); | |
679d6c4e HS |
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 | } |