Clean up heredoc.t
authorMichael G. Schwern <schwern@pobox.com>
Fri, 12 Jun 2009 22:35:00 +0000 (15:35 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 21 Aug 2012 21:11:00 +0000 (14:11 -0700)
* Made the tests more independent, mostly by decoupling the use of
  a single $string.  This will make it easier to expand on the test file
  later.

* Replace ok( $foo eq $bar ) with is() for better diagnostics

* Remove unnecessary STDERR redirection.  fresh_perl does that for you.

* fix fresh_perl to honor progfile and stderr arguments passed in
  rather than just blowing over them

t/op/heredoc.t
t/test.pl

index 962e8a7..b1ab684 100644 (file)
@@ -1,58 +1,67 @@
-
-# heredoc.t
 # tests for heredocs besides what is tested in base/lex.t
+
 BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
    require './test.pl';
 }
 
-plan (tests => 6);
-#heredoc without newline (#65838)
-$string = <<'HEREDOC';
+use strict;
+plan(tests => 6);
+
+
+# heredoc without newline (#65838)
+{
+    my $string = <<'HEREDOC';
 testing for 65838
 HEREDOC
-$code = "<<'HEREDOC';\n${string}HEREDOC";  # HD w/o newline, in eval-string
-$hd = eval $code or warn "$@ ---";
-ok($hd eq $string, "no terminating newline in string-eval");
 
-$redirect = <<\REDIR;
-BEGIN {
-   open STDERR, ">&STDOUT" or die "PROBLEM DUPING STDOUT: $!"
+    my $code = "<<'HEREDOC';\n${string}HEREDOC";  # HD w/o newline, in eval-string
+    my $hd = eval $code or warn "$@ ---";
+    is($hd, $string, "no terminating newline in string-eval");
+}
+
+
+# here-doc edge cases
+{
+    my $string = "testing for 65838";
+
+    fresh_perl_is(
+        "print <<'HEREDOC';\n${string}\nHEREDOC",
+        $string,
+        {},
+        "heredoc at EOF without trailing newline"
+    );
+
+    fresh_perl_is(
+        "print <<;\n$string\n",
+        $string,
+        {},
+        "blank-terminated heredoc at EOF"
+    );
 }
-REDIR
-
-chomp (my $chomped_string = $string);
-fresh_perl_is(
-   "print $code",
-   $chomped_string,{},
-   "heredoc at EOF without trailing newline"
-);
-
-# like test 18 from t/base/lex.t but at EOF
-fresh_perl_is(
-   "print <<;\n$string",
-   $chomped_string,{},
-   "blank-terminated heredoc at EOF"
-);
-
-
-# the next three are supposed to fail parsing
-fresh_perl_like(
-   "$redirect print <<HEREDOC;\n$string HEREDOC",
-   qr/find string terminator/, {},
-   "string terminator must start at newline"
-);
-
-fresh_perl_like(
-   "$redirect print <<;\nno more newlines",
-   qr/find string terminator/, {},
-   "empty string terminator still needs a newline"
-);
-
-fresh_perl_like(
-   "$redirect print <<ThisTerminatorIsLongerThanTheData;\nno more newlines",
-   qr/find string terminator/, {},
-   "long terminator fails correctly"
-);
 
+
+# here-doc parse failures
+{
+    fresh_perl_like(
+        "print <<HEREDOC;\nwibble\n HEREDOC",
+        qr/find string terminator/,
+        {},
+        "string terminator must start at newline"
+    );
+
+    fresh_perl_like(
+        "print <<;\nno more newlines",
+        qr/find string terminator/,
+        {},
+        "empty string terminator still needs a newline"
+    );
+
+    fresh_perl_like(
+        "print <<ThisTerminatorIsLongerThanTheData;\nno more newlines",
+        qr/find string terminator/,
+        {},
+        "long terminator fails correctly"
+    );
+}
index 6d45076..bd5ff3b 100644 (file)
--- a/t/test.pl
+++ b/t/test.pl
@@ -793,8 +793,8 @@ sub _fresh_perl {
     # it feels like the least-worse thing is to assume that auto-vivification
     # works. At least, this is only going to be a run-time failure, so won't
     # affect tests using this file but not this function.
-    $runperl_args->{progfile} = $tmpfile;
-    $runperl_args->{stderr} = 1;
+    $runperl_args->{progfile} ||= $tmpfile;
+    $runperl_args->{stderr}     = 1 unless exists $runperl_args->{stderr};
 
     open TEST, ">$tmpfile" or die "Cannot open $tmpfile: $!";