[p5sagit/p5-mst-13.2.git] / t / lib / filter-util.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';
}

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", <<EOM) ;
package ${module} ;

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

1 ;
EOM
 
$a = `$Perl "-I." $Inc -e "use ${module} ;"  2>&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", <<EOM) ;
package ${module} ;
 
use Filter::Util::Call ;
 
sub import { filter_add() }
 
1 ;
EOM
 
$a = `$Perl "-I." $Inc -e "use ${module} ;"  2>&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", <<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  2>&1` ;
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  2>&1` ;
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  2>&1` ;
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  2>&1` ;
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  2>&1` ;
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  2>&1` ;
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

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