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