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