lib/English.t

   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;
  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( $OLD_PERL_VERSION, $], '$OLD_PERL_VERSION' );
  86 is( $DEBUGGING, $^D, '$DEBUGGING' );
  87
  88 is( $WARNING, 0, '$WARNING' );
  89 like( $EXECUTABLE_NAME, qr/perl/i, '$EXECUTABLE_NAME' );
  90 is( $OSNAME, $Config{osname}, '$OSNAME' );
  91
  92 # may be non-portable
  93 ok( $SYSTEM_FD_MAX >= 2, '$SYSTEM_FD_MAX should be at least 2' );
  94
  95 is( $INPLACE_EDIT, '.inplace', '$INPLACE_EDIT' );
  96
  97 'aabbcc' =~ /(.{2}).+(.{2})(?{ 9 })/;
  98 is( $LAST_PAREN_MATCH, 'cc', '$LAST_PAREN_MATCH' );
  99 is( $LAST_REGEXP_CODE_RESULT, 9, '$LAST_REGEXP_CODE_RESULT' );
 100
 101 is( $LAST_MATCH_START[1], 0, '@LAST_MATCH_START' );
 102 is( $LAST_MATCH_END[1], 2, '@LAST_MATCH_END' );
 103
 104 ok( !$PERLDB, '$PERLDB should be false' );
 105
 106 {
 107         local $INPUT_RECORD_SEPARATOR = "\n\n";
 108         like( <DATA>, qr/a paragraph./, '$INPUT_RECORD_SEPARATOR' );
 109 }
 110 like( <DATA>, qr/second paragraph..\z/s, '$INPUT_RECORD_SEPARATOR' );
 111
 112 is( $INPUT_LINE_NUMBER, 2, '$INPUT_LINE_NUMBER' );
 113
 114 my %hash;
 115 $SUBSCRIPT_SEPARATOR = '|';
 116 $hash{d,e,f} = 1;
 117 $SUBSEP = ',';
 118 $hash{'a', 'b', 'c'} = 1;
 119 my @keys = sort keys %hash;
 120
 121 is( $keys[0], 'a,b,c', '$SUBSCRIPT_SEPARATOR' );
 122 is( $keys[1], 'd|e|f', '$SUBSCRIPT_SEPARATOR' );
 123
 124 eval { is( $EXCEPTIONS_BEING_CAUGHT, 1, '$EXCEPTIONS_BEING_CAUGHT' ) };
 125 ok( !$EXCEPTIONS_BEING_CAUGHT, '$EXCEPTIONS_BEING_CAUGHT should be false' );
 126
 127 eval { local *F; my $f = 'asdasdasd'; ++$f while -e $f; open(F, '<', $f); };
 128 is( $OS_ERROR, $ERRNO, '$OS_ERROR' );
 129 ok( $OS_ERROR{ENOENT}, '%OS_ERROR (ENOENT should be set)' );
 130
 131 package B;
 132
 133 use English;
 134
 135 "abc" =~ /b/;
 136
 137 main::is( $PREMATCH, 'a', '$PREMATCH defined' );
 138 main::is( $MATCH, 'b', '$MATCH defined' );
 139 main::is( $POSTMATCH, 'c', '$POSTMATCH defined' );
 140
 141 {
 142     my $s = "xyz";
 143     $s =~ s/y/t$MATCH/;
 144     main::is( $s, "xtyz", '$MATCH defined in right side of s///' );
 145 }
 146
 147 package C;
 148
 149 use English qw( -no_match_vars ) ;
 150
 151 "abc" =~ /b/;
 152
 153 main::ok( !$PREMATCH, '$PREMATCH disabled' );
 154 main::ok( !$MATCH, '$MATCH disabled' );
 155 main::ok( !$POSTMATCH, '$POSTMATCH disabled' );
 156
 157
 158 # Check that both variables change when localized.
 159 {
 160     local $LIST_SEPARATOR = "wibble";
 161     ::is $", 'wibble', '$" changes when $LIST_SEPARATOR is localized';
 162
 163     local $" = 'frooble';
 164     ::is $LIST_SEPARATOR, 'frooble';
 165 }
 166
 167 # because of the 'package' statements above, we have to prefix Test::More::
 168 Test::More::done_testing();
 169
 170 __END__
 171 This is a line.
 172 This is a paragraph.
 173
 174 This is a second paragraph.
 175 It has several lines.