1#!./perl -i.inplace 2# note the extra switch, for the test below 3 4BEGIN { 5 chdir 't' if -d 't'; 6 @INC = '../lib'; 7} 8 9use Test::More tests => 58; 10 11use English qw( -no_match_vars ) ; 12use Config; 13use Errno; 14 15is( $PID, $$, '$PID' ); 16 17$_ = 1; 18is( $ARG, $_, '$ARG' ); 19 20sub foo { 21 is($ARG[0], $_[0], '@ARG' ); 22} 23foo(1); 24 25"abc" =~ /b/; 26 27ok( !$PREMATCH, '$PREMATCH undefined' ); 28ok( !$MATCH, '$MATCH undefined' ); 29ok( !$POSTMATCH, '$POSTMATCH undefined' ); 30 31$OFS = " "; 32$ORS = "\n"; 33 34{ 35 local(*IN, *OUT); 36 if ($^O ne 'dos') { 37 pipe(IN, OUT); 38 } else { 39 open(OUT, ">", "en.tmp"); 40 } 41 select(OUT); 42 $| = 1; 43 print 'ok', '7'; 44 45 # since $| is 1, this should be true 46 ok( $OUTPUT_AUTOFLUSH, '$OUTPUT_AUTOFLUSH should be true' ); 47 48 my $close = close OUT; 49 ok( !($close) == $CHILD_ERROR, '$CHILD_ERROR should be false' ); 50 51 open(IN, "<", "en.tmp") if ($^O eq 'dos'); 52 my $foo = <IN>; 53 like( $foo, qr/ok 7/, '$OFS' ); 54 55 # chomp is true because $ORS is "\n" 56 ok( chomp($foo), '$ORS should be \n' ); 57} 58 59is( $FORMAT_NAME, 'OUT', '$FORMAT_NAME' ); 60is( $FORMAT_TOP_NAME, 'OUT_TOP', '$FORMAT_TOP_NAME' ); 61is( $FORMAT_FORMFEED, "\f", '$FORMAT_FORMFEED' ); 62is( $FORMAT_LINES_LEFT, 0, '$FORMAT_LINES_LEFT' ); 63is( $FORMAT_LINES_PER_PAGE, 60, '$FORMAT_LINES_PER_PAGE' ); 64is( $FORMAT_LINE_BREAK_CHARACTERS, " \n-", '$FORMAT_LINE_BREAK_CHARACTERS'); 65is( $FORMAT_PAGE_NUMBER, 0, '$FORMAT_PAGE_NUMBER' ); 66is( $ACCUMULATOR, $^A, '$ACCUMULATOR' ); 67 68undef $OUTPUT_FIELD_SEPARATOR; 69 70if ($threads) { $" = "\n" } else { $LIST_SEPARATOR = "\n" }; 71@foo = (8, 9); 72@foo = split(/\n/, "@foo"); 73is( $foo[0], 8, '$"' ); 74is( $foo[1], 9, '$LIST_SEPARATOR' ); 75 76undef $OUTPUT_RECORD_SEPARATOR; 77 78eval 'NO SUCH FUNCTION'; 79like( $EVAL_ERROR, qr/method/, '$EVAL_ERROR' ); 80 81is( $UID, $<, '$UID' ); 82is( $GID, $(, '$GID' ); 83is( $EUID, $>, '$EUID' ); 84is( $EGID, $), '$EGID' ); 85 86is( $PROGRAM_NAME, $0, '$PROGRAM_NAME' ); 87is( $BASETIME, $^T, '$BASETIME' ); 88 89is( $PERL_VERSION, $^V, '$PERL_VERSION' ); 90is( $OLD_PERL_VERSION, $], '$OLD_PERL_VERSION' ); 91is( $DEBUGGING, $^D, '$DEBUGGING' ); 92 93is( $WARNING, 0, '$WARNING' ); 94like( $EXECUTABLE_NAME, qr/perl/i, '$EXECUTABLE_NAME' ); 95is( $OSNAME, $Config{osname}, '$OSNAME' ); 96 97# may be non-portable 98ok( $SYSTEM_FD_MAX >= 2, '$SYSTEM_FD_MAX should be at least 2' ); 99 100is( $INPLACE_EDIT, '.inplace', '$INPLACE_EDIT' ); 101 102'aabbcc' =~ /(.{2}).+(.{2})(?{ 9 })/; 103is( $LAST_PAREN_MATCH, 'cc', '$LAST_PAREN_MATCH' ); 104is( $LAST_REGEXP_CODE_RESULT, 9, '$LAST_REGEXP_CODE_RESULT' ); 105 106is( $LAST_MATCH_START[1], 0, '@LAST_MATCH_START' ); 107is( $LAST_MATCH_END[1], 2, '@LAST_MATCH_END' ); 108 109ok( !$PERLDB, '$PERLDB should be false' ); 110 111{ 112 local $INPUT_RECORD_SEPARATOR = "\n\n"; 113 like( <DATA>, qr/a paragraph./, '$INPUT_RECORD_SEPARATOR' ); 114} 115like( <DATA>, qr/second paragraph..\z/s, '$INPUT_RECORD_SEPARATOR' ); 116 117is( $INPUT_LINE_NUMBER, 2, '$INPUT_LINE_NUMBER' ); 118 119my %hash; 120$SUBSCRIPT_SEPARATOR = '|'; 121$hash{d,e,f} = 1; 122$SUBSEP = ','; 123$hash{'a', 'b', 'c'} = 1; 124my @keys = sort keys %hash; 125 126is( $keys[0], 'a,b,c', '$SUBSCRIPT_SEPARATOR' ); 127is( $keys[1], 'd|e|f', '$SUBSCRIPT_SEPARATOR' ); 128 129eval { is( $EXCEPTIONS_BEING_CAUGHT, 1, '$EXCEPTIONS_BEING_CAUGHT' ) }; 130ok( !$EXCEPTIONS_BEING_CAUGHT, '$EXCEPTIONS_BEING_CAUGHT should be false' ); 131 132eval { local *F; my $f = 'asdasdasd'; ++$f while -e $f; open(F, '<', $f); }; 133is( $OS_ERROR, $ERRNO, '$OS_ERROR' ); 134ok( $OS_ERROR{ENOENT}, '%OS_ERROR (ENOENT should be set)' ); 135 136package B; 137 138use English; 139 140"abc" =~ /b/; 141 142main::is( $PREMATCH, 'a', '$PREMATCH defined' ); 143main::is( $MATCH, 'b', '$MATCH defined' ); 144main::is( $POSTMATCH, 'c', '$POSTMATCH defined' ); 145 146{ 147 my $s = "xyz"; 148 $s =~ s/y/t$MATCH/; 149 main::is( $s, "xtyz", '$MATCH defined in right side of s///' ); 150} 151 152package C; 153 154use English qw( -no_match_vars ) ; 155 156"abc" =~ /b/; 157 158main::ok( !$PREMATCH, '$PREMATCH disabled' ); 159main::ok( !$MATCH, '$MATCH disabled' ); 160main::ok( !$POSTMATCH, '$POSTMATCH disabled' ); 161 162 163# Check that both variables change when localized. 164{ 165 local $LIST_SEPARATOR = "wibble"; 166 ::is $", 'wibble', '$" changes when $LIST_SEPARATOR is localized'; 167 168 local $" = 'frooble'; 169 ::is $LIST_SEPARATOR, 'frooble'; 170} 171 172__END__ 173This is a line. 174This is a paragraph. 175 176This is a second paragraph. 177It has several lines. 178