git.maemo.org Git - pkg-perl/blob - deb-src/libfilter-perl/libfilter-perl-1.34/t/order.t

   1
   2 # check that the filters are destroyed in the correct order by
   3 # installing two different types of filter. If they don't get destroyed
   4 # in the correct order we should get a "filter_del can only delete in
   5 # reverse order" error
   6
   7 # skip this set of tests is running on anything less than 5.004_55
   8 if ($] < 5.004_55) {
   9     print "1..0\n";
  10     exit 0;
  11 }
  12
  13 use strict;
  14 use warnings;
  15
  16 require "./filter-util.pl" ;
  17
  18 use vars qw( $Inc $Perl) ;
  19
  20 my $file = "tee.test" ;
  21 my $module = "Try";
  22 my $tee1 = "tee1" ;
  23
  24
  25 writeFile("${module}.pm", <<EOM, <<'EOM') ;
  26 package ${module} ;
  27
  28 EOM
  29 use Filter::Util::Call ;
  30 sub import {
  31     filter_add(
  32         sub {
  33
  34             my ($status) ;
  35
  36             if (($status = filter_read()) > 0) {
  37                 s/ABC/DEF/g
  38             }
  39             $status ;
  40         } ) ;
  41 }
  42
  43 1 ;
  44 EOM
  45
  46 my $fil1 = <<"EOM";
  47 use $module ;
  48
  49 print "ABC ABC\n" ;
  50
  51 EOM
  52
  53 writeFile($file, <<"EOM", $fil1) ;
  54 use Filter::tee '>$tee1' ;
  55 EOM
  56
  57 my $a = `$Perl $Inc $file 2>&1` ;
  58
  59 print "1..3\n" ;
  60
  61 ok(1, ($? >> 8) == 0) ;
  62 #print "|$a|\n";
  63 ok(2, $a eq <<EOM) ;
  64 DEF DEF
  65 EOM
  66
  67 ok(3, $fil1 eq readFile($tee1)) ;
  68
  69 unlink $file or die "Cannot remove $file: $!\n" ;
  70 unlink $tee1 or die "Cannot remove $tee1: $!\n" ;