BEGIN {
chdir 't' if -d 't';
- @INC = '../lib';
require './test.pl';
+ set_up_inc('../lib');
}
$| = 1;
$xxx = 'c' . ($xxx || 'e');
is( $xxx, 'cb', 'variables can be read before being overwritten');
-{ # Check calling STORE
- note('Tied variables, calling STORE');
- my $sc = 0;
- sub B::TIESCALAR {bless [11], 'B'}
- sub B::FETCH { -(shift->[0]) }
- sub B::STORE { $sc++; my $o = shift; $o->[0] = 17 + shift }
-
- my $m;
- tie $m, 'B';
- $m = 100;
-
- is( $sc, 1, 'STORE called when assigning scalar to tied variable' );
-
- my $t = 11;
- $m = $t + 89;
-
- is( $sc, 2, 'and again' );
- is( $m, -117, 'checking the tied variable result' );
-
- $m += $t;
-
- is( $sc, 3, 'called on self-increment' );
- is( $m, 89, 'checking the tied variable result' );
-
-}
-
# Chains of assignments
my ($l1, $l2, $l3, $l4);
if ($@) {
$warning = $@;
chomp $warning;
- if ($@ !~ /is unimplemented/) {
+ if ($@ !~ /(?:is un|not )implemented/) {
fail($_ . ' ' . $warning);
}
}
}
+{ # Check calling STORE
+ note('Tied variables, calling STORE');
+ my $sc = 0;
+ # do not use B:: namespace
+ sub BB::TIESCALAR {bless [11], 'BB'}
+ sub BB::FETCH { -(shift->[0]) }
+ sub BB::STORE { $sc++; my $o = shift; $o->[0] = 17 + shift }
+
+ my $m;
+ tie $m, 'BB';
+ $m = 100;
+
+ is( $sc, 1, 'STORE called when assigning scalar to tied variable' );
+
+ my $t = 11;
+ $m = $t + 89;
+
+ is( $sc, 2, 'and again' );
+ is( $m, -117, 'checking the tied variable result' );
+
+ $m += $t;
+
+ is( $sc, 3, 'called on self-increment' );
+ is( $m, 89, 'checking the tied variable result' );
+
+ for (@INPUT) {
+ ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
+ $comment = $op unless defined $comment;
+ next if ($op =~ /^'\?\?\?'/ or $comment =~ /skip\(.*\Q$^O\E.*\)/i);
+ $op =~ s/==.*//;
+
+ $sc = 0;
+ local $SIG{__WARN__} = \&wrn;
+ eval "\$m = $op";
+ is $sc, $@ ? 0 : 1, "STORE count for $comment";
+ }
+}
+
for (@simple_input) {
($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
$comment = $op unless defined $comment;
if ($@) {
$warning = $@;
chomp $warning;
- if ($@ =~ /is unimplemented/) {
+ if ($@ =~ /(?:is un|not )implemented/) {
SKIP: {
skip $warning, 1;
pass($comment);
}
}
+# [perl #123790] Assigning to a typeglob
+# These used to die or crash.
+# Once the bug is fixed for all ops, we can combine this with the tests
+# above that use <DATA>.
+for my $glob (*__) {
+ $glob = $y x $z;
+ { use integer; $glob = $y <=> $z; }
+ $glob = $y cmp $z;
+ $glob = vec 1, 2, 4;
+ $glob = ~${\""};
+ $glob = split;
+}
+
# XXX This test does not really belong here, as it has nothing to do with
# OPpTARGET_MY optimisation. But where should it go?
eval {
};
is($@, '', 'ex-PVBM assert'.$@);
+# RT perl #127855
+# Check that stringification and assignment to itself doesn't break
+# anything. This is unlikely to actually fail the tests; its more something
+# for valgrind to spot. It will also only fail if SvGROW or its caller
+# decides to over-allocate (otherwise copying the string will skip the
+# sv_grow(), as the new size is the same as the current size).
+
+{
+ my $s;
+ for my $len (1..40) {
+ $s = 'x' x $len;
+ my $t = $s;
+ $t = "$t";
+ ok($s eq $t, "RT 127855: len=$len");
+ }
+}
+
+# time() can't be tested using the standard framework since two successive
+# calls may return differing values.
+
+{
+ my $a;
+ $a = time;
+ $b = time;
+ my $diff = $b - $a;
+ cmp_ok($diff, '>=', 0, "time is monotically increasing");
+ cmp_ok($diff, '<', 2, "time delta is small");
+}
+
+
done_testing();
__END__
ref $cstr # ref nonref
`$runme -e "print qq[1\\n]"` # backtick skip(MSWin32)
`$undefed` # backtick undef skip(MSWin32)
-<*> # glob
+'???' # glob (not currently OA_TARGLEX)
<OP> # readline
'faked' # rcatline
(@z = (1 .. 3)) # aassign
-chop $chopit # chop
-(chop (@x=@chopar)) # schop
-chomp $chopit # chomp
-(chop (@x=@chopar)) # schomp
+(chop (@x=@chopar)) # chop
+chop $chopit # schop
+(chomp (@x=@chopar)) # chomp
+chomp $chopit # schomp
pos $posstr # pos
pos $chopit # pos returns undef
$nn++==2 # postinc
sprintf "%i%i", $n, $n # sprintf
ord $n # ord
chr $n # chr
+chr ${\256} # chr $wide
crypt $n, $n # crypt
ucfirst ($cstr . "a") # ucfirst padtmp
ucfirst $cstr # ucfirst
'???' # kill
getppid # getppid
getpgrp # getpgrp
-'???' # setpgrp
+setpgrp # setpgrp
getpriority $$, $$ # getpriority
'???' # setpriority
-time # time
+'???' # time
localtime $^T # localtime
gmtime $^T # gmtime
'???' # sleep: can randomly fail