summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPerl 5 Porters <perl5-porters@africa.nicoh.com>1996-08-28 02:42:55 +0000
committerAndy Dougherty <doughera@lafcol.lafayette.edu>1996-08-28 02:42:55 +0000
commitb98941349ef30a9e2a7d1bbadf33c4ecf948a1ee (patch)
treed60f4755d8aad691f94b02f2518ee28301925822
parentf783569bc3d9005f69b42948872f9ac61fdd46fb (diff)
downloadperl-b98941349ef30a9e2a7d1bbadf33c4ecf948a1ee.tar.gz
FAKE typeglobs seriously busted (with patch)
Handling of fake typeglobs (scalars that are really globs in disguise) is seriously busted since 5.002 (it wasn't so in 5.001n). The problem is that mg_get() on a glob calls gv_efullname() which might coerce its first arg to a string.
-rw-r--r--t/op/gv.t59
1 files changed, 59 insertions, 0 deletions
diff --git a/t/op/gv.t b/t/op/gv.t
new file mode 100644
index 0000000000..ece32d936c
--- /dev/null
+++ b/t/op/gv.t
@@ -0,0 +1,59 @@
+#!./perl
+
+#
+# various typeglob tests
+#
+
+print "1..11\n";
+
+# type coersion on assignment
+$foo = 'foo';
+$bar = *main::foo;
+$bar = $foo;
+print ref(\$bar) eq 'SCALAR' ? "ok 1\n" : "not ok 1\n";
+$foo = *main::bar;
+
+# type coersion (not) on misc ops
+
+if ($foo) {
+ print ref(\$foo) eq 'GLOB' ? "ok 2\n" : "not ok 2\n";
+}
+
+unless ($foo =~ /abcd/) {
+ print ref(\$foo) eq 'GLOB' ? "ok 3\n" : "not ok 3\n";
+}
+
+if ($foo eq '*main::bar') {
+ print ref(\$foo) eq 'GLOB' ? "ok 4\n" : "not ok 4\n";
+}
+
+# type coersion on substitutions that match
+$a = *main::foo;
+$b = $a;
+$a =~ s/^X//;
+print ref(\$a) eq 'GLOB' ? "ok 5\n" : "not ok 5\n";
+$a =~ s/^\*//;
+print $a eq 'main::foo' ? "ok 6\n" : "not ok 6\n";
+print ref(\$b) eq 'GLOB' ? "ok 7\n" : "not ok 7\n";
+
+# typeglobs as lvalues
+substr($foo, 0, 1) = "XXX";
+print ref(\$foo) eq 'SCALAR' ? "ok 8\n" : "not ok 8\n";
+print $foo eq 'XXXmain::bar' ? "ok 9\n" : "not ok 9\n";
+
+# returning glob values
+sub foo {
+ local($bar) = *main::foo;
+ $foo = *main::bar;
+ return ($foo, $bar);
+}
+
+($fuu, $baa) = foo();
+if (defined $fuu) {
+ print ref(\$fuu) eq 'GLOB' ? "ok 10\n" : "not ok 10\n";
+}
+
+if (defined $baa) {
+ print ref(\$baa) eq 'GLOB' ? "ok 11\n" : "not ok 11\n";
+}
+