Permalink
Browse files

1.43_05: fix format STDOUT/STDERR

added all format testcases to t/issue238.t
  • Loading branch information...
1 parent 149e03a commit ee98e2245a489a241315056ffb3e01e7eb697ae6 Reini Urban committed Jan 31, 2014
Showing with 39 additions and 18 deletions.
  1. +3 −1 STATUS
  2. +12 −9 lib/B/C.pm
  3. +23 −7 t/issue238.t
  4. +1 −1 t/testc.sh
View
4 STATUS
@@ -127,9 +127,11 @@ Fix CC
DONE
----
fixed with 1.44:
- -O3 with ~ and ~~ formatstrings
SvLEN and PV ptr for empty shared hash keys
cop_hints to support lexical numeric hints pragmas (use bytes, use open, ...)
+ -O3 with ~ and ~~ formatstrings
+ skip saving a cv on defined(&cv)
+ format STDOUT/STDERR
fixed with 1.43:
static strings and heks with LEN=0
View
@@ -12,7 +12,7 @@
package B::C;
use strict;
-our $VERSION = '1.43_04';
+our $VERSION = '1.43_05';
my %debug;
our $check;
my $eval_pvs = '';
@@ -3125,7 +3125,7 @@ sub B::CV::save {
and $fullname ne 'main::main::'
and ($PERL510 and !defined(&{"$cvstashname\::AUTOLOAD"})))
{
- warn "Warning: &".$fullname." not found\n" if $verbose or $debug{sub};
+ warn "Warning: &".$fullname." not found\n" if $debug{sub};
}
$init->add( "/* CV $fullname not found */" ) if $verbose or $debug{sub};
# This block broke test 15, disabled
@@ -3688,6 +3688,9 @@ sub B::GV::save {
elsif ( $fullname eq 'main::ARGV' ) {
$savefields = Save_HV | Save_SV | Save_CV | Save_FORM | Save_IO;
}
+ elsif ( $fullname =~ /^main::STD(OUT|ERR)$/ ) {
+ $savefields = Save_FORM | Save_IO;
+ }
$savefields &= ~$filter if ($filter and $filter !~ / :pad/
and $filter =~ /^\d+$/ and $filter > 0 and $filter < 64);
# issue 79: Only save stashes for stashes.
@@ -5464,10 +5467,10 @@ sub B::GV::savecv {
#
return if ( $package ne 'main' and !$include_package{$package} );
return if ( $package eq 'main' and
- $name =~ /^([^_A-Za-z0-9].*|_\<.*|INC|STDIN|STDOUT|STDERR|ARGV|SIG|ENV|BEGIN|main::|!)$/ );
+ $name =~ /^([^_A-Za-z0-9].*|_\<.*|INC|ARGV|SIG|ENV|BEGIN|main::|!)$/ );
warn sprintf( "Used GV \*$fullname 0x%x\n", $$gv ) if $debug{gv};
- return unless ( $$cv || $$av || $$sv || $$hv || $gv->IO );
+ return unless ( $$cv || $$av || $$sv || $$hv || $gv->IO || $gv->FORM );
if ($$cv and $name eq 'bootstrap' and $cv->XSUB) {
#return $cv->save($fullname);
warn sprintf( "Skip XS \&$fullname 0x%x\n", $$cv ) if $debug{gv};
@@ -6868,24 +6871,24 @@ This symbol was not resolved during compilation, and replaced by 0.
With B::C this is most likely a critical internal compiler bug, esp. if in
an op section. See [issue #110].
+
With B::CC it can be caused by valid optimizations, e.g. when op->next
pointers were inlined or inlined GV or CONST ops were optimized away.
=back
=head1 BUGS
-Current status: A few known bugs.
+Current status: A few known bugs, but usable in production
5.6:
reading from __DATA__ handles (15)
AUTOLOAD xsubs (27)
>=5.10:
- &XSLoader::load sometimes missing
- reading from __DATA__ handles (15) non-threaded
- handling npP magic for shared threaded variables (41-43)
- destruction of variables in END blocks
+ Attribute::Handlers and run-time attributes
+ package destruction
+ handling of empty functions, esp. sig handlers: $SIG{__WARN__}=sub{}
=head1 AUTHOR
View
@@ -6,27 +6,43 @@ BEGIN {
unshift @INC, 't';
require "test.pl";
}
-use Test::More tests => 2;
+use Test::More tests => 4;
-ctestok(1,'C,-O3','ccode238i',<<'EOF','#238 format STDOUT');
+ctestok(1,'C,-O3','ccode238i',<<'EOF','#238 format f::STDOUT');
sub f ($);
sub f ($) {
-my $test = $_[0];
-write;
-format STDOUT =
+ my $test = $_[0];
+ write;
+ format STDOUT =
ok @<<<<<<<
$test
.
}
-
f('');
EOF
-ctestok(2,'C,-O3','ccode238i',<<'EOF','TODO #239 format STDOUT');
+ctestok(2,'C,-O3','ccode239i',<<'EOF','#239,#285 format main::STDOUT');
my $x="1";
format STDOUT =
ok @<<<<<<<
$x
.
write;print "\n";
EOF
+
+ctestok(3,'C,-O3','ccode277i',<<'EOF','#277,#284 format -O3 ~~');
+format OUT =
+bar ~~
+.
+open(OUT, ">/dev/null"); write(OUT); close OUT;
+print "ok\n";
+EOF
+
+ctestok(4,'C,-O3','ccode283i',<<'EOF','#283 implicit format STDOUT');
+format =
+ok
+.
+write
+EOF
+
+
View
@@ -1085,7 +1085,7 @@ tests[280]='package M; $| = 1; sub DESTROY {eval {print "Farewell ",ref($_[0])};
result[280]='Farewell M'
tests[282]='use vars qw($glook $smek $foof); $glook = 3; $smek = 4; $foof = "halt and cool down"; my $rv = \*smek; *glook = $rv; my $pv = ""; $pv = \*smek; *foof = $pv; print "ok\n";'
result[282]='ok'
-tests[283]='#TODO #238 Undefined format "STDOUT"
+tests[283]='#238 Undefined format "STDOUT"
format =
ok
.

0 comments on commit ee98e22

Please sign in to comment.