Suppress a few compilation warnings in pp_hot.c.
[p5sagit/p5-mst-13.2.git] / 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);