[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';
}

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" ;

# 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} ;"  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

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