From: chromatic Date: Wed, 5 Sep 2001 22:58:05 +0000 (-0600) Subject: Re: [PATCH lib/English.t] Test All Aliases (including %Errno) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8a945467f8662d3525215e1c48a1b0dace00ef55;p=p5sagit%2Fp5-mst-13.2.git Re: [PATCH lib/English.t] Test All Aliases (including %Errno) Message-Id: <01090522580506.19590@firewheel> p4raw-id: //depot/perl@11925 --- diff --git a/lib/English.t b/lib/English.t index 459dc3b..6447aff 100755 --- a/lib/English.t +++ b/lib/English.t @@ -1,65 +1,155 @@ -#!./perl +#!./perl -i.inplace +# note the extra switch, for the test below -print "1..22\n"; +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +use Test::More tests => 54; -BEGIN { @INC = '../lib' } use English qw( -no_match_vars ) ; use Config; -my $threads = $Config{'use5005threads'} || 0; +use Errno; -print $PID == $$ ? "ok 1\n" : "not ok 1\n"; +is( $PID, $$, '$PID' ); $_ = 1; -print $ARG == $_ || $threads ? "ok 2\n" : "not ok 2\n"; +is( $ARG, $_, '$ARG' ); sub foo { - print $ARG[0] == $_[0] || $threads ? "ok 3\n" : "not ok 3\n"; + is($ARG[0], $_[0], '@ARG' ); } -&foo(1); +foo(1); "abc" =~ /b/; -print ! $PREMATCH ? "" : "not ", "ok 4\n" ; -print ! $MATCH ? "" : "not ", "ok 5\n" ; -print ! $POSTMATCH ? "" : "not ", "ok 6\n" ; +ok( !$PREMATCH, '$PREMATCH undefined' ); +ok( !$MATCH, '$MATCH undefined' ); +ok( !$POSTMATCH, '$POSTMATCH undefined' ); $OFS = " "; $ORS = "\n"; -print 'ok',7; + +{ + local(*IN, *OUT); + pipe(IN, OUT); + select(OUT); + $| = 1; + print 'ok', '7'; + + # since $| is 1, this should be true + ok( $OUTPUT_AUTOFLUSH, '$OUTPUT_AUTOFLUSH should be true' ); + + my $close = close OUT; + ok( !($close) == $CHILD_ERROR, '$CHILD_ERROR should be false' ); + + my $foo = ; + like( $foo, qr/ok 7/, '$OFS' ); + + # chomp is true because $ORS is "\n" + ok( chomp($foo), '$ORS should be \n' ); +} + +is( $FORMAT_NAME, 'OUT', '$FORMAT_NAME' ); +is( $FORMAT_TOP_NAME, 'OUT_TOP', '$FORMAT_TOP_NAME' ); +is( $FORMAT_FORMFEED, "\f", '$FORMAT_FORMFEED' ); +is( $FORMAT_LINES_LEFT, 0, '$FORMAT_LINES_LEFT' ); +is( $FORMAT_LINES_PER_PAGE, 60, '$FORMAT_LINES_PER_PAGE' ); +is( $FORMAT_LINE_BREAK_CHARACTERS, " \n-", '$FORMAT_LINE_BREAK_CHARACTERS'); +is( $FORMAT_PAGE_NUMBER, 0, '$FORMAT_PAGE_NUMBER' ); +is( $ACCUMULATOR, $^A, '$ACCUMULATOR' ); + undef $OUTPUT_FIELD_SEPARATOR; if ($threads) { $" = "\n" } else { $LIST_SEPARATOR = "\n" }; -@foo = ("ok 8", "ok 9"); -print "@foo"; +@foo = (8, 9); +@foo = split(/\n/, "@foo"); +is( $foo[0], 8, '$"' ); +is( $foo[1], 9, '$LIST_SEPARATOR' ); + undef $OUTPUT_RECORD_SEPARATOR; eval 'NO SUCH FUNCTION'; -print "ok 10\n" if $EVAL_ERROR =~ /method/ || $threads; +like( $EVAL_ERROR, qr/method/, '$EVAL_ERROR' ); + +is( $UID, $<, '$UID' ); +is( $GID, $(, '$GID' ); +is( $EUID, $>, '$EUID' ); +is( $EGID, $), '$EGID' ); + +is( $PROGRAM_NAME, $0, '$PROGRAM_NAME' ); +is( $BASETIME, $^T, '$BASETIME' ); + +is( $PERL_VERSION, $^V, '$PERL_VERSION' ); +is( $DEBUGGING, $^D, '$DEBUGGING' ); -print $UID == $< ? "ok 11\n" : "not ok 11\n"; -print $GID == $( ? "ok 12\n" : "not ok 12\n"; -print $EUID == $> ? "ok 13\n" : "not ok 13\n"; -print $EGID == $) ? "ok 14\n" : "not ok 14\n"; +is( $WARNING, 0, '$WARNING' ); +like( $EXECUTABLE_NAME, qr/perl/, '$EXECUTABLE_NAME' ); +is( $OSNAME, $Config{osname}, '$OSNAME' ); -print $PROGRAM_NAME eq $0 ? "ok 15\n" : "not ok 15\n"; -print $BASETIME == $^T ? "ok 16\n" : "not ok 16\n"; +# may be non-portable +ok( $SYSTEM_FD_MAX >= 2, '$SYSTEM_FD_MAX should be at least 2' ); -package B ; +is( $INPLACE_EDIT, '.inplace', '$INPLACE_EDIT' ); -use English ; +'aabbcc' =~ /(.{2}).+(.{2})(?{ 9 })/; +is( $LAST_PAREN_MATCH, 'cc', '$LAST_PARENT_MATCH' ); +is( $LAST_REGEXP_CODE_RESULT, 9, '$LAST_REGEXP_CODE_RESULT' ); + +is( $LAST_MATCH_START[1], 0, '@LAST_MATCH_START' ); +is( $LAST_MATCH_END[1], 2, '@LAST_MATCH_END' ); + +ok( !$PERLDB, '$PERLDB should be false' ); + +{ + local $INPUT_RECORD_SEPARATOR = "\n\n"; + like( , qr/a paragraph./, '$INPUT_RECORD_SEPARATOR' ); +} +like( , qr/second paragraph..\z/s, '$INPUT_RECORD_SEPARATOR' ); + +is( $INPUT_LINE_NUMBER, 2, '$INPUT_LINE_NUMBER' ); + +my %hash; +$SUBSCRIPT_SEPARATOR = '|'; +$hash{1,2,3} = 1; +$SUBSEP = ','; +$hash{'a', 'b', 'c'} = 1; +my @keys = sort keys %hash; + +is( $keys[0], '1|2|3', '$SUBSCRIPT_SEPARATOR' ); +is( $keys[1], 'a,b,c', '$SUBSCRIPT_SEPARATOR' ); + +eval { is( $EXCEPTIONS_BEING_CAUGHT, 1, '$EXCEPTIONS_BEING_CAUGHT' ) }; +ok( !$EXCEPTIONS_BEING_CAUGHT, '$EXCEPTIONS_BEING_CAUGHT should be false' ); + +eval { open('') }; +is( $OS_ERROR, $ERRNO, '$OS_ERROR' ); +ok( $OS_ERROR{ENOENT}, '%OS_ERROR (ENOENT should be set)' ); + +package B; + +use English; "abc" =~ /b/; -print $PREMATCH ? "" : "not ", "ok 17\n" ; -print $MATCH ? "" : "not ", "ok 18\n" ; -print $POSTMATCH ? "" : "not ", "ok 19\n" ; +main::is( $PREMATCH, 'a', '$PREMATCH defined' ); +main::is( $MATCH, 'b', '$MATCH defined' ); +main::is( $POSTMATCH, 'c', '$POSTMATCH defined' ); -package C ; +package C; use English qw( -no_match_vars ) ; "abc" =~ /b/; -print ! $PREMATCH ? "" : "not ", "ok 20\n" ; -print ! $MATCH ? "" : "not ", "ok 21\n" ; -print ! $POSTMATCH ? "" : "not ", "ok 22\n" ; +main::ok( !$PREMATCH, '$PREMATCH disabled' ); +main::ok( !$MATCH, '$MATCH disabled' ); +main::ok( !$POSTMATCH, '$POSTMATCH disabled' ); + +__END__ +This is a line. +This is a paragraph. + +This is a second paragraph. +It has several lines.