summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2002-05-29 13:21:58 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2002-05-29 13:21:58 +0000
commit87f0b2135fb8ed0f01fabb0bd9eac630ea278e75 (patch)
treeade1d0602fcf39e6ce65669c7add245b8e451a67 /t
parentb0ef04295d6eb384855a3fa2790521ad3437adc1 (diff)
downloadperl-87f0b2135fb8ed0f01fabb0bd9eac630ea278e75.tar.gz
Recover some of the #16845.
p4raw-id: //depot/perl@16858
Diffstat (limited to 't')
-rwxr-xr-xt/op/tie.t42
-rw-r--r--t/run/fresh_perl.t6
2 files changed, 36 insertions, 12 deletions
diff --git a/t/op/tie.t b/t/op/tie.t
index f8f2322632..914db116a0 100755
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -3,7 +3,7 @@
# This test harness will (eventually) test the "tie" functionality
# without the need for a *DBM* implementation.
-# Currently it only tests the untie warning
+# Currently it only tests the untie warning
chdir 't' if -d 't';
@INC = '../lib';
@@ -138,7 +138,7 @@ untie %h;
EXPECT
########
-# strict error behaviour, with 2 extra references
+# strict error behaviour, with 2 extra references
use warnings 'untie';
use Tie::Hash ;
$a = tie %h, Tie::StdHash;
@@ -171,7 +171,7 @@ sub Self::DESTROY { $b = $_[0] + 1; }
tie %c, 'Self', \%c;
}
EXPECT
-Self-ties of arrays and hashes are not supported
+Self-ties of arrays and hashes are not supported
########
# Allowed scalar self-ties
my ($a, $b) = (0, 0);
@@ -206,8 +206,38 @@ EXPECT
# correct unlocalisation of tied hashes (patch #16431)
use Tie::Hash ;
tie %tied, Tie::StdHash;
-{ local $hash{'foo'} } print "exist1\n" if exists $hash{'foo'};
-{ local $tied{'foo'} } print "exist2\n" if exists $tied{'foo'};
-{ local $ENV{'foo'} } print "exist3\n" if exists $ENV{'foo'};
+{ local $hash{'foo'} } warn "plain hash bad unlocalize" if exists $hash{'foo'};
+{ local $tied{'foo'} } warn "tied hash bad unlocalize" if exists $tied{'foo'};
+{ local $ENV{'foo'} } warn "%ENV bad unlocalize" if exists $ENV{'foo'};
EXPECT
+########
+# Allowed glob self-ties
+my $destroyed = 0;
+my $printed = 0;
+sub Self2::TIEHANDLE { bless $_[1], $_[0] }
+sub Self2::DESTROY { $destroyed = 1; }
+sub Self2::PRINT { $printed = 1; }
+{
+ use Symbol;
+ my $c = gensym;
+ tie *$c, 'Self2', $c;
+ print $c 'Hello';
+}
+die "self-tied glob not PRINTed" unless $printed == 1;
+die "self-tied glob not DESTROYd" unless $destroyed == 1;
+EXPECT
+########
+
+# Allowed IO self-ties
+my $destroyed = 0;
+sub Self3::TIEHANDLE { bless $_[1], $_[0] }
+sub Self3::DESTROY { $destroyed = 1; }
+{
+ use Symbol 'geniosym';
+ my $c = geniosym;
+ tie *$c, 'Self3', $c;
+}
+die "self-tied IO not DESTROYd" unless $destroyed == 1;
+EXPECT
+########
diff --git a/t/run/fresh_perl.t b/t/run/fresh_perl.t
index 9ed6023ba7..3c0a9259ad 100644
--- a/t/run/fresh_perl.t
+++ b/t/run/fresh_perl.t
@@ -821,12 +821,6 @@ $人++; # a child is born
print $人, "\n";
EXPECT
3
-########
-# TODO An attempt at lvalueable barewords broke this
-tie FH, 'main';
-EXPECT
-Can't modify constant item in tie at - line 2, near "'main';"
-Execution of - aborted due to compilation errors.
######## example from Camel 5, ch. 15, pp.406 (with use vars)
# SKIP: ord "A" == 193 # EBCDIC
use strict;