Commit | Line | Data |
---|---|---|
60ccc62f A |
1 | #!./perl |
2 | # Tests counting number of FETCHes. | |
3 | # | |
4 | # See Bug #76814. | |
5 | ||
6 | BEGIN { | |
7 | chdir 't' if -d 't'; | |
8 | @INC = '../lib'; | |
9 | require './test.pl'; | |
a9984b10 | 10 | plan (tests => 94); |
60ccc62f A |
11 | } |
12 | ||
13 | use strict; | |
14 | use warnings; | |
15 | ||
60ccc62f A |
16 | my $count = 0; |
17 | ||
18 | sub TIESCALAR {bless \do {my $var = $_ [1]} => $_ [0];} | |
19 | sub FETCH {$count ++; ${$_ [0]}} | |
20 | sub STORE {1;} | |
21 | ||
22 | ||
23 | sub check_count { | |
24 | my $op = shift; | |
79504a3e | 25 | is $count, 1, "FETCH called just once using '$op'"; |
60ccc62f A |
26 | $count = 0; |
27 | } | |
28 | ||
29 | my ($dummy, @dummy); | |
30 | ||
31 | tie my $var => 'main', 1; | |
32 | ||
33 | # Assignment. | |
34 | $dummy = $var ; check_count "="; | |
35 | ||
36 | # Unary +/- | |
37 | $dummy = +$var ; check_count "unary +"; | |
38 | $dummy = -$var ; check_count "unary -"; | |
39 | ||
40 | # Basic arithmetic and string operators. | |
41 | $dummy = $var + 1 ; check_count '+'; | |
42 | $dummy = $var - 1 ; check_count '-'; | |
43 | $dummy = $var / 1 ; check_count '/'; | |
44 | $dummy = $var * 1 ; check_count '*'; | |
45 | $dummy = $var % 1 ; check_count '%'; | |
46 | $dummy = $var ** 1 ; check_count '**'; | |
47 | $dummy = $var << 1 ; check_count '<<'; | |
48 | $dummy = $var >> 1 ; check_count '>>'; | |
49 | $dummy = $var x 1 ; check_count 'x'; | |
50 | @dummy = ($var) x 1 ; check_count 'x'; | |
51 | $dummy = $var . 1 ; check_count '.'; | |
52 | ||
53 | # Pre/post in/decrement | |
54 | $var ++ ; check_count 'post ++'; | |
55 | $var -- ; check_count 'post --'; | |
56 | ++ $var ; check_count 'pre ++'; | |
57 | -- $var ; check_count 'pre --'; | |
58 | ||
59 | # Numeric comparison | |
60 | $dummy = $var < 1 ; check_count '<'; | |
61 | $dummy = $var <= 1 ; check_count '<='; | |
62 | $dummy = $var == 1 ; check_count '=='; | |
63 | $dummy = $var >= 1 ; check_count '>='; | |
64 | $dummy = $var > 1 ; check_count '>'; | |
65 | $dummy = $var != 1 ; check_count '!='; | |
66 | $dummy = $var <=> 1 ; check_count '<=>'; | |
67 | ||
68 | # String comparison | |
078504b2 FC |
69 | $dummy = $var lt 1 ; check_count 'lt'; |
70 | $dummy = $var le 1 ; check_count 'le'; | |
71 | $dummy = $var eq 1 ; check_count 'eq'; | |
72 | $dummy = $var ge 1 ; check_count 'ge'; | |
73 | $dummy = $var gt 1 ; check_count 'gt'; | |
74 | $dummy = $var ne 1 ; check_count 'ne'; | |
75 | $dummy = $var cmp 1 ; check_count 'cmp'; | |
60ccc62f A |
76 | |
77 | # Bitwise operators | |
78 | $dummy = $var & 1 ; check_count '&'; | |
79 | $dummy = $var ^ 1 ; check_count '^'; | |
80 | $dummy = $var | 1 ; check_count '|'; | |
81 | $dummy = ~$var ; check_count '~'; | |
82 | ||
83 | # Logical operators | |
06c841cf | 84 | $dummy = !$var ; check_count '!'; |
1c3caf3f FC |
85 | tie my $v_1, "main", 0; |
86 | $dummy = $v_1 || 1 ; check_count '||'; | |
87 | $dummy = ($v_1 or 1); check_count 'or'; | |
60ccc62f A |
88 | $dummy = $var && 1 ; check_count '&&'; |
89 | $dummy = ($var and 1); check_count 'and'; | |
90 | $dummy = ($var xor 1); check_count 'xor'; | |
91 | $dummy = $var ? 1 : 1 ; check_count '?:'; | |
92 | ||
93 | # Overloadable functions | |
94 | $dummy = sin $var ; check_count 'sin'; | |
95 | $dummy = cos $var ; check_count 'cos'; | |
96 | $dummy = exp $var ; check_count 'exp'; | |
97 | $dummy = abs $var ; check_count 'abs'; | |
98 | $dummy = log $var ; check_count 'log'; | |
99 | $dummy = sqrt $var ; check_count 'sqrt'; | |
100 | $dummy = int $var ; check_count 'int'; | |
101 | $dummy = atan2 $var, 1 ; check_count 'atan2'; | |
102 | ||
103 | # Readline/glob | |
104 | tie my $var0, "main", \*DATA; | |
105 | $dummy = <$var0> ; check_count '<readline>'; | |
106 | $dummy = <${var}> ; check_count '<glob>'; | |
107 | ||
108 | # File operators | |
109 | $dummy = -r $var ; check_count '-r'; | |
110 | $dummy = -w $var ; check_count '-w'; | |
111 | $dummy = -x $var ; check_count '-x'; | |
112 | $dummy = -o $var ; check_count '-o'; | |
113 | $dummy = -R $var ; check_count '-R'; | |
114 | $dummy = -W $var ; check_count '-W'; | |
115 | $dummy = -X $var ; check_count '-X'; | |
116 | $dummy = -O $var ; check_count '-O'; | |
117 | $dummy = -e $var ; check_count '-e'; | |
118 | $dummy = -z $var ; check_count '-z'; | |
119 | $dummy = -s $var ; check_count '-s'; | |
120 | $dummy = -f $var ; check_count '-f'; | |
121 | $dummy = -d $var ; check_count '-d'; | |
122 | $dummy = -l $var ; check_count '-l'; | |
123 | $dummy = -p $var ; check_count '-p'; | |
124 | $dummy = -S $var ; check_count '-S'; | |
125 | $dummy = -b $var ; check_count '-b'; | |
126 | $dummy = -c $var ; check_count '-c'; | |
127 | $dummy = -t $var ; check_count '-t'; | |
128 | $dummy = -u $var ; check_count '-u'; | |
129 | $dummy = -g $var ; check_count '-g'; | |
130 | $dummy = -k $var ; check_count '-k'; | |
131 | $dummy = -T $var ; check_count '-T'; | |
132 | $dummy = -B $var ; check_count '-B'; | |
133 | $dummy = -M $var ; check_count '-M'; | |
134 | $dummy = -A $var ; check_count '-A'; | |
135 | $dummy = -C $var ; check_count '-C'; | |
136 | ||
137 | # Matching | |
138 | $_ = "foo"; | |
139 | $dummy = $var =~ m/ / ; check_count 'm//'; | |
140 | $dummy = $var =~ s/ //; check_count 's///'; | |
141 | $dummy = $var ~~ 1 ; check_count '~~'; | |
9138d6ca | 142 | $dummy = $var =~ y/ //; check_count 'y///'; |
a9984b10 FC |
143 | /$var/ ; check_count 'm/pattern/'; |
144 | /$var foo/ ; check_count 'm/$tied foo/'; | |
145 | s/$var// ; check_count 's/pattern//'; | |
146 | s/$var foo// ; check_count 's/$tied foo//'; | |
60ccc62f A |
147 | s/./$var/ ; check_count 's//replacement/'; |
148 | ||
149 | # Dereferencing | |
150 | tie my $var1 => 'main', \1; | |
151 | $dummy = $$var1 ; check_count '${}'; | |
152 | tie my $var2 => 'main', []; | |
153 | $dummy = @$var2 ; check_count '@{}'; | |
154 | tie my $var3 => 'main', {}; | |
155 | $dummy = %$var3 ; check_count '%{}'; | |
156 | { | |
157 | no strict 'refs'; | |
158 | tie my $var4 => 'main', **; | |
159 | $dummy = *$var4 ; check_count '*{}'; | |
160 | } | |
161 | ||
162 | tie my $var5 => 'main', sub {1}; | |
163 | $dummy = &$var5 ; check_count '&{}'; | |
164 | ||
165 | __DATA__ |