4 # various typeglob tests
17 # type coersion on assignment
21 is(ref(\$bar), 'SCALAR');
24 # type coersion (not) on misc ops
27 is(ref(\$foo), 'GLOB');
29 unlike ($foo, qr/abcd/);
30 is(ref(\$foo), 'GLOB');
32 is($foo, '*main::bar');
33 is(ref(\$foo), 'GLOB');
35 # type coersion on substitutions that match
44 # typeglobs as lvalues
45 substr($foo, 0, 1) = "XXX";
46 is(ref(\$foo), 'SCALAR');
47 is($foo, 'XXXmain::bar');
49 # returning glob values
51 local($bar) = *main::foo;
58 is(ref(\$fuu), 'GLOB');
62 is(ref(\$baa), 'GLOB');
64 # nested package globs
65 # NOTE: It's probably OK if these semantics change, because the
66 # fact that %X::Y:: is stored in %X:: isn't documented.
69 { package Foo::Bar; no warnings 'once'; $test=1; }
70 ok(exists $Foo::{'Bar::'});
71 is($Foo::{'Bar::'}, '*Foo::Bar::');
74 # test undef operator clearing out entire glob
76 @foo = qw(more stuff);
77 %foo = qw(even more random stuff);
84 # test warnings from assignment of undef to glob
86 local $SIG{__WARN__} = sub { $msg = $_[0] };
91 like($msg, qr/Undefined value assigned to typeglob/);
94 my $test = curr_test();
95 # test *glob{THING} syntax
100 %x = ("ok $test" => "\n");
102 sub x { "ok $test\n" }
103 print ${*x{SCALAR}}, @{*x{ARRAY}}, %{*x{HASH}}, &{*x{CODE}};
104 # This needs to go here, after the print, as sub x will return the current
108 XXX This text isn't used. Should it be?
112 is (ref *x{FORMAT}, "FORMAT");
114 is (*{*x{GLOB}}, "*main::STDOUT");
117 my $test = curr_test();
119 print {*x{IO}} "ok $test\n";
123 local $SIG{__WARN__} = sub {
126 my $val = *x{FILEHANDLE};
127 print {*x{IO}} ($warn =~ /is deprecated/
128 ? "ok $test\n" : "not ok $test\n");
134 # test if defined() doesn't create any new symbols
152 *{$a} = sub { $state = "ok" };
160 # although it *should* if you're talking about magicals
177 "o" =~ /(((((((((((o)))))))))))/;
182 # [ID 20010526.001] localized glob loses value when assigned to
184 $j=1; %j=(a=>1); @j=(1); local *j=*j; *j = sub{};
191 # does pp_readline() handle glob-ness correctly?
199 $SIG{__WARN__} = sub { $w = $_[0] };
201 local *abc1 = sub { };
209 like ($w, qr/Prototype mismatch/);
213 # [17375] rcatline to formerly-defined undef was broken. Fixed in
214 # do_readline by checking SvOK. AMS, 20020918
222 # test the assignment of a GLOB to an LVALUE
224 local $SIG{__DIE__} = sub { $e = $_[0] };
226 sub f { $_[0] = 0; $_[0] = "a"; $_[0] = *DATA }
228 is ($v, '*main::DATA');
235 # GLOB assignment to tied element
236 local $SIG{__DIE__} = sub { $e = $_[0] };
237 sub T::TIEARRAY { bless [] => "T" }
238 sub T::STORE { $_[0]->[ $_[1] ] = $_[2] }
239 sub T::FETCH { $_[0]->[ $_[1] ] }
240 sub T::FETCHSIZE { @{$_[0]} }
243 is ($ary[0], '*main::DATA');
245 my $x = readline $ary[0];
250 # Need some sort of die or warn to get the global destruction text if the
251 # bug is still present
252 my $output = runperl(prog => <<'EOPROG');
255 sub DESTROY {eval {die qq{Farewell $_[0]}}; print $@}
261 like($output, qr/^Farewell M=SCALAR/, "DESTROY was called");
262 unlike($output, qr/global destruction/,
263 "unreferenced symbol tables should be cleaned up immediately");