From: Jarkko Hietaniemi Date: Fri, 8 Jun 2001 19:40:32 +0000 (+0000) Subject: Redo the #10482, there already was a test script for formats. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9ccde9ea2bb57aed1bc0b0aa9ab7efb13c7c1a15;p=p5sagit%2Fp5-mst-13.2.git Redo the #10482, there already was a test script for formats. p4raw-id: //depot/perl@10483 --- diff --git a/MANIFEST b/MANIFEST index 010a800..0ca5004 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1453,7 +1453,6 @@ t/harness Finer diagnostics from test suite t/io/argv.t See if ARGV stuff works t/io/dup.t See if >& works right t/io/fflush.t See if auto-flush on fork/exec/system/qx works -t/io/format.t See if formats work t/io/fs.t See if directory manipulations work t/io/inplace.t See if inplace editing works t/io/iprefix.t See if inplace editing works with prefixes @@ -1809,7 +1808,7 @@ t/op/utf8decode.t See if UTF-8 decoding works t/op/vec.t See if vectors work t/op/ver.t See if v-strings and the %v format flag work t/op/wantarray.t See if wantarray works -t/op/write.t See if write works +t/op/write.t See if write works (formats work) t/pod/emptycmd.t Test empty pod directives t/pod/emptycmd.xr Expected results for emptycmd.t t/pod/find.t See if Pod::Find works diff --git a/t/io/format.t b/t/io/format.t deleted file mode 100644 index a1baa38..0000000 --- a/t/io/format.t +++ /dev/null @@ -1,138 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - -print "1..33\n"; - -use strict; # Amazed that this hackery can be made strict ... - -# Just a complete test for format, including top-, left- and bottom marging -# and format detection through glob entries - - $= = 7; # Page length -my $ps = $^L; $^L = ""; # Catch the page separator -my $tm = 1; # Top margin (empty lines before first output) -my $bm = 2; # Bottom marging (empty lines between last text and footer) -my $lm = 4; # Left margin (indent in spaces) - -if ($lm > 0 and !open STDOUT, "|-") { # Left margin (in this test ALWAYS set) - my $i = 1; - my $s = " " x $lm; - while () { - s/^/$s/; - print + ($_ eq ? "" : "not "), "ok ", $i++, "\n"; - } - close STDIN; - print + (?"not ":""), "ok ", $i++, "\n"; - close STDOUT; - exit; - } -$tm = "\n" x $tm; -$= -= $bm + 1; # count one for the trailing "----" -my $lastmin = 0; - -my @E; - -sub wryte -{ - $lastmin = $-; - write; - } # wryte; - -sub footer -{ - $% == 1 and return ""; - - $lastmin < $= and print "\n" x $lastmin; - print "\n" x $bm, "----\n", $ps; - $lastmin = $-; - ""; - } # footer - -# Yes, this is sick ;-) -format TOP = -@* ~ -@{[footer]} -@* ~ -$tm -. - -format EmptyTOP = -. - -format ENTRY = -@ @<<<<~~ -@{(shift @E)||["",""]} -. - -format EOR = -- ----- -. - -sub has_format ($) -{ - my $fmt = shift; - exists $::{$fmt} or return 0; - $^O eq "MSWin32" or return defined *{$::{$fmt}}{FORMAT}; - open my $null, "> /dev/null" or die; - my $fh = select $null; - local $~ = $fmt; - eval "write"; - select $fh; - $@?0:1; - } # has_format - -$^ = has_format ("TOP") ? "TOP" : "EmptyTOP"; -has_format ("ENTRY") or die "No format defined for ENTRY"; -foreach my $e ( [ map { [ $_, "Test$_" ] } 1 .. 7 ], - [ map { [ $_, "${_}tseT" ] } 1 .. 5 ]) { - @E = @$e; - local $~ = "ENTRY"; - wryte; - has_format ("EOR") or next; - local $~ = "EOR"; - wryte; - } -if (has_format ("EOF")) { - local $~ = "EOF"; - wryte; - } - -close STDOUT; - -__END__ - - 1 Test1 - 2 Test2 - 3 Test3 - - - ---- - - 4 Test4 - 5 Test5 - 6 Test6 - - - ---- - - 7 Test7 - - ----- - - - - ---- - - 1 1tseT - 2 2tseT - 3 3tseT - - - ---- - - 4 4tseT - 5 5tseT - - ----- diff --git a/t/op/write.t b/t/op/write.t index fc155a8..e5baaa4 100755 --- a/t/op/write.t +++ b/t/op/write.t @@ -1,6 +1,11 @@ #!./perl -print "1..11\n"; +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +print "1..44\n"; my $CAT = ($^O eq 'MSWin32') ? 'type' : 'cat'; @@ -263,3 +268,137 @@ if (`$CAT Op_write.tmp` eq $right) { print "ok 11\n"; 1 while unlink 'Op_write.tmp'; } else { print "not ok 11\n"; } + +# 12..44: scary format testing from Merijn H. Brand + +use strict; # Amazed that this hackery can be made strict ... + +# Just a complete test for format, including top-, left- and bottom marging +# and format detection through glob entries + + $= = 7; # Page length +my $ps = $^L; $^L = ""; # Catch the page separator +my $tm = 1; # Top margin (empty lines before first output) +my $bm = 2; # Bottom marging (empty lines between last text and footer) +my $lm = 4; # Left margin (indent in spaces) + +if ($lm > 0 and !open STDOUT, "|-") { # Left margin (in this test ALWAYS set) + my $i = 12; + my $s = " " x $lm; + while () { + s/^/$s/; + print + ($_ eq ? "" : "not "), "ok ", $i++, "\n"; + } + close STDIN; + print + (?"not ":""), "ok ", $i++, "\n"; + close STDOUT; + exit; + } +$tm = "\n" x $tm; +$= -= $bm + 1; # count one for the trailing "----" +my $lastmin = 0; + +my @E; + +sub wryte +{ + $lastmin = $-; + write; + } # wryte; + +sub footer +{ + $% == 1 and return ""; + + $lastmin < $= and print "\n" x $lastmin; + print "\n" x $bm, "----\n", $ps; + $lastmin = $-; + ""; + } # footer + +# Yes, this is sick ;-) +format TOP = +@* ~ +@{[footer]} +@* ~ +$tm +. + +format EmptyTOP = +. + +format ENTRY = +@ @<<<<~~ +@{(shift @E)||["",""]} +. + +format EOR = +- ----- +. + +sub has_format ($) +{ + my $fmt = shift; + exists $::{$fmt} or return 0; + $^O eq "MSWin32" or return defined *{$::{$fmt}}{FORMAT}; + open my $null, "> /dev/null" or die; + my $fh = select $null; + local $~ = $fmt; + eval "write"; + select $fh; + $@?0:1; + } # has_format + +$^ = has_format ("TOP") ? "TOP" : "EmptyTOP"; +has_format ("ENTRY") or die "No format defined for ENTRY"; +foreach my $e ( [ map { [ $_, "Test$_" ] } 1 .. 7 ], + [ map { [ $_, "${_}tseT" ] } 1 .. 5 ]) { + @E = @$e; + local $~ = "ENTRY"; + wryte; + has_format ("EOR") or next; + local $~ = "EOR"; + wryte; + } +if (has_format ("EOF")) { + local $~ = "EOF"; + wryte; + } + +close STDOUT; + +# That was test 44. + +__END__ + + 1 Test1 + 2 Test2 + 3 Test3 + + + ---- + + 4 Test4 + 5 Test5 + 6 Test6 + + + ---- + + 7 Test7 + - ----- + + + + ---- + + 1 1tseT + 2 2tseT + 3 3tseT + + + ---- + + 4 4tseT + 5 5tseT + - -----