test.pl

   1 #!/usr/bin/perl
   2 #
   3 # nkf test program for nkf 2.0
   4 #    Shinji KONO <kono@ie.u-ryukyu.ac.jp>
   5 # Sun Aug 18 12:25:40 JST 1996
   6 # Sun Nov  8 00:16:06 JST 1998
   7 # Sun Sep  8 14:04:02 JST 2002
   8 #
   9 # This is useful when you add new patch on nkf.
  10 # Since this test is too strict, faileurs may not mean
  11 # wrong conversion.
  12 #
  13 # nkf 2.0 utf8
  14 # nkf 1.5 differs on MIME decoding
  15 # nkf 1.4 passes Basic Conversion tests
  16 # nkf PDS version passes Basic Conversion tests  using "nkf -iB -oB "
  17 #
  18
  19 if ($ARGV[0]) {
  20     $nkf = $ARGV[0];
  21 } else {
  22     $nkf = 'MSWin32' eq $^O ? ".\\nkf" : "./nkf";
  23 }
  24 # $nkf = "doscmd nkf.exe";
  25
  26 # If you want to see the testing process, set next flag.
  27
  28 $detail_all = 0;
  29 $error_count=1;
  30 $diff=1;
  31
  32 # &library_test0();
  33 sub test {
  34     &command_test(@_);
  35 }
  36
  37 sub command_test {
  38     local ($nkf,$in,@ans) = @_;
  39     local ($result);
  40
  41     $result = '';
  42     open(OUT,"> nkf.in");
  43     binmode OUT;
  44     print OUT $in;
  45     close(OUT);
  46     system("$nkf <nkf.in >nkf.out");   # easy
  47     open(IN,"< nkf.out");
  48     binmode IN;
  49     while(<IN>) {
  50         $result .= $_;
  51     }
  52
  53     if( $nkf =~ /-\S*m/) {
  54         $result =~ s/ //g;
  55     }
  56     $i = 0;
  57     foreach $ans (@ans) {
  58         if( $nkf =~ /-\S*m/) {
  59             $ans =~ s/ //g;
  60         }
  61         if ($result eq $ans) {
  62             print "Ok\n";
  63             return $result;
  64         }
  65         $i++;
  66     }
  67     $ans = $ans[0];
  68     print "Fail\n";
  69     system "mv nkf.in nkf.in.$error_count.bad";
  70     system "mv nkf.out nkf.out.$error_count.bad";
  71     open(OUT,"> nkf.expect.$error_count.bad");
  72     binmode OUT;
  73     print OUT $ans;
  74     close(OUT);
  75     $error_count++;
  76     if ($diff) {
  77         open(R,"|od -c >tmp.result.bad"); binmode R; print R $result; close(R);
  78         open(R,"|od -c >tmp.expect.bad"); binmode R; print R $ans; close(R);
  79         system "diff -c tmp.result.bad tmp.expect.bad";
  80     }
  81     return $result;
  82 }
  83
  84 do "nkf_test.pl";
  85
  86 unlink "nkf.in";
  87 unlink "nkf.out";