| 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 => 55;
|
|---|
| 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 | 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 |
|
|---|
| 59 | is( $FORMAT_NAME, 'OUT', '$FORMAT_NAME' );
|
|---|
| 60 | is( $FORMAT_TOP_NAME, 'OUT_TOP', '$FORMAT_TOP_NAME' );
|
|---|
| 61 | is( $FORMAT_FORMFEED, "\f", '$FORMAT_FORMFEED' );
|
|---|
| 62 | is( $FORMAT_LINES_LEFT, 0, '$FORMAT_LINES_LEFT' );
|
|---|
| 63 | is( $FORMAT_LINES_PER_PAGE, 60, '$FORMAT_LINES_PER_PAGE' );
|
|---|
| 64 | is( $FORMAT_LINE_BREAK_CHARACTERS, " \n-", '$FORMAT_LINE_BREAK_CHARACTERS');
|
|---|
| 65 | is( $FORMAT_PAGE_NUMBER, 0, '$FORMAT_PAGE_NUMBER' );
|
|---|
| 66 | is( $ACCUMULATOR, $^A, '$ACCUMULATOR' );
|
|---|
| 67 |
|
|---|
| 68 | undef $OUTPUT_FIELD_SEPARATOR;
|
|---|
| 69 |
|
|---|
| 70 | if ($threads) { $" = "\n" } else { $LIST_SEPARATOR = "\n" };
|
|---|
| 71 | @foo = (8, 9);
|
|---|
| 72 | @foo = split(/\n/, "@foo");
|
|---|
| 73 | is( $foo[0], 8, '$"' );
|
|---|
| 74 | is( $foo[1], 9, '$LIST_SEPARATOR' );
|
|---|
| 75 |
|
|---|
| 76 | undef $OUTPUT_RECORD_SEPARATOR;
|
|---|
| 77 |
|
|---|
| 78 | eval 'NO SUCH FUNCTION';
|
|---|
| 79 | like( $EVAL_ERROR, qr/method/, '$EVAL_ERROR' );
|
|---|
| 80 |
|
|---|
| 81 | is( $UID, $<, '$UID' );
|
|---|
| 82 | is( $GID, $(, '$GID' );
|
|---|
| 83 | is( $EUID, $>, '$EUID' );
|
|---|
| 84 | is( $EGID, $), '$EGID' );
|
|---|
| 85 |
|
|---|
| 86 | is( $PROGRAM_NAME, $0, '$PROGRAM_NAME' );
|
|---|
| 87 | is( $BASETIME, $^T, '$BASETIME' );
|
|---|
| 88 |
|
|---|
| 89 | is( $PERL_VERSION, $^V, '$PERL_VERSION' );
|
|---|
| 90 | is( $DEBUGGING, $^D, '$DEBUGGING' );
|
|---|
| 91 |
|
|---|
| 92 | is( $WARNING, 0, '$WARNING' );
|
|---|
| 93 | like( $EXECUTABLE_NAME, qr/perl/i, '$EXECUTABLE_NAME' );
|
|---|
| 94 | is( $OSNAME, $Config{osname}, '$OSNAME' );
|
|---|
| 95 |
|
|---|
| 96 | # may be non-portable
|
|---|
| 97 | ok( $SYSTEM_FD_MAX >= 2, '$SYSTEM_FD_MAX should be at least 2' );
|
|---|
| 98 |
|
|---|
| 99 | is( $INPLACE_EDIT, '.inplace', '$INPLACE_EDIT' );
|
|---|
| 100 |
|
|---|
| 101 | 'aabbcc' =~ /(.{2}).+(.{2})(?{ 9 })/;
|
|---|
| 102 | is( $LAST_PAREN_MATCH, 'cc', '$LAST_PARENT_MATCH' );
|
|---|
| 103 | is( $LAST_REGEXP_CODE_RESULT, 9, '$LAST_REGEXP_CODE_RESULT' );
|
|---|
| 104 |
|
|---|
| 105 | is( $LAST_MATCH_START[1], 0, '@LAST_MATCH_START' );
|
|---|
| 106 | is( $LAST_MATCH_END[1], 2, '@LAST_MATCH_END' );
|
|---|
| 107 |
|
|---|
| 108 | ok( !$PERLDB, '$PERLDB should be false' );
|
|---|
| 109 |
|
|---|
| 110 | {
|
|---|
| 111 | local $INPUT_RECORD_SEPARATOR = "\n\n";
|
|---|
| 112 | like( <DATA>, qr/a paragraph./, '$INPUT_RECORD_SEPARATOR' );
|
|---|
| 113 | }
|
|---|
| 114 | like( <DATA>, qr/second paragraph..\z/s, '$INPUT_RECORD_SEPARATOR' );
|
|---|
| 115 |
|
|---|
| 116 | is( $INPUT_LINE_NUMBER, 2, '$INPUT_LINE_NUMBER' );
|
|---|
| 117 |
|
|---|
| 118 | my %hash;
|
|---|
| 119 | $SUBSCRIPT_SEPARATOR = '|';
|
|---|
| 120 | $hash{d,e,f} = 1;
|
|---|
| 121 | $SUBSEP = ',';
|
|---|
| 122 | $hash{'a', 'b', 'c'} = 1;
|
|---|
| 123 | my @keys = sort keys %hash;
|
|---|
| 124 |
|
|---|
| 125 | is( $keys[0], 'a,b,c', '$SUBSCRIPT_SEPARATOR' );
|
|---|
| 126 | is( $keys[1], 'd|e|f', '$SUBSCRIPT_SEPARATOR' );
|
|---|
| 127 |
|
|---|
| 128 | eval { is( $EXCEPTIONS_BEING_CAUGHT, 1, '$EXCEPTIONS_BEING_CAUGHT' ) };
|
|---|
| 129 | ok( !$EXCEPTIONS_BEING_CAUGHT, '$EXCEPTIONS_BEING_CAUGHT should be false' );
|
|---|
| 130 |
|
|---|
| 131 | eval { local *F; my $f = 'asdasdasd'; ++$f while -e $f; open(F, $f); };
|
|---|
| 132 | is( $OS_ERROR, $ERRNO, '$OS_ERROR' );
|
|---|
| 133 | ok( $OS_ERROR{ENOENT}, '%OS_ERROR (ENOENT should be set)' );
|
|---|
| 134 |
|
|---|
| 135 | package B;
|
|---|
| 136 |
|
|---|
| 137 | use English;
|
|---|
| 138 |
|
|---|
| 139 | "abc" =~ /b/;
|
|---|
| 140 |
|
|---|
| 141 | main::is( $PREMATCH, 'a', '$PREMATCH defined' );
|
|---|
| 142 | main::is( $MATCH, 'b', '$MATCH defined' );
|
|---|
| 143 | main::is( $POSTMATCH, 'c', '$POSTMATCH defined' );
|
|---|
| 144 |
|
|---|
| 145 | {
|
|---|
| 146 | my $s = "xyz";
|
|---|
| 147 | $s =~ s/y/t$MATCH/;
|
|---|
| 148 | main::is( $s, "xtyz", '$MATCH defined in right side of s///' );
|
|---|
| 149 | }
|
|---|
| 150 |
|
|---|
| 151 | package C;
|
|---|
| 152 |
|
|---|
| 153 | use English qw( -no_match_vars ) ;
|
|---|
| 154 |
|
|---|
| 155 | "abc" =~ /b/;
|
|---|
| 156 |
|
|---|
| 157 | main::ok( !$PREMATCH, '$PREMATCH disabled' );
|
|---|
| 158 | main::ok( !$MATCH, '$MATCH disabled' );
|
|---|
| 159 | main::ok( !$POSTMATCH, '$POSTMATCH disabled' );
|
|---|
| 160 |
|
|---|
| 161 | __END__
|
|---|
| 162 | This is a line.
|
|---|
| 163 | This is a paragraph.
|
|---|
| 164 |
|
|---|
| 165 | This is a second paragraph.
|
|---|
| 166 | It has several lines.
|
|---|