5.004_56: Patch to Tie::Hash and docs

[perl5.git] / t / op / misc.t

diff --git a/t/op/misc.t b/t/op/misc.t
index 09385b9..7a7fc33 100755 (executable)
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -1,5 +1,8 @@
 #!./perl
 
 #!./perl
 

+# NOTE: Please don't add tests to this file unless they *need* to be run in
+# separate executable and can't simply use eval.
+

 chdir 't' if -d 't';
 @INC = "../lib";
 $ENV{PERL5LIB} = "../lib";
 chdir 't' if -d 't';
 @INC = "../lib";
 $ENV{PERL5LIB} = "../lib";


@@ -14,17 +17,24 @@ $tmpfile = "misctmp000";
 1 while -f ++$tmpfile;
 END { unlink $tmpfile if $tmpfile; }
 
 1 while -f ++$tmpfile;
 END { unlink $tmpfile if $tmpfile; }
 

+$CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : 'cat');
+

 for (@prgs){
     my $switch;
 for (@prgs){
     my $switch;

-    if (s/^\s*-\w+//){
-       $switch = $&;
+    if (s/^\s*(-\w.*)//){
+       $switch = $1;

     }
     my($prog,$expected) = split(/\nEXPECT\n/, $_);
     }
     my($prog,$expected) = split(/\nEXPECT\n/, $_);

-    open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1";
+    if ($^O eq 'MSWin32') {
+      open TEST, "| .\\perl -I../lib $switch >$tmpfile 2>&1";
+    }
+    else {
+      open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1";
+    }

     print TEST $prog, "\n";
     close TEST;
     $status = $?;
     print TEST $prog, "\n";
     close TEST;
     $status = $?;

-    $results = `cat $tmpfile`;
+    $results = `$CAT $tmpfile`;

     $results =~ s/\n+$//;
     $expected =~ s/\n+$//;
     if ( $results ne $expected){
     $results =~ s/\n+$//;
     $expected =~ s/\n+$//;
     if ( $results ne $expected){


@@ -74,7 +84,7 @@ EXPECT
 ########
 eval {sub bar {print "In bar";}}
 ########
 ########
 eval {sub bar {print "In bar";}}
 ########

-system "./perl -ne 'print if eof' /dev/null"
+system './perl -ne "print if eof" /dev/null'

 ########
 chop($file = <>);
 ########
 ########
 chop($file = <>);
 ########


@@ -88,7 +98,8 @@ EXPECT
 ########
 %@x=0;
 EXPECT
 ########
 %@x=0;
 EXPECT

-Can't coerce HASH to string in repeat at - line 1.
+Can't modify hash deref in repeat at - line 1, near "0;"
+Execution of - aborted due to compilation errors.

 ########
 $_="foo";
 printf(STDOUT "%s\n", $_);
 ########
 $_="foo";
 printf(STDOUT "%s\n", $_);


@@ -188,6 +199,11 @@ BEGIN failed--compilation aborted at - line 1.
         shift;
         print join(' ', reverse @_)."\n";
     }
         shift;
         print join(' ', reverse @_)."\n";
     }

+    sub PRINTF {
+        shift;
+         my $fmt = shift;
+        print sprintf($fmt, @_)."\n";
+    }

     sub TIEHANDLE {
         bless {}, shift;
     }
     sub TIEHANDLE {
         bless {}, shift;
     }


@@ -196,17 +212,36 @@ BEGIN failed--compilation aborted at - line 1.
     }
     sub DESTROY {
        print "and destroyed as well\n";
     }
     sub DESTROY {
        print "and destroyed as well\n";

-    }
+  }
+  sub READ {
+      shift;
+      print STDOUT "foo->can(READ)(@_)\n";
+      return 100; 
+  }
+  sub GETC {
+      shift;
+      print STDOUT "Don't GETC, Get Perl\n";
+      return "a"; 
+  }    

 }
 {
     local(*FOO);
     tie(*FOO,'foo');
     print FOO "sentence.", "reversed", "a", "is", "This";
     print "-- ", <FOO>, " --\n";
 }
 {
     local(*FOO);
     tie(*FOO,'foo');
     print FOO "sentence.", "reversed", "a", "is", "This";
     print "-- ", <FOO>, " --\n";

+    my($buf,$len,$offset);
+    $buf = "string";
+    $len = 10; $offset = 1;
+    read(FOO, $buf, $len, $offset) == 100 or die "foo->READ failed";
+    getc(FOO) eq "a" or die "foo->GETC failed";
+    printf "%s is number %d\n", "Perl", 1;

 }
 EXPECT
 This is a reversed sentence.
 -- Out of inspiration --
 }
 EXPECT
 This is a reversed sentence.
 -- Out of inspiration --

+foo->can(READ)(string 10 1)
+Don't GETC, Get Perl
+Perl is number 1

 and destroyed as well
 ########
 my @a; $a[2] = 1; for (@a) { $_ = 2 } print "@a\n"
 and destroyed as well
 ########
 my @a; $a[2] = 1; for (@a) { $_ = 2 } print "@a\n"


@@ -259,6 +294,13 @@ print p::func()->groovy(), "\n"
 EXPECT
 really groovy
 ########
 EXPECT
 really groovy
 ########

+@list = ([ 'one', 1 ], [ 'two', 2 ]);
+sub func { $num = shift; (grep $_->[1] == $num, @list)[0] }
+print scalar(map &func($_), 1 .. 3), " ",
+      scalar(map scalar &func($_), 1 .. 3), "\n";
+EXPECT
+2 3
+########

 ($k, $s)  = qw(x 0);
 @{$h{$k}} = qw(1 2 4);
 for (@{$h{$k}}) { $s += $_; delete $h{$k} if ($_ == 2) }
 ($k, $s)  = qw(x 0);
 @{$h{$k}} = qw(1 2 4);
 for (@{$h{$k}}) { $s += $_; delete $h{$k} if ($_ == 2) }


@@ -289,3 +331,29 @@ $s = 0;
 map {#this newline here tickles the bug
 $s += $_} (1,2,4);
 print "eat flaming death\n" unless ($s == 7);
 map {#this newline here tickles the bug
 $s += $_} (1,2,4);
 print "eat flaming death\n" unless ($s == 7);

+########
+sub foo { local $_ = shift; split; @_ }
+@x = foo(' x  y  z ');
+print "you die joe!\n" unless "@x" eq 'x y z';
+########
+/(?{"{"})/     # Check it outside of eval too
+EXPECT
+Sequence (?{...}) not terminated or not {}-balanced at - line 1, within pattern
+/(?{"{"})/: Sequence (?{...}) not terminated or not {}-balanced at - line 1.
+########
+/(?{"{"}})/    # Check it outside of eval too
+EXPECT
+Unmatched right bracket at (re_eval 1) line 1, at end of line
+syntax error at (re_eval 1) line 1, near ""{"}"
+Compilation failed in regexp at - line 1.
+########
+BEGIN { @ARGV = qw(a b c) }
+BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" }
+END { print "end <",shift,">\nargv <@ARGV>\n" }
+INIT { print "init <",shift,">\n" }
+EXPECT
+argv <a b c>
+begin <a>
+init <b>
+end <c>
+argv <>