Skip to content

Commit e476b1b

Browse files
author
Gurusamy Sarathy
committed
lexical warnings update, ability to inspect bitmask in calling
scope, among other things (from Paul Marquess) p4raw-id: //depot/perl@5170
1 parent 635bbe8 commit e476b1b

26 files changed

+1108
-773
lines changed

‎MANIFEST

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1445,6 +1445,7 @@ t/pragma/warn/5nolint Tests for -X switch
14451445
t/pragma/warn/6default Tests default warnings
14461446
t/pragma/warn/7fatal Tests fatal warnings
14471447
t/pragma/warn/8signal Tests warnings + __WARN__ and __DIE__
1448+
t/pragma/warn/9enabled Tests warnings
14481449
t/pragma/warn/av Tests for av.c for warnings.t
14491450
t/pragma/warn/doio Tests for doio.c for warnings.t
14501451
t/pragma/warn/doop Tests for doop.c for warnings.t

‎lib/warnings.pm

Lines changed: 143 additions & 78 deletions
Original file line numberDiff line numberDiff line change
@@ -17,98 +17,141 @@ warnings - Perl pragma to control optional warnings
1717
use warnings "all";
1818
no warnings "all";
1919
20+
if (warnings::enabled("void") {
21+
warnings::warn("void", "some warning");
22+
}
23+
2024
=head1 DESCRIPTION
2125
2226
If no import list is supplied, all possible warnings are either enabled
2327
or disabled.
2428
25-
See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
29+
Two functions are provided to assist module authors.
30+
31+
=over 4
32+
33+
=item warnings::enabled($category)
34+
35+
Returns TRUE if the warnings category in C<$category> is enabled in the
36+
calling module. Otherwise returns FALSE.
37+
38+
39+
=item warnings::warn($category, $message)
2640
41+
If the calling module has I<not> set C<$category> to "FATAL", print
42+
C<$message> to STDERR.
43+
If the calling module has set C<$category> to "FATAL", print C<$message>
44+
STDERR then die.
45+
46+
=back
47+
48+
See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
2749
2850
=cut
2951

3052
use Carp ;
3153

3254
%Bits = (
33-
'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..35]
34-
'ambiguous' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [16]
35-
'bareword' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [17]
36-
'closed' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
37-
'closure' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [27]
38-
'debugging' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [12]
39-
'deprecated' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [18]
40-
'digit' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [19]
41-
'exec' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
42-
'inplace' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [13]
43-
'internal' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [14]
44-
'io' => "\x55\x05\x00\x00\x00\x00\x00\x00\x00", # [0..5]
45-
'misc' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [6]
46-
'newline' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
47-
'numeric' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [7]
48-
'octal' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [20]
49-
'once' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [8]
50-
'overflow' => "\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [28]
51-
'parenthesis' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [21]
52-
'pipe' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [4]
53-
'portable' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [29]
54-
'printf' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [22]
55-
'recursion' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [9]
56-
'redefine' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [10]
57-
'reserved' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [23]
58-
'semicolon' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [24]
59-
'severe' => "\x00\x00\x40\x15\x00\x00\x00\x00\x00", # [11..14]
60-
'signal' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [30]
61-
'substr' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [31]
62-
'syntax' => "\x00\x00\x00\x40\x55\x55\x01\x00\x00", # [15..24]
63-
'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [32]
64-
'uninitialized' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [25]
65-
'unopened' => "\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [5]
66-
'unsafe' => "\x00\x00\x00\x00\x00\x00\x50\x55\x15", # [26..34]
67-
'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [33]
68-
'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [34]
69-
'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [35]
55+
'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..47]
56+
'ambiguous' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
57+
'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28]
58+
'chmod' => "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [0]
59+
'closed' => "\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5]
60+
'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
61+
'debugging' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
62+
'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
63+
'digit' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
64+
'exec' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
65+
'exiting' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
66+
'glob' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
67+
'inplace' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21]
68+
'internal' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
69+
'io' => "\x00\x55\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9]
70+
'malloc' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
71+
'misc' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
72+
'newline' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
73+
'numeric' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
74+
'once' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
75+
'overflow' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
76+
'pack' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
77+
'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
78+
'pipe' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
79+
'portable' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
80+
'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
81+
'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
82+
'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
83+
'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
84+
'recursion' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
85+
'redefine' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
86+
'regexp' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
87+
'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
88+
'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
89+
'severe' => "\x00\x00\x00\x00\x40\x55\x00\x00\x00\x00\x00\x00", # [19..23]
90+
'signal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
91+
'substr' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
92+
'syntax' => "\x00\x00\x00\x00\x00\x00\x50\x55\x55\x05\x00\x00", # [26..37]
93+
'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
94+
'umask' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
95+
'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
96+
'unopened' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
97+
'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
98+
'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
99+
'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
100+
'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
101+
'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
70102
);
71103

