Skip to content

Commit 901d80a

Browse files
demerphqdemerphq
committed
pp_ctl.c - require_file: truthful errors and tests: ties are called once
We need to keep track of what we actually checked. We cannot simply report the state of @inc at the end of the require, as it might have changed, possibly several times during the require. This also accounts for most "silly" stuff that might upset our internal assumptions, for instance where a tie might report one value to the code doing the directory check and another in the error message. We had long standing tests to see that @inc tie elements where called "once" but they actually tested they were called twice despite claiming otherwise. This fixes all of those test so that a tied @inc entry is called exactly once, and whatever it returned the first time is placed in the error message. This includes a change to the require error message, so that where it once said "@inc contains:" it now says "@inc entries checked:". Note this patch requires parent v0.239 to be available (which was done in the previous commit).
1 parent c8b0222 commit 901d80a

File tree

4 files changed

+67
-30
lines changed

4 files changed

+67
-30
lines changed

‎pod/perldelta.pod‎

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -232,6 +232,37 @@ XXX Changes (i.e. rewording) of diagnostic messages go here
232232

233233
=item *
234234

235+
The error message that is produced when a C<require> or C<use> statement
236+
fails has been changed. It used to contain the words C<@INC contains:>,
237+
and it used to show the state of C<@INC> *after* the require had
238+
completed and failed. The error message has been changed to say C<@INC
239+
entries checked:> and to reflect the actual directories or hooks that
240+
were executed during the require statement. For example:
241+
242+
perl -e'push @INC, sub {@INC=()}; eval "require Frobnitz"
243+
or die $@'
244+
Can't locate Frobnitz.pm in @INC (you may need to install the
245+
Frobnitz module) (@INC contains:) at (eval 1) line 1.
246+
247+
Will change to (with some output elided for clarity):
248+
249+
perl -e'push @INC, sub {@INC=()}; eval "require Frobnitz"
250+
or die $@'
251+
Can't locate Frobnitz.pm in @INC (you may need to install the
252+
Frobnitz module) (@INC entries checked:
253+
.../site_perl/5.37.7/x86_64-linux .../site_perl/5.37.7
254+
.../5.37.7/x86_64-linux .../5.37.7 CODE(0x562745e684b8))
255+
at (eval 1) line 1.
256+
257+
thus showing the actual directories checked. Code that checks for
258+
C<@INC contains:> in error messages should be hardened against any future
259+
wording changes between the C<@INC> and C<:>, for instance use
260+
C<qr/\@INC[ \w]+:/> instead of using C<qr/\@INC contains:/> or
261+
C<qr/\@INC entries checked:/> in tests as this will ensure both forward
262+
and backward compatibility.
263+
264+
=item *
265+
235266
XXX Describe change here
236267

237268
=back

‎pp_ctl.c‎

