In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/f85f649414f06ca9f99fce46e2025cdf33fe16e9?hp=8a2938341d31ca951f764ec0a05ab6ca6811b5e3>

- Log -----------------------------------------------------------------
commit f85f649414f06ca9f99fce46e2025cdf33fe16e9
Author: Steve Hay <[email protected]>
Date:   Fri Aug 10 02:09:56 2012 +0100

    Newlines in a runperl() prog cause trouble so use progfile instead
    
    This fixes "Format not terminated at -e line 2, at end of line" errors
    on Windows (at least) coming from the new tests added by commit 35f7559499.
-----------------------------------------------------------------------

Summary of changes:
 ext/B/t/OptreeCheck.pm |   33 +++++++++++++++++++++------------
 ext/B/t/optree_misc.t  |    9 ++++++++-
 2 files changed, 29 insertions(+), 13 deletions(-)

diff --git a/ext/B/t/OptreeCheck.pm b/ext/B/t/OptreeCheck.pm
index 8cfc5b6..73446b9 100644
--- a/ext/B/t/OptreeCheck.pm
+++ b/ext/B/t/OptreeCheck.pm
@@ -5,11 +5,11 @@ use warnings;
 use vars qw($TODO $Level $using_open);
 require "test.pl";
 
-our $VERSION = '0.07';
+our $VERSION = '0.08';
 
 # now export checkOptree, and those test.pl functions used by tests
 our @EXPORT = qw( checkOptree plan skip skip_all pass is like unlike
-                 require_ok runperl);
+                 require_ok runperl tempfile);
 
 
 # The hints flags will differ if ${^OPEN} is set.
@@ -135,10 +135,10 @@ results.
 
 =head2 getRendering
 
-getRendering() runs code or prog through B::Concise, and captures its
-rendering.  Errors emitted during rendering are checked against
-expected errors, and are reported as diagnostics by default, or as
-failures if 'report=fail' cmdline-option is given.
+getRendering() runs code or prog or progfile through B::Concise, and
+captures its rendering.  Errors emitted during rendering are checked
+against expected errors, and are reported as diagnostics by default,
+or as failures if 'report=fail' cmdline-option is given.
 
 prog is run in a sub-shell, with $bcopts passed through. This is the way
 to run code intended for main.  The code arg in contrast, is always a
@@ -180,9 +180,9 @@ If name property is not provided, it is synthesized from 
these params:
 bcopts, note, prog, code.  This is more convenient than trying to do
 it manually.
 
-=head2 code or prog
+=head2 code or prog or profile
 
-Either code or prog must be present.
+Either code or prog or progfile must be present.
 
 =head2 prog => $perl_source_string
 
@@ -191,6 +191,11 @@ via test.pl:runperl, and through B::Concise like so:
 
     './perl -w -MO=Concise,$bcopts_massaged -e $src'
 
+=head2 progfile => $perl_script
+
+progfile => $file provides a file containing a snippet of code which is
+run as per the prog => $src example above.
+
 =head2 code => $perl_source_string || CODEREF
 
 The $code arg is passed to B::Concise::compile(), and run in-process.
@@ -214,8 +219,8 @@ The bcopts arg can be a single string, or an array of 
strings.
 
 =head2 errs => $err_str_regex || [ @err_str_regexs ] 
 
-getRendering() processes the code or prog arg under warnings, and both
-parsing and optree-traversal errors are collected.  These are
+getRendering() processes the code or prog or progfile arg under warnings,
+and both parsing and optree-traversal errors are collected.  These are
 validated against the one or more errors you specify.
 
 =head1 testcase modifier properties
@@ -463,8 +468,8 @@ sub label {
 
 sub getRendering {
     my $tc = shift;
-    fail("getRendering: code or prog is required")
-       unless $tc->{code} or $tc->{prog};
+    fail("getRendering: code or prog or progfile is required")
+       unless $tc->{code} or $tc->{prog} or $tc->{progfile};
 
     my @opts = get_bcopts($tc);
     my $rendering = ''; # suppress "Use of uninitialized value in open"
@@ -475,6 +480,10 @@ sub getRendering {
        $rendering = runperl( switches => ['-w',join(',',"-MO=Concise",@opts)],
                              prog => $tc->{prog}, stderr => 1,
                              ); # verbose => 1);
+    } elsif ($tc->{progfile}) {
+       $rendering = runperl( switches => ['-w',join(',',"-MO=Concise",@opts)],
+                             progfile => $tc->{progfile}, stderr => 1,
+                             ); # verbose => 1);
     } else {
        my $code = $tc->{code};
        unless (ref $code eq 'CODE') {
diff --git a/ext/B/t/optree_misc.t b/ext/B/t/optree_misc.t
index 2d9ad77..9a5c706 100644
--- a/ext/B/t/optree_misc.t
+++ b/ext/B/t/optree_misc.t
@@ -124,9 +124,14 @@ checkOptree ( name      => 'index and PVBM',
              strip_open_hints => 1,
              expect    => $t,  expect_nt => $nt);
 
+my $tmpfile = tempfile();
+open my $fh, '>', $tmpfile or die "Cannot open $tmpfile: $!";
+print $fh "no warnings;format =\n@<<<\n\$a\n@>>>\n\@b\n.";
+close $fh;
+
 checkOptree ( name      => 'formats',
              bcopts    => 'STDOUT',
-             prog      => "no warnings;format =\n@<<<\n\$a\n@>>>\n\@b\n.",
+             progfile  => $tmpfile,
              strip_open_hints => 1,
              expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 # main::STDOUT (FORMAT):
@@ -169,3 +174,5 @@ EOT_EOT
 # a              <1> rv2av[t3] lK/1 ->b
 # 9                 <$> gv(*b) s ->a
 EONT_EONT
+
+unlink $tmpfile;

--
Perl5 Master Repository

Reply via email to