72104
%DeadBits = (
73-
'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..35]
74-
'ambiguous' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [16]
75-
'bareword' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [17]
76-
'closed' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
77-
'closure' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [27]
78-
'debugging' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [12]
79-
'deprecated' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [18]
80-
'digit' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [19]
81-
'exec' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
82-
'inplace' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [13]
83-
'internal' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [14]
84-
'io' => "\xaa\x0a\x00\x00\x00\x00\x00\x00\x00", # [0..5]
85-
'misc' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [6]
86-
'newline' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
87-
'numeric' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [7]
88-
'octal' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [20]
89-
'once' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [8]
90-
'overflow' => "\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [28]
91-
'parenthesis' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [21]
92-
'pipe' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [4]
93-
'portable' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [29]
94-
'printf' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [22]
95-
'recursion' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [9]
96-
'redefine' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [10]
97-
'reserved' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [23]
98-
'semicolon' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [24]
99-
'severe' => "\x00\x00\x80\x2a\x00\x00\x00\x00\x00", # [11..14]
100-
'signal' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [30]
101-
'substr' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [31]
102-
'syntax' => "\x00\x00\x00\x80\xaa\xaa\x02\x00\x00", # [15..24]
103-
'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [32]
104-
'uninitialized' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [25]
105-
'unopened' => "\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [5]
106-
'unsafe' => "\x00\x00\x00\x00\x00\x00\xa0\xaa\x2a", # [26..34]
107-
'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [33]
108-
'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [34]
109-
'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [35]
105+
'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..47]
106+
'ambiguous' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
107+
'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28]
108+
'chmod' => "\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [0]
109+
'closed' => "\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5]
110+
'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
111+
'debugging' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
112+
'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
113+
'digit' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
114+
'exec' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
115+
'exiting' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
116+
'glob' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
117+
'inplace' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21]
118+
'internal' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
119+
'io' => "\x00\xaa\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9]
120+
'malloc' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
121+
'misc' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
122+
'newline' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
123+
'numeric' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
124+
'once' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
125+
'overflow' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
126+
'pack' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
127+
'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
128+
'pipe' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
129+
'portable' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
130+
'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
131+
'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
132+
'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
133+
'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
134+
'recursion' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
135+
'redefine' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
136+
'regexp' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
137+
'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
138+
'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
139+
'severe' => "\x00\x00\x00\x00\x80\xaa\x00\x00\x00\x00\x00\x00", # [19..23]
140+
'signal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
141+
'substr' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
142+
'syntax' => "\x00\x00\x00\x00\x00\x00\xa0\xaa\xaa\x0a\x00\x00", # [26..37]
143+
'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
144+
'umask' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
145+
'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
146+
'unopened' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
147+
'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
148+
'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
149+
'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
150+
'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
151+
'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
110152
);
111153

154+
$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
112155

