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