X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/9d6d5a7950f47e97191ed3cc7a45cd5b06163193..f2b25aae946cb16fd38f3531fea3c67b6fdd4a07:/t/op/tie_fetch_count.t diff --git a/t/op/tie_fetch_count.t b/t/op/tie_fetch_count.t index 3198105..9f60bb4 100644 --- a/t/op/tie_fetch_count.t +++ b/t/op/tie_fetch_count.t @@ -7,7 +7,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require './test.pl'; - plan (tests => 295); + plan (tests => 312); } use strict; @@ -121,7 +121,15 @@ $dummy = atan2 $var, 1 ; check_count 'atan2'; # Readline/glob tie my $var0, "main", \*DATA; $dummy = <$var0> ; check_count ''; -$dummy = <${var}> ; check_count ''; +$var = \1; +$var .= ; check_count '$tiedref .= '; +$var = "tied"; +$var .= ; check_count '$tiedstr .= '; +$var = *foo; +$var .= ; check_count '$tiedglob .= '; +{ no warnings "glob"; + $dummy = <${var}> ; check_count ''; +} # File operators for (split //, 'rwxoRWXOezsfdpSbctugkTBMAC') { @@ -136,12 +144,17 @@ for (split //, 'rwxoRWXOezsfdpSbctugkTBMAC') { check_count "-$_ \\\$tied_glob"; } $dummy = -l $var ; check_count '-l'; +$var = "test.pl"; +$dummy = -e -e -e $var ; check_count '-e -e'; # Matching $_ = "foo"; $dummy = $var =~ m/ / ; check_count 'm//'; $dummy = $var =~ s/ //; check_count 's///'; -$dummy = $var ~~ 1 ; check_count '~~'; +{ + no warnings 'experimental::smartmatch'; + $dummy = $var ~~ 1 ; check_count '~~'; +} $dummy = $var =~ y/ //; check_count 'y///'; $var = \1; $dummy = $var =~y/ /-/; check_count '$ref =~ y///'; @@ -156,13 +169,19 @@ tie my $var1 => 'main', \1; $dummy = $$var1 ; check_count '${}'; tie my $var2 => 'main', []; $dummy = @$var2 ; check_count '@{}'; -$dummy = shift $var2 ; check_count 'shift arrayref'; +{ + no warnings 'experimental::autoderef'; + $dummy = shift $var2 ; check_count 'shift arrayref'; +} tie my $var3 => 'main', {}; $dummy = %$var3 ; check_count '%{}'; -$dummy = keys $var3 ; check_count 'keys hashref'; +{ + no warnings 'experimental::autoderef'; + $dummy = keys $var3 ; check_count 'keys hashref'; +} { no strict 'refs'; - tie my $var4 => 'main', **; + tie my $var4 => 'main', *]; $dummy = *$var4 ; check_count '*{}'; } @@ -238,6 +257,35 @@ for ([chdir=>''],[chmod=>'0,'],[chown=>'0,0,'],[utime=>'0,0,'], ; check_count 'select $tied_undef, ...'; } +chop(my $u = "\xff\x{100}"); +tie $var, "main", $u; +$dummy = pack "u", $var; check_count 'pack "u", $utf8'; + +tie $var, "main", "\x{100}"; +pos$var = 0 ; check_count 'lvalue pos $utf8'; +$dummy=sprintf"%1s",$var; check_count 'sprintf "%1s", $utf8'; +$dummy=sprintf"%.1s",$var; check_count 'sprintf "%.1s", $utf8'; +$dummy = substr$var,0,1; check_count 'substr $utf8'; +my $l =\substr$var,0,1; +$dummy = $$l ; check_count 'reading lvalue substr($utf8)'; +$$l = 0 ; check_count 'setting lvalue substr($utf8)'; +tie $var, "main", "a"; +$$l = "\x{100}" ; check_count 'assigning $utf8 to lvalue substr'; +tie $var1, "main", "a"; +substr$var1,0,0,"\x{100}"; check_count '4-arg substr with utf8 replacement'; + +{ + local $SIG{__WARN__} = sub {}; + $dummy = warn $var ; check_count 'warn $tied'; + tie $@, => 'main', 1; + $dummy = warn ; check_count 'warn() with $@ tied (num)'; + tie $@, => 'main', \1; + $dummy = warn ; check_count 'warn() with $@ tied (ref)'; + tie $@, => 'main', "foo\n"; + $dummy = warn ; check_count 'warn() with $@ tied (str)'; + untie $@; +} + ############################################### # Tests for $foo binop $foo # ###############################################