t/io/format.t

   1 #!/usr/bin/perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 print "1..33\n";
   9
  10 use strict;     # Amazed that this hackery can be made strict ...
  11
  12 # Just a complete test for format, including top-, left- and bottom marging
  13 # and format detection through glob entries
  14
  15    $=  =  7;            # Page length
  16 my $ps = $^L; $^L = ""; # Catch the page separator
  17 my $tm =  1;            # Top margin (empty lines before first output)
  18 my $bm =  2;            # Bottom marging (empty lines between last text and footer)
  19 my $lm =  4;            # Left margin (indent in spaces)
  20
  21 if ($lm > 0 and !open STDOUT, "|-") {   # Left margin (in this test ALWAYS set)
  22     my $i = 1;
  23     my $s = " " x $lm;
  24     while (<STDIN>) {
  25         s/^/$s/;
  26         print + ($_ eq <DATA> ? "" : "not "), "ok ", $i++, "\n";
  27         }
  28     close STDIN;
  29     print + (<DATA>?"not ":""), "ok ", $i++, "\n";
  30     close STDOUT;
  31     exit;
  32     }
  33 $tm = "\n" x $tm;
  34 $= -= $bm + 1; # count one for the trailing "----"
  35 my $lastmin = 0;
  36
  37 my @E;
  38
  39 sub wryte
  40 {
  41     $lastmin = $-;
  42     write;
  43     } # wryte;
  44
  45 sub footer
  46 {
  47     $% == 1 and return "";
  48
  49     $lastmin < $= and print "\n" x $lastmin;
  50     print "\n" x $bm, "----\n", $ps;
  51     $lastmin = $-;
  52     "";
  53     } # footer
  54
  55 # Yes, this is sick ;-)
  56 format TOP =
  57 @* ~
  58 @{[footer]}
  59 @* ~
  60 $tm
  61 .
  62
  63 format EmptyTOP =
  64 .
  65
  66 format ENTRY =
  67 @ @<<<<~~
  68 @{(shift @E)||["",""]}
  69 .
  70
  71 format EOR =
  72 - -----
  73 .
  74
  75 sub has_format ($)
  76 {
  77     my $fmt = shift;
  78     exists $::{$fmt} or return 0;
  79     $^O eq "MSWin32" or return defined *{$::{$fmt}}{FORMAT};
  80     open my $null, "> /dev/null" or die;
  81     my $fh = select $null;
  82     local $~ = $fmt;
  83     eval "write";
  84     select $fh;
  85     $@?0:1;
  86     } # has_format
  87
  88 $^ = has_format ("TOP") ? "TOP" : "EmptyTOP";
  89 has_format ("ENTRY") or die "No format defined for ENTRY";
  90 foreach my $e ( [ map { [ $_, "Test$_"   ] } 1 .. 7 ],
  91                 [ map { [ $_, "${_}tseT" ] } 1 .. 5 ]) {
  92     @E = @$e;
  93     local $~ = "ENTRY";
  94     wryte;
  95     has_format ("EOR") or next;
  96     local $~ = "EOR";
  97     wryte;
  98     }
  99 if (has_format ("EOF")) {
 100     local $~ = "EOF";
 101     wryte;
 102     }
 103
 104 close STDOUT;
 105
 106 __END__
 107
 108     1 Test1
 109     2 Test2
 110     3 Test3
 111
 112
 113     ----
 114     \f
 115     4 Test4
 116     5 Test5
 117     6 Test6
 118
 119
 120     ----
 121     \f
 122     7 Test7
 123     - -----
 124
 125
 126
 127     ----
 128     \f
 129     1 1tseT
 130     2 2tseT
 131     3 3tseT
 132
 133
 134     ----
 135     \f
 136     4 4tseT
 137     5 5tseT
 138     - -----