Lines changed: 21 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -4259,6 +4259,7 @@ S_require_file(pTHX_ SV *sv)
42594259
*
42604260
* For searchable paths, just search @INC normally
42614261
*/
4262+
AV *inc_checked = (AV*)sv_2mortal((SV*)newAV());
42624263
if (!tryrsfp && !(errno == EACCES && !path_searchable)) {
42634264
SSize_t inc_idx;
42644265
#ifdef VMS
@@ -4269,9 +4270,21 @@ S_require_file(pTHX_ SV *sv)
42694270
namesv = newSV_type(SVt_PV);
42704271
AV *inc_ar = GvAVn(PL_incgv);
42714272
for (inc_idx = 0; inc_idx <= AvFILL(inc_ar); inc_idx++) {
4272-
SV * const dirsv = *av_fetch(inc_ar, inc_idx, TRUE);
4273+
SV *dirsv = *av_fetch(inc_ar, inc_idx, TRUE);
4274+
4275+
if (SvGMAGICAL(dirsv)) {
4276+
SvGETMAGIC(dirsv);
4277+
dirsv = newSVsv_nomg(dirsv);
4278+
} else {
4279+
/* on the other hand, since we aren't copying we do need
4280+
* to increment */
4281+
SvREFCNT_inc(dirsv);
4282+
}
4283+
if (!SvOK(dirsv))
4284+
continue;
4285+
4286+
av_push(inc_checked, dirsv);
42734287

4274-
SvGETMAGIC(dirsv);
42754288
if (SvROK(dirsv)) {
42764289
int count;
42774290
SV **svp;
@@ -4536,14 +4549,15 @@ S_require_file(pTHX_ SV *sv)
45364549
DIE(aTHX_ "Can't locate %s: %s: %s",
45374550
name, tryname, Strerror(saved_errno));
45384551
} else {
4539-
if (path_searchable) { /* did we lookup @INC? */
4540-
AV * const ar = GvAVn(PL_incgv);
4552+
if (path_searchable) { /* did we lookup @INC? */
45414553
SSize_t i;
45424554
SV *const msg = newSVpvs_flags("", SVs_TEMP);
45434555
SV *const inc = newSVpvs_flags("", SVs_TEMP);
4544-
for (i = 0; i <= AvFILL(ar); i++) {
4556+
for (i = 0; i <= AvFILL(inc_checked); i++) {
4557+
SV **svp= av_fetch(inc_checked, i, TRUE);
4558+
if (!svp || !*svp) continue;
45454559
sv_catpvs(inc, " ");
4546-
sv_catsv(inc, *av_fetch(ar, i, TRUE));
4560+
sv_catsv(inc, *svp);
45474561
}
45484562
if (memENDPs(name, len, ".pm")) {
45494563
const char *e = name + len - (sizeof(".pm") - 1);
@@ -4597,7 +4611,7 @@ S_require_file(pTHX_ SV *sv)
45974611

45984612
/* diag_listed_as: Can't locate %s */
45994613
DIE(aTHX_
4600-
"Can't locate %s in @INC%" SVf " (@INC contains:%" SVf ")",
4614+
"Can't locate %s in @INC%" SVf " (@INC entries checked:%" SVf ")",
46014615
name, msg, inc);
46024616
}
46034617
}

‎t/op/inccode.t‎

Lines changed: 1 addition & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -294,18 +294,14 @@ SKIP: {
294294
$$t = sub { $called ++; !1 };
295295
delete $INC{'foo.pm'}; # in case another test uses foo
296296
eval { require foo };
297-
{ local $::TODO = "Will be fixed in a follow up patch";
298297
is $INCtie::count, 1,
299298
'FETCH is called once on undef scalar-tied @INC elem';
300-
}
301299
is $called, 1, 'sub in scalar-tied @INC elem is called';
302300
() = "$INC[0]"; # force a fetch, so the SV is ROK
303301
$INCtie::count = 0;
304302
eval { require foo };
305-
{ local $::TODO = "Will be fixed in a follow up patch";
306303
is $INCtie::count, 1,
307304
'FETCH is called once on scalar-tied @INC elem holding ref';
308-
}
309305
is $called, 2, 'sub in scalar-tied @INC elem holding ref is called';
310306
$$t = [];
311307
$INCtie::count = 0;
@@ -315,10 +311,8 @@ SKIP: {
315311
$$t = "string";
316312
$INCtie::count = 0;
317313
eval { require foo };
318-
{ local $::TODO = "Will be fixed in a follow up patch";
319314
is $INCtie::count, 1,
320315
'FETCH called once on scalar-tied @INC elem returning string';
321-
}
322316
}
323317

324318

@@ -409,7 +403,7 @@ SKIP:{
409403
fresh_perl_like('@INC=("A",bless({},"Hook"),"D"); '
410404
.'sub Hook::INCDIR { return "B","C"} '
411405
.'eval "require Frobnitz" or print $@;',
412-
qr/\(\@INC contains: A Hook=HASH\(0x[A-Fa-f0-9]+\) B C D\)/,
406+
qr/\(\@INC[\w ]+: A Hook=HASH\(0x[A-Fa-f0-9]+\) B C D\)/,
413407
{},
414408
"Check if INCDIR hook works as expected");
415409
}

‎t/op/require_errors.t‎

Lines changed: 14 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,7 @@ for my $file ($nonfile, ' ') {
2727
require $file;
2828
};
2929

30-
like $@, qr/^Can't locate $file in \@INC \(\@INC contains: \Q@INC\E\) at/,
30+
like $@, qr/^Can't locate $file in \@INC \(\@INC[\w ]+: \Q@INC\E\) at/,
3131
"correct error message for require '$file'";
3232
}
3333

@@ -91,7 +91,7 @@ for my $file ($nonfile, ' ') {
9191
$hint =~ s/\.pm$//;
9292
$exp .= " (you may need to install the $hint module)";
9393
}
94-
$exp .= " (\@INC contains: @INC) at";
94+
$exp .= " (\@INC entries checked: @INC) at";
9595
}
9696
else {
9797
# undef implies a require which doesn't compile,
@@ -139,14 +139,14 @@ eval {
139139
require "$nonfile.ph";
140140
};
141141

142-
like $@, qr/^Can't locate $nonfile\.ph in \@INC \(did you run h2ph\?\) \(\@INC contains: @INC\) at/;
142+
like $@, qr/^Can't locate $nonfile\.ph in \@INC \(did you run h2ph\?\) \(\@INC[\w ]+: @INC\) at/;
143143

144144
for my $file ("$nonfile.h", ".h") {
145145
eval {
146146
require $file
147147
};
148148

149-
like $@, qr/^Can't locate \Q$file\E in \@INC \(change \.h to \.ph maybe\?\) \(did you run h2ph\?\) \(\@INC contains: @INC\) at/,
149+
like $@, qr/^Can't locate \Q$file\E in \@INC \(change \.h to \.ph maybe\?\) \(did you run h2ph\?\) \(\@INC[\w ]+: @INC\) at/,
150150
"correct error message for require '$file'";
151151
}
152152

@@ -155,7 +155,7 @@ for my $file ("$nonfile.ph", ".ph") {
155155
require $file
156156
};
157157

158-
like $@, qr/^Can't locate \Q$file\E in \@INC \(did you run h2ph\?\) \(\@INC contains: @INC\) at/,
158+
like $@, qr/^Can't locate \Q$file\E in \@INC \(did you run h2ph\?\) \(\@INC[\w ]+: @INC\) at/,
159159
"correct error message for require '$file'";
160160
}
161161

@@ -311,24 +311,22 @@ like $@, qr/^Can't locate \Q$nonsearch\E at/,
311311
{ }, 'Inc hooks have the correct cop_file');
312312
}
313313
{
314-
local $::TODO = "Pending segfault fix";
315314
# this can segfault or assert prior to @INC hardening.
316315
fresh_perl_like(
317316
'unshift @INC, sub { *INC=["a","b"] }; '
318317
.'eval "require Frobnitz" or print $@',
319-
qr!\(\@INC contains: CODE\(0x[A-Fa-f0-9]+\) b\)!,
318+
qr!\(\@INC[\w ]+: CODE\(0x[A-Fa-f0-9]+\) b\)!,
320319
{ }, 'INC hooks do not segfault when overwritten');
321320
}
322321
{
323-
local $::TODO = "Pending error message improvement";
324322
# this is the defined behavior, but in older perls the error message
325323
# would lie and say "contains: a b", which is true in the sense that
326324
# it is the value of @INC after the require, but not the directory
327325
# list that was looked at.
328326
fresh_perl_like(
329327
'@INC = (sub { @INC=("a","b"); () }, "z"); '
330328
.'eval "require Frobnitz" or print $@',
331-
qr!\(\@INC contains: CODE\(0x[A-Fa-f0-9]+\) b\)!,
329+
qr!\(\@INC[\w ]+: CODE\(0x[A-Fa-f0-9]+\) b\)!,
332330
{ }, 'INC hooks that overwrite @INC continue as expected (skips a and z)');
333331
}
334332
{
@@ -337,7 +335,7 @@ like $@, qr/^Can't locate \Q$nonsearch\E at/,
337335
fresh_perl_like(
338336
'@INC = (sub { @INC=qw(a b); undef $INC }, "z"); '
339337
.'eval "require Frobnitz" or print $@',
340-
qr!\(\@INC contains: CODE\(0x[A-Fa-f0-9]+\) a b\)!,
338+
qr!\(\@INC[\w ]+: CODE\(0x[A-Fa-f0-9]+\) a b\)!,
341339
{ }, 'INC hooks that overwrite @INC and undef $INC continue at start');
342340
}
343341
{
@@ -347,7 +345,7 @@ like $@, qr/^Can't locate \Q$nonsearch\E at/,
347345
'sub CB::INCDIR { return "b", "c","d" }; '
348346
.'@INC = ("a",bless({},"CB"),"e");'
349347
.'eval "require Frobnitz" or print $@',
350-
qr!\(\@INC contains: a CB=HASH\(0x[A-Fa-f0-9]+\) b c d e\)!,
348+
qr!\(\@INC[\w ]+: a CB=HASH\(0x[A-Fa-f0-9]+\) b c d e\)!,
351349
{ }, 'INCDIR works as expected');
352350
}
353351
{
@@ -356,7 +354,7 @@ like $@, qr/^Can't locate \Q$nonsearch\E at/,
356354
fresh_perl_like(
357355
'@INC = ("a",bless({},"CB"),"e");'
358356
.'eval "require Frobnitz" or print $@',
359-
qr!\(\@INC contains: a CB=HASH\(0x[A-Fa-f0-9]+\) e\)!,
357+
qr!\(\@INC[\w ]+: a CB=HASH\(0x[A-Fa-f0-9]+\) e\)!,
360358
{ }, 'Objects with no INC or INCDIR method are stringified');
361359
}
362360
{
@@ -366,7 +364,7 @@ like $@, qr/^Can't locate \Q$nonsearch\E at/,
366364
'{package CB; use overload qw("")=>sub { "blorg"};} '
367365
.'@INC = ("a",bless({},"CB"),"e");'
368366
.'eval "require Frobnitz" or print $@',
369-
qr!\(\@INC contains: a blorg e\)!,
367+
qr!\(\@INC[\w ]+: a blorg e\)!,
370368
{ }, 'Objects with overload and no INC or INCDIR method are stringified');
371369
}
372370
{
@@ -375,7 +373,7 @@ like $@, qr/^Can't locate \Q$nonsearch\E at/,
375373
fresh_perl_like(
376374
'@INC = ("a",bless(sub { warn "blessed sub called" },"CB"),"e");'
377375
.'eval "require Frobnitz" or print $@',
378-
qr!blessed sub called.*\(\@INC contains: a CB=CODE\(0x[a-fA-F0-9]+\) e\)!s,
376+
qr!blessed sub called.*\(\@INC[\w ]+: a CB=CODE\(0x[a-fA-F0-9]+\) e\)!s,
379377
{ }, 'Blessed subs with no hook methods are executed');
380378
}
381379
{
@@ -412,7 +410,7 @@ like $@, qr/^Can't locate \Q$nonsearch\E at/,
412410
'sub CB::INCDIR { "i" } sub CB2::INCDIR { }'
413411
.'@INC = ("a",bless(sub{"b"},"CB"),bless(sub{"c"},"CB2"),"e");'
414412
.'eval "require Frobnitz" or print $@',
415-
qr!\(\@INC contains: a CB=CODE\(0x[a-fA-F0-9]+\) i CB2=CODE\(0x[a-fA-F0-9]+\) e\)!s,
413+
qr!\(\@INC[\w ]+: a CB=CODE\(0x[a-fA-F0-9]+\) i CB2=CODE\(0x[a-fA-F0-9]+\) e\)!s,
416414
{ }, 'Blessed subs with INCDIR methods call INCDIR');
417415
}
418416
{
@@ -422,6 +420,6 @@ like $@, qr/^Can't locate \Q$nonsearch\E at/,
422420
'sub CB::INCDIR { return @{$_[2]} }'
423421
.'@INC = ("a",[bless([],"CB"),"b"],"c");'
424422
.'eval "require Frobnitz" or print $@',
425-
qr!\(\@INC contains: a ARRAY\(0x[a-fA-F0-9]+\) CB=ARRAY\(0x[a-fA-F0-9]+\) b c\)!s,
423+
qr!\(\@INC[\w ]+: a ARRAY\(0x[a-fA-F0-9]+\) CB=ARRAY\(0x[a-fA-F0-9]+\) b c\)!s,
426424
{ }, 'INCDIR ref returns are stringified');
427425
}

0 commit comments

Comments
 (0)