DB::files() and DB::loadfile() failing to locate files

[jkeenan]

Consider the following file, which is adapted from lib/DB.t in the Perl core distribution:

# $ cat lib/DB-small.t 
#!./perl -Tw

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
    require Config;
    if (($Config::Config{'extensions'} !~ m!\bList/Util\b!) ){
        print "1..0 # Skip -- Perl configured without List::Util module\n";
        exit 0;
    }
}

# symbolic references used later
use strict qw( vars subs );
use Data::Dumper;

# @DB::dbline values have both integer and string components (Benjamin Goldberg)
use Scalar::Util qw( dualvar );
my $dualfalse = dualvar(0, 'false');
my $dualtrue = dualvar(1, 'true');

use Test::More qw(no_plan); # tests => 106;

# must happen at compile time for DB:: package variable localizations to work
BEGIN {
        use_ok( 'DB' );
}

# test DB::DB()
{ 
        ok( ! defined DB::DB(), 
                'DB::DB() should return undef if $DB::ready is false');
        is( DB::catch(), 1, 'DB::catch() should work' );
        is( DB->skippkg('foo'), 1, 'DB->skippkg() should push args' );

        # change packages to mess with caller()
        package foo;
        ::ok( ! defined DB::DB(), 'DB::DB() should skip skippable packages' );

        package main;
        is( $DB::filename, $0, '... should set $DB::filename' );
        is( $DB::lineno, __LINE__ - 4, '... should set $DB::lineno' );

        DB::DB();
        # stops at line 94
}


# test DB::files()
{
        my $dbf = () = DB::files();
my @temp = DB::files();
for (@temp[0..4]) { if (length $_) { print "AAA: $_\n"; } }
@temp = grep { /\.pm/ } keys %main::;
for (@temp[0..4]) { if (length $_) { print "BBB: $_\n"; } }
        my $main = () = grep ( m!^_<!, keys %main:: );
print "CCC: $main\n";
        is( $dbf, $main, 'DB::files() should pick up filenames from %main::' );
}

# test DB::lines()
{
        local @DB::dbline = ( 'foo' );
        is( DB->lines->[0], 'foo', 'DB::lines() should return ref to @DB::dbline' );
}

# test DB::loadfile()
SKIP: {
print "WWW: $_\n" for @DB::dbline;
        local (*DB::dbline, $DB::filename);
print "XXX: $DB::filename\n";
print Dumper \*DB::dbline;
        ok( ! defined DB->loadfile('notafile'),
                'DB::loadfile() should not find unloaded file' );
my @temp = grep { /\.pm/ } keys %main::;
for (@temp[0..4]) { if (length $_) { print "YYY: $_\n"; } }
        my $file = (grep { m|^_<.+\.pm| } keys %main:: )[0];
        skip('cannot find loaded file', 3) unless $file;
        $file =~ s/^_<..//;

        my $db = DB->loadfile($file);
        like( $db, qr!$file\z!, '... should find loaded file from partial name');

        is( *DB::dbline, *{ "_<$db" } , 
                '... should set *DB::dbline to associated glob');
        is( $DB::filename, $db, '... should set $DB::filename to file name' );

        # test clients
}

The file essentially consists of 4 blocks from the original file, hacked up with debugging code and one Data::Dumper call. Our focus will be on blocks 2 and 4.

If we place this inside the Perl 5 core distribution and run it, we get this output:

