make gv_fullname() etc include a literal '^' for *^FOO style names

[perl5.git] / t / op / gv.t

diff --git a/t/op/gv.t b/t/op/gv.t
index c253e4b..851f6b1 100755 (executable)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -4,7 +4,14 @@
 # various typeglob tests
 #
 
-print "1..23\n";
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}   
+
+use warnings;
+
+print "1..53\n";
 
 # type coersion on assignment
 $foo = 'foo';
@@ -62,7 +69,7 @@ if (defined $baa) {
 #        fact that %X::Y:: is stored in %X:: isn't documented.
 #        (I hope.)
 
-{ package Foo::Bar }
+{ package Foo::Bar; no warnings 'once'; $test=1; }
 print exists $Foo::{'Bar::'} ? "ok 12\n" : "not ok 12\n";
 print $Foo::{'Bar::'} eq '*Foo::Bar::' ? "ok 13\n" : "not ok 13\n";
 
@@ -77,7 +84,7 @@ print +($foo || @foo || %foo) ? "not ok" : "ok", " 14\n";
 {
     my $msg;
     local $SIG{__WARN__} = sub { $msg = $_[0] };
-    local $^W = 1;
+    use warnings;
     *foo = 'bar';
     print $msg ? "not ok" : "ok", " 15\n";
     *foo = undef;
@@ -90,9 +97,156 @@ $x = "ok 17\n";
 %x = ("ok 19" => "\n");
 sub x { "ok 20\n" }
 print ${*x{SCALAR}}, @{*x{ARRAY}}, %{*x{HASH}}, &{*x{CODE}};
+format x =
+ok 21
+.
+print ref *x{FORMAT} eq "FORMAT" ? "ok 21\n" : "not ok 21\n";
 *x = *STDOUT;
-print *{*x{GLOB}} eq "*main::STDOUT" ? "ok 21\n" : "not ok 21\n";
-print {*x{IO}} "ok 22\n";
-print {*x{FILEHANDLE}} "ok 23\n";
+print *{*x{GLOB}} eq "*main::STDOUT" ? "ok 22\n" : "not ok 22\n";
+print {*x{IO}} "ok 23\n";
+
+{
+       my $warn;
+       local $SIG{__WARN__} = sub {
+               $warn .= $_[0];
+       };
+       my $val = *x{FILEHANDLE};
+       print {*x{IO}} ($warn =~ /is deprecated/ ? "ok 24\n" : "not ok 24\n");
+       
+}
+
+# test if defined() doesn't create any new symbols
+
+{
+    my $test = 24;
+
+    my $a = "SYM000";
+    print "not " if defined *{$a};
+    ++$test; print "ok $test\n";
+
+    print "not " if defined @{$a} or defined *{$a};
+    ++$test; print "ok $test\n";
+
+    print "not " if defined %{$a} or defined *{$a};
+    ++$test; print "ok $test\n";
+
+    print "not " if defined ${$a} or defined *{$a};
+    ++$test; print "ok $test\n";
+
+    print "not " if defined &{$a} or defined *{$a};
+    ++$test; print "ok $test\n";
+
+    *{$a} = sub { print "ok $test\n" };
+    print "not " unless defined &{$a} and defined *{$a};
+    ++$test; &{$a};
+}
+
+# although it *should* if you're talking about magicals
+
+{
+    my $test = 30;
+
+    my $a = "]";
+    print "not " unless defined ${$a};
+    ++$test; print "ok $test\n";
+    print "not " unless defined *{$a};
+    ++$test; print "ok $test\n";
+
+    $a = "1";
+    "o" =~ /(o)/;
+    print "not " unless ${$a};
+    ++$test; print "ok $test\n";
+    print "not " unless defined *{$a};
+    ++$test; print "ok $test\n";
+    $a = "2";
+    print "not " if ${$a};
+    ++$test; print "ok $test\n";
+    print "not " unless defined *{$a};
+    ++$test; print "ok $test\n";
+    $a = "1x";
+    print "not " if defined ${$a};
+    ++$test; print "ok $test\n";
+    print "not " if defined *{$a};
+    ++$test; print "ok $test\n";
+    $a = "11";
+    "o" =~ /(((((((((((o)))))))))))/;
+    print "not " unless ${$a};
+    ++$test; print "ok $test\n";
+    print "not " unless defined *{$a};
+    ++$test; print "ok $test\n";
+}
+
+
+# [ID 20010526.001] localized glob loses value when assigned to
+
+$j=1; %j=(a=>1); @j=(1); local *j=*j; *j = sub{};
+
+print $j    == 1 ? "ok 41\n"  : "not ok 41\n";
+print $j{a} == 1 ? "ok 42\n"  : "not ok 42\n";
+print $j[0] == 1 ? "ok 43\n" : "not ok 43\n";
+
+# does pp_readline() handle glob-ness correctly?
+
+{
+    my $g = *foo;
+    $g = <DATA>;
+    print $g;
+}
+
+{
+    my $w = '';
+    $SIG{__WARN__} = sub { $w = $_[0] };
+    sub abc1 ();
+    local *abc1 = sub { };
+    print $w eq '' ? "ok 45\n" : "not ok 45\n# $w";
+    sub abc2 ();
+    local *abc2;
+    *abc2 = sub { };
+    print $w eq '' ? "ok 46\n" : "not ok 46\n# $w";
+    sub abc3 ();
+    *abc3 = sub { };
+    print $w =~ /Prototype mismatch/ ? "ok 47\n" : "not ok 47\n# $w";
+}
+
+{
+    # [17375] rcatline to formerly-defined undef was broken. Fixed in
+    # do_readline by checking SvOK. AMS, 20020918
+    my $x = "not ";
+    $x  = undef;
+    $x .= <DATA>;
+    print $x;
+}
+
+{
+    # test the assignment of a GLOB to an LVALUE
+    my $e = '';
+    local $SIG{__DIE__} = sub { $e = $_[0] };
+    my $v;
+    sub f { $_[0] = 0; $_[0] = "a"; $_[0] = *DATA }
+    f($v);
+    print $v eq '*main::DATA' ? "ok 49\n" : "not ok 49\n# $e";
+    my $x = <$v>;
+    print $x || "not ok 50\n";
+}
+
+{   
+    # GLOB assignment to tied element
+    local $SIG{__DIE__} = sub { $e = $_[0] };
+    sub T::TIEARRAY { bless [] => "T" }
+    sub T::STORE    { $_[0]->[ $_[1] ] = $_[2] }
+    sub T::FETCH    { $_[0]->[ $_[1] ] }
+    tie my @ary => "T";
+    $ary[0] = *DATA;
+    print $ary[0] eq '*main::DATA' ? "ok 51\n" : "not ok 51\n# $e";
+    my $x = readline $ary[0];
+    print $x || "not ok 52\n";
+}
 
+# stringified typeglob should escape leading control char
+print *^A eq "*main::^A" ? "ok 53\n" : "not ok 53\n";
 
+__END__
+ok 44
+ok 48
+ok 50
+ok 52