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