require 'test.pl';
use strict qw(refs subs);
-plan(119);
+plan(138);
# Test glob operations.
is ($$name1, "Yummy", 'Accessing via the correct name works');
is ($$name2, undef,
'Accessing via a different NUL-containing name gives nothing');
+ # defined uses a different code path
+ ok (defined $$name1, 'defined via the correct name works');
+ ok (!defined $$name2,
+ 'defined via a different NUL-containing name gives nothing');
is ($name1->[0], undef, 'Nothing before we start (arrays)');
is ($name2->[0], undef, 'Nothing before we start');
is ($name1->[0], "Yummy", 'Accessing via the correct name works');
is ($name2->[0], undef,
'Accessing via a different NUL-containing name gives nothing');
+ ok (defined $name1->[0], 'defined via the correct name works');
+ ok (!defined$name2->[0],
+ 'defined via a different NUL-containing name gives nothing');
my (undef, $one) = @{$name1}[2,3];
my (undef, $two) = @{$name2}[2,3];
is ($one, "Yummy", 'Accessing via the correct name works');
is ($two, undef,
'Accessing via a different NUL-containing name gives nothing');
+ ok (defined $one, 'defined via the correct name works');
+ ok (!defined $two,
+ 'defined via a different NUL-containing name gives nothing');
is ($name1->{PWOF}, undef, 'Nothing before we start (hashes)');
is ($name2->{PWOF}, undef, 'Nothing before we start');
is ($name1->{PWOF}, "Yummy", 'Accessing via the correct name works');
is ($name2->{PWOF}, undef,
'Accessing via a different NUL-containing name gives nothing');
+ ok (defined $name1->{PWOF}, 'defined via the correct name works');
+ ok (!defined $name2->{PWOF},
+ 'defined via a different NUL-containing name gives nothing');
my (undef, $one) = @{$name1}{'SNIF', 'BEEYOOP'};
my (undef, $two) = @{$name2}{'SNIF', 'BEEYOOP'};
is ($one, "Yummy", 'Accessing via the correct name works');
is ($two, undef,
'Accessing via a different NUL-containing name gives nothing');
+ ok (defined $one, 'defined via the correct name works');
+ ok (!defined $two,
+ 'defined via a different NUL-containing name gives nothing');
$name1 = "Left"; $name2 = "Left\0Right";
my $glob2 = *{$name2};
- isnt ($glob1, $glob2, "We get different typeglobs");
+ is ($glob1, undef, "We get different typeglobs. In fact, undef");
+
+ *{$name1} = sub {"One"};
+ *{$name2} = sub {"Two"};
+
+ is (&{$name1}, "One");
+ is (&{$name2}, "Two");
}
# test derefs after list slice
# test dereferencing errors
{
- eval q/ ${*STDOUT{IO}} /;
- like($@, qr/Not a SCALAR reference/);
- eval q/ @{*STDOUT{IO}} /;
- like($@, qr/Not an ARRAY reference/);
- eval q/ %{*STDOUT{IO}} /;
- like($@, qr/Not a HASH reference/);
- eval q/ &{*STDOUT{IO}} /;
- like($@, qr/Not a CODE reference/);
+ format STDERR =
+.
+ my $ref;
+ foreach $ref (*STDOUT{IO}, *STDERR{FORMAT}) {
+ eval q/ $$ref /;
+ like($@, qr/Not a SCALAR reference/, "Scalar dereference");
+ eval q/ @$ref /;
+ like($@, qr/Not an ARRAY reference/, "Array dereference");
+ eval q/ %$ref /;
+ like($@, qr/Not a HASH reference/, "Hash dereference");
+ eval q/ &$ref /;
+ like($@, qr/Not a CODE reference/, "Code dereference");
+ }
+
+ $ref = *STDERR{FORMAT};
+ eval q/ *$ref /;
+ like($@, qr/Not a GLOB reference/, "Glob dereference");
+
+ $ref = *STDOUT{IO};
+ eval q/ *$ref /;
+ is($@, '', "Glob dereference of PVIO is acceptable");
+
+ is($ref, *{$ref}{IO}, "IO slot of the temporary glob is set correctly");
}
# Bit of a hack to make test.pl happy. There are 3 more tests after it leaves.