Add B::Generate to perl5220delta
[perl.git] / 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 tests => 58;
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( $OLD_PERL_VERSION, $], '$OLD_PERL_VERSION' );
91 is( $DEBUGGING, $^D, '$DEBUGGING' );
92
93 is( $WARNING, 0, '$WARNING' );
94 like( $EXECUTABLE_NAME, qr/perl/i, '$EXECUTABLE_NAME' );
95 is( $OSNAME, $Config{osname}, '$OSNAME' );
96
97 # may be non-portable
98 ok( $SYSTEM_FD_MAX >= 2, '$SYSTEM_FD_MAX should be at least 2' );
99
100 is( $INPLACE_EDIT, '.inplace', '$INPLACE_EDIT' );
101
102 'aabbcc' =~ /(.{2}).+(.{2})(?{ 9 })/;
103 is( $LAST_PAREN_MATCH, 'cc', '$LAST_PAREN_MATCH' );
104 is( $LAST_REGEXP_CODE_RESULT, 9, '$LAST_REGEXP_CODE_RESULT' );
105
106 is( $LAST_MATCH_START[1], 0, '@LAST_MATCH_START' );
107 is( $LAST_MATCH_END[1], 2, '@LAST_MATCH_END' );
108
109 ok( !$PERLDB, '$PERLDB should be false' );
110
111 {
112         local $INPUT_RECORD_SEPARATOR = "\n\n";
113         like( <DATA>, qr/a paragraph./, '$INPUT_RECORD_SEPARATOR' );
114 }
115 like( <DATA>, qr/second paragraph..\z/s, '$INPUT_RECORD_SEPARATOR' );
116
117 is( $INPUT_LINE_NUMBER, 2, '$INPUT_LINE_NUMBER' );
118
119 my %hash;
120 $SUBSCRIPT_SEPARATOR = '|';
121 $hash{d,e,f} = 1;
122 $SUBSEP = ',';
123 $hash{'a', 'b', 'c'} = 1;
124 my @keys = sort keys %hash;
125
126 is( $keys[0], 'a,b,c', '$SUBSCRIPT_SEPARATOR' );
127 is( $keys[1], 'd|e|f', '$SUBSCRIPT_SEPARATOR' );
128
129 eval { is( $EXCEPTIONS_BEING_CAUGHT, 1, '$EXCEPTIONS_BEING_CAUGHT' ) };
130 ok( !$EXCEPTIONS_BEING_CAUGHT, '$EXCEPTIONS_BEING_CAUGHT should be false' );
131
132 eval { local *F; my $f = 'asdasdasd'; ++$f while -e $f; open(F, $f); };
133 is( $OS_ERROR, $ERRNO, '$OS_ERROR' );
134 ok( $OS_ERROR{ENOENT}, '%OS_ERROR (ENOENT should be set)' );
135
136 package B;
137
138 use English;
139
140 "abc" =~ /b/;
141
142 main::is( $PREMATCH, 'a', '$PREMATCH defined' );
143 main::is( $MATCH, 'b', '$MATCH defined' );
144 main::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
152 package C;
153
154 use English qw( -no_match_vars ) ;
155
156 "abc" =~ /b/;
157
158 main::ok( !$PREMATCH, '$PREMATCH disabled' );
159 main::ok( !$MATCH, '$MATCH disabled' );
160 main::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__
173 This is a line.
174 This is a paragraph.
175
176 This is a second paragraph.
177 It has several lines.