1#!./perl 2 3print "1..9\n"; 4 5my $CAT = ($^O eq 'MSWin32') ? 'type' : 'cat'; 6 7format OUT = 8the quick brown @<< 9$fox 10jumped 11@* 12$multiline 13^<<<<<<<<< 14$foo 15^<<<<<<<<< 16$foo 17^<<<<<<... 18$foo 19now @<<the@>>>> for all@|||||men to come @<<<< 20{ 21 'i' . 's', "time\n", $good, 'to' 22} 23. 24 25open(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'; 31write(OUT); 32close OUT; 33 34$right = 35"the quick brown fox 36jumped 37forescore 38and 39seven years 40when in 41the course 42of huma... 43now is the time for all good men to come to\n"; 44 45if (`$CAT Op_write.tmp` eq $right) 46 { print "ok 1\n"; unlink 'Op_write.tmp'; } 47else 48 { print "not ok 1\n"; } 49 50$fox = 'wolfishness'; 51my $fox = 'foxiness'; # Test a lexical variable. 52 53format OUT2 = 54the quick brown @<< 55$fox 56jumped 57@* 58$multiline 59^<<<<<<<<< ~~ 60$foo 61now @<<the@>>>> for all@|||||men to come @<<<< 62'i' . 's', "time\n", $good, 'to' 63. 64 65open 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'; 70write(OUT2); 71close OUT2; 72 73$right = 74"the quick brown fox 75jumped 76forescore 77and 78seven years 79when in 80the course 81of human 82events it 83becomes 84necessary 85now is the time for all good men to come to\n"; 86 87if (`$CAT Op_write.tmp` eq $right) 88 { print "ok 2\n"; unlink 'Op_write.tmp'; } 89else 90 { print "not ok 2\n"; } 91 92eval <<'EOFORMAT'; 93format OUT2 = 94the brown quick @<< 95$fox 96jumped 97@* 98$multiline 99and 100^<<<<<<<<< ~~ 101$foo 102now @<<the@>>>> for all@|||||men to come @<<<< 103'i' . 's', "time\n", $good, 'to' 104. 105EOFORMAT 106 107open(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'; 113write(OUT2); 114close OUT2; 115 116$right = 117"the brown quick fox 118jumped 119forescore 120and 121seven years 122and 123when in 124the course 125of human 126events it 127becomes 128necessary 129now is the time for all good men to come to\n"; 130 131if (`$CAT Op_write.tmp` eq $right) 132 { print "ok 3\n"; unlink 'Op_write.tmp'; } 133else 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 150EOT 151 152$was1 = $was2 = ''; 153for (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} 165print $was1 eq $mustbe ? "ok 4\n" : "not ok 4\n"; 166print $was2 eq $mustbe ? "ok 5\n" : "not ok 5\n"; 167 168$^A = ''; 169 170# more test 171 172format OUT3 = 173^<<<<<<... 174$foo 175. 176 177open(OUT3, '>Op_write.tmp') || die "Can't create Op_write.tmp"; 178 179$foo = 'fit '; 180write(OUT3); 181close OUT3; 182 183$right = 184"fit\n"; 185 186if (`$CAT Op_write.tmp` eq $right) 187 { print "ok 6\n"; unlink 'Op_write.tmp'; } 188else 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 206my %e = ( a => 1 ); 207format OUT4 = 208@<<<<<< 209"$e{a}" 210. 211open OUT4, ">Op_write.tmp" or die "Can't create Op_write.tmp"; 212write (OUT4); 213close OUT4; 214if (`$CAT Op_write.tmp` eq "1\n") { 215 print "ok 9\n"; 216 unlink "Op_write.tmp"; 217 } 218else { 219 print "not ok 9\n"; 220 } 221