Companion to #16601: cxinc would create uninitialized

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

diff --git a/t/op/tie.t b/t/op/tie.t
index ea37cb3..309656d 100755 (executable)
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -1,9 +1,13 @@
 #!./perl
 
-# This test harness will (eventually) test the "tie" functionality
-# without the need for a *DBM* implementation.
-
-# Currently it only tests the untie warning 
+# Add new tests to the end with format:
+# ########
+#
+# # test description
+# Test code
+# EXPECT
+# Warn or die msgs (if any) at - line 1234
+#
 
 chdir 't' if -d 't';
 @INC = '../lib';
@@ -11,37 +15,22 @@ $ENV{PERL5LIB} = "../lib";
 
 $|=1;
 
-# catch warnings into fatal errors
-$SIG{__WARN__} = sub { die "WARNING: @_" } ;
-$SIG{__DIE__}  = sub { die @_ };
-
 undef $/;
 @prgs = split /^########\n/m, <DATA>;
-print "1..", scalar @prgs, "\n";
 
+require './test.pl';
+plan(tests => scalar @prgs);
 for (@prgs){
     ++$i;
     my($prog,$expected) = split(/\nEXPECT\n/, $_, 2);
     print("not ok $i # bad test format\n"), next
         unless defined $expected;
-    my ($testname) = $prog =~ /^(# .*)\n/;
+    my ($testname) = $prog =~ /^# (.*)\n/m;
     $testname ||= '';
-    eval "$prog" ;
-    $status = $?;
-    $results = $@ ;
     $results =~ s/\n+$//;
     $expected =~ s/\n+$//;
-    if ( $status || ($expected eq '') != ($results eq '') ||
-         $results !~ /^(WARNING: )?$expected/){
-       print STDERR "STATUS: $status\n";
-       print STDERR "PROG: $prog\n";
-       print STDERR "EXPECTED:\n$expected\n";
-       print STDERR "GOT:\n$results\n";
-       print "not ok $i $testname\n";
-    }
-    else {
-        print "ok $i $testname\n";
-    }
+
+    fresh_perl_is($prog, $expected, {}, $testname);
 }
 
 __END__
@@ -114,7 +103,7 @@ use Tie::Hash ;
 $a = tie %h, Tie::StdHash;
 untie %h;
 EXPECT
-untie attempted while 1 inner references still exist
+untie attempted while 1 inner references still exist at - line 6.
 ########
 
 # strict behaviour, with 1 extra references via tied generating an error
@@ -124,7 +113,7 @@ tie %h, Tie::StdHash;
 $a = tied %h;
 untie %h;
 EXPECT
-untie attempted while 1 inner references still exist
+untie attempted while 1 inner references still exist at - line 7.
 ########
 
 # strict behaviour, with 1 extra references which are destroyed
@@ -153,7 +142,7 @@ $a = tie %h, Tie::StdHash;
 $b = tied %h ;
 untie %h;
 EXPECT
-untie attempted while 2 inner references still exist
+untie attempted while 2 inner references still exist at - line 7.
 ########
 
 # strict behaviour, check scope of strictness.
@@ -170,6 +159,7 @@ $C = $B = tied %H ;
 untie %H;
 EXPECT
 ########
+
 # Forbidden aggregate self-ties
 sub Self::TIEHASH { bless $_[1], $_[0] }
 {
@@ -177,8 +167,9 @@ sub Self::TIEHASH { bless $_[1], $_[0] }
     tie %c, 'Self', \%c;
 }
 EXPECT
-Self-ties of arrays and hashes are not supported 
+Self-ties of arrays and hashes are not supported at - line 6.
 ########
+
 # Allowed scalar self-ties
 my $destroyed = 0;
 sub Self::TIESCALAR { bless $_[1], $_[0] }
@@ -190,6 +181,7 @@ sub Self::DESTROY   { $destroyed = 1; }
 die "self-tied scalar not DESTROYd" unless $destroyed == 1;
 EXPECT
 ########
+
 # Allowed glob self-ties
 my $destroyed = 0;
 sub Self2::TIEHANDLE { bless $_[1], $_[0] }
@@ -202,6 +194,7 @@ sub Self2::DESTROY   { $destroyed = 1; }
 die "self-tied glob not DESTROYd" unless $destroyed == 1;
 EXPECT
 ########
+
 # Allowed IO self-ties
 my $destroyed = 0;
 sub Self3::TIEHANDLE { bless $_[1], $_[0] }
@@ -214,6 +207,7 @@ sub Self3::DESTROY   { $destroyed = 1; }
 die "self-tied IO not DESTROYd" unless $destroyed == 1;
 EXPECT
 ########
+
 # Interaction of tie and vec
 
 my ($a, $b);
@@ -226,17 +220,18 @@ vec($b,1,1)=0;
 die unless $a eq $b;
 EXPECT
 ########
-# TODO An attempt at lvalueable barewords broke this
 
-tie FH, 'main';
-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
+########
 
+# An attempt at lvalueable barewords broke this
+tie FH, 'main';
+EXPECT
+Can't modify constant item in tie at - line 3, near "'main';"
+Execution of - aborted due to compilation errors.