[p5sagit/p5-mst-13.2.git] / ext / Filter / t / call.t

BEGIN {
    chdir('t') if -d 't';    
    @INC = '.'; 
    push @INC, '../lib';
    require Config; import Config;
    if ($Config{'extensions'} !~ m{\bFilter/Util/Call\b}) {
        print "1..0 # Skip: Filter::Util::Call was not built\n";
        exit 0;
    }
    require 'lib/filter-util.pl';
}

use strict;
use warnings;

use vars qw($Inc $Perl);

print "1..28\n" ;

$Perl = "$Perl -w" ;

use Cwd ;
my $here = getcwd ;


my $filename = "call.tst" ;
my $filenamebin = "call.bin" ;
my $module   = "MyTest" ;
my $module2  = "MyTest2" ;
my $module3  = "MyTest3" ;
my $module4  = "MyTest4" ;
my $module5  = "MyTest5" ;
my $nested   = "nested" ;
my $block   = "block" ;
my $redir   = $^O eq 'MacOS' ? "" : "2>&1";

# Test error cases
##################

# no filter function in module 
###############################

writeFile("${module}.pm", <<EOM) ;
package ${module} ;

use Filter::Util::Call ;
 
sub import { filter_add(bless []) }

1 ;
EOM
 
my $a = `$Perl "-I." $Inc -e "use ${module} ;"  $redir` ;
ok(1, (($? >>8) != 0 or (($^O eq 'MSWin32' || $^O eq 'MacOS' || $^O eq 'NetWare' || $^O eq 'mpeix') && $? != 0))) ;
ok(2, $a =~ /^Can't locate object method "filter" via package "MyTest"/) ;
 
# no reference parameter in filter_add
######################################

writeFile("${module}.pm", <<EOM) ;
package ${module} ;
 
use Filter::Util::Call ;
 
sub import { filter_add() }
 
1 ;
EOM
 
$a = `$Perl "-I." $Inc -e "use ${module} ;"  $redir` ;
ok(3, (($? >>8) != 0 or (($^O eq 'MSWin32' || $^O eq 'MacOS' || $^O eq 'NetWare' || $^O eq 'mpeix') && $? != 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", <<EOM, <<'EOM') ;
package ${module} ;
 
EOM
use Filter::Util::Call ;
sub import { 
    filter_add(
  	sub {
 
    	    my ($status) ;
 
    	    if (($status = filter_read()) > 0) {
        	s/ABC/DEF/g 
    	    }
    	    $status ;
  	} ) ;
}

1 ;
EOM
 
writeFile($filename, <<EOM, <<'EOM') ;

use $module ;
EOM

use Cwd ;
$here = getcwd ;
print "I am $here\n" ;
print "some letters ABC\n" ;
$y = "ABCDEF" ;
print <<EOF ;
Alphabetti Spagetti ($y)
EOF

EOM

$a = `$Perl "-I." $Inc $filename  $redir` ;
ok(5, ($? >>8) == 0) ;
ok(6, $a eq <<EOM) ;
I am $here
some letters DEF
Alphabetti Spagetti (DEFDEF)
EOM

# a simple filter, not using a closure
#################
 
writeFile("${module}.pm", <<EOM, <<'EOM') ;
package ${module} ;
 
EOM
use Filter::Util::Call ;
sub import { filter_add(bless []) }
 
sub filter
{
    my ($self) = @_ ;
    my ($status) ;
 
    if (($status = filter_read()) > 0) {
        s/ABC/DEF/g
    }
    $status ;
}

 
1 ;
EOM
 
writeFile($filename, <<EOM, <<'EOM') ;
 
use $module ;
EOM
 
use Cwd ;
$here = getcwd ;
print "I am $here\n" ;
print "some letters ABC\n" ;
$y = "ABCDEF" ;
print <<EOF ;
Alphabetti Spagetti ($y)
EOF
 
EOM
 
$a = `$Perl "-I." $Inc $filename  $redir` ;
ok(7, ($? >>8) == 0) ;
ok(8, $a eq <<EOM) ;
I am $here
some letters DEF
Alphabetti Spagetti (DEFDEF)
EOM


# nested filters
################


writeFile("${module2}.pm", <<EOM, <<'EOM') ;
package ${module2} ;
use Filter::Util::Call ;
 
EOM
sub import { filter_add(bless []) }
 
sub filter
{
    my ($self) = @_ ;
    my ($status) ;
 
    if (($status = filter_read()) > 0) {
        s/XYZ/PQR/g
    }
    $status ;
}
 
1 ;
EOM
 
writeFile("${module3}.pm", <<EOM, <<'EOM') ;
package ${module3} ;
use Filter::Util::Call ;
 
EOM
sub import { filter_add(
 
    sub 
    {
        my ($status) ;
     
        if (($status = filter_read()) > 0) {
            s/Fred/Joe/g
        }
        $status ;
    } ) ;
}
 
1 ;
EOM
 
writeFile("${module4}.pm", <<EOM) ;
package ${module4} ;
 
use $module5 ;

print "I'm feeling used!\n" ;
print "Fred Joe ABC DEF PQR XYZ\n" ;
print "See you Today\n" ;
1;
EOM

writeFile("${module5}.pm", <<EOM, <<'EOM') ;
package ${module5} ;
use Filter::Util::Call ;
 
EOM
sub import { filter_add(bless []) }
 
sub filter
{
    my ($self) = @_ ;
    my ($status) ;
 
    if (($status = filter_read()) > 0) {
        s/Today/Tomorrow/g
    }
    $status ;
}
 
1 ;
EOM

writeFile($filename, <<EOM, <<'EOM') ;
 
# two filters for this file
use $module ;
use $module2 ;
require "$nested" ;
use $module4 ;
EOM
 
print "some letters ABCXYZ\n" ;
$y = "ABCDEFXYZ" ;
print <<EOF ;
Fred likes Alphabetti Spagetti ($y)
EOF
 
EOM
 
writeFile($nested, <<EOM, <<'EOM') ;
use $module3 ;
EOM
 
print "This is another file XYZ\n" ;
print <<EOF ;
Where is Fred?
EOF
 
EOM

$a = `$Perl "-I." $Inc $filename  $redir` ;
ok(9, ($? >>8) == 0) ;
ok(10, $a eq <<EOM) ;
I'm feeling used!
Fred Joe ABC DEF PQR XYZ
See you Tomorrow
This is another file XYZ
Where is Joe?
some letters DEFPQR
Fred likes Alphabetti Spagetti (DEFDEFPQR)
EOM

# using the module context (with a closure)
###########################################
 
 
writeFile("${module2}.pm", <<EOM, <<'EOM') ;
package ${module2} ;
use Filter::Util::Call ;
 
EOM
sub import
{
    my ($type) = shift ;
    my (@strings) = @_ ;
 
 
    filter_add (
 
	sub 
	{
    	    my ($status) ;
    	    my ($pattern) ;
	     
    	    if (($status = filter_read()) > 0) {
                foreach $pattern (@strings)
          	    { s/$pattern/PQR/g }
    	    }
	     
    	    $status ;
	}
	)
 
}
1 ;
EOM
 
 
writeFile($filename, <<EOM, <<'EOM') ;
 
use $module2 qw( XYZ KLM) ;
use $module2 qw( ABC NMO) ;
EOM
 
print "some letters ABCXYZ KLM NMO\n" ;
$y = "ABCDEFXYZKLMNMO" ;
print <<EOF ;
Alphabetti Spagetti ($y)
EOF
 
EOM
 
$a = `$Perl "-I." $Inc $filename  $redir` ;
ok(11, ($? >>8) == 0) ;
ok(12, $a eq <<EOM) ;
some letters PQRPQR PQR PQR
Alphabetti Spagetti (PQRDEFPQRPQRPQR)
EOM
 

# using the module context (without a closure)
##############################################


writeFile("${module2}.pm", <<EOM, <<'EOM') ;
package ${module2} ;
use Filter::Util::Call ;
 
EOM
sub import 
{ 
    my ($type) = shift ;
    my (@strings) = @_ ;

  
    filter_add (bless [@strings]) 
}
 
sub filter
{
    my ($self) = @_ ;
    my ($status) ;
    my ($pattern) ;
 
    if (($status = filter_read()) > 0) {
	foreach $pattern (@$self)
          { s/$pattern/PQR/g }
    }

    $status ;
}
 
1 ;
EOM
 
 
writeFile($filename, <<EOM, <<'EOM') ;
 
use $module2 qw( XYZ KLM) ;
use $module2 qw( ABC NMO) ;
EOM
 
print "some letters ABCXYZ KLM NMO\n" ;
$y = "ABCDEFXYZKLMNMO" ;
print <<EOF ;
Alphabetti Spagetti ($y)
EOF
 
EOM
 
$a = `$Perl "-I." $Inc $filename  $redir` ;
ok(13, ($? >>8) == 0) ;
ok(14, $a eq <<EOM) ;
some letters PQRPQR PQR PQR
Alphabetti Spagetti (PQRDEFPQRPQRPQR)
EOM

# multi line test
#################


writeFile("${module2}.pm", <<EOM, <<'EOM') ;
package ${module2} ;
use Filter::Util::Call ;
 
EOM
sub import
{ 
    my ($type) = shift ;
    my (@strings) = @_ ;

  
    filter_add(bless []) 
}
 
sub filter
{
    my ($self) = @_ ;
    my ($status) ;
 
    # read first line
    if (($status = filter_read()) > 0) {
	chop ;
	s/\r$//;
	# and now the second line (it will append)
        $status = filter_read() ;
    }

    $status ;
}
 
1 ;
EOM
 
 
writeFile($filename, <<EOM, <<'EOM') ;
 
use $module2  ;
EOM
print "don't cut me 
in half\n" ;
print  
<<EOF ;
appen
ded
EO
F
 
EOM
 
$a = `$Perl "-I." $Inc $filename  $redir` ;
ok(15, ($? >>8) == 0) ;
ok(16, $a eq <<EOM) ;
don't cut me in half
appended
EOM

# Block test
#############

writeFile("${block}.pm", <<EOM, <<'EOM') ;
package ${block} ;
use Filter::Util::Call ;
 
EOM
sub import
{ 
    my ($type) = shift ;
    my (@strings) = @_ ;

  
    filter_add (bless [@strings] )
}
 
sub filter
{
    my ($self) = @_ ;
    my ($status) ;
    my ($pattern) ;
 
    filter_read(20)  ;
}
 
1 ;
EOM

my $string = <<'EOM' ;
print "hello mum\n" ;
$x = 'me ' x 3 ;
print "Who wants it?\n$x\n" ;
EOM


writeFile($filename, <<EOM, $string ) ;
use $block ;
EOM
 
$a = `$Perl "-I." $Inc $filename  $redir` ;
ok(17, ($? >>8) == 0) ;
ok(18, $a eq <<EOM) ;
hello mum
Who wants it?
me me me 
EOM

# use in the filter
####################

writeFile("${block}.pm", <<EOM, <<'EOM') ;
package ${block} ;
use Filter::Util::Call ;
 
EOM
use Cwd ;

sub import
{ 
    my ($type) = shift ;
    my (@strings) = @_ ;

  
    filter_add(bless [@strings] )
}
 
sub filter
{
    my ($self) = @_ ;
    my ($status) ;
    my ($here) = quotemeta getcwd ;
 
    if (($status = filter_read()) > 0) {
        s/DIR/$here/g
    }
    $status ;
}
 
1 ;
EOM

writeFile($filename, <<EOM, <<'EOM') ;
use $block ;
EOM
print "We are in DIR\n" ;
EOM
 
$a = `$Perl "-I." $Inc $filename  $redir` ;
ok(19, ($? >>8) == 0) ;
ok(20, $a eq <<EOM) ;
We are in $here
EOM


# filter_del
#############
 
writeFile("${block}.pm", <<EOM, <<'EOM') ;
package ${block} ;
use Filter::Util::Call ;
 
EOM
 
sub import
{
    my ($type) = shift ;
    my ($count) = @_ ;
 
 
    filter_add(bless \$count )
}
 
sub filter
{
    my ($self) = @_ ;
    my ($status) ;
 
    s/HERE/THERE/g
        if ($status = filter_read()) > 0 ;

    -- $$self ;
    filter_del() if $$self <= 0 ;

    $status ;
}
 
1 ;
EOM
 
writeFile($filename, <<EOM, <<'EOM') ;
use $block (3) ;
EOM
print "
HERE I am
I am HERE
HERE today gone tomorrow\n" ;
EOM
 
$a = `$Perl "-I." $Inc $filename  $redir` ;
ok(21, ($? >>8) == 0) ;
ok(22, $a eq <<EOM) ;

THERE I am
I am THERE
HERE today gone tomorrow
EOM


# filter_read_exact
####################
 
writeFile("${block}.pm", <<EOM, <<'EOM') ;
package ${block} ;
use Filter::Util::Call ;
 
EOM
 
sub import
{
    my ($type) = shift ;
 
    filter_add(bless [] )
}
 
sub filter
{
    my ($self) = @_ ;
    my ($status) ;
 
    if (($status = filter_read_exact(9)) > 0) {
        s/HERE/THERE/g
    }
 
    $status ;
}
 
1 ;
EOM
 
writeFile($filenamebin, <<EOM, <<'EOM') ;
use $block ;
EOM
print "
HERE I am
I'm HERE
HERE today gone tomorrow\n" ;
EOM
 
$a = `$Perl "-I." $Inc $filenamebin  $redir` ;
ok(23, ($? >>8) == 0) ;
ok(24, $a eq <<EOM) ;

HERE I am
I'm THERE
THERE today gone tomorrow
EOM

{

# Check __DATA__
####################
 
writeFile("${block}.pm", <<EOM, <<'EOM') ;
package ${block} ;
use Filter::Util::Call ;
 
EOM
 
sub import
{
    my ($type) = shift ;
 
    filter_add(bless [] )
}
 
sub filter
{
    my ($self) = @_ ;
    my ($status) ;
 
    if (($status = filter_read()) > 0) {
        s/HERE/THERE/g
    }
 
    $status ;
}
 
1 ;
EOM
 
writeFile($filename, <<EOM, <<'EOM') ;
use $block ;
EOM
print "HERE HERE\n";
@a = <DATA>;
print @a;
__DATA__
HERE I am
I'm HERE
HERE today gone tomorrow
EOM
 
$a = `$Perl "-I." $Inc $filename  $redir` ;
ok(25, ($? >>8) == 0) ;
ok(26, $a eq <<EOM) ;
THERE THERE
HERE I am
I'm HERE
HERE today gone tomorrow
EOM

}

{

# Check __END__
####################
 
writeFile("${block}.pm", <<EOM, <<'EOM') ;
package ${block} ;
use Filter::Util::Call ;
 
EOM
 
sub import
{
    my ($type) = shift ;
 
    filter_add(bless [] )
}
 
sub filter
{
    my ($self) = @_ ;
    my ($status) ;
 
    if (($status = filter_read()) > 0) {
        s/HERE/THERE/g
    }
 
    $status ;
}
 
1 ;
EOM
 
writeFile($filename, <<EOM, <<'EOM') ;
use $block ;
EOM
print "HERE HERE\n";
@a = <DATA>;
print @a;
__END__
HERE I am
I'm HERE
HERE today gone tomorrow
EOM
 
$a = `$Perl "-I." $Inc $filename  $redir` ;
ok(27, ($? >>8) == 0) ;
ok(28, $a eq <<EOM) ;
THERE THERE
HERE I am
I'm HERE
HERE today gone tomorrow
EOM

}

END {
    1 while unlink $filename ;
    1 while unlink $filenamebin ;
    1 while unlink "${module}.pm" ;
    1 while unlink "${module2}.pm" ;
    1 while unlink "${module3}.pm" ;
    1 while unlink "${module4}.pm" ;
    1 while unlink "${module5}.pm" ;
    1 while unlink $nested ;
    1 while unlink "${block}.pm" ;
}
Commit	Line	Data
2c4bb738	1	BEGIN {
	2	chdir('t') if -d 't';
	3	@INC = '.';
	4	push @INC, '../lib';
	5	require Config; import Config;
5e506771	6	if ($Config{'extensions'} !~ m{\bFilter/Util/Call\b}) {
5e506771	7	print "1..0 # Skip: Filter::Util::Call was not built\n";
2c4bb738	8	exit 0;
2c4bb738	9	}
5e506771	10	require 'lib/filter-util.pl';
2c4bb738	11	}
2c4bb738	12
4176d4e4	13	use strict;
	14	use warnings;
	15
	16	use vars qw($Inc $Perl);
	17
2c4bb738	18	print "1..28\n" ;
	19
	20	$Perl = "$Perl -w" ;
	21
	22	use Cwd ;
4176d4e4	23	my $here = getcwd ;
2c4bb738	24
2c4bb738	25
4176d4e4	26	my $filename = "call.tst" ;
	27	my $filenamebin = "call.bin" ;
	28	my $module = "MyTest" ;
	29	my $module2 = "MyTest2" ;
	30	my $module3 = "MyTest3" ;
	31	my $module4 = "MyTest4" ;
	32	my $module5 = "MyTest5" ;
	33	my $nested = "nested" ;
	34	my $block = "block" ;
68ae75ab	35	my $redir = $^O eq 'MacOS' ? "" : "2>&1";
2c4bb738	36
	37	# Test error cases
	38	##################
	39
	40	# no filter function in module
	41	###############################
	42
	43	writeFile("${module}.pm", <<EOM) ;
	44	package ${module} ;
	45
	46	use Filter::Util::Call ;
	47
	48	sub import { filter_add(bless []) }
	49
	50	1 ;
	51	EOM
	52
68ae75ab	53	my $a = `$Perl "-I." $Inc -e "use ${module} ;" $redir` ;
68ae75ab	54	ok(1, (($? >>8) != 0 or (($^O eq 'MSWin32' \|\| $^O eq 'MacOS' \|\| $^O eq 'NetWare' \|\| $^O eq 'mpeix') && $? != 0))) ;
2c4bb738	55	ok(2, $a =~ /^Can't locate object method "filter" via package "MyTest"/) ;
	56
	57	# no reference parameter in filter_add
	58	######################################
	59
	60	writeFile("${module}.pm", <<EOM) ;
	61	package ${module} ;
	62
	63	use Filter::Util::Call ;
	64
	65	sub import { filter_add() }
	66
	67	1 ;
	68	EOM
	69
68ae75ab	70	$a = `$Perl "-I." $Inc -e "use ${module} ;" $redir` ;
68ae75ab	71	ok(3, (($? >>8) != 0 or (($^O eq 'MSWin32' \|\| $^O eq 'MacOS' \|\| $^O eq 'NetWare' \|\| $^O eq 'mpeix') && $? != 0))) ;
2c4bb738	72	#ok(4, $a =~ /^usage: filter_add\(ref\) at ${module}.pm/) ;
	73	ok(4, $a =~ /^Not enough arguments for Filter::Util::Call::filter_add/) ;
	74
	75
	76
	77
	78	# non-error cases
	79	#################
	80
	81
	82	# a simple filter, using a closure
	83	#################
	84
	85	writeFile("${module}.pm", <<EOM, <<'EOM') ;
	86	package ${module} ;
	87
	88	EOM
	89	use Filter::Util::Call ;
	90	sub import {
	91	filter_add(
	92	sub {
	93
	94	my ($status) ;
	95
	96	if (($status = filter_read()) > 0) {
	97	s/ABC/DEF/g
	98	}
	99	$status ;
	100	} ) ;
	101	}
	102
	103	1 ;
	104	EOM
	105
	106	writeFile($filename, <<EOM, <<'EOM') ;
	107
	108	use $module ;
	109	EOM
	110
	111	use Cwd ;
	112	$here = getcwd ;
	113	print "I am $here\n" ;
	114	print "some letters ABC\n" ;
	115	$y = "ABCDEF" ;
	116	print <<EOF ;
	117	Alphabetti Spagetti ($y)
	118	EOF
	119
	120	EOM
	121
68ae75ab	122	$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738	123	ok(5, ($? >>8) == 0) ;
	124	ok(6, $a eq <<EOM) ;
	125	I am $here
	126	some letters DEF
	127	Alphabetti Spagetti (DEFDEF)
	128	EOM
	129
	130	# a simple filter, not using a closure
	131	#################
	132
	133	writeFile("${module}.pm", <<EOM, <<'EOM') ;
	134	package ${module} ;
	135
	136	EOM
	137	use Filter::Util::Call ;
	138	sub import { filter_add(bless []) }
	139
	140	sub filter
	141	{
	142	my ($self) = @_ ;
	143	my ($status) ;
	144
	145	if (($status = filter_read()) > 0) {
	146	s/ABC/DEF/g
	147	}
	148	$status ;
	149	}
	150
	151
	152	1 ;
	153	EOM
	154
	155	writeFile($filename, <<EOM, <<'EOM') ;
	156
	157	use $module ;
	158	EOM
	159
	160	use Cwd ;
	161	$here = getcwd ;
	162	print "I am $here\n" ;
	163	print "some letters ABC\n" ;
	164	$y = "ABCDEF" ;
	165	print <<EOF ;
	166	Alphabetti Spagetti ($y)
	167	EOF
	168
	169	EOM
	170
68ae75ab	171	$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738	172	ok(7, ($? >>8) == 0) ;
	173	ok(8, $a eq <<EOM) ;
	174	I am $here
	175	some letters DEF
	176	Alphabetti Spagetti (DEFDEF)
	177	EOM
	178
	179
	180	# nested filters
	181	################
	182
	183
	184	writeFile("${module2}.pm", <<EOM, <<'EOM') ;
	185	package ${module2} ;
	186	use Filter::Util::Call ;
	187
	188	EOM
	189	sub import { filter_add(bless []) }
	190
	191	sub filter
	192	{
	193	my ($self) = @_ ;
	194	my ($status) ;
	195
	196	if (($status = filter_read()) > 0) {
	197	s/XYZ/PQR/g
	198	}
	199	$status ;
	200	}
	201
	202	1 ;
	203	EOM
	204
	205	writeFile("${module3}.pm", <<EOM, <<'EOM') ;
	206	package ${module3} ;
	207	use Filter::Util::Call ;
	208
	209	EOM
	210	sub import { filter_add(
	211
	212	sub
	213	{
	214	my ($status) ;
	215
	216	if (($status = filter_read()) > 0) {
	217	s/Fred/Joe/g
	218	}
	219	$status ;
	220	} ) ;
	221	}
	222
	223	1 ;
	224	EOM
	225
	226	writeFile("${module4}.pm", <<EOM) ;
	227	package ${module4} ;
	228
	229	use $module5 ;
	230
	231	print "I'm feeling used!\n" ;
	232	print "Fred Joe ABC DEF PQR XYZ\n" ;
	233	print "See you Today\n" ;
	234	1;
	235	EOM
236
237	writeFile("${module5}.pm", <<EOM, <<'EOM') ;
238	package ${module5} ;
239	use Filter::Util::Call ;
240
241	EOM
242	sub import { filter_add(bless []) }
243
244	sub filter
245	{
246	my ($self) = @_ ;
247	my ($status) ;
248
249	if (($status = filter_read()) > 0) {
250	s/Today/Tomorrow/g
251	}
252	$status ;
253	}
254
255	1 ;
256	EOM
257
258	writeFile($filename, <<EOM, <<'EOM') ;
259
260	# two filters for this file
261	use $module ;
262	use $module2 ;
263	require "$nested" ;
264	use $module4 ;
265	EOM
266
267	print "some letters ABCXYZ\n" ;
268	$y = "ABCDEFXYZ" ;
269	print <<EOF ;
270	Fred likes Alphabetti Spagetti ($y)
271	EOF
272
273	EOM
274
275	writeFile($nested, <<EOM, <<'EOM') ;
276	use $module3 ;
277	EOM
278
279	print "This is another file XYZ\n" ;
280	print <<EOF ;
281	Where is Fred?
282	EOF
283
284	EOM
285
68ae75ab	286	$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738	287	ok(9, ($? >>8) == 0) ;
	288	ok(10, $a eq <<EOM) ;
	289	I'm feeling used!
	290	Fred Joe ABC DEF PQR XYZ
	291	See you Tomorrow
	292	This is another file XYZ
	293	Where is Joe?
	294	some letters DEFPQR
	295	Fred likes Alphabetti Spagetti (DEFDEFPQR)
	296	EOM
	297
	298	# using the module context (with a closure)
	299	###########################################
	300
	301
	302	writeFile("${module2}.pm", <<EOM, <<'EOM') ;
	303	package ${module2} ;
	304	use Filter::Util::Call ;
	305
	306	EOM
	307	sub import
	308	{
	309	my ($type) = shift ;
	310	my (@strings) = @_ ;
	311
	312
	313	filter_add (
	314
	315	sub
	316	{
	317	my ($status) ;
	318	my ($pattern) ;
	319
	320	if (($status = filter_read()) > 0) {
	321	foreach $pattern (@strings)
	322	{ s/$pattern/PQR/g }
	323	}
	324
	325	$status ;
	326	}
	327	)
	328
	329	}
	330	1 ;
	331	EOM
	332
	333
	334	writeFile($filename, <<EOM, <<'EOM') ;
	335
	336	use $module2 qw( XYZ KLM) ;
	337	use $module2 qw( ABC NMO) ;
	338	EOM
	339
	340	print "some letters ABCXYZ KLM NMO\n" ;
	341	$y = "ABCDEFXYZKLMNMO" ;
	342	print <<EOF ;
	343	Alphabetti Spagetti ($y)
	344	EOF
	345
	346	EOM
	347
68ae75ab	348	$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738	349	ok(11, ($? >>8) == 0) ;
	350	ok(12, $a eq <<EOM) ;
	351	some letters PQRPQR PQR PQR
	352	Alphabetti Spagetti (PQRDEFPQRPQRPQR)
	353	EOM
	354
	355
	356
	357	# using the module context (without a closure)
	358	##############################################
	359
	360
	361	writeFile("${module2}.pm", <<EOM, <<'EOM') ;
	362	package ${module2} ;
	363	use Filter::Util::Call ;
	364
	365	EOM
	366	sub import
	367	{
	368	my ($type) = shift ;
	369	my (@strings) = @_ ;
	370
	371
	372	filter_add (bless [@strings])
	373	}
	374
	375	sub filter
	376	{
	377	my ($self) = @_ ;
	378	my ($status) ;
	379	my ($pattern) ;
	380
	381	if (($status = filter_read()) > 0) {
	382	foreach $pattern (@$self)
	383	{ s/$pattern/PQR/g }
	384	}
	385
	386	$status ;
	387	}
	388
	389	1 ;
	390	EOM
	391
	392
	393	writeFile($filename, <<EOM, <<'EOM') ;
	394
	395	use $module2 qw( XYZ KLM) ;
	396	use $module2 qw( ABC NMO) ;
	397	EOM
	398
	399	print "some letters ABCXYZ KLM NMO\n" ;
	400	$y = "ABCDEFXYZKLMNMO" ;
	401	print <<EOF ;
	402	Alphabetti Spagetti ($y)
	403	EOF
	404
	405	EOM
	406
68ae75ab	407	$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738	408	ok(13, ($? >>8) == 0) ;
	409	ok(14, $a eq <<EOM) ;
	410	some letters PQRPQR PQR PQR
	411	Alphabetti Spagetti (PQRDEFPQRPQRPQR)
	412	EOM
	413
	414	# multi line test
	415	#################
	416
	417
	418	writeFile("${module2}.pm", <<EOM, <<'EOM') ;
	419	package ${module2} ;
	420	use Filter::Util::Call ;
	421
	422	EOM
	423	sub import
	424	{
	425	my ($type) = shift ;
	426	my (@strings) = @_ ;
	427
	428
	429	filter_add(bless [])
	430	}
	431
	432	sub filter
	433	{
	434	my ($self) = @_ ;
	435	my ($status) ;
	436
	437	# read first line
	438	if (($status = filter_read()) > 0) {
	439	chop ;
	440	s/\r$//;
	441	# and now the second line (it will append)
	442	$status = filter_read() ;
	443	}
	444
	445	$status ;
	446	}
	447
	448	1 ;
	449	EOM
	450
	451
	452	writeFile($filename, <<EOM, <<'EOM') ;
	453
	454	use $module2 ;
	455	EOM
	456	print "don't cut me
	457	in half\n" ;
	458	print
	459	<<EOF ;
	460	appen
	461	ded
	462	EO
	463	F
	464
	465	EOM
	466
68ae75ab	467	$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738	468	ok(15, ($? >>8) == 0) ;
	469	ok(16, $a eq <<EOM) ;
	470	don't cut me in half
	471	appended
	472	EOM
	473
	474	# Block test
	475	#############
	476
	477	writeFile("${block}.pm", <<EOM, <<'EOM') ;
	478	package ${block} ;
	479	use Filter::Util::Call ;
	480
	481	EOM
	482	sub import
	483	{
	484	my ($type) = shift ;
	485	my (@strings) = @_ ;
	486
	487
	488	filter_add (bless [@strings] )
	489	}
	490
	491	sub filter
	492	{
	493	my ($self) = @_ ;
	494	my ($status) ;
	495	my ($pattern) ;
	496
	497	filter_read(20) ;
	498	}
	499
	500	1 ;
	501	EOM
	502
4176d4e4	503	my $string = <<'EOM' ;
2c4bb738	504	print "hello mum\n" ;
	505	$x = 'me ' x 3 ;
	506	print "Who wants it?\n$x\n" ;
	507	EOM
	508
	509
	510	writeFile($filename, <<EOM, $string ) ;
	511	use $block ;
	512	EOM
	513
68ae75ab	514	$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738	515	ok(17, ($? >>8) == 0) ;
	516	ok(18, $a eq <<EOM) ;
	517	hello mum
	518	Who wants it?
	519	me me me
	520	EOM
	521
	522	# use in the filter
	523	####################
	524
	525	writeFile("${block}.pm", <<EOM, <<'EOM') ;
	526	package ${block} ;
	527	use Filter::Util::Call ;
	528
	529	EOM
	530	use Cwd ;
	531
	532	sub import
	533	{
	534	my ($type) = shift ;
	535	my (@strings) = @_ ;
	536
	537
	538	filter_add(bless [@strings] )
	539	}
	540
	541	sub filter
	542	{
	543	my ($self) = @_ ;
	544	my ($status) ;
1fcbfbda	545	my ($here) = quotemeta getcwd ;
2c4bb738	546
	547	if (($status = filter_read()) > 0) {
	548	s/DIR/$here/g
	549	}
	550	$status ;
	551	}
	552
	553	1 ;
	554	EOM
	555
	556	writeFile($filename, <<EOM, <<'EOM') ;
	557	use $block ;
	558	EOM
	559	print "We are in DIR\n" ;
	560	EOM
	561
68ae75ab	562	$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738	563	ok(19, ($? >>8) == 0) ;
	564	ok(20, $a eq <<EOM) ;
	565	We are in $here
	566	EOM
	567
	568
	569	# filter_del
	570	#############
	571
	572	writeFile("${block}.pm", <<EOM, <<'EOM') ;
	573	package ${block} ;
	574	use Filter::Util::Call ;
	575
	576	EOM
	577
	578	sub import
	579	{
	580	my ($type) = shift ;
	581	my ($count) = @_ ;
	582
	583
	584	filter_add(bless \$count )
	585	}
	586
	587	sub filter
	588	{
	589	my ($self) = @_ ;
	590	my ($status) ;
	591
	592	s/HERE/THERE/g
	593	if ($status = filter_read()) > 0 ;
	594
	595	-- $$self ;
	596	filter_del() if $$self <= 0 ;
	597
	598	$status ;
	599	}
	600
	601	1 ;
	602	EOM
	603
	604	writeFile($filename, <<EOM, <<'EOM') ;
	605	use $block (3) ;
	606	EOM
	607	print "
	608	HERE I am
	609	I am HERE
	610	HERE today gone tomorrow\n" ;
	611	EOM
	612
68ae75ab	613	$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738	614	ok(21, ($? >>8) == 0) ;
	615	ok(22, $a eq <<EOM) ;
	616
	617	THERE I am
	618	I am THERE
	619	HERE today gone tomorrow
	620	EOM
	621
	622
	623	# filter_read_exact
	624	####################
	625
	626	writeFile("${block}.pm", <<EOM, <<'EOM') ;
	627	package ${block} ;
	628	use Filter::Util::Call ;
	629
	630	EOM
	631
	632	sub import
	633	{
	634	my ($type) = shift ;
	635
	636	filter_add(bless [] )
	637	}
	638
	639	sub filter
	640	{
	641	my ($self) = @_ ;
	642	my ($status) ;
	643
	644	if (($status = filter_read_exact(9)) > 0) {
	645	s/HERE/THERE/g
	646	}
	647
	648	$status ;
	649	}
	650
	651	1 ;
	652	EOM
	653
	654	writeFile($filenamebin, <<EOM, <<'EOM') ;
	655	use $block ;
	656	EOM
	657	print "
	658	HERE I am
	659	I'm HERE
	660	HERE today gone tomorrow\n" ;
	661	EOM
	662
68ae75ab	663	$a = `$Perl "-I." $Inc $filenamebin $redir` ;
2c4bb738	664	ok(23, ($? >>8) == 0) ;
	665	ok(24, $a eq <<EOM) ;
	666
	667	HERE I am
	668	I'm THERE
	669	THERE today gone tomorrow
	670	EOM
	671
	672	{
	673
	674	# Check __DATA__
	675	####################
	676
	677	writeFile("${block}.pm", <<EOM, <<'EOM') ;
	678	package ${block} ;
	679	use Filter::Util::Call ;
	680
	681	EOM
	682
	683	sub import
	684	{
	685	my ($type) = shift ;
	686
	687	filter_add(bless [] )
	688	}
	689
	690	sub filter
	691	{
	692	my ($self) = @_ ;
	693	my ($status) ;
	694
	695	if (($status = filter_read()) > 0) {
	696	s/HERE/THERE/g
	697	}
	698
	699	$status ;
	700	}
	701
	702	1 ;
	703	EOM
	704
	705	writeFile($filename, <<EOM, <<'EOM') ;
	706	use $block ;
	707	EOM
	708	print "HERE HERE\n";
	709	@a = <DATA>;
	710	print @a;
	711	__DATA__
	712	HERE I am
	713	I'm HERE
	714	HERE today gone tomorrow
	715	EOM
	716
68ae75ab	717	$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738	718	ok(25, ($? >>8) == 0) ;
	719	ok(26, $a eq <<EOM) ;
	720	THERE THERE
	721	HERE I am
	722	I'm HERE
	723	HERE today gone tomorrow
	724	EOM
	725
	726	}
	727
	728	{
	729
	730	# Check __END__
	731	####################
	732
	733	writeFile("${block}.pm", <<EOM, <<'EOM') ;
	734	package ${block} ;
	735	use Filter::Util::Call ;
	736
	737	EOM
	738
	739	sub import
	740	{
	741	my ($type) = shift ;
	742
	743	filter_add(bless [] )
	744	}
	745
	746	sub filter
	747	{
	748	my ($self) = @_ ;
	749	my ($status) ;
	750
	751	if (($status = filter_read()) > 0) {
	752	s/HERE/THERE/g
	753	}
	754
	755	$status ;
	756	}
	757
	758	1 ;
	759	EOM
	760
	761	writeFile($filename, <<EOM, <<'EOM') ;
	762	use $block ;
	763	EOM
	764	print "HERE HERE\n";
	765	@a = <DATA>;
	766	print @a;
	767	__END__
	768	HERE I am
	769	I'm HERE
	770	HERE today gone tomorrow
	771	EOM
	772
68ae75ab	773	$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738	774	ok(27, ($? >>8) == 0) ;
	775	ok(28, $a eq <<EOM) ;
	776	THERE THERE
	777	HERE I am
	778	I'm HERE
	779	HERE today gone tomorrow
	780	EOM
	781
	782	}
	783
	784	END {
95fa9585	785	1 while unlink $filename ;
	786	1 while unlink $filenamebin ;
	787	1 while unlink "${module}.pm" ;
	788	1 while unlink "${module2}.pm" ;
	789	1 while unlink "${module3}.pm" ;
	790	1 while unlink "${module4}.pm" ;
	791	1 while unlink "${module5}.pm" ;
	792	1 while unlink $nested ;
	793	1 while unlink "${block}.pm" ;
2c4bb738	794	}
	795
	796