view release on metacpan or  search on metacpan

t/base/rs.t  view on Meta::CPAN

}


{
 # If we do not include the lib directories, we may end up picking up a
 # binary-incompatible previously-installed version. The eval won’t help in
 # intercepting a SIGTRAP.
 local @INC = ("../lib", "lib", @INC);
 # Test if a file in memory behaves the same as a real file (= re-run the test with a file in memory)
 open TESTFILE, "<", \$teststring;
 test_string(*TESTFILE);
 close TESTFILE;

 open TESTFILE, "<", \$teststring2;
 test_record(*TESTFILE);
 close TESTFILE;
}

# Get rid of the temp file
END { unlink "./foo"; }

sub test_string {
  *FH = shift;

  # Check the default $/
  $bar = <FH>;
  if ($bar ne "1\n") {print "not ";}
  print "ok $test_count # default \$/\n";
  $test_count++;

  # explicitly set to \n
  $/ = "\n";
  $bar = <FH>;
  if ($bar ne "12\n") {print "not ";}
  print "ok $test_count # \$/ = \"\\n\"\n";
  $test_count++;

  # Try a non line terminator
  $/ = 3;
  $bar = <FH>;
  if ($bar ne "123") {print "not ";}
  print "ok $test_count # \$/ = 3\n";
  $test_count++;

  # Eat the line terminator
  $/ = "\n";
  $bar = <FH>;

  # How about a larger terminator
  $/ = "34";
  $bar = <FH>;
  if ($bar ne "1234") {print "not ";}
  print "ok $test_count # \$/ = \"34\"\n";
  $test_count++;

  # Eat the line terminator
  $/ = "\n";
  $bar = <FH>;

  # Does paragraph mode work?
  $/ = '';
  $bar = <FH>;
  if ($bar ne "1234\n12345\n\n") {print "not ";}
  print "ok $test_count # \$/ = ''\n";
  $test_count++;

  # Try slurping the rest of the file
  $/ = undef;
  $bar = <FH>;
  if ($bar ne "123456\n1234567\n") {print "not ";}
  print "ok $test_count # \$/ = undef\n";
  $test_count++;
}

sub test_record {
  *FH = shift;

  # Test straight number
  $/ = \2;
  $bar = <FH>;
  if ($bar ne "12") {print "not ";}
  print "ok $test_count # \$/ = \\2\n";
  $test_count++;

  # Test stringified number
  $/ = \"2";
  $bar = <FH>;
  if ($bar ne "34") {print "not ";}
  print "ok $test_count # \$/ = \"2\"\n";
  $test_count++;

  # Integer variable
  $foo = 2;
  $/ = \$foo;
  $bar = <FH>;
  if ($bar ne "56") {print "not ";}
  print "ok $test_count # \$/ = \\\$foo (\$foo = 2)\n";
  $test_count++;

  # String variable
  $foo = "2";
  $/ = \$foo;
  $bar = <FH>;
  if ($bar ne "78") {print "not ";}
  print "ok $test_count # \$/ = \\\$foo (\$foo = \"2\")\n";
  $test_count++;
}

sub test_bad_setting {
  if (eval {$/ = \0; 1}) {
    print "not ok ",$test_count++," # \$/ = \\0; should die\n";
    print "not ok ",$test_count++," # \$/ = \\0; produced expected error message\n";
  } else {
    my $msg= $@ || "Zombie Error";
    print "ok ",$test_count++," # \$/ = \\0; should die\n";
    if ($msg!~m!Setting \$\/ to a reference to zero is forbidden!) {
      print "not ";
    }
    print "ok ",$test_count++," # \$/ = \\0; 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 {