From: Jarkko Hietaniemi Date: Wed, 22 Nov 2000 22:45:51 +0000 (+0000) Subject: Add the Filter::Util::Call 1.04 by Paul Marquess from Filter-1.19. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2c4bb738a4721f993f446c73b9ec18fc8ed72864;p=p5sagit%2Fp5-mst-13.2.git Add the Filter::Util::Call 1.04 by Paul Marquess from Filter-1.19. p4raw-id: //depot/perl@7820 --- diff --git a/MANIFEST b/MANIFEST index 5c25ff6..98e1150 100644 --- a/MANIFEST +++ b/MANIFEST @@ -287,6 +287,9 @@ ext/File/Glob/Makefile.PL File::Glob extension makefile writer ext/File/Glob/TODO File::Glob extension todo list ext/File/Glob/bsd_glob.c File::Glob extension run time code ext/File/Glob/bsd_glob.h File::Glob extension header file +ext/Filter/Util/Call.pm Filter::Util::Call extension module +ext/Filter/Util/Call.xs Filter::Util::Call extension external subroutines +ext/Filter/Util/Makefile.PL Filter::Util::Call extension makefile writer ext/GDBM_File/GDBM_File.pm GDBM extension Perl module ext/GDBM_File/GDBM_File.xs GDBM extension external subroutines ext/GDBM_File/Makefile.PL GDBM extension makefile writer @@ -680,6 +683,7 @@ lib/File/Temp.pm create safe temporary files and file handles lib/File/stat.pm By-name interface to Perl's builtin stat lib/FileCache.pm Keep more files open than the system permits lib/FileHandle.pm Backward-compatible front end to IO extension +lib/Filter/Simple.pm Simple frontend to Filter::Util::Call lib/FindBin.pm Find name of currently executing program lib/Getopt/Long.pm Fetch command options (GetOptions) lib/Getopt/Std.pm Fetch command options (getopt, getopts) @@ -1384,6 +1388,8 @@ t/lib/filefunc.t See if File::Spec::Functions works t/lib/filehand.t See if FileHandle works t/lib/filepath.t See if File::Path works t/lib/filespec.t See if File::Spec works +t/lib/filt-util.t See if Filter::Util::Call works +t/lib/filt-util.pl See if Filter::Util::Call works t/lib/findbin.t See if FindBin works t/lib/ftmp-mktemp.t See if File::Temp works t/lib/ftmp-posix.t See if File::Temp works diff --git a/ext/Filter/Util/Call.pm b/ext/Filter/Util/Call.pm new file mode 100644 index 0000000..8d8d125 --- /dev/null +++ b/ext/Filter/Util/Call.pm @@ -0,0 +1,470 @@ +package Filter::Util::Call ; + +require 5.002 ; +require DynaLoader; +require Exporter; +use Carp ; +use strict; +use vars qw($VERSION @ISA @EXPORT) ; + +@ISA = qw(Exporter DynaLoader); +@EXPORT = qw( filter_add filter_del filter_read filter_read_exact) ; +$VERSION = "1.04" ; + +sub filter_read_exact($) +{ + my ($size) = @_ ; + my ($left) = $size ; + my ($status) ; + + croak ("filter_read_exact: size parameter must be > 0") + unless $size > 0 ; + + # try to read a block which is exactly $size bytes long + while ($left and ($status = filter_read($left)) > 0) { + $left = $size - length $_ ; + } + + # EOF with pending data is a special case + return 1 if $status == 0 and length $_ ; + + return $status ; +} + +sub filter_add($) +{ + my($obj) = @_ ; + + # Did we get a code reference? + my $coderef = (ref $obj eq 'CODE') ; + + # If the parameter isn't already a reference, make it one. + $obj = \$obj unless ref $obj ; + + $obj = bless ($obj, (caller)[0]) unless $coderef ; + + # finish off the installation of the filter in C. + Filter::Util::Call::real_import($obj, (caller)[0], $coderef) ; +} + +bootstrap Filter::Util::Call ; + +1; +__END__ + +=head1 NAME + +Filter::Util::Call - Perl Source Filter Utility Module + +=head1 DESCRIPTION + +This module provides you with the framework to write I +in Perl. + +A I is implemented as a Perl module. The structure +of the module can take one of two broadly similar formats. To +distinguish between them, the first will be referred to as I and the second as I. + +Here is a skeleton for the I: + + package MyFilter ; + + use Filter::Util::Call ; + + sub import + { + my($type, @arguments) = @_ ; + filter_add([]) ; + } + + sub filter + { + my($self) = @_ ; + my($status) ; + + $status = filter_read() ; + $status ; + } + + 1 ; + +and this is the equivalent skeleton for the I: + + package MyFilter ; + + use Filter::Util::Call ; + + sub import + { + my($type, @arguments) = @_ ; + + filter_add( + sub + { + my($status) ; + $status = filter_read() ; + $status ; + } ) + } + + 1 ; + +To make use of either of the two filter modules above, place the line +below in a Perl source file. + + use MyFilter; + +In fact, the skeleton modules shown above are fully functional I, albeit fairly useless ones. All they does is filter the +source stream without modifying it at all. + +As you can see both modules have a broadly similar structure. They both +make use of the C module and both have an C +method. The difference between them is that the I +requires a I method, whereas the I gets the +equivalent of a I method with the anonymous sub passed to +I. + +To make proper use of the I shown above you need to +have a good understanding of the concept of a I. See +L for more details on the mechanics of I. + +=head2 B + +The following functions are exported by C: + + filter_add() + filter_read() + filter_read_exact() + filter_del() + +=head2 B + +The C method is used to create an instance of the filter. It is +called indirectly by Perl when it encounters the C line +in a source file (See L for more details on +C). + +It will always have at least one parameter automatically passed by Perl +- this corresponds to the name of the package. In the example above it +will be C<"MyFilter">. + +Apart from the first parameter, import can accept an optional list of +parameters. These can be used to pass parameters to the filter. For +example: + + use MyFilter qw(a b c) ; + +will result in the C<@_> array having the following values: + + @_ [0] => "MyFilter" + @_ [1] => "a" + @_ [2] => "b" + @_ [3] => "c" + +Before terminating, the C function must explicitly install the +filter by calling C. + +B + +The function, C, actually installs the filter. It takes one +parameter which should be a reference. The kind of reference used will +dictate which of the two filter types will be used. + +If a CODE reference is used then a I will be assumed. + +If a CODE reference is not used, a I will be assumed. +In a I, the reference can be used to store context +information. The reference will be I into the package by +C. + +See the filters at the end of this documents for examples of using +context information using both I and I. + +=head2 B + +Both the C method used with a I and the +anonymous sub used with a I is where the main +processing for the filter is done. + +The big difference between the two types of filter is that the I uses the object passed to the method to store any context data, +whereas the I uses the lexical variables that are +maintained by the closure. + +Note that the single parameter passed to the I, +C<$self>, is the same reference that was passed to C +blessed into the filter's package. See the example filters later on for +details of using C<$self>. + +Here is a list of the common features of the anonymous sub and the +C method. + +=over 5 + +=item B<$_> + +Although C<$_> doesn't actually appear explicitly in the sample filters +above, it is implicitly used in a number of places. + +Firstly, when either C or the anonymous sub are called, a local +copy of C<$_> will automatically be created. It will always contain the +empty string at this point. + +Next, both C and C will append any +source data that is read to the end of C<$_>. + +Finally, when C or the anonymous sub are finished processing, +they are expected to return the filtered source using C<$_>. + +This implicit use of C<$_> greatly simplifies the filter. + +=item B<$status> + +The status value that is returned by the user's C method or +anonymous sub and the C and C functions take +the same set of values, namely: + + < 0 Error + = 0 EOF + > 0 OK + +=item B and B + +These functions are used by the filter to obtain either a line or block +from the next filter in the chain or the actual source file if there +aren't any other filters. + +The function C takes two forms: + + $status = filter_read() ; + $status = filter_read($size) ; + +The first form is used to request a I, the second requests a +I. + +In line mode, C will append the next source line to the +end of the C<$_> scalar. + +In block mode, C will append a block of data which is <= +C<$size> to the end of the C<$_> scalar. It is important to emphasise +the that C will not necessarily read a block which is +I C<$size> bytes. + +If you need to be able to read a block which has an exact size, you can +use the function C. It works identically to +C in block mode, except it will try to read a block which +is exactly C<$size> bytes in length. The only circumstances when it +will not return a block which is C<$size> bytes long is on EOF or +error. + +It is I important to check the value of C<$status> after I +call to C or C. + +=item B + +The function, C, is used to disable the current filter. It +does not affect the running of the filter. All it does is tell Perl not +to call filter any more. + +See L for details. + +=back + +=head1 EXAMPLES + +Here are a few examples which illustrate the key concepts - as such +most of them are of little practical use. + +The C sub-directory has copies of all these filters +implemented both as I and as I. + +=head2 Example 1: A simple filter. + +Below is a I which is hard-wired to replace all +occurrences of the string C<"Joe"> to C<"Jim">. Not particularly +Useful, but it is the first example and I wanted to keep it simple. + + package Joe2Jim ; + + use Filter::Util::Call ; + + sub import + { + my($type) = @_ ; + + filter_add(bless []) ; + } + + sub filter + { + my($self) = @_ ; + my($status) ; + + s/Joe/Jim/g + if ($status = filter_read()) > 0 ; + $status ; + } + + 1 ; + +Here is an example of using the filter: + + use Joe2Jim ; + print "Where is Joe?\n" ; + +And this is what the script above will print: + + Where is Jim? + +=head2 Example 2: Using the context + +The previous example was not particularly useful. To make it more +general purpose we will make use of the context data and allow any +arbitrary I and I strings to be used. This time we will use a +I. To reflect its enhanced role, the filter is called +C. + + package Subst ; + + use Filter::Util::Call ; + use Carp ; + + sub import + { + croak("usage: use Subst qw(from to)") + unless @_ == 3 ; + my ($self, $from, $to) = @_ ; + filter_add( + sub + { + my ($status) ; + s/$from/$to/ + if ($status = filter_read()) > 0 ; + $status ; + }) + } + 1 ; + +and is used like this: + + use Subst qw(Joe Jim) ; + print "Where is Joe?\n" ; + + +=head2 Example 3: Using the context within the filter + +Here is a filter which a variation of the C filter. As well as +substituting all occurrences of C<"Joe"> to C<"Jim"> it keeps a count +of the number of substitutions made in the context object. + +Once EOF is detected (C<$status> is zero) the filter will insert an +extra line into the source stream. When this extra line is executed it +will print a count of the number of substitutions actually made. +Note that C<$status> is set to C<1> in this case. + + package Count ; + + use Filter::Util::Call ; + + sub filter + { + my ($self) = @_ ; + my ($status) ; + + if (($status = filter_read()) > 0 ) { + s/Joe/Jim/g ; + ++ $$self ; + } + elsif ($$self >= 0) { # EOF + $_ = "print q[Made ${$self} substitutions\n]" ; + $status = 1 ; + $$self = -1 ; + } + + $status ; + } + + sub import + { + my ($self) = @_ ; + my ($count) = 0 ; + filter_add(\$count) ; + } + + 1 ; + +Here is a script which uses it: + + use Count ; + print "Hello Joe\n" ; + print "Where is Joe\n" ; + +Outputs: + + Hello Jim + Where is Jim + Made 2 substitutions + +=head2 Example 4: Using filter_del + +Another variation on a theme. This time we will modify the C +filter to allow a starting and stopping pattern to be specified as well +as the I and I patterns. If you know the I editor, it is +the equivalent of this command: + + :/start/,/stop/s/from/to/ + +When used as a filter we want to invoke it like this: + + use NewSubst qw(start stop from to) ; + +Here is the module. + + package NewSubst ; + + use Filter::Util::Call ; + use Carp ; + + sub import + { + my ($self, $start, $stop, $from, $to) = @_ ; + my ($found) = 0 ; + croak("usage: use Subst qw(start stop from to)") + unless @_ == 5 ; + + filter_add( + sub + { + my ($status) ; + + if (($status = filter_read()) > 0) { + + $found = 1 + if $found == 0 and /$start/ ; + + if ($found) { + s/$from/$to/ ; + filter_del() if /$stop/ ; + } + + } + $status ; + } ) + + } + + 1 ; + +=head1 AUTHOR + +Paul Marquess + +=head1 DATE + +26th January 1996 + +=cut + diff --git a/ext/Filter/Util/Call.xs b/ext/Filter/Util/Call.xs new file mode 100644 index 0000000..c8105d0 --- /dev/null +++ b/ext/Filter/Util/Call.xs @@ -0,0 +1,252 @@ +/* + * Filename : Call.xs + * + * Author : Paul Marquess + * Date : 26th March 2000 + * Version : 1.05 + * + */ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#ifndef PERL_VERSION +# include "patchlevel.h" +# define PERL_REVISION 5 +# define PERL_VERSION PATCHLEVEL +# define PERL_SUBVERSION SUBVERSION +#endif + +/* defgv must be accessed differently under threaded perl */ +/* DEFSV et al are in 5.004_56 */ +#ifndef DEFSV +# define DEFSV GvSV(defgv) +#endif + +#ifndef pTHX +# define pTHX +# define pTHX_ +# define aTHX +# define aTHX_ +#endif + + +/* Internal defines */ +#define PERL_MODULE(s) IoBOTTOM_NAME(s) +#define PERL_OBJECT(s) IoTOP_GV(s) +#define FILTER_ACTIVE(s) IoLINES(s) +#define BUF_OFFSET(sv) IoPAGE_LEN(sv) +#define CODE_REF(sv) IoPAGE(sv) + +#define SET_LEN(sv,len) \ + do { SvPVX(sv)[len] = '\0'; SvCUR_set(sv, len); } while (0) + + + +static int fdebug = 0; +static int current_idx ; + +static I32 +filter_call(pTHX_ int idx, SV *buf_sv, int maxlen) +{ + SV *my_sv = FILTER_DATA(idx); + char *nl = "\n"; + char *p; + char *out_ptr; + int n; + + if (fdebug) + warn("**** In filter_call - maxlen = %d, out len buf = %d idx = %d my_sv = %d [%s]\n", + maxlen, SvCUR(buf_sv), idx, SvCUR(my_sv), SvPVX(my_sv) ) ; + + while (1) { + + /* anything left from last time */ + if (n = SvCUR(my_sv)) { + + out_ptr = SvPVX(my_sv) + BUF_OFFSET(my_sv) ; + + if (maxlen) { + /* want a block */ + if (fdebug) + warn("BLOCK(%d): size = %d, maxlen = %d\n", + idx, n, maxlen) ; + + sv_catpvn(buf_sv, out_ptr, maxlen > n ? n : maxlen ); + if(n <= maxlen) { + BUF_OFFSET(my_sv) = 0 ; + SET_LEN(my_sv, 0) ; + } + else { + BUF_OFFSET(my_sv) += maxlen ; + SvCUR_set(my_sv, n - maxlen) ; + } + return SvCUR(buf_sv); + } + else { + /* want lines */ + if (p = ninstr(out_ptr, out_ptr + n - 1, nl, nl)) { + + sv_catpvn(buf_sv, out_ptr, p - out_ptr + 1); + + n = n - (p - out_ptr + 1); + BUF_OFFSET(my_sv) += (p - out_ptr + 1); + SvCUR_set(my_sv, n) ; + if (fdebug) + warn("recycle %d - leaving %d, returning %d [%s]", + idx, n, SvCUR(buf_sv), SvPVX(buf_sv)) ; + + return SvCUR(buf_sv); + } + else /* no EOL, so append the complete buffer */ + sv_catpvn(buf_sv, out_ptr, n) ; + } + + } + + + SET_LEN(my_sv, 0) ; + BUF_OFFSET(my_sv) = 0 ; + + if (FILTER_ACTIVE(my_sv)) + { + dSP ; + int count ; + + if (fdebug) + warn("gonna call %s::filter\n", PERL_MODULE(my_sv)) ; + + ENTER ; + SAVETMPS; + + SAVEINT(current_idx) ; /* save current idx */ + current_idx = idx ; + + SAVESPTR(DEFSV) ; /* save $_ */ + /* make $_ use our buffer */ + DEFSV = sv_2mortal(newSVpv("", 0)) ; + + PUSHMARK(sp) ; + + if (CODE_REF(my_sv)) { + /* if (SvROK(PERL_OBJECT(my_sv)) && SvTYPE(SvRV(PERL_OBJECT(my_sv))) == SVt_PVCV) { */ + count = perl_call_sv((SV*)PERL_OBJECT(my_sv), G_SCALAR); + } + else { + XPUSHs((SV*)PERL_OBJECT(my_sv)) ; + + PUTBACK ; + + count = perl_call_method("filter", G_SCALAR); + } + + SPAGAIN ; + + if (count != 1) + croak("Filter::Util::Call - %s::filter returned %d values, 1 was expected \n", + PERL_MODULE(my_sv), count ) ; + + n = POPi ; + + if (fdebug) + warn("status = %d, length op buf = %d [%s]\n", + n, SvCUR(DEFSV), SvPVX(DEFSV) ) ; + if (SvCUR(DEFSV)) + sv_setpvn(my_sv, SvPVX(DEFSV), SvCUR(DEFSV)) ; + + PUTBACK ; + FREETMPS ; + LEAVE ; + } + else + n = FILTER_READ(idx + 1, my_sv, maxlen) ; + + if (n <= 0) + { + /* Either EOF or an error */ + + if (fdebug) + warn ("filter_read %d returned %d , returning %d\n", idx, n, + (SvCUR(buf_sv)>0) ? SvCUR(buf_sv) : n); + + /* PERL_MODULE(my_sv) ; */ + /* PERL_OBJECT(my_sv) ; */ + filter_del(filter_call); + + /* If error, return the code */ + if (n < 0) + return n ; + + /* return what we have so far else signal eof */ + return (SvCUR(buf_sv)>0) ? SvCUR(buf_sv) : n; + } + + } +} + + + +MODULE = Filter::Util::Call PACKAGE = Filter::Util::Call + +REQUIRE: 1.924 +PROTOTYPES: ENABLE + +#define IDX current_idx + +int +filter_read(size=0) + int size + CODE: + { + SV * buffer = DEFSV ; + + RETVAL = FILTER_READ(IDX + 1, buffer, size) ; + } + OUTPUT: + RETVAL + + + + +void +real_import(object, perlmodule, coderef) + SV * object + char * perlmodule + int coderef + PPCODE: + { + SV * sv = newSV(1) ; + + (void)SvPOK_only(sv) ; + filter_add(filter_call, sv) ; + + PERL_MODULE(sv) = savepv(perlmodule) ; + PERL_OBJECT(sv) = (GV*) newSVsv(object) ; + FILTER_ACTIVE(sv) = TRUE ; + BUF_OFFSET(sv) = 0 ; + CODE_REF(sv) = coderef ; + + SvCUR_set(sv, 0) ; + + } + +void +filter_del() + CODE: + FILTER_ACTIVE(FILTER_DATA(IDX)) = FALSE ; + + + +void +unimport(...) + PPCODE: + filter_del(filter_call); + + +BOOT: + /* temporary hack to control debugging in toke.c */ + if (fdebug) + filter_add(NULL, (fdebug) ? (SV*)"1" : (SV*)"0"); + + diff --git a/ext/Filter/Util/Makefile.PL b/ext/Filter/Util/Makefile.PL new file mode 100644 index 0000000..01e1ca7 --- /dev/null +++ b/ext/Filter/Util/Makefile.PL @@ -0,0 +1,6 @@ +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Filter::Util::Call', + VERSION_FROM => 'Call.pm', +); diff --git a/t/lib/filt-util.pl b/t/lib/filt-util.pl new file mode 100644 index 0000000..1615873 --- /dev/null +++ b/t/lib/filt-util.pl @@ -0,0 +1,48 @@ +sub readFile +{ + my ($filename) = @_ ; + my ($string) = '' ; + + open (F, "<$filename") + or die "Cannot open $filename: $!\n" ; + while () + { $string .= $_ } + close F ; + $string ; +} + +sub writeFile +{ + my($filename, @strings) = @_ ; + open (F, ">$filename") + or die "Cannot open $filename: $!\n" ; + binmode(F) if $filename =~ /bin$/i; + foreach (@strings) + { print F } + close F ; +} + +sub ok +{ + my($number, $result, $note) = @_ ; + + $note = "" if ! defined $note ; + if ($note) { + $note = "# $note" if $note !~ /^\s*#/ ; + $note =~ s/^\s*/ / ; + } + + print "not " if !$result ; + print "ok ${number}${note}\n"; +} + +$Inc = '' ; +foreach (@INC) + { $Inc .= "-I$_ " } + +$Perl = '' ; +$Perl = ($ENV{'FULLPERL'} or $^X or 'perl') ; + +$Perl = "$Perl -w" ; + +1; diff --git a/t/lib/filt-util.t b/t/lib/filt-util.t new file mode 100644 index 0000000..78f47b8 --- /dev/null +++ b/t/lib/filt-util.t @@ -0,0 +1,791 @@ +BEGIN { + chdir('t') if -d 't'; + @INC = '.'; + push @INC, '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ m{\bFilter/Util\b}) { + print "1..0 # Skip: Filter::Util was not built\n"; + exit 0; + } + require 'lib/filt-util.pl'; +} + +print "1..28\n" ; + +$Perl = "$Perl -w" ; + +use Cwd ; +$here = getcwd ; + +use vars qw($Inc $Perl); + +$filename = "call.tst" ; +$filenamebin = "call.bin" ; +$module = "MyTest" ; +$module2 = "MyTest2" ; +$module3 = "MyTest3" ; +$module4 = "MyTest4" ; +$module5 = "MyTest5" ; +$nested = "nested" ; +$block = "block" ; + +# Test error cases +################## + +# no filter function in module +############################### + +writeFile("${module}.pm", <&1` ; +ok(1, (($? >>8) != 0 or ($^O eq 'MSWin32' && $? != 0))) ; +ok(2, $a =~ /^Can't locate object method "filter" via package "MyTest"/) ; + +# no reference parameter in filter_add +###################################### + +writeFile("${module}.pm", <&1` ; +ok(3, (($? >>8) != 0 or ($^O eq 'MSWin32' && $? != 0))) ; +#ok(4, $a =~ /^usage: filter_add\(ref\) at ${module}.pm/) ; +ok(4, $a =~ /^Not enough arguments for Filter::Util::Call::filter_add/) ; + + + + +# non-error cases +################# + + +# a simple filter, using a closure +################# + +writeFile("${module}.pm", < 0) { + s/ABC/DEF/g + } + $status ; + } ) ; +} + +1 ; +EOM + +writeFile($filename, <&1` ; +ok(5, ($? >>8) == 0) ; +ok(6, $a eq < 0) { + s/ABC/DEF/g + } + $status ; +} + + +1 ; +EOM + +writeFile($filename, <&1` ; +ok(7, ($? >>8) == 0) ; +ok(8, $a eq < 0) { + s/XYZ/PQR/g + } + $status ; +} + +1 ; +EOM + +writeFile("${module3}.pm", < 0) { + s/Fred/Joe/g + } + $status ; + } ) ; +} + +1 ; +EOM + +writeFile("${module4}.pm", < 0) { + s/Today/Tomorrow/g + } + $status ; +} + +1 ; +EOM + +writeFile($filename, <&1` ; +ok(9, ($? >>8) == 0) ; +ok(10, $a eq < 0) { + foreach $pattern (@strings) + { s/$pattern/PQR/g } + } + + $status ; + } + ) + +} +1 ; +EOM + + +writeFile($filename, <&1` ; +ok(11, ($? >>8) == 0) ; +ok(12, $a eq < 0) { + foreach $pattern (@$self) + { s/$pattern/PQR/g } + } + + $status ; +} + +1 ; +EOM + + +writeFile($filename, <&1` ; +ok(13, ($? >>8) == 0) ; +ok(14, $a eq < 0) { + chop ; + s/\r$//; + # and now the second line (it will append) + $status = filter_read() ; + } + + $status ; +} + +1 ; +EOM + + +writeFile($filename, <&1` ; +ok(15, ($? >>8) == 0) ; +ok(16, $a eq <&1` ; +ok(17, ($? >>8) == 0) ; +ok(18, $a eq < 0) { + s/DIR/$here/g + } + $status ; +} + +1 ; +EOM + +writeFile($filename, <&1` ; +ok(19, ($? >>8) == 0) ; +ok(20, $a eq < 0 ; + + -- $$self ; + filter_del() if $$self <= 0 ; + + $status ; +} + +1 ; +EOM + +writeFile($filename, <&1` ; +ok(21, ($? >>8) == 0) ; +ok(22, $a eq < 0) { + s/HERE/THERE/g + } + + $status ; +} + +1 ; +EOM + +writeFile($filenamebin, <&1` ; +ok(23, ($? >>8) == 0) ; +ok(24, $a eq < 0) { + s/HERE/THERE/g + } + + $status ; +} + +1 ; +EOM + +writeFile($filename, <; +print @a; +__DATA__ +HERE I am +I'm HERE +HERE today gone tomorrow +EOM + +$a = `$Perl -I. $Inc $filename 2>&1` ; +ok(25, ($? >>8) == 0) ; +ok(26, $a eq < 0) { + s/HERE/THERE/g + } + + $status ; +} + +1 ; +EOM + +writeFile($filename, <; +print @a; +__END__ +HERE I am +I'm HERE +HERE today gone tomorrow +EOM + +$a = `$Perl -I. $Inc $filename 2>&1` ; +ok(27, ($? >>8) == 0) ; +ok(28, $a eq <