Add tests and fix new fatal errors related to $/

In b3a2acfa0c0e4f8e48e1f6eb4d6fd143f293d2c6 I added new exceptions, but
forgot to test them properly. In the process I managed to partially break
the functionality, and since it was not tested I did not notice.

Ilmari on #p5p pointed out I forgot the test, and in the end I had to completely
rewrite the original patch.

Now tested as fully as I could. Thanks Ilmari.

1 files changed, 49 insertions, 1 deletions

diff --git a/t/base/rs.t b/t/base/rs.t
index ab416521aa..b73ef4028d 100644
--- a/t/base/rs.t
+++ b/t/base/rs.t
@@ -1,7 +1,7 @@
 #!./perl
 # Test $!
 
-print "1..28\n";
+print "1..48\n";
 
 $test_count = 1;
 $teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n";
@@ -32,6 +32,7 @@ open TESTFILE, "<./foo";
 binmode TESTFILE;
 test_record(*TESTFILE);
 close TESTFILE;
+test_bad_setting();
 $test_count_end = $test_count;  # Needed to know how many tests to skip
 
 
@@ -242,3 +243,50 @@ sub test_record {
   $test_count++;
 }
 
+sub test_bad_setting {
+  if (eval {$/ = []; 1}) {
+    print "not ok ",$test_count++," # \$/ = []; should die\n";
+    print "not ok ",$test_count++," # \$/ = []; produced expected error message\n";
+  } else {
+    my $msg= $@ || "Zombie Error";
+    print "ok ",$test_count++," # \$/ = []; should die\n";
+    if ($msg!~m!Setting \$\/ to a ARRAY reference is forbidden!) {print "not ";}
+    print "ok ",$test_count++," # \$/ = []; produced expected error message\n";
+  }
+  if (eval {$/ = {}; 1}) {
+    print "not ok ",$test_count++," # \$/ = {}; should die\n";
+    print "not ok ",$test_count++," # \$/ = {}; produced expected error message\n";
+  } else {
+    my $msg= $@ || "Zombie Error";
+    print "ok ",$test_count++," # \$/ = {}; should die\n";
+    if ($msg!~m!Setting \$\/ to a HASH reference is forbidden!) {print "not ";}
+    print "ok ",$test_count++," # \$/ = {}; produced expected error message\n";
+  }
+  if (eval {$/ = \\1; 1}) {
+    print "not ok ",$test_count++," # \$/ = \\\\1; should die\n";
+    print "not ok ",$test_count++," # \$/ = \\\\1; produced expected error message\n";
+  } else {
+    my $msg= $@ || "Zombie Error";
+    print "ok ",$test_count++," # \$/ = \\\\1; should die\n";
+    if ($msg!~m!Setting \$\/ to a REF reference is forbidden!) {print "not ";}
+    print "ok ",$test_count++," # \$/ = \\\\1; produced expected error message\n";
+  }
+  if (eval {$/ = qr/foo/; 1}) {
+    print "not ok ",$test_count++," # \$/ = qr/foo/; should die\n";
+    print "not ok ",$test_count++," # \$/ = qr/foo/; produced expected error message\n";
+  } else {
+    my $msg= $@ || "Zombie Error";
+    print "ok ",$test_count++," # \$/ = qr/foo/; should die\n";
+    if ($msg!~m!Setting \$\/ to a REGEXP reference is forbidden!) {print "not ";}
+    print "ok ",$test_count++," # \$/ = qr/foo/; produced expected error message\n";
+  }
+  if (eval {$/ = \*STDOUT; 1}) {
+    print "not ok ",$test_count++," # \$/ = \\*STDOUT; should die\n";
+    print "not ok ",$test_count++," # \$/ = \\*STDOUT; produced expected error message\n";
+  } else {
+    my $msg= $@ || "Zombie Error";
+    print "ok ",$test_count++," # \$/ = \\*STDOUT; should die\n";
+    if ($msg!~m!Setting \$\/ to a GLOB reference is forbidden!) {print "not ";}
+    print "ok ",$test_count++," # \$/ = \\*STDOUT; produced expected error message\n";
+  }
+}