| 1 | #!./perl
|
|---|
| 2 |
|
|---|
| 3 | BEGIN {
|
|---|
| 4 | chdir 't' if -d 't';
|
|---|
| 5 | @INC = '../lib';
|
|---|
| 6 | }
|
|---|
| 7 |
|
|---|
| 8 | print "1..10\n";
|
|---|
| 9 |
|
|---|
| 10 | @oops = @ops = <op/*>;
|
|---|
| 11 |
|
|---|
| 12 | if ($^O eq 'MSWin32') {
|
|---|
| 13 | map { $files{lc($_)}++ } <op/*>;
|
|---|
| 14 | map { delete $files{"op/$_"} } split /[\s\n]/, `dir /b /l op & dir /b /l /ah op 2>nul`,
|
|---|
| 15 | }
|
|---|
| 16 | elsif ($^O eq 'VMS') {
|
|---|
| 17 | map { $files{lc($_)}++ } <[.op]*>;
|
|---|
| 18 | map { s/;.*$//; delete $files{lc($_)}; } split /[\n]/, `directory/noheading/notrailing/versions=1 [.op]`,
|
|---|
| 19 | }
|
|---|
| 20 | elsif ($^O eq 'MacOS') {
|
|---|
| 21 | @oops = @ops = <:op:*>;
|
|---|
| 22 | map { $files{$_}++ } <:op:*>;
|
|---|
| 23 | map { delete $files{$_} } split /[\s\n]/, `echo :op:\xc5`;
|
|---|
| 24 | }
|
|---|
| 25 | else {
|
|---|
| 26 | map { $files{$_}++ } <op/*>;
|
|---|
| 27 | map { delete $files{$_} } split /[\s\n]/, `echo op/*`;
|
|---|
| 28 | }
|
|---|
| 29 | if (keys %files) {
|
|---|
| 30 | print "not ok 1\t(",join(' ', sort keys %files),"\n";
|
|---|
| 31 | } else { print "ok 1\n"; }
|
|---|
| 32 |
|
|---|
| 33 | print $/ eq "\n" ? "ok 2\n" : "not ok 2\n";
|
|---|
| 34 |
|
|---|
| 35 | if ($^O eq 'MacOS') {
|
|---|
| 36 | while (<jskdfjskdfj* :op:* jskdjfjkosvk*>) {
|
|---|
| 37 | $not = "not " unless $_ eq shift @ops;
|
|---|
| 38 | $not = "not at all " if $/ eq "\0";
|
|---|
| 39 | }
|
|---|
| 40 | } else {
|
|---|
| 41 | while (<jskdfjskdfj* op/* jskdjfjkosvk*>) {
|
|---|
| 42 | $not = "not " unless $_ eq shift @ops;
|
|---|
| 43 | $not = "not at all " if $/ eq "\0";
|
|---|
| 44 | }
|
|---|
| 45 | }
|
|---|
| 46 | print "${not}ok 3\n";
|
|---|
| 47 |
|
|---|
| 48 | print $/ eq "\n" ? "ok 4\n" : "not ok 4\n";
|
|---|
| 49 |
|
|---|
| 50 | # test the "glob" operator
|
|---|
| 51 | $_ = $^O eq 'MacOS' ? ":op:*" : "op/*";
|
|---|
| 52 | @glops = glob $_;
|
|---|
| 53 | print "@glops" eq "@oops" ? "ok 5\n" : "not ok 5\n";
|
|---|
| 54 |
|
|---|
| 55 | @glops = glob;
|
|---|
| 56 | print "@glops" eq "@oops" ? "ok 6\n" : "not ok 6\n";
|
|---|
| 57 |
|
|---|
| 58 | # glob should still work even after the File::Glob stash has gone away
|
|---|
| 59 | # (this used to dump core)
|
|---|
| 60 | my $i = 0;
|
|---|
| 61 | for (1..2) {
|
|---|
| 62 | eval "<.>";
|
|---|
| 63 | undef %File::Glob::;
|
|---|
| 64 | ++$i;
|
|---|
| 65 | }
|
|---|
| 66 | print $i == 2 ? "ok 7\n" : "not ok 7\n";
|
|---|
| 67 |
|
|---|
| 68 | # ... while ($var = glob(...)) should test definedness not truth
|
|---|
| 69 |
|
|---|
| 70 | if( $INC{'File/Glob.pm'} ) {
|
|---|
| 71 | my $ok = "not ok 8\n";
|
|---|
| 72 | $ok = "ok 8\n" while my $var = glob("0");
|
|---|
| 73 | print $ok;
|
|---|
| 74 | }
|
|---|
| 75 | else {
|
|---|
| 76 | print "ok 8 # skip: File::Glob emulated Unixism\n";
|
|---|
| 77 | }
|
|---|
| 78 |
|
|---|
| 79 |
|
|---|
| 80 | # The formerly-broken test for the situation above would accidentally
|
|---|
| 81 | # test definedness for an assignment with a LOGOP on the right:
|
|---|
| 82 | my $f=0;
|
|---|
| 83 | $ok="ok 9\n";
|
|---|
| 84 | $ok="not ok 9\n", undef $f while $x = $f||$f;
|
|---|
| 85 | print $ok;
|
|---|
| 86 |
|
|---|
| 87 | # Better check that glob actually returned some entries
|
|---|
| 88 | {
|
|---|
| 89 | my $not = (scalar @oops > 0) ? '' : 'not ';
|
|---|
| 90 | print "${not}ok 10\n";
|
|---|
| 91 | }
|
|---|