Commit | Line | Data |
---|---|---|
66cad4ab NC |
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 | require './test.pl'; | |
11 | ||
12 | plan('no_plan'); | |
13 | ||
14 | open my $fh, '<', '../MANIFEST' or die "Can't open MANIFEST: $!"; | |
15 | ||
16 | # Three tests in t/comp need to use require or use to get their job done: | |
17 | my %exceptions = (hints => "require './test.pl'", | |
18 | parser => 'use DieDieDie', | |
19 | proto => 'use strict', | |
20 | ); | |
21 | ||
22 | while (my $file = <$fh>) { | |
23 | next unless $file =~ s!^t/!!; | |
24 | chomp $file; | |
25 | $file =~ s/\s+.*//; | |
26 | next unless $file =~ m!\.t$!; | |
27 | ||
28 | local $/; | |
29 | open my $t, '<', $file or die "Can't open $file: $!"; | |
30 | my $contents = <$t>; | |
31 | # Make sure that we don't match ourselves | |
32 | unlike($contents, qr/use\s+Test::More/, "$file doesn't use Test::\QMore"); | |
33 | next unless $file =~ m!^base/! or $file =~ m!^comp!; | |
34 | ||
35 | # Remove only the excepted constructions for the specific files. | |
36 | if ($file =~ m!comp/(.*)\.t! && $exceptions{$1}) { | |
37 | my $allowed = $exceptions{$1}; | |
38 | $contents =~ s/\Q$allowed//gs; | |
39 | } | |
40 | ||
41 | # All uses of use are allowed in t/comp/use.t | |
42 | unlike($contents, qr/^\s*use\s+/m, "$file doesn't use use") | |
43 | unless $file eq 'comp/use.t'; | |
44 | # All uses of require are allowed in t/comp/require.t | |
45 | unlike($contents, qr/^\s*require\s+/m, "$file doesn't use require") | |
46 | unless $file eq 'comp/require.t' | |
47 | } | |
178e9024 NC |
48 | |
49 | # There are regression tests using test.pl that don't want PL_sawampersand set | |
50 | ||
51 | # This very much relies on a bug in the regexp implementation, but for now it's | |
52 | # the best way to work out whether PL_sawampersand is true. | |
53 | # Then again, PL_sawampersand *is* a bug, for precisely the reason that this | |
54 | # test can detect the behaviour change. | |
55 | ||
56 | isnt($INC{'./test.pl'}, undef, 'We loaded test.pl'); | |
57 | ok("Perl rules" =~ /Perl/, 'Perl rules'); | |
58 | is(eval '$&', undef, 'Nothing in test.pl mentioned $&'); | |
59 | is(eval '$`', undef, 'Nothing in test.pl mentioned $`'); | |
60 | is(eval '$\'', undef, 'Nothing in test.pl mentioned $\''); | |
61 | # Currently seeing any of the 3 triggers the setting of all 3. | |
62 | # $` and $' will be '' rather than undef if the regexp sets them. |