Commit | Line | Data |
---|---|---|
436b3d12 TC |
1 | #!./perl |
2 | ||
3 | # Minimally test if dump() behaves as expected | |
4 | ||
5 | BEGIN { | |
6 | chdir 't' if -d 't'; | |
7 | @INC = qw(. ../lib); | |
8 | require './test.pl'; | |
9 | ||
10 | skip_all_if_miniperl(); | |
11 | } | |
12 | ||
13 | use Config; | |
14 | use File::Temp qw(tempdir); | |
15 | use Cwd qw(getcwd); | |
e9c7535a | 16 | use File::Spec; |
436b3d12 TC |
17 | |
18 | skip_all("only tested on devel builds") | |
19 | unless $Config{usedevel}; | |
20 | ||
21 | # there may be other operating systems where it makes sense, but | |
22 | # there are some where it isn't, so limit the platforms we test | |
49c4aee9 DM |
23 | # this on. Also this needs to be a platform that fully supports |
24 | # fork() and waitpid(). | |
25 | ||
436b3d12 TC |
26 | skip_all("no point in dumping on $^O") |
27 | unless $^O =~ /^(linux|.*bsd|solaris)$/; | |
28 | ||
977bf595 DM |
29 | skip_all("avoid coredump under ASan") |
30 | if $Config{ccflags} =~ /-fsanitize=/; | |
31 | ||
436b3d12 TC |
32 | # execute in a work directory so File::Temp can clean up core dumps |
33 | my $tmp = tempdir(CLEANUP => 1); | |
34 | ||
35 | my $start = getcwd; | |
36 | ||
e9c7535a TC |
37 | # on systems which don't make $^X absolute which_perl() in test.pl won't |
38 | # return an absolute path, so once we change directories it can't | |
39 | # find ./perl, resulting in test failures | |
40 | $^X = File::Spec->rel2abs($^X); | |
41 | ||
436b3d12 TC |
42 | chdir $tmp |
43 | or skip_all("Cannot chdir to work directory"); | |
44 | ||
45 | plan(2); | |
46 | ||
49c4aee9 DM |
47 | # Depending on how perl is built, there may be extraneous stuff on stderr |
48 | # such as "Aborted", which isn't caught by the '2>&1' that | |
49 | # fresh_perl_like() does. So execute each dump() in a sub-process. | |
50 | # | |
51 | # In detail: | |
52 | # fresh_perl_like() ends up doing a `` which invokes a shell with 2 args: | |
53 | # | |
54 | # "sh", "-c", "perl /tmp/foo 2>&1" | |
55 | # | |
56 | # When the perl process coredumps after calling dump(), the parent | |
57 | # sh sees that the exit of the child flags a coredump and so prints | |
58 | # something like the following to stderr: | |
59 | # | |
60 | # sh: line 1: 17605 Aborted (core dumped) | |
61 | # | |
62 | # Note that the '2>&1' only applies to the perl process, not to the sh | |
63 | # command itself. | |
64 | # By do the dump in a child, the parent perl process exits back to sh with | |
65 | # a normal exit value, so sh won't complain. | |
436b3d12 TC |
66 | |
67 | fresh_perl_like(<<'PROG', qr/\AA(?!B\z)/, {}, "plain dump quits"); | |
68 | ++$|; | |
49c4aee9 DM |
69 | my $pid = fork; |
70 | die "fork: $!\n" unless defined $pid; | |
71 | if ($pid) { | |
72 | # parent | |
73 | waitpid($pid, 0); | |
74 | } | |
75 | else { | |
76 | # child | |
77 | print qq(A); | |
78 | dump; | |
79 | print qq(B); | |
80 | } | |
436b3d12 TC |
81 | PROG |
82 | ||
436b3d12 TC |
83 | fresh_perl_like(<<'PROG', qr/A(?!B\z)/, {}, "dump with label quits"); |
84 | ++$|; | |
49c4aee9 DM |
85 | my $pid = fork; |
86 | die "fork: $!\n" unless defined $pid; | |
87 | if ($pid) { | |
88 | # parent | |
89 | waitpid($pid, 0); | |
90 | } | |
91 | else { | |
92 | print qq(A); | |
93 | dump foo; | |
94 | foo: | |
95 | print qq(B); | |
96 | } | |
436b3d12 | 97 | PROG |
436b3d12 TC |
98 | |
99 | END { | |
43b19dac | 100 | chdir $start if defined $start; |
436b3d12 | 101 | } |