fix up the namedproto test
[perl.git] / t / porting / test_bootstrap.t
1 #!/perl -w
2 use strict;
3
4 # See "Writing a test" in perlhack.pod for the instructions about the order that
5 # testing directories run, and which constructions should be avoided in the
6 # early tests.
7
8 # This regression tests ensures that the rules aren't accidentally overlooked.
9
10 BEGIN {
11     chdir 't';
12     require './test.pl';
13 }
14
15 plan('no_plan');
16
17 open my $fh, '<', '../MANIFEST' or die "Can't open MANIFEST: $!";
18
19 # Three tests in t/comp need to use require or use to get their job done:
20 my %exceptions = (hints => "require './test.pl'",
21                   parser => 'use DieDieDie',
22                   proto => 'use strict',
23                   namedproto => qr/require (?:warnings|Scalar::Util)/,
24                  );
25                   
26 while (my $file = <$fh>) {
27     next unless $file =~ s!^t/!!;
28     chomp $file;
29     $file =~ s/\s+.*//;
30     next unless $file =~ m!\.t$!;
31
32     local $/;
33     open my $t, '<', $file or die "Can't open $file: $!";
34     my $contents = <$t>;
35     # Make sure that we don't match ourselves
36     unlike($contents, qr/use\s+Test::More/, "$file doesn't use Test::\QMore");
37     next unless $file =~ m!^base/! or $file =~ m!^comp!;
38
39     # Remove only the excepted constructions for the specific files.
40     if ($file =~ m!comp/(.*)\.t! && $exceptions{$1}) {
41         my $allowed = $exceptions{$1};
42         if (ref $allowed) {
43             $contents =~ s/$allowed//gs;
44         }
45         else {
46             $contents =~ s/\Q$allowed//gs;
47         }
48     }
49
50     # All uses of use are allowed in t/comp/use.t
51     unlike($contents, qr/^\s*use\s+/m, "$file doesn't use use")
52         unless $file eq 'comp/use.t';
53     # All uses of require are allowed in t/comp/require.t
54     unlike($contents, qr/^\s*require\s+/m, "$file doesn't use require")
55         unless $file eq 'comp/require.t'
56 }
57
58 # There are regression tests using test.pl that don't want PL_sawampersand set
59
60 # This very much relies on a bug in the regexp implementation, but for now it's
61 # the best way to work out whether PL_sawampersand is true.
62 # Then again, PL_sawampersand *is* a bug, for precisely the reason that this
63 # test can detect the behaviour change.
64
65 isnt($INC{'./test.pl'}, undef, 'We loaded test.pl');
66 ok("Perl rules" =~ /Perl/, 'Perl rules');
67 is(eval '$&', undef, 'Nothing in test.pl mentioned $&');
68 is(eval '$`', undef, 'Nothing in test.pl mentioned $`');
69 is(eval '$\'', undef, 'Nothing in test.pl mentioned $\'');
70 # Currently seeing any of the 3 triggers the setting of all 3.
71 # $` and $' will be '' rather than undef if the regexp sets them.