X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/8a945467f8662d3525215e1c48a1b0dace00ef55..2ad3fd79fc9c36127e4a72f731e2784799de0b2f:/lib/English.t

diff --git a/lib/English.t b/lib/English.t
old mode 100755
new mode 100644
index 6447aff..aa7e9d4
--- 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, "<en.tmp") if ($^O eq 'dos');
 	my $foo = <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
@@ -94,7 +99,7 @@ ok( $SYSTEM_FD_MAX >= 2, '$SYSTEM_FD_MAX should be at least 2' );
 is( $INPLACE_EDIT, '.inplace', '$INPLACE_EDIT' );
 
 'aabbcc' =~ /(.{2}).+(.{2})(?{ 9 })/;
-is( $LAST_PAREN_MATCH, 'cc', '$LAST_PARENT_MATCH' );
+is( $LAST_PAREN_MATCH, 'cc', '$LAST_PAREN_MATCH' );
 is( $LAST_REGEXP_CODE_RESULT, 9, '$LAST_REGEXP_CODE_RESULT' );
 
 is( $LAST_MATCH_START[1], 0, '@LAST_MATCH_START' );
@@ -112,18 +117,18 @@ is( $INPUT_LINE_NUMBER, 2, '$INPUT_LINE_NUMBER' );
 
 my %hash;
 $SUBSCRIPT_SEPARATOR = '|';
-$hash{1,2,3} = 1;
+$hash{d,e,f} = 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' ); 
+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 ) ;