This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
shared hash keys and ++/--
[perl5.git] / t / op / inc.t
1 #!./perl -w
2
3 # use strict;
4
5 print "1..24\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 # Verify that shared hash keys become unshared.
91
92 sub check_same {
93   my ($orig, $suspect) = @_;
94   my $fail;
95   while (my ($key, $value) = each %$suspect) {
96     if (exists $orig->{$key}) {
97       if ($orig->{$key} ne $value) {
98         print "# key '$key' was '$orig->{$key}' now '$value'\n";
99         $fail = 1;
100       }
101     } else {
102       print "# key '$key' is '$orig->{$key}', unexpect.\n";
103       $fail = 1;
104     }
105   }
106   foreach (keys %$orig) {
107     next if (exists $suspect->{$_});
108     print "# key '$_' was '$orig->{$_}' now missing\n";
109     $fail = 1;
110   }
111   ok (!$fail);
112 }
113
114 my (%orig) = my (%inc) = my (%dec) = my (%postinc) = my (%postdec)
115   = (1 => 1, ab => "ab");
116 my %up = (1=>2, ab => 'ac');
117 my %down = (1=>0, ab => -1);
118
119 foreach (keys %inc) {
120   my $ans = $up{$_};
121   my $up;
122   eval {$up = ++$_};
123   ok ((defined $up and $up eq $ans), $up, $@);
124 }
125
126 check_same (\%orig, \%inc);
127
128 foreach (keys %dec) {
129   my $ans = $down{$_};
130   my $down;
131   eval {$down = --$_};
132   ok ((defined $down and $down eq $ans), $down, $@);
133 }
134
135 check_same (\%orig, \%dec);
136
137 foreach (keys %postinc) {
138   my $ans = $postinc{$_};
139   my $up;
140   eval {$up = $_++};
141   ok ((defined $up and $up eq $ans), $up, $@);
142 }
143
144 check_same (\%orig, \%postinc);
145
146 foreach (keys %postdec) {
147   my $ans = $postdec{$_};
148   my $down;
149   eval {$down = $_--};
150   ok ((defined $down and $down eq $ans), $down, $@);
151 }
152
153 check_same (\%orig, \%postdec);