[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..32\n" ;

$Perl = "$Perl -w" ;

use Cwd ;
my $here = getcwd ;


my $filename = "call.tst" ;
my $filename2 = "call2.tst" ;
my $filenamebin = "call.bin" ;
my $module   = "MyTest" ;
my $module2  = "MyTest2" ;
my $module3  = "MyTest3" ;
my $module4  = "MyTest4" ;
my $module5  = "MyTest5" ;
my $module6  = "MyTest6" ;
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

}

{

# no without use
# see Message-ID: <20021106212427.A15377@ttul.org>
####################

writeFile("${module6}.pm", <<EOM);
package ${module6} ;
#use Filter::Simple;
#FILTER {}
use Filter::Util::Call;
sub import { filter_add(sub{}) }
sub unimport { filter_del() }
1;
EOM

writeFile($filename2, <<EOM);
no ${module6} ;
print "ok";
EOM

my $str = $^O eq 'MacOS' ? "'ok'" : "q{ok}";
my $a = `$Perl "-I." $Inc -e "no ${module6}; print $str"`;
ok(29, ($? >>8) == 0);
chomp( $a ) if $^O eq 'VMS';
ok(30, $a eq 'ok');

$a = `$Perl "-I." $Inc $filename2`;
ok(31, ($? >>8) == 0);
chomp( $a ) if $^O eq 'VMS';
ok(32, $a eq 'ok');

}

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