X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FEnglish.t;h=d7466c2d3b88911c22e552e01e6f22c30b25ccee;hb=53273a086103cdbbf7ebdd5f1a18b2c0777cbc1b;hp=745d42ee2a3dcb412ecd2da51a9ad667d0058da2;hpb=6e3f923e7662037ff257ef70ff708eb110d8f4e1;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/English.t b/lib/English.t index 745d42e..d7466c2 100755 --- a/lib/English.t +++ b/lib/English.t @@ -6,7 +6,7 @@ BEGIN { @INC = '../lib'; } -use Test::More tests => 54; +use Test::More tests => 55; use English qw( -no_match_vars ) ; use Config; @@ -33,7 +33,11 @@ $ORS = "\n"; { local(*IN, *OUT); - pipe(IN, OUT); + if ($^O ne 'dos') { + pipe(IN, OUT); + } else { + open(OUT, ">en.tmp"); + } select(OUT); $| = 1; print 'ok', '7'; @@ -44,6 +48,7 @@ $ORS = "\n"; my $close = close OUT; ok( !($close) == $CHILD_ERROR, '$CHILD_ERROR should be false' ); + open(IN, "; like( $foo, qr/ok 7/, '$OFS' ); @@ -75,7 +80,7 @@ like( $EVAL_ERROR, qr/method/, '$EVAL_ERROR' ); is( $UID, $<, '$UID' ); is( $GID, $(, '$GID' ); -is( $EUID, $>, '$EUID' ); +is( $EUID, $>, '$EUID' ); is( $EGID, $), '$EGID' ); is( $PROGRAM_NAME, $0, '$PROGRAM_NAME' ); @@ -85,7 +90,7 @@ is( $PERL_VERSION, $^V, '$PERL_VERSION' ); is( $DEBUGGING, $^D, '$DEBUGGING' ); is( $WARNING, 0, '$WARNING' ); -like( $EXECUTABLE_NAME, qr/perl/, '$EXECUTABLE_NAME' ); +like( $EXECUTABLE_NAME, qr/perl/i, '$EXECUTABLE_NAME' ); is( $OSNAME, $Config{osname}, '$OSNAME' ); # may be non-portable @@ -117,13 +122,13 @@ $SUBSEP = ','; $hash{'a', 'b', 'c'} = 1; my @keys = sort keys %hash; -is( $keys[0], 'a,b,c', '$SUBSCRIPT_SEPARATOR' ); -is( $keys[1], 'd|e|f', '$SUBSCRIPT_SEPARATOR' ); +is( $keys[0], 'a,b,c', '$SUBSCRIPT_SEPARATOR' ); +is( $keys[1], 'd|e|f', '$SUBSCRIPT_SEPARATOR' ); eval { is( $EXCEPTIONS_BEING_CAUGHT, 1, '$EXCEPTIONS_BEING_CAUGHT' ) }; ok( !$EXCEPTIONS_BEING_CAUGHT, '$EXCEPTIONS_BEING_CAUGHT should be false' ); -eval { open('') }; +eval { local *F; my $f = 'asdasdasd'; ++$f while -e $f; open(F, $f); }; is( $OS_ERROR, $ERRNO, '$OS_ERROR' ); ok( $OS_ERROR{ENOENT}, '%OS_ERROR (ENOENT should be set)' ); @@ -137,6 +142,12 @@ main::is( $PREMATCH, 'a', '$PREMATCH defined' ); main::is( $MATCH, 'b', '$MATCH defined' ); main::is( $POSTMATCH, 'c', '$POSTMATCH defined' ); +{ + my $s = "xyz"; + $s =~ s/y/t$MATCH/; + main::is( $s, "xtyz", '$MATCH defined in right side of s///' ); +} + package C; use English qw( -no_match_vars ) ;