summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJim Cromie <jcromie@cpan.org>2004-05-06 10:37:56 -0600
committerDave Mitchell <davem@fdisolutions.com>2004-05-07 18:21:22 +0000
commit2ce64696ee310efa4fd2ab1e0db39fb5c15500d3 (patch)
treec6ad2aa4d99e6008b17785df72157b0f844d047a
parent8b0ac1d72e8a6530ddcafe41734c2fd10d6cbe5a (diff)
downloadperl-2ce64696ee310efa4fd2ab1e0db39fb5c15500d3.tar.gz
Re: stdio still supported?
Message-Id: <409ABE44.8060307@divsol.com> Update B::Concise tests to skip stuff requiring the "open to a scalar" feature of Perlio is it isn't available. Also note this caveat in perlfunc.pod p4raw-id: //depot/perl@22801
-rw-r--r--ext/B/B/Concise.pm8
-rw-r--r--ext/B/t/concise.t142
-rw-r--r--ext/B/t/optree_check.t10
-rw-r--r--ext/B/t/optree_concise.t6
-rw-r--r--ext/B/t/optree_samples.t6
-rw-r--r--ext/B/t/optree_sort.t6
-rw-r--r--ext/B/t/optree_varinit.t7
-rw-r--r--pod/perlfunc.pod6
8 files changed, 114 insertions, 77 deletions
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 94e62a3c77..3e532e9554 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -107,8 +107,11 @@ our $walkHandle = \*STDOUT; # public for your convenience
sub walk_output { # updates $walkHandle
my $handle = shift;
if (ref $handle eq 'SCALAR') {
+ require Config;
+ die "no perlio in this build, can't call walk_output (\\\$scalar)\n"
+ unless $Config::Config{useperlio};
# in 5.8+, open(FILEHANDLE,MODE,REFERENCE) writes to string
- open my $tmp, '>', $handle; # but cant re-set an existing filehandle
+ open my $tmp, '>', $handle; # but cant re-set existing STDOUT
$walkHandle = $tmp; # so use my $tmp as intermediate var
return;
}
@@ -1323,7 +1326,8 @@ coderef, you may change the output style; thereafter the coderef renders
in the new style.
B<walk_output> lets you change the print destination from STDOUT to
-another open filehandle, or into a string passed as a ref.
+another open filehandle, or (unless you've built with -Uuseperlio)
+into a string passed as a ref.
walk_output(\my $buf);
my $walker = B::Concise::compile('-concise','funcName', \&aSubRef);
diff --git a/ext/B/t/concise.t b/ext/B/t/concise.t
index 809b155199..ec4795b194 100644
--- a/ext/B/t/concise.t
+++ b/ext/B/t/concise.t
@@ -44,12 +44,6 @@ B::Concise->import(qw(set_style set_style_standard add_callback
## walk_output argument checking
-# test that walk_output accepts a HANDLE arg
-foreach my $foo (\*STDOUT, \*STDERR) {
- eval { walk_output($foo) };
- is ($@, '', "walk_output() accepts STD* " . ref $foo);
-}
-
# test that walk_output rejects non-HANDLE args
foreach my $foo (undef, 0, "string",[], {}) {
eval { walk_output($foo) };
@@ -66,13 +60,24 @@ my $foo = new Hugo; # suggested this API fix
eval { walk_output($foo) };
is ($@, '', "walk_output() accepts obj that can print");
-# now test a ref to scalar
-eval { walk_output(\my $junk) };
-is ($@, '', "walk_output() accepts ref-to-sprintf target");
-
-$junk = "non-empty";
-eval { walk_output(\$junk) };
-is ($@, '', "walk_output() accepts ref-to-non-empty-scalar");
+# test that walk_output accepts a HANDLE arg
+SKIP: {
+ skip("no perlio in this build", 4)
+ unless $Config::Config{useperlio};
+
+ foreach my $foo (\*STDOUT, \*STDERR) {
+ eval { walk_output($foo) };
+ is ($@, '', "walk_output() accepts STD* " . ref $foo);
+ }
+
+ # now test a ref to scalar
+ eval { walk_output(\my $junk) };
+ is ($@, '', "walk_output() accepts ref-to-sprintf target");
+
+ $junk = "non-empty";
+ eval { walk_output(\$junk) };
+ is ($@, '', "walk_output() accepts ref-to-non-empty-scalar");
+}
## add_style
my @stylespec;
@@ -104,64 +109,67 @@ like ($@, qr/expecting 3 style-format args/,
#### for content with doc'd options
-
-set_style_standard('concise'); # MUST CALL b4 output needed
-my $func = sub{ $a = $b+42 };
-
-@options = qw(
- -basic -exec -tree -compact -loose -vt -ascii -main
- -base10 -bigendian -littleendian
- );
-foreach $opt (@options) {
- walk_output(\my $out);
- my $treegen = B::Concise::compile($opt, $func);
- $treegen->();
- #print "foo:$out\n";
- isnt($out, '', "got output with option $opt");
-}
-
-## test output control via walk_output
-
-my $treegen = B::Concise::compile('-basic', $func); # reused
-
-{ # test output into a package global string (sprintf-ish)
- our $thing;
- walk_output(\$thing);
- $treegen->();
- ok($thing, "walk_output to our SCALAR, output seen");
-}
-
+SKIP:
{ # test output to GLOB, using perlio feature directly
- skip 1, "no perlio on this build" unless $Config{useperlio};
+ skip "no perlio on this build", 18
+ unless $Config::Config{useperlio};
+
+ set_style_standard('concise'); # MUST CALL b4 output needed
+ my $func = sub{ $a = $b+42 };
+
+ @options = qw(
+ -basic -exec -tree -compact -loose -vt -ascii -main
+ -base10 -bigendian -littleendian
+ );
+ foreach $opt (@options) {
+ walk_output(\my $out);
+ my $treegen = B::Concise::compile($opt, $func);
+ $treegen->();
+ #print "foo:$out\n";
+ isnt($out, '', "got output with option $opt");
+ }
+
+ ## test output control via walk_output
+
+ my $treegen = B::Concise::compile('-basic', $func); # reused
+
+ { # test output into a package global string (sprintf-ish)
+ our $thing;
+ walk_output(\$thing);
+ $treegen->();
+ ok($thing, "walk_output to our SCALAR, output seen");
+ }
+
open (my $fh, '>', \my $buf);
walk_output($fh);
$treegen->();
ok($buf, "walk_output to GLOB, output seen");
-}
-
-## Test B::Concise::compile error checking
-
-# call compile on non-CODE ref items
-foreach my $ref ([], {}) {
- my $typ = ref $ref;
- walk_output(\my $out);
- eval { B::Concise::compile('-basic', $ref)->() };
- like ($@, qr/^err: not a coderef: $typ/,
- "compile detects $typ-ref where expecting subref");
- # is($out,'', "no output when errd"); # announcement prints
-}
-# test against a bogus autovivified subref.
-# in debugger, it should look like:
-# 1 CODE(0x84840cc)
-# -> &CODE(0x84840cc) in ???
-sub nosuchfunc;
-eval { B::Concise::compile('-basic', \&nosuchfunc)->() };
-like ($@, qr/^err: coderef has no START/,
- "compile detects CODE-ref w/o actual code");
-
-foreach my $opt (qw( -concise -exec )) {
- eval { B::Concise::compile($opt,'non_existent_function')->() };
- like ($@, qr/unknown function \(main::non_existent_function\)/,
- "'$opt' reports non-existent-function properly");
+ ## Test B::Concise::compile error checking
+
+ # call compile on non-CODE ref items
+ foreach my $ref ([], {}) {
+ my $typ = ref $ref;
+ walk_output(\my $out);
+ eval { B::Concise::compile('-basic', $ref)->() };
+ like ($@, qr/^err: not a coderef: $typ/,
+ "compile detects $typ-ref where expecting subref");
+ # is($out,'', "no output when errd"); # announcement prints
+ }
+
+
+ # test against a bogus autovivified subref.
+ # in debugger, it should look like:
+ # 1 CODE(0x84840cc)
+ # -> &CODE(0x84840cc) in ???
+ sub nosuchfunc;
+ eval { B::Concise::compile('-basic', \&nosuchfunc)->() };
+ like ($@, qr/^err: coderef has no START/,
+ "compile detects CODE-ref w/o actual code");
+
+ foreach my $opt (qw( -concise -exec )) {
+ eval { B::Concise::compile($opt,'non_existent_function')->() };
+ like ($@, qr/unknown function \(main::non_existent_function\)/,
+ "'$opt' reports non-existent-function properly");
+ }
}
diff --git a/ext/B/t/optree_check.t b/ext/B/t/optree_check.t
index f0e6425d61..6dd9bdd540 100644
--- a/ext/B/t/optree_check.t
+++ b/ext/B/t/optree_check.t
@@ -19,11 +19,14 @@ cmdline args in 'standard' way across all clients of OptreeCheck.
=cut
-##################
- ;
-
+use Config;
plan tests => 5 + 19 + 14 * $gOpts{selftest}; # fudged
+SKIP: {
+ skip "no perlio in this build", 5 + 19 + 14 * $gOpts{selftest}
+ unless $Config::Config{useperlio};
+
+
pass("REGEX TEST HARNESS SELFTEST");
checkOptree ( name => "bare minimum opcode search",
@@ -233,6 +236,7 @@ EONT_EONT
checkOptree ( name => 'tree reftext is messy cut-paste',
skip => 1);
+} # skip
__END__
diff --git a/ext/B/t/optree_concise.t b/ext/B/t/optree_concise.t
index 33c6795ba6..2fa4469418 100644
--- a/ext/B/t/optree_concise.t
+++ b/ext/B/t/optree_concise.t
@@ -8,8 +8,11 @@ BEGIN {
# import checkOptree(), and %gOpts (containing test state)
use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
+use Config;
-plan tests => 24; # need to set based on testing state
+plan tests => 24;
+SKIP: {
+skip "no perlio in this build", 24 unless $Config::Config{useperlio};
$SIG{__WARN__} = sub {
my $err = shift;
@@ -442,6 +445,7 @@ EOT_EOT
1 <;> nextstate(main 76 optree_concise.t:407) v ->2
EONT_EONT
+} #skip
__END__
diff --git a/ext/B/t/optree_samples.t b/ext/B/t/optree_samples.t
index d22eb911d9..c42ffa05a7 100644
--- a/ext/B/t/optree_samples.t
+++ b/ext/B/t/optree_samples.t
@@ -6,8 +6,10 @@ BEGIN {
require './test.pl';
}
use OptreeCheck;
-
+use Config;
plan tests => 13;
+SKIP: {
+ skip "no perlio in this build", 13 unless $Config::Config{useperlio};
pass("GENERAL OPTREE EXAMPLES");
@@ -454,6 +456,8 @@ EOT_EOT
# 6 <@> leave[1 ref] vKP/REFC
EONT_EONT
+} # skip
+
__END__
#######################################################################
diff --git a/ext/B/t/optree_sort.t b/ext/B/t/optree_sort.t
index ca67990385..5462960e28 100644
--- a/ext/B/t/optree_sort.t
+++ b/ext/B/t/optree_sort.t
@@ -6,9 +6,12 @@ BEGIN {
require './test.pl';
}
use OptreeCheck;
-
+use Config;
plan tests => 11;
+SKIP: {
+skip "no perlio in this build", 11 unless $Config::Config{useperlio};
+
pass("SORT OPTIMIZATION");
checkOptree ( name => 'sub {sort @a}',
@@ -288,6 +291,7 @@ EOT_EOT
# a <1> leavesub[1 ref] K/REFC,1
EONT_EONT
+} #skip
__END__
diff --git a/ext/B/t/optree_varinit.t b/ext/B/t/optree_varinit.t
index e8eb8720e0..25129793f3 100644
--- a/ext/B/t/optree_varinit.t
+++ b/ext/B/t/optree_varinit.t
@@ -6,8 +6,11 @@ BEGIN {
require './test.pl';
}
use OptreeCheck;
-
+use Config;
plan tests => 22;
+SKIP: {
+skip "no perlio in this build", 22 unless $Config::Config{useperlio};
+
pass("OPTIMIZER TESTS - VAR INITIALIZATION");
checkOptree ( name => 'sub {my $a}',
@@ -378,5 +381,7 @@ EOT_EOT
# 8 <@> leave[1 ref] vKP/REFC
EONT_EONT
+} #skip
+
__END__
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index b2c67763f5..23b841844f 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -2908,7 +2908,9 @@ works for symmetry, but you really should consider writing something
to the temporary file first. You will need to seek() to do the
reading.
-File handles can be opened to "in memory" files held in Perl scalars via:
+Since v5.8.0, perl has built using PerlIO by default. Unless you've
+changed this (ie Configure -Uuseperlio), you can open file handles to
+"in memory" files held in Perl scalars via:
open($fh, '>', \$variable) || ..
@@ -2971,6 +2973,8 @@ Examples:
}
}
+See L<perliol/> for detailed info on PerlIO.
+
You may also, in the Bourne shell tradition, specify an EXPR beginning
with C<< '>&' >>, in which case the rest of the string is interpreted
as the name of a filehandle (or file descriptor, if numeric) to be