xref: /openbsd-src/gnu/usr.bin/perl/t/porting/test_bootstrap.t (revision de8cc8edbc71bd3e3bc7fbffa27ba0e564c37d8b)
1#!/perl -w
2use strict;
3
4# See "TESTING" in perlhack.pod for the instructions about where test files
5# are located and which constructions should be avoided in the early tests.
6
7# This regression tests ensures that the rules aren't accidentally overlooked.
8
9BEGIN {
10    chdir 't';
11    require './test.pl';
12}
13
14plan('no_plan');
15
16open my $fh, '<', '../MANIFEST' or die "Can't open MANIFEST: $!";
17
18# Some tests in t/comp need to use require or use to get their job done:
19my %exceptions = (
20    filter_exception => "require './test.pl'",
21    hints => "require './test.pl'",
22    parser => 'use DieDieDie',
23    parser_run => "require './test.pl'",
24    proto => 'use strict',
25 );
26
27while (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    # Don't 'use' Test::* modules under 't/' --
39    # but exclude this file from that test.
40    unlike(
41        $contents,
42        qr/use\s+Test::(?:Simple|More)/,
43        "$file doesn't use Test::Simple or Test::More"
44    ) unless ($file =~ m|porting/test_bootstrap\.t|);
45    next unless $file =~ m!^base/! or $file =~ m!^comp!;
46
47    # Remove only the excepted constructions for the specific files.
48    if ($file =~ m!comp/(.*)\.t! && $exceptions{$1}) {
49	my $allowed = $exceptions{$1};
50	$contents =~ s/\Q$allowed//gs;
51    }
52
53    # All uses of use are allowed in t/comp/use.t
54    unlike($contents, qr/^\s*use\s+/m, "$file doesn't use use")
55	unless $file eq 'comp/use.t';
56    # All uses of require are allowed in t/comp/require.t
57    unlike($contents, qr/^\s*require\s+/m, "$file doesn't use require")
58	unless $file eq 'comp/require.t'
59}
60
61# There are regression tests using test.pl that don't want PL_sawampersand
62# set.  Or at least that was the case until PL_sawampersand was disabled
63# and replaced with copy-on-write.
64
65# We still allow PL_sawampersand to be enabled with
66# -Accflags=-DPERL_SAWAMPERSAND, or with -DPERL_NO_COW, so its still worth
67# checking.
68# There's no portable, reliable way to check whether PL_sawampersand is
69# set, so instead we just "grep $`|$&|$' test.pl"
70
71{
72    my $file = '';
73    my $fh;
74    if (ok(open(my $fh, '<', 'test.pl'), "opened test.pl")) {
75	$file = do { local $/; <$fh> };
76	$file //= '';
77    }
78    else {
79	diag("error: $!");
80    }
81    ok(length($file) > 0, "read test.pl successfully");
82    ok($file !~ /\$&/, 'Nothing in test.pl mentioned $&');
83    ok($file !~ /\$`/, 'Nothing in test.pl mentioned $`');
84    ok($file !~ /\$'/, 'Nothing in test.pl mentioned $\'');
85}
86