This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add Perl_current_re_engine() function
[perl5.git] / t / cmd / subval.t
index ba4d833..0999ff9 100644 (file)
@@ -1,7 +1,5 @@
 #!./perl
 
-# $Header: subval.t,v 4.0 91/03/20 01:49:40 lwall Locked $
-
 sub foo1 {
     'true1';
     if ($_[0]) { 'true2'; }
@@ -33,34 +31,34 @@ sub foo6 {
     'true2' unless $_[0];
 }
 
-print "1..34\n";
+print "1..36\n";
 
-if (do foo1(0) eq '0') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
-if (do foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";}
-if (do foo2(0) eq 'true3') {print "ok 3\n";} else {print "not ok 3\n";}
-if (do foo2(1) eq 'true2') {print "ok 4\n";} else {print "not ok 4\n";}
+if (&foo1(0) eq '0') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
+if (&foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";}
+if (&foo2(0) eq 'true3') {print "ok 3\n";} else {print "not ok 3\n";}
+if (&foo2(1) eq 'true2') {print "ok 4\n";} else {print "not ok 4\n";}
 
-if (do foo3(0) eq 'true2') {print "ok 5\n";} else {print "not ok 5\n";}
-if (do foo3(1) eq '1') {print "ok 6\n";} else {print "not ok 6\n";}
-if (do foo4(0) eq 'true2') {print "ok 7\n";} else {print "not ok 7\n";}
-if (do foo4(1) eq 'true3') {print "ok 8\n";} else {print "not ok 8\n";}
+if (&foo3(0) eq 'true2') {print "ok 5\n";} else {print "not ok 5\n";}
+if (&foo3(1) eq '1') {print "ok 6\n";} else {print "not ok 6\n";}
+if (&foo4(0) eq 'true2') {print "ok 7\n";} else {print "not ok 7\n";}
+if (&foo4(1) eq 'true3') {print "ok 8\n";} else {print "not ok 8\n";}
 
-if (do foo5(0) eq '0') {print "ok 9\n";} else {print "not ok 9\n";}
-if (do foo5(1) eq 'true2') {print "ok 10\n";} else {print "not ok 10\n";}
-if (do foo6(0) eq 'true2') {print "ok 11\n";} else {print "not ok 11\n";}
-if (do foo6(1) eq '1') {print "ok 12\n";} else {print "not ok 12 $x\n";}
+if (&foo5(0) eq '0') {print "ok 9\n";} else {print "not ok 9\n";}
+if (&foo5(1) eq 'true2') {print "ok 10\n";} else {print "not ok 10\n";}
+if (&foo6(0) eq 'true2') {print "ok 11\n";} else {print "not ok 11\n";}
+if (&foo6(1) eq '1') {print "ok 12\n";} else {print "not ok 12 $x\n";}
 
 # Now test to see that recursion works using a Fibonacci number generator
 
 sub fib {
-    local($arg) = @_;
-    local($foo);
+    my($arg) = @_;
+    my($foo);
     $level++;
     if ($arg <= 2) {
        $foo = 1;
     }
     else {
-       $foo = do fib($arg-1) + do fib($arg-2);
+       $foo = &fib($arg-1) + &fib($arg-2);
     }
     $level--;
     $foo;
@@ -70,7 +68,7 @@ sub fib {
 
 for ($i = 1; $i <= 10; $i++) {
     $foo = $i + 12;
-    if (do fib($i) == $good[$i]) {
+    if (&fib($i) == $good[$i]) {
        print "ok $foo\n";
     }
     else {
@@ -102,7 +100,7 @@ print $x eq '1:2:3' ? "ok 26\n" : "not ok 26 $x\n";
 sub somesub {
     local($num,$P,$F,$L) = @_;
     ($p,$f,$l) = caller;
-    print "$p:$f:$l" eq "$P:$F:$L" ? "ok $num\n" : "not ok $num\n";
+    print "$p:$f:$l" eq "$P:$F:$L" ? "ok $num\n" : "not ok $num $p:$f:$l ne $P:$F:$L\n";
 }
 
 &somesub(27, 'main', __FILE__, __LINE__);
@@ -114,14 +112,14 @@ package main;
 $i = 28;
 open(FOO,">Cmd_subval.tmp");
 print FOO "blah blah\n";
-close FOO;
+close FOO or die "Can't close Cmd_subval.tmp: $!";
 
 &file_main(*F);
-close F;
+close F or die "Can't close: $!";
 &info_main;
 
 &file_package(*F);
-close F;
+close F or die "Can't close: $!";
 &info_package;
 
 unlink 'Cmd_subval.tmp';
@@ -129,7 +127,7 @@ unlink 'Cmd_subval.tmp';
 sub file_main {
         local(*F) = @_;
 
-        open(F, 'Cmd_subval.tmp') || die "can't open\n";
+        open(F, 'Cmd_subval.tmp') || die "can't open: $!\n";
        $i++;
         eof F ? print "not ok $i\n" : print "ok $i\n";
 }
@@ -137,11 +135,11 @@ sub file_main {
 sub info_main {
         local(*F);
 
-        open(F, 'Cmd_subval.tmp') || die "test: can't open\n";
+        open(F, 'Cmd_subval.tmp') || die "test: can't open: $!\n";
        $i++;
         eof F ? print "not ok $i\n" : print "ok $i\n";
         &iseof(*F);
-       close F;
+       close F or die "Can't close: $!";
 }
 
 sub iseof {
@@ -156,7 +154,7 @@ sub iseof {
  sub main'file_package {
         local(*F) = @_;
 
-        open(F, 'Cmd_subval.tmp') || die "can't open\n";
+        open(F, 'Cmd_subval.tmp') || die "can't open: $!\n";
        $main'i++;
         eof F ? print "not ok $main'i\n" : print "ok $main'i\n";
  }
@@ -164,7 +162,7 @@ sub iseof {
  sub main'info_package {
         local(*F);
 
-        open(F, 'Cmd_subval.tmp') || die "can't open\n";
+        open(F, 'Cmd_subval.tmp') || die "can't open: $!\n";
        $main'i++;
         eof F ? print "not ok $main'i\n" : print "ok $main'i\n";
         &iseof(*F);
@@ -177,3 +175,10 @@ sub iseof {
         eof UNIQ ? print "not ok $main'i\n" : print "ok $main'i\n";
  }
 }
+
+sub autov { $_[0] = 23 };
+
+my $href = {};
+print keys %$href ? 'not ' : '', "ok 35\n";
+autov($href->{b});
+print join(':', %$href) eq 'b:23' ? '' : 'not ', "ok 36\n";