xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/t/op/inc.t (revision 0:68f95e015346) 
1#!./perl -w
2
3# use strict;
4
5print "1..26\n";
6
7my $test = 1;
8
9sub 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
36my $a = 2147483647;
37my $c=$a++;
38ok ($a == 2147483648, $a);
39
40$a = 2147483647;
41$c=++$a;
42ok ($a == 2147483648, $a);
43
44$a = 2147483647;
45$a=$a+1;
46ok ($a == 2147483648, $a);
47
48$a = -2147483648;
49$c=$a--;
50ok ($a == -2147483649, $a);
51
52$a = -2147483648;
53$c=--$a;
54ok ($a == -2147483649, $a);
55
56$a = -2147483648;
57$a=$a-1;
58ok ($a == -2147483649, $a);
59
60$a = 2147483648;
61$a = -$a;
62$c=$a--;
63ok ($a == -2147483649, $a);
64
65$a = 2147483648;
66$a = -$a;
67$c=--$a;
68ok ($a == -2147483649, $a);
69
70$a = 2147483648;
71$a = -$a;
72$a=$a-1;
73ok ($a == -2147483649, $a);
74
75$a = 2147483648;
76$b = -$a;
77$c=$b--;
78ok ($b == -$a-1, $a);
79
80$a = 2147483648;
81$b = -$a;
82$c=--$b;
83ok ($b == -$a-1, $a);
84
85$a = 2147483648;
86$b = -$a;
87$b=$b-1;
88ok ($b == -(++$a), $a);
89
90$a = undef;
91ok ($a++ eq '0', do { $a=undef; $a++ }, "postinc undef returns '0'");
92
93$a = undef;
94ok (!defined($a--), do { $a=undef; $a-- }, "postdec undef returns undef");
95
96# Verify that shared hash keys become unshared.
97
98sub 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
120my (%orig) = my (%inc) = my (%dec) = my (%postinc) = my (%postdec)
121  = (1 => 1, ab => "ab");
122my %up = (1=>2, ab => 'ac');
123my %down = (1=>0, ab => -1);
124
125foreach (keys %inc) {
126  my $ans = $up{$_};
127  my $up;
128  eval {$up = ++$_};
129  ok ((defined $up and $up eq $ans), $up, $@);
130}
131
132check_same (\%orig, \%inc);
133
134foreach (keys %dec) {
135  my $ans = $down{$_};
136  my $down;
137  eval {$down = --$_};
138  ok ((defined $down and $down eq $ans), $down, $@);
139}
140
141check_same (\%orig, \%dec);
142
143foreach (keys %postinc) {
144  my $ans = $postinc{$_};
145  my $up;
146  eval {$up = $_++};
147  ok ((defined $up and $up eq $ans), $up, $@);
148}
149
150check_same (\%orig, \%postinc);
151
152foreach (keys %postdec) {
153  my $ans = $postdec{$_};
154  my $down;
155  eval {$down = $_--};
156  ok ((defined $down and $down eq $ans), $down, $@);
157}
158
159check_same (\%orig, \%postdec);
160