Remove duplicate entries from MANIFEST

[p5sagit/p5-mst-13.2.git] / t / op / gv.t

diff --git a/t/op/gv.t b/t/op/gv.t
old mode 100755 (executable)
new mode 100644 (file)
index bca84e7..6f16ce2
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 use warnings;
 
 require './test.pl';
-plan( tests => 160 );
+plan( tests => 182 );
 
 # type coersion on assignment
 $foo = 'foo';
@@ -167,7 +167,10 @@ is (*{*x{GLOB}}, "*main::STDOUT");
     ok(!defined @{$a});
     ok(!defined *{$a});
 
-    ok(!defined %{$a});
+    {
+       no warnings 'deprecated';
+       ok(!defined %{$a});
+    }
     ok(!defined *{$a});
 
     ok(!defined ${$a});
@@ -377,18 +380,15 @@ is (ref $::{oonk}, 'SCALAR', "Export doesn't affect original");
 is (eval 'spritsits', "Value", "Constant has correct value");
 is (ref \$::{spritsits}, 'GLOB', "Symbol table has full typeglob");
 
-my $result;
 # Check that assignment to an existing typeglob works
 {
   my $w = '';
   local $SIG{__WARN__} = sub { $w = $_[0] };
-  $result = *{"plunk"} = \&{"oonk"};
+  *{"plunk"} = [];
+  *{"plunk"} = \&{"oonk"};
   is($w, '', "Should be no warning");
 }
 
-is (ref \$result, 'GLOB',
-    "Non void assignment should still return a typeglob");
-
 is (ref $::{oonk}, 'SCALAR', "Export doesn't affect original");
 is (eval 'plunk', "Value", "Constant has correct value");
 is (ref \$::{plunk}, 'GLOB', "Symbol table has full typeglob");
@@ -398,7 +398,7 @@ my $gr = eval '\*plunk' or die;
 {
   my $w = '';
   local $SIG{__WARN__} = sub { $w = $_[0] };
-  $result = *{$gr} = \&{"oonk"};
+  *{$gr} = \&{"oonk"};
   is($w, '', "Redefining a constant sub to another constant sub with the same underlying value should not warn (It's just re-exporting, and that was always legal)");
 }
 
@@ -406,6 +406,48 @@ is (ref $::{oonk}, 'SCALAR', "Export doesn't affect original");
 is (eval 'plunk', "Value", "Constant has correct value");
 is (ref \$::{plunk}, 'GLOB', "Symbol table has full typeglob");
 
+# Non-void context should defeat the optimisation, and will cause the original
+# to be promoted (what change 26482 intended)
+my $result;
+{
+  my $w = '';
+  local $SIG{__WARN__} = sub { $w = $_[0] };
+  $result = *{"awkkkkkk"} = \&{"oonk"};
+  is($w, '', "Should be no warning");
+}
+
+is (ref \$result, 'GLOB',
+    "Non void assignment should still return a typeglob");
+
+is (ref \$::{oonk}, 'GLOB', "This export does affect original");
+is (eval 'plunk', "Value", "Constant has correct value");
+is (ref \$::{plunk}, 'GLOB', "Symbol table has full typeglob");
+
+delete $::{oonk};
+$::{oonk} = \"Value";
+
+sub non_dangling {
+  my $w = '';
+  local $SIG{__WARN__} = sub { $w = $_[0] };
+  *{"zap"} = \&{"oonk"};
+  is($w, '', "Should be no warning");
+}
+
+non_dangling();
+is (ref $::{oonk}, 'SCALAR', "Export doesn't affect original");
+is (eval 'zap', "Value", "Constant has correct value");
+is (ref $::{zap}, 'SCALAR', "Exported target is also a PCS");
+
+sub dangling {
+  local $SIG{__WARN__} = sub { die $_[0] };
+  *{"biff"} = \&{"oonk"};
+}
+
+dangling();
+is (ref \$::{oonk}, 'GLOB', "This export does affect original");
+is (eval 'biff', "Value", "Constant has correct value");
+is (ref \$::{biff}, 'GLOB', "Symbol table has full typeglob");
+
 {
     use vars qw($glook $smek $foof);
     # Check reference assignment isn't affected by the SV type (bug #38439)
@@ -485,6 +527,71 @@ foreach my $value ([1,2,3], {1=>2}, *STDOUT{IO}, \&ok, *STDOUT{FORMAT}) {
     eval "`` if 0";
     is($@, '', "Can't trip up readpipe overloading");
 }
+
+{
+    die if exists $::{BONK};
+    $::{BONK} = \"powie";
+    *{"BONK"} = \&{"BONK"};
+    eval 'is(BONK(), "powie",
+             "Assigment works when glob created midway (bug 45607)"); 1'
+       or die $@;
+}
+
+# For now these tests are here, but they would probably be better in a file for
+# tests for croaks. (And in turn, that probably deserves to be in a different
+# directory. Gerard Goossen has a point about the layout being unclear
+
+sub coerce_integer {
+    no warnings 'numeric';
+    $_[0] |= 0;
+}
+sub coerce_number {
+    no warnings 'numeric';
+    $_[0] += 0;
+}
+sub coerce_string {
+    $_[0] .= '';
+}
+
+foreach my $type (qw(integer number string)) {
+    my $prog = "coerce_$type(*STDERR)";
+    is (scalar eval "$prog; 1", undef, "$prog failed...");
+    like ($@, qr/Can't coerce GLOB to $type in/,
+         "with the correct error message");
+}
+
+# RT #60954 anonymous glob should be defined, and not coredump when
+# stringified. The behaviours are:
+#
+#        defined($glob)    "$glob"
+# 5.8.8     false           "" with uninit warning
+# 5.10.0    true            (coredump)
+# 5.12.0    true            ""
+
+{
+    my $io_ref = *STDOUT{IO};
+    my $glob = *$io_ref;
+    ok(defined $glob, "RT #60954 anon glob should be defined");
+
+    my $warn = '';
+    local $SIG{__WARN__} = sub { $warn = $_[0] };
+    use warnings;
+    my $str = "$glob";
+    is($warn, '', "RT #60954 anon glob stringification shouln't warn");
+    is($str,  '', "RT #60954 anon glob stringification should be empty");
+}
+
+# [perl #71254] - Assigning a glob to a variable that has a current
+# match position. (We are testing that Perl_magic_setmglob respects globs'
+# special used of SvSCREAM.)
+{
+    $m = 2; $m=~s/./0/gems; $m= *STDERR;
+    is(
+        "$m", "*main::STDERR",
+        '[perl #71254] assignment of globs to vars with pos'
+    );
+}
+
 __END__
 Perl
 Rules