t/op/write.t

   1 #!./perl
   2
   3 print "1..11\n";
   4
   5 my $CAT = ($^O eq 'MSWin32') ? 'type' : 'cat';
   6
   7 format OUT =
   8 the quick brown @<<
   9 $fox
  10 jumped
  11 @*
  12 $multiline
  13 ^<<<<<<<<<
  14 $foo
  15 ^<<<<<<<<<
  16 $foo
  17 ^<<<<<<...
  18 $foo
  19 now @<<the@>>>> for all@|||||men to come @<<<<
  20 {
  21     'i' . 's', "time\n", $good, 'to'
  22 }
  23 .
  24
  25 open(OUT, '>Op_write.tmp') || die "Can't create Op_write.tmp";
  26
  27 $fox = 'foxiness';
  28 $good = 'good';
  29 $multiline = "forescore\nand\nseven years\n";
  30 $foo = 'when in the course of human events it becomes necessary';
  31 write(OUT);
  32 close OUT;
  33
  34 $right =
  35 "the quick brown fox
  36 jumped
  37 forescore
  38 and
  39 seven years
  40 when in
  41 the course
  42 of huma...
  43 now is the time for all good men to come to\n";
  44
  45 if (`$CAT Op_write.tmp` eq $right)
  46     { print "ok 1\n"; 1 while unlink 'Op_write.tmp'; }
  47 else
  48     { print "not ok 1\n"; }
  49
  50 $fox = 'wolfishness';
  51 my $fox = 'foxiness';           # Test a lexical variable.
  52
  53 format OUT2 =
  54 the quick brown @<<
  55 $fox
  56 jumped
  57 @*
  58 $multiline
  59 ^<<<<<<<<< ~~
  60 $foo
  61 now @<<the@>>>> for all@|||||men to come @<<<<
  62 'i' . 's', "time\n", $good, 'to'
  63 .
  64
  65 open OUT2, '>Op_write.tmp' or die "Can't create Op_write.tmp";
  66
  67 $good = 'good';
  68 $multiline = "forescore\nand\nseven years\n";
  69 $foo = 'when in the course of human events it becomes necessary';
  70 write(OUT2);
  71 close OUT2;
  72
  73 $right =
  74 "the quick brown fox
  75 jumped
  76 forescore
  77 and
  78 seven years
  79 when in
  80 the course
  81 of human
  82 events it
  83 becomes
  84 necessary
  85 now is the time for all good men to come to\n";
  86
  87 if (`$CAT Op_write.tmp` eq $right)
  88     { print "ok 2\n"; 1 while unlink 'Op_write.tmp'; }
  89 else
  90     { print "not ok 2\n"; }
  91
  92 eval <<'EOFORMAT';
  93 format OUT2 =
  94 the brown quick @<<
  95 $fox
  96 jumped
  97 @*
  98 $multiline
  99 and
 100 ^<<<<<<<<< ~~
 101 $foo
 102 now @<<the@>>>> for all@|||||men to come @<<<<
 103 'i' . 's', "time\n", $good, 'to'
 104 .
 105 EOFORMAT
 106
 107 open(OUT2, '>Op_write.tmp') || die "Can't create Op_write.tmp";
 108
 109 $fox = 'foxiness';
 110 $good = 'good';
 111 $multiline = "forescore\nand\nseven years\n";
 112 $foo = 'when in the course of human events it becomes necessary';
 113 write(OUT2);
 114 close OUT2;
 115
 116 $right =
 117 "the brown quick fox
 118 jumped
 119 forescore
 120 and
 121 seven years
 122 and
 123 when in
 124 the course
 125 of human
 126 events it
 127 becomes
 128 necessary
 129 now is the time for all good men to come to\n";
 130
 131 if (`$CAT Op_write.tmp` eq $right)
 132     { print "ok 3\n"; 1 while unlink 'Op_write.tmp'; }
 133 else
 134     { print "not ok 3\n"; }
 135
 136 # formline tests
 137
 138 $mustbe = <<EOT;
 139 @ a
 140 @> ab
 141 @>> abc
 142 @>>>  abc
 143 @>>>>   abc
 144 @>>>>>    abc
 145 @>>>>>>     abc
 146 @>>>>>>>      abc
 147 @>>>>>>>>       abc
 148 @>>>>>>>>>        abc
 149 @>>>>>>>>>>         abc
 150 EOT
 151
 152 $was1 = $was2 = '';
 153 for (0..10) {
 154   # lexical picture
 155   $^A = '';
 156   my $format1 = '@' . '>' x $_;
 157   formline $format1, 'abc';
 158   $was1 .= "$format1 $^A\n";
 159   # global
 160   $^A = '';
 161   local $format2 = '@' . '>' x $_;
 162   formline $format2, 'abc';
 163   $was2 .= "$format2 $^A\n";
 164 }
 165 print $was1 eq $mustbe ? "ok 4\n" : "not ok 4\n";
 166 print $was2 eq $mustbe ? "ok 5\n" : "not ok 5\n";
 167
 168 $^A = '';
 169
 170 # more test
 171
 172 format OUT3 =
 173 ^<<<<<<...
 174 $foo
 175 .
 176
 177 open(OUT3, '>Op_write.tmp') || die "Can't create Op_write.tmp";
 178
 179 $foo = 'fit          ';
 180 write(OUT3);
 181 close OUT3;
 182
 183 $right =
 184 "fit\n";
 185
 186 if (`$CAT Op_write.tmp` eq $right)
 187     { print "ok 6\n"; 1 while unlink 'Op_write.tmp'; }
 188 else
 189     { print "not ok 6\n"; }
 190
 191 # test lexicals and globals
 192 {
 193     my $this = "ok";
 194     our $that = 7;
 195     format LEX =
 196 @<<@|
 197 $this,$that
 198 .
 199     open(LEX, ">&STDOUT") or die;
 200     write LEX;
 201     $that = 8;
 202     write LEX;
 203     close LEX;
 204 }
 205 # LEX_INTERPNORMAL test
 206 my %e = ( a => 1 );
 207 format OUT4 =
 208 @<<<<<<
 209 "$e{a}"
 210 .
 211 open   OUT4, ">Op_write.tmp" or die "Can't create Op_write.tmp";
 212 write (OUT4);
 213 close  OUT4;
 214 if (`$CAT Op_write.tmp` eq "1\n") {
 215     print "ok 9\n";
 216     1 while unlink "Op_write.tmp";
 217     }
 218 else {
 219     print "not ok 9\n";
 220     }
 221
 222 eval <<'EOFORMAT';
 223 format OUT10 =
 224 @####.## @0###.##
 225 $test1, $test1
 226 .
 227 EOFORMAT
 228
 229 open(OUT10, '>Op_write.tmp') || die "Can't create Op_write.tmp";
 230
 231 $test1 = 12.95;
 232 write(OUT10);
 233 close OUT10;
 234
 235 $right = "   12.95 00012.95\n";
 236 if (`$CAT Op_write.tmp` eq $right)
 237     { print "ok 10\n"; 1 while unlink 'Op_write.tmp'; }
 238 else
 239     { print "not ok 10\n"; }
 240
 241 eval <<'EOFORMAT';
 242 format OUT11 =
 243 @0###.##
 244 $test1
 245 @ 0#
 246 $test1
 247 @0 #
 248 $test1
 249 .
 250 EOFORMAT
 251
 252 open(OUT11, '>Op_write.tmp') || die "Can't create Op_write.tmp";
 253
 254 $test1 = 12.95;
 255 write(OUT11);
 256 close OUT11;
 257
 258 $right =
 259 "00012.95
 260 1 0#
 261 10 #\n";
 262 if (`$CAT Op_write.tmp` eq $right)
 263     { print "ok 11\n"; 1 while unlink 'Op_write.tmp'; }
 264 else
 265     { print "not ok 11\n"; }