113156
sub bits {
114157
my $mask ;
@@ -141,12 +184,34 @@ sub unimport {
141184

142185
sub enabled
143186
{
144-
my $string = shift ;
145-
187+
# If no parameters, check for any lexical warnings enabled
188+
# in the users scope.
189+
my $callers_bitmask = (caller(1))[9] ;
190+
return ($callers_bitmask ne $NONE) if @_ == 0 ;
191+
192+
# otherwise check for the category supplied.
193+
my $category = shift ;
194+
return 0
195+
unless $Bits{$category} ;
196+
return 0 unless defined $callers_bitmask ;
146197
return 1
147-
if $bits{$string} && ${^WARNING_BITS} & $bits{$string} ;
198+
if ($callers_bitmask & $Bits{$category}) ne $NONE ;
148199

149200
return 0 ;
150201
}
151202

203+
sub warn
204+
{
205+
croak "Usage: warnings::warn('category', 'message')"
206+
unless @_ == 2 ;
207+
my $category = shift ;
208+
my $message = shift ;
209+
local $Carp::CarpLevel = 1 ;
210+
my $callers_bitmask = (caller(1))[9] ;
211+
croak($message)
212+
if defined $callers_bitmask &&
213+
($callers_bitmask & $DeadBits{$category}) ne $NONE ;
214+
carp($message) ;
215+
}
216+
152217
1;

‎malloc.c

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -332,6 +332,13 @@
332332
} STMT_END
333333
#endif
334334

335+
#ifdef PERL_IMPLICIT_CONTEXT
336+
# define PERL_IS_ALIVE aTHX
337+
#else
338+
# define PERL_IS_ALIVE TRUE
339+
#endif
340+
341+
335342
/*
336343
* Layout of memory:
337344
* ~~~~~~~~~~~~~~~~
@@ -1513,10 +1520,21 @@ Perl_mfree(void *mp)
15131520
if (!bad_free_warn)
15141521
return;
15151522
#ifdef RCHECK
1523+
#ifdef PERL_CORE
1524+
if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
1525+
Perl_warner(WARN_MALLOC, "%s free() ignored",
1526+
ovp->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad");
1527+
#else
15161528
warn("%s free() ignored",
15171529
ovp->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad");
1530+
#endif
1531+
#else
1532+
#ifdef PERL_CORE
1533+
if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
1534+
Perl_warner(WARN_MALLOC, "%s", "Bad free() ignored");
15181535
#else
15191536
warn("%s", "Bad free() ignored");
1537+
#endif
15201538
#endif
15211539
return; /* sanity */
15221540
}
@@ -1595,11 +1613,23 @@ Perl_realloc(void *mp, size_t nbytes)
15951613
if (!bad_free_warn)
15961614
return Nullch;
15971615
#ifdef RCHECK
1616+
#ifdef PERL_CORE
1617+
if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
1618+
Perl_warner(WARN_MALLOC, "%srealloc() %signored",
1619+
(ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "),
1620+
ovp->ov_rmagic == RMAGIC - 1 ? "of freed memory " : "");
1621+
#else
15981622
warn("%srealloc() %signored",
15991623
(ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "),
16001624
ovp->ov_rmagic == RMAGIC - 1 ? "of freed memory " : "");
1625+
#endif
1626+
#else
1627+
#ifdef PERL_CORE
1628+
if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
1629+
Perl_warner(WARN_MALLOC, "%s", "Bad realloc() ignored");
16011630
#else
16021631
warn("%s", "Bad realloc() ignored");
1632+
#endif
16031633
#endif
16041634
return Nullch; /* sanity */
16051635
}

‎mg.c

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1009,7 +1009,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
10091009
else {
10101010
i = whichsig(s); /* ...no, a brick */
10111011
if (!i) {
1012-
if (ckWARN(WARN_SIGNAL) || strEQ(s,"ALARM"))
1012+
if (ckWARN(WARN_SIGNAL))
10131013
Perl_warner(aTHX_ WARN_SIGNAL, "No such signal: SIG%s", s);
10141014
return 0;
10151015
}

0 commit comments

Comments
 (0)