This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
6888daa921323d5980af718d3894d2db96562ab4
[perl5.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 # Some tests in t/comp need to use require or use to get their job done:
20 my %exceptions = (
21     hints => "require './test.pl'",
22     parser => 'use DieDieDie',
23     parser_run => "require './test.pl'",
24     proto => 'use strict',
25  );
26
27 while (my $file = <$fh>) {
28     next unless $file =~ s!^t/!!;
29     chomp $file;
30     $file =~ s/\s+.*//;
31     next unless $file =~ m!\.t$!;
32
33     local $/;
34     open my $t, '<', $file or die "Can't open $file: $!";
35     # avoid PERL_UNICODE causing us to read non-UTF-8 files as UTF-8
36     binmode $t;
37     my $contents = <$t>;
38     # Make sure that we don't match ourselves
39     unlike($contents, qr/use\s+Test::More/, "$file doesn't use Test::\QMore");
40     next unless $file =~ m!^base/! or $file =~ m!^comp!;
41
42     # Remove only the excepted constructions for the specific files.
43     if ($file =~ m!comp/(.*)\.t! && $exceptions{$1}) {
44         my $allowed = $exceptions{$1};
45         $contents =~ s/\Q$allowed//gs;
46     }
47
48     # All uses of use are allowed in t/comp/use.t
49     unlike($contents, qr/^\s*use\s+/m, "$file doesn't use use")
50         unless $file eq 'comp/use.t';
51     # All uses of require are allowed in t/comp/require.t
52     unlike($contents, qr/^\s*require\s+/m, "$file doesn't use require")
53         unless $file eq 'comp/require.t'
54 }
55
56 # There are regression tests using test.pl that don't want PL_sawampersand
57 # set.  Or at least that was the case until PL_sawampersand was disabled
58 # and replaced with copy-on-write.
59
60 # We still allow PL_sawampersand to be enabled with
61 # -Accflags=-DPERL_SAWAMPERSAND, or with -DPERL_NO_COW, so its still worth
62 # checking.
63 # There's no portable, reliable way to check whether PL_sawampersand is
64 # set, so instead we just "grep $`|$&|$' test.pl"
65
66 {
67     my $file = '';
68     my $fh;
69     if (ok(open(my $fh, '<', 'test.pl'), "opened test.pl")) {
70         $file = do { local $/; <$fh> };
71         $file //= '';
72     }
73     else {
74         diag("error: $!");
75     }
76     ok(length($file) > 0, "read test.pl successfully");
77     ok($file !~ /\$&/, 'Nothing in test.pl mentioned $&');
78     ok($file !~ /\$`/, 'Nothing in test.pl mentioned $`');
79     ok($file !~ /\$'/, 'Nothing in test.pl mentioned $\'');
80 }