This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make gv_fullname() etc include a literal '^' for *^FOO style names
[perl5.git] / t / op / gv.t
index bb10b75..851f6b1 100755 (executable)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -6,12 +6,12 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }   
 
 use warnings;
 
-print "1..41\n";
+print "1..53\n";
 
 # type coersion on assignment
 $foo = 'foo';
@@ -104,7 +104,16 @@ print ref *x{FORMAT} eq "FORMAT" ? "ok 21\n" : "not ok 21\n";
 *x = *STDOUT;
 print *{*x{GLOB}} eq "*main::STDOUT" ? "ok 22\n" : "not ok 22\n";
 print {*x{IO}} "ok 23\n";
-print {*x{FILEHANDLE}} "ok 24\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
 
@@ -168,6 +177,14 @@ print {*x{FILEHANDLE}} "ok 24\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?
 
 {
@@ -176,5 +193,60 @@ print {*x{FILEHANDLE}} "ok 24\n";
     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 41
+ok 44
+ok 48
+ok 50
+ok 52