$ ./perl -Ilib -T lib/DB-small.t 
ok 1 - use DB;
ok 2 - DB::DB() should return undef if $DB::ready is false
ok 3 - DB::catch() should work
ok 4 - DB->skippkg() should push args
ok 5 - DB::DB() should skip skippable packages
ok 6 - ... should set $DB::filename
ok 7 - ... should set $DB::lineno
AAA: ../lib/Test2/EventFacet/Control.pm
AAA: ../lib/Test2/Hub/Interceptor.pm
AAA: ../lib/Test2/Formatter/TAP.pm
AAA: ../lib/Test2/Event/V2.pm
AAA: ../lib/Test2/Event/Pass.pm
BBB: _<../lib/Test2/EventFacet/Control.pm
BBB: _<../lib/Test2/Hub/Interceptor.pm
BBB: _<../lib/Test2/Formatter/TAP.pm
BBB: _<../lib/Test2/Event/V2.pm
BBB: _<../lib/Test2/Event/Pass.pm
CCC: 70
ok 8 - DB::files() should pick up filenames from %main::
ok 9 - DB::lines() should return ref to @DB::dbline
XXX: 
$VAR1 = \*DB::dbline;
ok 10 - DB::loadfile() should not find unloaded file
YYY: _<../lib/constant.pm
YYY: _<../lib/Test2/EventFacet/About.pm
YYY: _<../lib/Test2/EventFacet/Amnesty.pm
YYY: _<../lib/Test2/EventFacet/Assert.pm
YYY: _<../lib/Test2/Event/Skip.pm
ok 11 - ... should find loaded file from partial name
ok 12 - ... should set *DB::dbline to associated glob
ok 13 - ... should set $DB::filename to file name
1..13

If, however, we run this against Perl 7 -- I'll temporarily included it in the distribution in the alpha-dev-02-strict branch -- we get different output.

 ./perl -Ilib -T lib/DB-small.t
ok 1 - use DB;
ok 2 - DB::DB() should return undef if $DB::ready is false
ok 3 - DB::catch() should work
ok 4 - DB->skippkg() should push args
ok 5 - DB::DB() should skip skippable packages
ok 6 - ... should set $DB::filename
ok 7 - ... should set $DB::lineno
AAA: lib/DB-small.t
AAA: (eval in cmp_ok) lib/DB-small.t
CCC: 2
ok 8 - DB::files() should pick up filenames from %main::
ok 9 - DB::lines() should return ref to @DB::dbline
XXX: 
$VAR1 = \*DB::dbline;
ok 10 - DB::loadfile() should not find unloaded file
ok 11 # skip cannot find loaded file
ok 12 # skip cannot find loaded file
ok 13 # skip cannot find loaded file
1..13

Note that in Perl 7 we're not picking up the .pm files we are in Perl 5 at AAA in Block 2. We're not picking up any files at BBB. CCC suggests we're failing to find 68 files that we would find in blead.
And because in Block 4 we're not picking up any files at YYY, the test is skipping the last 3 tests rather than running them against properly located files.

At this point in the branch's development, there have been no changes yet in lib/DB.pm.

$ diff -w lib/DB.pm ~/gitwork/perl/lib/DB.pm
[no output]

And the only change in lib/dumpvar.pl that I've made is to insert an explicit no strict; (cf. #193).

[perl-atoomic-2] 528 $ diff -w lib/dumpvar.pl ~/gitwork/perl/lib/dumpvar.pl
3d2
< no strict;

So I suspect the problem lies in other code I've touched or mangled, perhaps in ext/B or `lib/B'.

Note: As it stands in the branch, lib/DB.t is not strict-compliant. When I went through it to insert no strict 'refs' and similar statements in an attempt to get it to be strict-compliant, I came to a point where I had to insert a relaxation of strictures into one part of lib/DB.pm. When I then ran lib/DB.t, it froze my system and I had to do a hard reboot. Hence, in lib/DB-small.t, I've removed all code below the relevant blocks, because the places where lib/DB.t were not strict-compliant all fell below those blocks.

@atoomic @toddr

Thank you very much.
Jim Keenan

[atoomic]

