&CORE::open()
[perl.git] / t / op / coresubs.t
1 #!./perl
2
3 # This file tests the results of calling subroutines in the CORE::
4 # namespace with ampersand syntax.  In other words, it tests the bodies of
5 # the subroutines themselves, not the ops that they might inline themselves
6 # as when called as barewords.
7
8 # coreinline.t tests the inlining of these subs as ops.  Since it was
9 # convenient, I also put the prototype and undefinedness checking in that
10 # file, even though those have nothing to do with inlining.  (coreinline.t
11 # reads the list in keywords.pl, which is why it’s convenient.)
12
13 BEGIN {
14     chdir 't' if -d 't';
15     @INC = qw(. ../lib);
16     require "test.pl";
17     $^P |= 0x100;
18 }
19 # Since tests inside evals can too easily fail silently, we cannot rely
20 # on done_testing. It’s much easier to count the tests as we go than to
21 # declare the plan up front, so this script ends with a test that makes
22 # sure the right number of tests have happened.
23
24 sub lis($$;$) {
25   &is(map(@$_ ? "[@{[map $_//'~~u~~', @$_]}]" : 'nought', @_[0,1]), $_[2]);
26 }
27
28 my %op_desc = (
29  join     => 'join or string',
30  readline => '<HANDLE>',
31  readpipe => 'quoted execution (``, qx)',
32  ref      => 'reference-type operator',
33 );
34 sub op_desc($) {
35   return $op_desc{$_[0]} || $_[0];
36 }
37
38
39 # This tests that the &{} syntax respects the number of arguments implied
40 # by the prototype, plus some extra tests for the (_) prototype.
41 sub test_proto {
42   my($o) = shift;
43
44   # Create an alias, for the caller’s convenience.
45   *{"my$o"} = \&{"CORE::$o"};
46
47   my $p = prototype "CORE::$o";
48
49   if ($p eq '') {
50     $tests ++;
51
52     eval " &CORE::$o(1) ";
53     like $@, qr/^Too many arguments for $o at /, "&$o with too many args";
54
55   }
56   elsif ($p eq '_') {
57     $tests ++;
58
59     eval " &CORE::$o(1,2) ";
60     my $desc = quotemeta op_desc($o);
61     like $@, qr/^Too many arguments for $desc at /,
62       "&$o with too many args";
63
64     if (!@_) { return }
65
66     $tests += 6;
67
68     my($in,$out) = @_; # for testing implied $_
69
70     # Since we have $in and $out values, we might as well test basic amper-
71     # sand calls, too.
72
73     is &{"CORE::$o"}($in), $out, "&$o";
74     lis [&{"CORE::$o"}($in)], [$out], "&$o in list context";
75
76     $_ = $in;
77     is &{"CORE::$o"}(), $out, "&$o with no args";
78
79     # Since there is special code to deal with lexical $_, make sure it
80     # works in all cases.
81     undef $_;
82     {
83       my $_ = $in;
84       is &{"CORE::$o"}(), $out, "&$o with no args uses lexical \$_";
85     }
86     # Make sure we get the right pad under recursion
87     my $r;
88     $r = sub {
89       if($_[0]) {
90         my $_ = $in;
91         is &{"CORE::$o"}(), $out,
92            "&$o with no args uses the right lexical \$_ under recursion";
93       }
94       else {
95         &$r(1)
96       }
97     };
98     &$r(0);
99     my $_ = $in;
100     eval {
101        is "CORE::$o"->(), $out, "&$o with the right lexical \$_ in an eval"
102     };   
103   }
104   elsif ($p =~ '^;([$*]+)\z') { # ;$ ;* ;$$ etc.
105     my $maxargs = length $1;
106     $tests += 1;    
107     eval " &CORE::$o((1)x($maxargs+1)) ";
108     my $desc = quotemeta op_desc($o);
109     like $@, qr/^Too many arguments for $desc at /,
110         "&$o with too many args";
111   }
112   elsif ($p =~ '^([$*]+);?\z') { # Fixed-length $$$ or ***
113     my $args = length $1;
114     $tests += 2;    
115     eval " &CORE::$o((1)x($args-1)) ";
116     like $@, qr/^Not enough arguments for $o at /, "&$o with too few args";
117     eval " &CORE::$o((1)x($args+1)) ";
118     like $@, qr/^Too many arguments for $o at /, "&$o with too many args";
119   }
120   elsif ($p =~ '^([$*]+);([$*]+)\z') { # Variable-length $$$ or ***
121     my $minargs = length $1;
122     my $maxargs = $minargs + length $2;
123     $tests += 2;    
124     eval " &CORE::$o((1)x($minargs-1)) ";
125     like $@, qr/^Not enough arguments for $o at /, "&$o with too few args";
126     eval " &CORE::$o((1)x($maxargs+1)) ";
127     like $@, qr/^Too many arguments for $o at /, "&$o with too many args";
128   }
129   elsif ($p eq '_;$') {
130     $tests += 1;
131
132     eval " &CORE::$o(1,2,3) ";
133     like $@, qr/^Too many arguments for $o at /, "&$o with too many args";
134   }
135   elsif ($p eq '@') {
136     # Do nothing, as we cannot test for too few or too many arguments.
137   }
138   elsif ($p =~ '^[$*;]+@\z') {
139     $tests ++;    
140     $p =~ ';@';
141     my $minargs = $-[0];
142     eval " &CORE::$o((1)x($minargs-1)) ";
143     my $desc = quotemeta op_desc($o);
144     like $@, qr/^Not enough arguments for $desc at /,
145        "&$o with too few args";
146   }
147   elsif ($p =~ /^\\%\$*\z/) { #  \% and \%$$
148     $tests += 5;
149
150     eval "&CORE::$o(" . join(",", (1) x length $p) . ")";
151     like $@, qr/^Too many arguments for $o at /,
152          "&$o with too many args";
153     eval " &CORE::$o(" . join(",", (1) x (length($p)-2)) . ") ";
154     like $@, qr/^Not enough arguments for $o at /,
155          "&$o with too few args";
156     my $moreargs = ",1" x (length($p) - 2);
157     eval " &CORE::$o([]$moreargs) ";
158     like $@, qr/^Type of arg 1 to &CORE::$o must be hash reference at /,
159         "&$o with array ref arg";
160     eval " &CORE::$o(*foo$moreargs) ";
161     like $@, qr/^Type of arg 1 to &CORE::$o must be hash reference at /,
162         "&$o with typeglob arg";
163     eval " &CORE::$o(bless([], 'hov')$moreargs) ";
164     like $@, qr/^Type of arg 1 to &CORE::$o must be hash reference at /,
165         "&$o with non-hash arg with hash overload (which does not count)";
166   }
167   elsif ($p eq '\[$@%&*]') {
168     $tests += 5;
169
170     eval " &CORE::$o(1,2) ";
171     like $@, qr/^Too many arguments for $o at /,
172          "&$o with too many args";
173     eval " &CORE::$o() ";
174     like $@, qr/^Not enough arguments for $o at /,
175          "&$o with too few args";
176     eval " &CORE::$o(2) ";
177     like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
178                 ) \[\$\@%&\*] at /,
179         "&$o with non-ref arg";
180     eval " &CORE::$o(*STDOUT{IO}) ";
181     like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
182                 ) \[\$\@%&\*] at /,
183         "&$o with ioref arg";
184     my $class = ref *DATA{IO};
185     eval " &CORE::$o(bless(*DATA{IO}, 'hov')) ";
186     like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
187                 ) \[\$\@%&\*] at /,
188         "&$o with ioref arg with hash overload (which does not count)";
189     bless *DATA{IO}, $class;
190   }
191
192   else {
193     die "Please add tests for the $p prototype";
194   }
195 }
196
197 test_proto '__FILE__';
198 test_proto '__LINE__';
199 test_proto '__PACKAGE__';
200
201 is file(), 'frob'    , '__FILE__ does check its caller'   ; ++ $tests;
202 is line(),  5        , '__LINE__ does check its caller'   ; ++ $tests;
203 is pakg(), 'stribble', '__PACKAGE__ does check its caller'; ++ $tests;
204
205 test_proto 'abs', -5, 5;
206
207 test_proto 'accept';
208 $tests += 6; eval q{
209   is &CORE::accept(qw{foo bar}), undef, "&accept";
210   lis [&{"CORE::accept"}(qw{foo bar})], [undef], "&accept in list context";
211
212   &myaccept(my $foo, my $bar);
213   is ref $foo, 'GLOB', 'CORE::accept autovivifies its first argument';
214   is $bar, undef, 'CORE::accept does not autovivify its second argument';
215   use strict;
216   undef $foo;
217   eval { 'myaccept'->($foo, $bar) };
218   like $@, qr/^Can't use an undefined value as a symbol reference at/,
219       'CORE::accept will not accept undef 2nd arg under strict';
220   is ref $foo, 'GLOB', 'CORE::accept autovivs its first arg under strict';
221 };
222
223 test_proto 'alarm';
224 test_proto 'atan2';
225
226 test_proto 'bind';
227 $tests += 3;
228 is &CORE::bind('foo', 'bear'), undef, "&bind";
229 lis [&CORE::bind('foo', 'bear')], [undef], "&bind in list context";
230 eval { &mybind(my $foo, "bear") };
231 like $@, qr/^Bad symbol for filehandle at/,
232      'CORE::bind dies with undef first arg';
233
234 test_proto 'binmode';
235 $tests += 3;
236 is &CORE::binmode(qw[foo bar]), undef, "&binmode";
237 lis [&CORE::binmode(qw[foo bar])], [undef], "&binmode in list context";
238 is &mybinmode(foo), undef, '&binmode with one arg';
239
240 test_proto 'bless';
241 $tests += 3;
242 like &CORE::bless([],'parcel'), qr/^parcel=ARRAY/, "&bless";
243 like join(" ", &CORE::bless([],'parcel')),
244      qr/^parcel=ARRAY(?!.* )/, "&bless in list context";
245 like &mybless([]), qr/^main=ARRAY/, '&bless with one arg';
246
247 test_proto 'break';
248 { $tests ++;
249   my $tmp;
250   CORE::given(1) {
251     CORE::when(1) {
252       &mybreak;
253       $tmp = 'bad';
254     }
255   }
256   is $tmp, undef, '&break';
257 }
258
259 test_proto 'caller';
260 $tests += 4;
261 sub caller_test {
262     is scalar &CORE::caller, 'hadhad', '&caller';
263     is scalar &CORE::caller(1), 'main', '&caller(1)';
264     lis [&CORE::caller], [caller], '&caller in list context';
265     lis [&CORE::caller(1)], [caller(1)], '&caller(1) in list context';
266 }
267 sub {
268    package hadhad;
269    ::caller_test();
270 }->();
271
272 test_proto 'chmod';
273 $tests += 3;
274 is &CORE::chmod(), 0, '&chmod with no args';
275 is &CORE::chmod(0666), 0, '&chmod';
276 lis [&CORE::chmod(0666)], [0], '&chmod in list context';
277
278 test_proto 'chown';
279 $tests += 4;
280 is &CORE::chown(), 0, '&chown with no args';
281 is &CORE::chown(1), 0, '&chown with 1 arg';
282 is &CORE::chown(1,2), 0, '&chown';
283 lis [&CORE::chown(1,2)], [0], '&chown in list context';
284
285 test_proto 'chr', 5, "\5";
286 test_proto 'chroot';
287
288 test_proto 'close';
289 {
290   last if is_miniperl;
291   $tests += 3;
292   
293   open my $fh, ">", \my $buffalo;
294   print $fh 'an address in the outskirts of Jersey';
295   ok &CORE::close($fh), '&CORE::close retval';
296   print $fh 'lalala';
297   is $buffalo, 'an address in the outskirts of Jersey',
298      'effect of &CORE::close';
299   # This has to be a separate variable from $fh, as re-using the same
300   # variable can cause the tests to pass by accident.  That actually hap-
301   # pened during developement, because the second close() was reading
302   # beyond the end of the stack and finding a $fh left over from before.
303   open my $fh2, ">", \($buffalo = '');
304   select+(select($fh2), do {
305      print "Nasusiro Tokasoni";
306      &CORE::close();
307      print "jfd";
308      is $buffalo, "Nasusiro Tokasoni", '&CORE::close with no args';
309   })[0];
310 }
311 lis [&CORE::close('tototootot')], [''], '&close in list context'; ++$tests;
312
313 test_proto 'closedir';
314 $tests += 2;
315 is &CORE::closedir(foo), undef, '&CORE::closedir';
316 lis [&CORE::closedir(foo)], [undef], '&CORE::closedir in list context';
317
318 test_proto 'connect';
319 $tests += 2;
320 is &CORE::connect('foo','bar'), undef, '&connect';
321 lis [&myconnect('foo','bar')], [undef], '&connect in list context';
322
323 test_proto 'continue';
324 $tests ++;
325 CORE::given(1) {
326   CORE::when(1) {
327     &mycontinue();
328   }
329   pass "&continue";
330 }
331
332 test_proto 'cos';
333 test_proto 'crypt';
334
335 test_proto 'dbmclose';
336 test_proto 'dbmopen';
337 {
338   last unless eval { require AnyDBM_File };
339   $tests ++;
340   my $filename = tempfile();
341   &mydbmopen(\my %db, $filename, 0666);
342   $db{1} = 2; $db{3} = 4;
343   &mydbmclose(\%db);
344   is scalar keys %db, 0, '&dbmopen and &dbmclose';
345 }
346
347 test_proto 'die';
348 eval { dier('quinquangle') };
349 is $@, "quinquangle at frob line 6.\n", '&CORE::die'; $tests ++;
350
351 test_proto $_ for qw(
352  endgrent endhostent endnetent endprotoent endpwent endservent
353 );
354
355 test_proto 'exit';
356 $tests ++;
357 is runperl(prog => '&CORE::exit; END { print q-ok- }'), 'ok',
358   '&exit with no args';
359
360 test_proto 'fork';
361
362 test_proto 'formline';
363 $tests += 3;
364 is &myformline(' @<<< @>>>', 1, 2), 1, '&myformline retval';
365 is $^A,        ' 1       2', 'effect of &myformline';
366 lis [&myformline('@')], [1], '&myformline in list context';
367
368 test_proto 'exp';
369 test_proto 'fcntl';
370
371 test_proto 'fileno';
372 $tests += 2;
373 is &CORE::fileno(\*STDIN), fileno STDIN, '&CORE::fileno';
374 lis [&CORE::fileno(\*STDIN)], [fileno STDIN], '&CORE::fileno in list cx';
375
376 test_proto 'flock';
377 test_proto 'fork';
378
379 test_proto 'getc';
380 {
381   last if is_miniperl;
382   $tests += 3;
383   local *STDIN;
384   open my $fh, "<", \(my $buf='falo');
385   open STDIN, "<", \(my $buf2 = 'bison');
386   is &mygetc($fh), 'f', '&mygetc';
387   is &mygetc(), 'b', '&mygetc with no args';
388   lis [&mygetc($fh)], ['a'], '&mygetc in list context';
389 }
390
391 test_proto "get$_" for qw '
392   grent grgid grnam hostbyaddr hostbyname hostent login netbyaddr netbyname
393   netent peername
394 ';
395
396 test_proto 'getpgrp';
397 eval {&mygetpgrp()};
398 pass '&getpgrp with no args does not crash'; $tests++;
399
400 test_proto "get$_" for qw '
401   ppid priority protobyname protobynumber protoent
402   pwent pwnam pwuid servbyname servbyport servent sockname sockopt
403 ';
404
405 test_proto 'gmtime';
406 &CORE::gmtime;
407 pass '&gmtime without args does not crash'; ++$tests;
408
409 test_proto 'hex', ff=>255;
410
411 test_proto 'index';
412 $tests += 3;
413 is &myindex("foffooo","o",2),4,'&index';
414 lis [&myindex("foffooo","o",2)],[4],'&index in list context';
415 is &myindex("foffooo","o"),1,'&index with 2 args';
416
417 test_proto 'int', 1.5=>1;
418 test_proto 'ioctl';
419
420 test_proto 'join';
421 $tests += 2;
422 is &myjoin('a','b','c'), 'bac', '&join';
423 lis [&myjoin('a','b','c')], ['bac'], '&join in list context';
424
425 test_proto 'kill'; # set up mykill alias
426 if ($^O ne 'riscos') {
427     $tests ++;
428     ok( &mykill(0, $$), '&kill' );
429 }
430
431 test_proto 'lc', 'A', 'a';
432 test_proto 'lcfirst', 'AA', 'aA';
433 test_proto 'length', 'aaa', 3;
434 test_proto 'link';
435 test_proto 'listen';
436
437 test_proto 'localtime';
438 &CORE::localtime;
439 pass '&localtime without args does not crash'; ++$tests;
440
441 test_proto 'lock';
442 $tests += 6;
443 is \&mylock(\$foo), \$foo, '&lock retval when passed a scalar ref';
444 lis [\&mylock(\$foo)], [\$foo], '&lock in list context';
445 is &mylock(\@foo), \@foo, '&lock retval when passed an array ref';
446 is &mylock(\%foo), \%foo, '&lock retval when passed a ash ref';
447 is &mylock(\&foo), \&foo, '&lock retval when passed a code ref';
448 is \&mylock(\*foo), \*foo, '&lock retval when passed a glob ref';
449
450 test_proto 'log';
451
452 test_proto 'mkdir';
453 # mkdir is tested with implicit $_ at the end, to make the test easier
454
455 test_proto "msg$_" for qw( ctl get rcv snd );
456
457 test_proto 'not';
458 $tests += 2;
459 is &mynot(1), !1, '&not';
460 lis [&mynot(0)], [!0], '&not in list context';
461
462 test_proto 'oct', '666', 438;
463
464 test_proto 'open';
465 $tests += 5;
466 $file = 'test.pl';
467 ok &myopen('file'), '&open with 1 arg' or warn "1-arg open: $!";
468 like <file>, qr|^#|, 'result of &open with 1 arg';
469 close file;
470 {
471   ok &myopen(my $fh, "test.pl"), 'two-arg &open';
472   ok $fh, '&open autovivifies';
473   like <$fh>, qr '^#', 'result of &open with 2 args';
474   last if is_miniperl;
475   $tests +=2;
476   ok &myopen(my $fh2, "<", \"sharummbles"), 'retval of 3-arg &open';
477   is <$fh2>, 'sharummbles', 'result of three-arg &open';
478 }
479
480 test_proto 'opendir';
481 test_proto 'ord', chr(64), 64;
482
483 test_proto 'pack';
484 $tests += 2;
485 is &mypack("H*", '5065726c'), 'Perl', '&pack';
486 lis [&mypack("H*", '5065726c')], ['Perl'], '&pack in list context';
487
488 test_proto 'pipe';
489 test_proto 'quotemeta', '$', '\$';
490 test_proto 'readdir';
491
492 test_proto 'readline';
493 {
494   local *ARGV = *DATA;
495   $tests ++;
496   is scalar &myreadline,
497     "I wandered lonely as a cloud\n", '&readline w/no args';
498 }
499 {
500   last if is_miniperl;
501   $tests += 2;
502   open my $fh, "<", \(my $buff = <<END);
503 The Recursive Problem
504 ---------------------
505 I have a problem I cannot solve.
506 The problem is that I cannot solve it.
507 END
508   is &myreadline($fh), "The Recursive Problem\n",
509     '&readline with 1 arg';
510   lis [&myreadline($fh)], [
511        "---------------------\n",
512        "I have a problem I cannot solve.\n",
513        "The problem is that I cannot solve it.\n",
514       ], '&readline in list context';
515 }
516
517 test_proto 'readlink';
518 test_proto 'readpipe';
519
520 use if !is_miniperl, File::Spec::Functions, qw "catfile";
521 use if !is_miniperl, File::Temp, 'tempdir';
522
523 test_proto 'rename';
524 {
525     last if is_miniperl;
526     $tests ++;
527     my $dir = tempdir(uc cleanup => 1);
528     my $tmpfilenam = catfile $dir, 'aaa';
529     open my $fh, ">", $tmpfilenam or die "cannot open $tmpfilenam: $!";
530     close $fh or die "cannot close $tmpfilenam: $!";
531     &myrename("$tmpfilenam", $tmpfilenam = catfile $dir,'bbb');
532     ok open(my $fh, '>', $tmpfilenam), '&rename';
533 }
534
535 test_proto 'ref', [], 'ARRAY';
536
537 test_proto 'reverse';
538 $tests += 2;
539 is &myreverse('reward'), 'drawer', '&reverse';
540 lis [&myreverse(qw 'dog bites man')], [qw 'man bites dog'],
541   '&reverse in list context';
542
543 test_proto 'rewinddir';
544
545 test_proto 'rindex';
546 $tests += 3;
547 is &myrindex("foffooo","o",2),1,'&rindex';
548 lis [&myrindex("foffooo","o",2)],[1],'&rindex in list context';
549 is &myrindex("foffooo","o"),6,'&rindex with 2 args';
550
551 test_proto 'rmdir';
552
553 test_proto 'seek';
554 {
555     last if is_miniperl;
556     $tests += 1;
557     open my $fh, "<", \"misled" or die $!;
558     &myseek($fh, 2, 0);
559     is <$fh>, 'sled', '&seek in action';
560 }
561
562 test_proto 'seekdir';
563 test_proto "sem$_" for qw "ctl get op";
564
565 test_proto "set$_" for qw '
566   grent hostent netent priority protoent pwent servent sockopt
567 ';
568
569 test_proto "shm$_" for qw "ctl get read write";
570 test_proto 'shutdown';
571 test_proto 'sin';
572 test_proto "socket$_" for "", "pair";
573
574 test_proto 'sprintf';
575 $tests += 2;
576 is &mysprintf("%x", 65), '41', '&sprintf';
577 lis [&mysprintf("%x", '65')], ['41'], '&sprintf in list context';
578
579 test_proto 'sqrt', 4, 2;
580 test_proto 'symlink';
581 test_proto 'syscall';
582 test_proto 'sysseek';
583 test_proto 'telldir';
584
585 test_proto 'time';
586 $tests += 2;
587 like &mytime, '^\d+\z', '&time in scalar context';
588 like join('-', &mytime), '^\d+\z', '&time in list context';
589
590 test_proto 'times';
591 $tests += 2;
592 like &mytimes, '^[\d.]+\z', '&times in scalar context';
593 like join('-',&mytimes), '^[\d.]+-[\d.]+-[\d.]+-[\d.]+\z',
594    '&times in list context';
595
596 test_proto 'uc', 'aa', 'AA';
597 test_proto 'ucfirst', 'aa', "Aa";
598
599 test_proto 'utime';
600 $tests += 2;
601 is &myutime(undef,undef), 0, '&utime';
602 lis [&myutime(undef,undef)], [0], '&utime in list context';
603
604 test_proto 'vec';
605 $tests += 3;
606 is &myvec("foo", 0, 4), 6, '&vec';
607 lis [&myvec("foo", 0, 4)], [6], '&vec in list context';
608 $tmp = "foo";
609 ++&myvec($tmp,0,4);
610 is $tmp, "goo", 'lvalue &vec';
611
612 test_proto 'wait';
613 test_proto 'waitpid';
614
615 test_proto 'wantarray';
616 $tests += 4;
617 my $context;
618 my $cx_sub = sub {
619   $context = qw[void scalar list][&mywantarray + defined mywantarray()]
620 };
621 () = &$cx_sub;
622 is $context, 'list', '&wantarray with caller in list context';
623 scalar &$cx_sub;
624 is($context, 'scalar', '&wantarray with caller in scalar context');
625 &$cx_sub;
626 is($context, 'void', '&wantarray with caller in void context');
627 lis [&mywantarray],[wantarray], '&wantarray itself in list context';
628
629 test_proto 'warn';
630 { $tests += 3;
631   my $w;
632   local $SIG{__WARN__} = sub { $w = shift };
633   is &mywarn('a'), 1, '&warn retval';
634   is $w, "a at " . __FILE__ . " line " . (__LINE__-1) . ".\n", 'warning';
635   lis [&mywarn()], [1], '&warn retval in list context';
636 }
637
638 # This is just a check to make sure we have tested everything.  If we
639 # haven’t, then either the sub needs to be tested or the list in
640 # gv.c is wrong.
641 {
642   last if is_miniperl;
643   require File::Spec::Functions;
644   my $keywords_file =
645    File::Spec::Functions::catfile(
646       File::Spec::Functions::updir,'regen','keywords.pl'
647    );
648   open my $kh, $keywords_file
649     or die "$0 cannot open $keywords_file: $!";
650   while(<$kh>) {
651     if (m?__END__?..${\0} and /^[-](.*)/) {
652       my $word = $1;
653       next if
654        $word =~ /^(?:CORE|and|cmp|dump|eq|ge|gt|le|lt|ne|or|x|xor)\z/;
655       $tests ++;
656       ok   exists &{"my$word"}
657         || (eval{&{"CORE::$word"}}, $@ =~ /cannot be called directly/),
658      "$word either has been tested or is not ampable";
659     }
660   }
661 }
662
663 # Add new tests above this line.
664
665 # This test must come last (before the test count test):
666
667 {
668   last if is_miniperl;
669   $tests += 2;
670   require File::Temp ;
671   my $dir = File::Temp::tempdir(uc cleanup => 1);
672   chdir($dir);
673   my $_ = 'Phoo';
674   ok &mymkdir(), '&mkdir';
675   like <*>, qr/^phoo\z/i, 'mkdir works with implicit $_';
676 }
677
678 # ------------ END TESTING ----------- #
679
680 is curr_test, $tests+1, 'right number of tests';
681 done_testing;
682
683 #line 3 frob
684
685 sub file { &CORE::__FILE__ }
686 sub line { &CORE::__LINE__ } # 5
687 sub dier { &CORE::die(@_)  } # 6
688 package stribble;
689 sub main::pakg { &CORE::__PACKAGE__ }
690
691 # Please do not add new tests here.
692 package main;
693 CORE::__DATA__
694 I wandered lonely as a cloud
695 That floats on high o’er vales and hills,
696 And all at once I saw a crowd, 
697 A host of golden daffodils!
698 Beside the lake, beneath the trees,
699 Fluttering, dancing, in the breeze.
700 -- Wordsworth