contrib/perl5/t/op/write.t

   1 #!./perl
   2
   3 # $RCSfile: write.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:38 $
   4
   5 print "1..6\n";
   6
   7 my $CAT = ($^O eq 'MSWin32') ? 'type' : 'cat';
   8
   9 format OUT =
  10 the quick brown @<<
  11 $fox
  12 jumped
  13 @*
  14 $multiline
  15 ^<<<<<<<<<
  16 $foo
  17 ^<<<<<<<<<
  18 $foo
  19 ^<<<<<<...
  20 $foo
  21 now @<<the@>>>> for all@|||||men to come @<<<<
  22 {
  23     'i' . 's', "time\n", $good, 'to'
  24 }
  25 .
  26
  27 open(OUT, '>Op_write.tmp') || die "Can't create Op_write.tmp";
  28
  29 $fox = 'foxiness';
  30 $good = 'good';
  31 $multiline = "forescore\nand\nseven years\n";
  32 $foo = 'when in the course of human events it becomes necessary';
  33 write(OUT);
  34 close OUT;
  35
  36 $right =
  37 "the quick brown fox
  38 jumped
  39 forescore
  40 and
  41 seven years
  42 when in
  43 the course
  44 of huma...
  45 now is the time for all good men to come to\n";
  46
  47 if (`$CAT Op_write.tmp` eq $right)
  48     { print "ok 1\n"; unlink 'Op_write.tmp'; }
  49 else
  50     { print "not ok 1\n"; }
  51
  52 $fox = 'wolfishness';
  53 my $fox = 'foxiness';           # Test a lexical variable.
  54
  55 format OUT2 =
  56 the quick brown @<<
  57 $fox
  58 jumped
  59 @*
  60 $multiline
  61 ^<<<<<<<<< ~~
  62 $foo
  63 now @<<the@>>>> for all@|||||men to come @<<<<
  64 'i' . 's', "time\n", $good, 'to'
  65 .
  66
  67 open OUT2, '>Op_write.tmp' or die "Can't create Op_write.tmp";
  68
  69 $good = 'good';
  70 $multiline = "forescore\nand\nseven years\n";
  71 $foo = 'when in the course of human events it becomes necessary';
  72 write(OUT2);
  73 close OUT2;
  74
  75 $right =
  76 "the quick brown fox
  77 jumped
  78 forescore
  79 and
  80 seven years
  81 when in
  82 the course
  83 of human
  84 events it
  85 becomes
  86 necessary
  87 now is the time for all good men to come to\n";
  88
  89 if (`$CAT Op_write.tmp` eq $right)
  90     { print "ok 2\n"; unlink 'Op_write.tmp'; }
  91 else
  92     { print "not ok 2\n"; }
  93
  94 eval <<'EOFORMAT';
  95 format OUT2 =
  96 the brown quick @<<
  97 $fox
  98 jumped
  99 @*
 100 $multiline
 101 and
 102 ^<<<<<<<<< ~~
 103 $foo
 104 now @<<the@>>>> for all@|||||men to come @<<<<
 105 'i' . 's', "time\n", $good, 'to'
 106 .
 107 EOFORMAT
 108
 109 open(OUT2, '>Op_write.tmp') || die "Can't create Op_write.tmp";
 110
 111 $fox = 'foxiness';
 112 $good = 'good';
 113 $multiline = "forescore\nand\nseven years\n";
 114 $foo = 'when in the course of human events it becomes necessary';
 115 write(OUT2);
 116 close OUT2;
 117
 118 $right =
 119 "the brown quick fox
 120 jumped
 121 forescore
 122 and
 123 seven years
 124 and
 125 when in
 126 the course
 127 of human
 128 events it
 129 becomes
 130 necessary
 131 now is the time for all good men to come to\n";
 132
 133 if (`$CAT Op_write.tmp` eq $right)
 134     { print "ok 3\n"; unlink 'Op_write.tmp'; }
 135 else
 136     { print "not ok 3\n"; }
 137
 138 # formline tests
 139
 140 $mustbe = <<EOT;
 141 @ a
 142 @> ab
 143 @>> abc
 144 @>>>  abc
 145 @>>>>   abc
 146 @>>>>>    abc
 147 @>>>>>>     abc
 148 @>>>>>>>      abc
 149 @>>>>>>>>       abc
 150 @>>>>>>>>>        abc
 151 @>>>>>>>>>>         abc
 152 EOT
 153
 154 $was1 = $was2 = '';
 155 for (0..10) {
 156   # lexical picture
 157   $^A = '';
 158   my $format1 = '@' . '>' x $_;
 159   formline $format1, 'abc';
 160   $was1 .= "$format1 $^A\n";
 161   # global
 162   $^A = '';
 163   local $format2 = '@' . '>' x $_;
 164   formline $format2, 'abc';
 165   $was2 .= "$format2 $^A\n";
 166 }
 167 print $was1 eq $mustbe ? "ok 4\n" : "not ok 4\n";
 168 print $was2 eq $mustbe ? "ok 5\n" : "not ok 5\n";
 169
 170 $^A = '';
 171
 172 # more test
 173
 174 format OUT3 =
 175 ^<<<<<<...
 176 $foo
 177 .
 178
 179 open(OUT3, '>Op_write.tmp') || die "Can't create Op_write.tmp";
 180
 181 $foo = 'fit          ';
 182 write(OUT3);
 183 close OUT3;
 184
 185 $right =
 186 "fit\n";
 187
 188 if (`$CAT Op_write.tmp` eq $right)
 189     { print "ok 6\n"; unlink 'Op_write.tmp'; }
 190 else
 191     { print "not ok 6\n"; }
 192