When using alpha-dev-02-strict branch at commit 873afb5
I got a different output then yours, very close to the Perl 5 output.
But as you can see there is a strict issue when doing this is( *DB::dbline, *{ "_<$db" }, ...

╰─> ./perl x.t
ok 1 - use DB;
ok 2 - DB::DB() should return undef if $DB::ready is false
ok 3 - DB::catch() should work
ok 4 - DB->skippkg() should push args
ok 5 - DB::DB() should skip skippable packages
ok 6 - ... should set $DB::filename
ok 7 - ... should set $DB::lineno
AAA: ../lib/Test2/EventFacet/Parent.pm
AAA: ../lib/DB.pm
AAA: ../lib/Test2/Hub/Interceptor.pm
AAA: ../lib/Test2/EventFacet/Hub.pm
AAA: x.t
BBB: _<../lib/Test2/EventFacet/Parent.pm
BBB: _<../lib/DB.pm
BBB: _<../lib/Test2/Hub/Interceptor.pm
BBB: _<../lib/Test2/EventFacet/Hub.pm
BBB: _<../lib/XSLoader.pm
CCC: 70
ok 8 - DB::files() should pick up filenames from %main::
ok 9 - DB::lines() should return ref to @DB::dbline
XXX:
$VAR1 = \*DB::dbline;
ok 10 - DB::loadfile() should not find unloaded file
YYY: _<../lib/Test2/EventFacet/Amnesty.pm
YYY: _<../lib/Test2/Event/Fail.pm
YYY: _<../lib/Tie/Hash.pm
YYY: _<../lib/Test2/EventFacet.pm
YYY: _<../lib/base.pm
ok 11 - ... should find loaded file from partial name
Can't use string ("_<../lib/Test2/EventFacet/Amnest"...) as a symbol ref while "strict refs" in use at x.t line 82.
1..11
# Looks like your test exited with 255 just after 11.

[jkeenan]

When using alpha-dev-02-strict branch at commit 873afb5
I got a different output then yours, very close to the Perl 5 output.
But as you can see there is a strict issue when doing this is( *DB::dbline, *{ "_<$db" }, ...

╰─> ./perl x.t

What do you get if you say:

./perl -Ilib -T x.t

... where I assume that x.t is the same as lib/DB-small.t? And shouldn't you be placing this file in the lib/ subdir?

Thank you very much.
Jim Keenan

[atoomic]

yes it's the file above, I should have removed its name from the output and forgot about it...

╰─> ./perl -Ilib -T x.t
ok 1 - use DB;
ok 2 - DB::DB() should return undef if $DB::ready is false
ok 3 - DB::catch() should work
ok 4 - DB->skippkg() should push args
ok 5 - DB::DB() should skip skippable packages
ok 6 - ... should set $DB::filename
ok 7 - ... should set $DB::lineno
AAA: ../lib/Test2/EventFacet/Amnesty.pm
AAA: ../lib/Test2/EventFacet/Meta.pm
AAA: ../lib/Test2/Event/Ok.pm
AAA: ../lib/Test2/Event/Fail.pm
AAA: ../lib/Test2/Event/Waiting.pm
BBB: _<../lib/Test2/EventFacet/Amnesty.pm
BBB: _<../lib/Test2/EventFacet/Meta.pm
BBB: _<../lib/Test2/Event/Ok.pm
BBB: _<../lib/Test2/Event/Fail.pm
BBB: _<../lib/Test2/Event/Waiting.pm
CCC: 70
ok 8 - DB::files() should pick up filenames from %main::
ok 9 - DB::lines() should return ref to @DB::dbline
XXX:
$VAR1 = \*DB::dbline;
ok 10 - DB::loadfile() should not find unloaded file
YYY: _<../lib/Test/Builder/Module.pm
YYY: _<../lib/XSLoader.pm
YYY: _<../lib/Test2/EventFacet/Control.pm
YYY: _<../lib/Config.pm
YYY: _<../lib/Test2/Util/Facets2Legacy.pm
ok 11 - ... should find loaded file from partial name
Can't use string ("_<../lib/Test/Builder/Module.pm") as a symbol ref while "strict refs" in use at x.t line 82.
1..11
# Looks like your test exited with 255 just after 11.

I left the file in the root directory and adjusted the inc setup unshift @INC, '../lib';

[jkeenan]

The problem described in this ticket is not of our doing. lib/DB.t performs differently on threaded builds versus unthreaded builds in Perl 5. Apparently this has always been the case since the file was first introduced in 2001 as discussed in the Perl 5 ticket cited above.

The file passes with 3 skips in one case and passes with those 3 tests run in the other. So this is not something we have to worry about or can do anything about. Closing.

Thank you very much.
Jim Keenan