Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

perl5db.t fails and crashes when trying to install Perl 5.25.9 #15782

Closed
p5pRT opened this issue Dec 29, 2016 · 10 comments
Labels

Comments

@p5pRT
Copy link
Collaborator

@p5pRT p5pRT commented Dec 29, 2016

Migrated from rt.perl.org#130445 (status was 'resolved')

Searchable as RT130445$

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 29, 2016

From @hakonhagland

Hi.

The script lib/perl5db.t fails when trying to install Perl 5.25.9 on my
Ubuntu laptop.

Here is the commands I ran after having cloned the Perl 5 Git
repository​:

sh Configure -de -Dprefix='/opt/perl/blead' -Dusedevel
make
make test

Some relevant output from "make test" :

lib/Net/servent ................................................ ok
lib/open ....................................................... ok
lib/overload ................................................... ok
lib/overload64 ................................................. ok
lib/overloading ................................................ ok
lib/perl5db ....................................................

# Failed test 19 - Can set breakpoint in a line in the middle of the file.
at ../lib/perl5db.t line 555
# got 'In MyModule.\nIn Main File.\n'
# expected /(?^msx​:
# ^Var=Bar$
# .*
# ^In\ MyModule\.$
# .*
# ^In\ Main\ File\.$
# .*
# )/
#

Then, several other tests also fail in lib/perl5db.t; the last one is
number 118​:

# Failed test 118 - Test w for lexical values. at ../lib/perl5db.t line 2691
# got ''
# expected /(?^msx​:
# \s+old\ value​:\s+'1'\n
# \s+new\ value​:\s+'2'\n
# )/

After this it seems "make test" crashes. I must press CTRL-C to exit "make
test", or if
I don't interrupt with CTRL-C, and wait some minutes (as I did the
first time) my laptop freezes (i.e. becomes unreponsive to input) after a
while (I can hear the disk is very active, though).

The complete log from running Configure, make, and "make test" is
here​:

http​://pastebin.com/Ds2hxd2s

Also note, I had a similar problem two years ago​:

http​://stackoverflow.com/q/28433032/2173773

So there seems to be something with my system that confuses the
perl5db.t script.

Best regards,
Håkon Hægland

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 30, 2016

From @jkeenan

On Thu, 29 Dec 2016 21​:54​:58 GMT, hakon.hagland@​gmail.com wrote​:

Hi.

The script lib/perl5db.t fails when trying to install Perl 5.25.9 on my
Ubuntu laptop.

Here is the commands I ran after having cloned the Perl 5 Git
repository​:

sh Configure -de -Dprefix='/opt/perl/blead' -Dusedevel
make
make test

Some relevant output from "make test" :

lib/Net/servent ................................................ ok
lib/open ....................................................... ok
lib/overload ................................................... ok
lib/overload64 ................................................. ok
lib/overloading ................................................ ok
lib/perl5db ....................................................

# Failed test 19 - Can set breakpoint in a line in the middle of the file.
at ../lib/perl5db.t line 555
# got 'In MyModule.\nIn Main File.\n'
# expected /(?^msx​:
# ^Var=Bar$
# .*
# ^In\ MyModule\.$
# .*
# ^In\ Main\ File\.$
# .*
# )/
#

Then, several other tests also fail in lib/perl5db.t; the last one is
number 118​:

# Failed test 118 - Test w for lexical values. at ../lib/perl5db.t line 2691
# got ''
# expected /(?^msx​:
# \s+old\ value​:\s+'1'\n
# \s+new\ value​:\s+'2'\n
# )/

After this it seems "make test" crashes. I must press CTRL-C to exit "make
test", or if
I don't interrupt with CTRL-C, and wait some minutes (as I did the
first time) my laptop freezes (i.e. becomes unreponsive to input) after a
while (I can hear the disk is very active, though).

The complete log from running Configure, make, and "make test" is
here​:

http​://pastebin.com/Ds2hxd2s

Also note, I had a similar problem two years ago​:

http​://stackoverflow.com/q/28433032/2173773

So there seems to be something with my system that confuses the
perl5db.t script.

Best regards,
Håkon Hægland

Can you provide the output of './perl -Ilib -V' from the build of perl after which this error occurred? Please attach it, preferably with a '.txt' extension to this ticket or your email response.

Thank you very much.

--
James E Keenan (jkeenan@​cpan.org)

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 30, 2016

The RT System itself - Status changed from 'new' to 'open'

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 30, 2016

From @jkeenan

On Fri, 30 Dec 2016 13​:35​:40 GMT, jkeenan wrote​:

On Thu, 29 Dec 2016 21​:54​:58 GMT, hakon.hagland@​gmail.com wrote​:

Hi.

The script lib/perl5db.t fails when trying to install Perl 5.25.9 on
my
Ubuntu laptop.

Here is the commands I ran after having cloned the Perl 5 Git
repository​:

sh Configure -de -Dprefix='/opt/perl/blead' -Dusedevel
make
make test

Some relevant output from "make test" :

lib/Net/servent ................................................ ok
lib/open ....................................................... ok
lib/overload ................................................... ok
lib/overload64 ................................................. ok
lib/overloading ................................................ ok
lib/perl5db ....................................................

# Failed test 19 - Can set breakpoint in a line in the middle of the
file.
at ../lib/perl5db.t line 555
# got 'In MyModule.\nIn Main File.\n'
# expected /(?^msx​:
# ^Var=Bar$
# .*
# ^In\ MyModule\.$
# .*
# ^In\ Main\ File\.$
# .*
# )/
#

Then, several other tests also fail in lib/perl5db.t; the last one is
number 118​:

# Failed test 118 - Test w for lexical values. at ../lib/perl5db.t
line 2691
# got ''
# expected /(?^msx​:
# \s+old\ value​:\s+'1'\n
# \s+new\ value​:\s+'2'\n
# )/

After this it seems "make test" crashes. I must press CTRL-C to exit
"make
test", or if
I don't interrupt with CTRL-C, and wait some minutes (as I did the
first time) my laptop freezes (i.e. becomes unreponsive to input)
after a
while (I can hear the disk is very active, though).

The complete log from running Configure, make, and "make test" is
here​:

http​://pastebin.com/Ds2hxd2s

Also note, I had a similar problem two years ago​:

http​://stackoverflow.com/q/28433032/2173773

So there seems to be something with my system that confuses the
perl5db.t script.

Best regards,
Håkon Hægland

Can you provide the output of './perl -Ilib -V' from the build of perl
after which this error occurred? Please attach it, preferably with a
'.txt' extension to this ticket or your email response.

Thank you very much.

Also, can you create a git branch to which you apply the attached patch, configure and build perl (up through 'make test_prep') and then run the file in the attachment by itself (./perl -Ilib lib/xperl5db.t) and attach the output?

Thank you very much.

--
James E Keenan (jkeenan@​cpan.org)

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 30, 2016

From @jkeenan

0001-For-diagnosis-cut-down-the-test-file-to-the-first-fa.patch
From 735a87dcb4d56316cba387ea2f4bfd454a0fa77c Mon Sep 17 00:00:00 2001
From: James E Keenan <jkeenan@cpan.org>
Date: Fri, 30 Dec 2016 09:33:19 -0500
Subject: [PATCH] For diagnosis, cut down the test file to the first failing
 test.

---
 lib/xperl5db.t | 571 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 571 insertions(+)
 create mode 100644 lib/xperl5db.t

diff --git a/lib/xperl5db.t b/lib/xperl5db.t
new file mode 100644
index 0000000..fbd12b3
--- /dev/null
+++ b/lib/xperl5db.t
@@ -0,0 +1,571 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+use strict;
+use warnings;
+use Config;
+use feature 'say';
+use Data::Dumper;
+
+BEGIN {
+    if (! -c "/dev/null") {
+        print "1..0 # Skip: no /dev/null\n";
+        exit 0;
+    }
+
+    my $dev_tty = '/dev/tty';
+    $dev_tty = 'TT:' if ($^O eq 'VMS');
+    if (! -c $dev_tty) {
+        print "1..0 # Skip: no $dev_tty\n";
+        exit 0;
+    }
+    if ($ENV{PERL5DB}) {
+        print "1..0 # Skip: \$ENV{PERL5DB} is already set to '$ENV{PERL5DB}'\n";
+        exit 0;
+    }
+    $ENV{PERL_RL} = 'Perl'; # Suppress system Term::ReadLine::Gnu
+}
+
+plan(19);
+
+my $rc_filename = '.perldb';
+
+sub rc {
+    open my $rc_fh, '>', $rc_filename
+        or die $!;
+    print {$rc_fh} @_;
+    close ($rc_fh);
+
+    # overly permissive perms gives "Must not source insecure rcfile"
+    # and hangs at the DB(1> prompt
+    chmod 0644, $rc_filename;
+}
+
+sub _slurp
+{
+    my $filename = shift;
+
+    open my $in, '<', $filename
+        or die "Cannot open '$filename' for slurping - $!";
+
+    local $/;
+    my $contents = <$in>;
+
+    close($in);
+
+    return $contents;
+}
+
+my $out_fn = 'db.out';
+
+sub _out_contents
+{
+    return _slurp($out_fn);
+}
+
+
+# Test for Proxy constants
+{
+    rc(
+        <<'EOF',
+
+&parse_options("NonStop=0 ReadLine=0 TTY=db.out");
+
+sub afterinit {
+    push(@DB::typeahead,
+        'm main->s1',
+        'q',
+    );
+}
+
+EOF
+    );
+
+    my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/proxy-constants');
+    is($output, "", "proxy constant subroutines");
+}
+
+# [perl #66110] Call a subroutine inside a regex
+{
+    local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
+    my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-66110');
+    like($output, qr/\bAll tests successful\.$/, "[perl #66110]");
+}
+# [ perl #116769] Frame=2
+{
+    local $ENV{PERLDB_OPTS} = "frame=2 nonstop";
+    my $output = runperl( switches => [ '-d' ], prog => 'print qq{success\n}' );
+    is( $?, 0, '[perl #116769] frame=2 does not crash debugger, exit == 0' );
+    is( $output, "success\n" , '[perl #116769] code is run' );
+}
+# [ perl #116771] autotrace
+{
+    local $ENV{PERLDB_OPTS} = "autotrace nonstop";
+    my $output = runperl( switches => [ '-d' ], prog => 'print qq{success\n}' );
+    is( $?, 0, '[perl #116771] autotrace does not crash debugger, exit == 0' );
+    is( $output, "success\n" , '[perl #116771] code is run' );
+}
+# [ perl #41461] Frame=2 noTTY
+{
+    local $ENV{PERLDB_OPTS} = "frame=2 noTTY nonstop";
+    rc('');
+    my $output = runperl( switches => [ '-d' ], prog => 'print qq{success\n}' );
+    is( $?, 0, '[perl #41461] frame=2 noTTY does not crash debugger, exit == 0' );
+    is( $output, "success\n" , '[perl #41461] code is run' );
+}
+
+package DebugWrap;
+
+sub new {
+    my $class = shift;
+
+    my $self = bless {}, $class;
+
+    $self->_init(@_);
+
+    return $self;
+}
+
+sub _cmds {
+    my $self = shift;
+
+    if (@_) {
+        $self->{_cmds} = shift;
+    }
+
+    return $self->{_cmds};
+}
+
+sub _prog {
+    my $self = shift;
+
+    if (@_) {
+        $self->{_prog} = shift;
+    }
+
+    return $self->{_prog};
+}
+
+sub _output {
+    my $self = shift;
+
+    if (@_) {
+        $self->{_output} = shift;
+    }
+
+    return $self->{_output};
+}
+
+sub _include_t
+{
+    my $self = shift;
+
+    if (@_)
+    {
+        $self->{_include_t} = shift;
+    }
+
+    return $self->{_include_t};
+}
+
+sub _stderr_val
+{
+    my $self = shift;
+
+    if (@_)
+    {
+        $self->{_stderr_val} = shift;
+    }
+
+    return $self->{_stderr_val};
+}
+
+sub field
+{
+    my $self = shift;
+
+    if (@_)
+    {
+        $self->{field} = shift;
+    }
+
+    return $self->{field};
+}
+
+sub _switches
+{
+    my $self = shift;
+
+    if (@_)
+    {
+        $self->{_switches} = shift;
+    }
+
+    return $self->{_switches};
+}
+
+sub _contents
+{
+    my $self = shift;
+
+    if (@_)
+    {
+        $self->{_contents} = shift;
+    }
+
+    return $self->{_contents};
+}
+
+sub _init
+{
+    my ($self, $args) = @_;
+
+    my $cmds = $args->{cmds};
+
+    if (ref($cmds) ne 'ARRAY') {
+        die "cmds must be an array of commands.";
+    }
+
+    $self->_cmds($cmds);
+
+    my $prog = $args->{prog};
+
+    if (ref($prog) ne '' or !defined($prog)) {
+        die "prog should be a path to a program file.";
+    }
+
+    $self->_prog($prog);
+
+    $self->_include_t($args->{include_t} ? 1 : 0);
+
+    $self->_stderr_val(exists($args->{stderr}) ? $args->{stderr} : 1);
+
+    if (exists($args->{switches}))
+    {
+        $self->_switches($args->{switches});
+    }
+
+    $self->_run();
+
+    return;
+}
+
+sub _quote
+{
+    my ($self, $str) = @_;
+
+    $str =~ s/(["\@\$\\])/\\$1/g;
+    $str =~ s/\n/\\n/g;
+    $str =~ s/\r/\\r/g;
+
+    return qq{"$str"};
+}
+
+sub _run {
+    my $self = shift;
+
+    my $rc = qq{&parse_options("NonStop=0 TTY=db.out");\n};
+
+    $rc .= join('',
+        map { "$_\n"}
+        (q#sub afterinit {#,
+         q#push (@DB::typeahead,#,
+         (map { $self->_quote($_) . "," } @{$self->_cmds()}),
+         q#);#,
+         q#}#,
+        )
+    );
+
+    # I guess two objects like that cannot be used at the same time.
+    # Oh well.
+    ::rc($rc);
+
+    my $output =
+        ::runperl(
+            switches =>
+            [
+                ($self->_switches ? (@{$self->_switches()}) : ('-d')),
+                ($self->_include_t ? ('-I', '../lib/perl5db/t') : ())
+            ],
+            (defined($self->_stderr_val())
+                ? (stderr => $self->_stderr_val())
+                : ()
+            ),
+            progfile => $self->_prog()
+        );
+
+    $self->_output($output);
+
+    $self->_contents(::_out_contents());
+
+    return;
+}
+
+sub get_output
+{
+    return shift->_output();
+}
+
+sub output_like {
+    my ($self, $re, $msg) = @_;
+
+    local $::Level = $::Level + 1;
+    ::like($self->_output(), $re, $msg);
+}
+
+sub output_unlike {
+    my ($self, $re, $msg) = @_;
+
+    local $::Level = $::Level + 1;
+    ::unlike($self->_output(), $re, $msg);
+}
+
+sub contents_like {
+    my ($self, $re, $msg) = @_;
+
+    local $::Level = $::Level + 1;
+    ::like($self->_contents(), $re, $msg);
+}
+
+sub contents_unlike {
+    my ($self, $re, $msg) = @_;
+
+    local $::Level = $::Level + 1;
+    ::unlike($self->_contents(), $re, $msg);
+}
+
+package main;
+
+{
+    local $ENV{PERLDB_OPTS} = "ReadLine=0";
+    my $target = '../lib/perl5db/t/eval-line-bug';
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'b 23',
+                'n',
+                'n',
+                'n',
+                'c', # line 23
+                'n',
+                "p \@{'main::_<$target'}",
+                'q',
+            ],
+            prog => $target,
+        }
+    );
+    $wrapper->contents_like(
+        qr/sub factorial/,
+        'The ${main::_<filename} variable in the debugger was not destroyed',
+    );
+}
+
+sub _calc_generic_wrapper
+{
+    my $args = shift;
+
+    my $extra_opts = delete($args->{extra_opts});
+    $extra_opts ||= '';
+    local $ENV{PERLDB_OPTS} = "ReadLine=0" . $extra_opts;
+    return DebugWrap->new(
+        {
+            cmds => delete($args->{cmds}),
+            prog => delete($args->{prog}),
+            %$args,
+        }
+    );
+}
+
+sub _calc_new_var_wrapper
+{
+    my ($args) = @_;
+    return _calc_generic_wrapper(
+        {
+            cmds =>
+            [
+                'b 23',
+                'c',
+                '$new_var = "Foo"',
+                'x "new_var = <$new_var>\\n"',
+                'q',
+            ],
+            %$args,
+        }
+    );
+}
+
+sub _calc_threads_wrapper
+{
+    my $args = shift;
+
+    return _calc_new_var_wrapper(
+        {
+            switches => [ '-dt', ],
+            stderr => 1,
+            %$args
+        }
+    );
+}
+
+{
+    _calc_new_var_wrapper({ prog => '../lib/perl5db/t/eval-line-bug'})
+        ->contents_like(
+            qr/new_var = <Foo>/,
+            "no strict 'vars' in evaluated lines.",
+        );
+}
+
+{
+    _calc_new_var_wrapper(
+        {
+            prog => '../lib/perl5db/t/lvalue-bug',
+            stderr => undef(),
+        },
+    )->output_like(
+            qr/foo is defined/,
+             'lvalue subs work in the debugger',
+         );
+}
+
+{
+    _calc_new_var_wrapper(
+        {
+            prog =>  '../lib/perl5db/t/symbol-table-bug',
+            extra_opts => "NonStop=1",
+            stderr => undef(),
+        }
+    )->output_like(
+        qr/Undefined symbols 0/,
+        'there are no undefined values in the symbol table',
+    );
+}
+
+SKIP:
+{
+    if ( $Config{usethreads} ) {
+        skip('This perl has threads, skipping non-threaded debugger tests');
+    }
+    else {
+        my $error = 'This Perl not built to support threads';
+        _calc_threads_wrapper(
+            {
+                prog => '../lib/perl5db/t/eval-line-bug',
+            }
+        )->output_like(
+            qr/\Q$error\E/,
+            'Perl debugger correctly complains that it was not built with threads',
+        );
+    }
+}
+
+SKIP:
+{
+    if ( $Config{usethreads} ) {
+        _calc_threads_wrapper(
+            {
+                prog =>  '../lib/perl5db/t/symbol-table-bug',
+            }
+        )->output_like(
+            qr/Undefined symbols 0/,
+            'there are no undefined values in the symbol table when running with thread support',
+        );
+    }
+    else {
+        skip("This perl is not threaded, skipping threaded debugger tests");
+    }
+}
+
+# Test [perl #61222]
+{
+    local $ENV{PERLDB_OPTS};
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'm Pie',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/rt-61222',
+        }
+    );
+
+    $wrapper->contents_unlike(qr/INCORRECT/, "[perl #61222]");
+}
+
+sub _calc_trace_wrapper
+{
+    my ($args) = @_;
+
+    return _calc_generic_wrapper(
+        {
+            cmds =>
+            [
+                't 2',
+                'c',
+                'q',
+            ],
+            %$args,
+        }
+    );
+}
+
+# [perl 104168] level option for tracing
+{
+    my $wrapper = _calc_trace_wrapper({ prog =>  '../lib/perl5db/t/rt-104168' });
+    $wrapper->contents_like(qr/level 2/, "[perl #104168] - level 2 appears");
+    $wrapper->contents_unlike(qr/baz/, "[perl #104168] - no 'baz'");
+}
+
+# taint tests
+{
+    my $wrapper = _calc_trace_wrapper(
+        {
+            prog => '../lib/perl5db/t/taint',
+            extra_opts => ' NonStop=1',
+            switches => [ '-d', '-T', ],
+        }
+    );
+
+    my $output = $wrapper->get_output();
+    chomp $output if $^O eq 'VMS'; # newline guaranteed at EOF
+    is($output, '[$^X][done]', "taint");
+}
+
+# Testing that we can set a line in the middle of the file.
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'b ../lib/perl5db/t/MyModule.pm:12',
+                'c',
+                q/do { use IO::Handle; STDOUT->autoflush(1); print "Var=$var\n"; }/,
+                'c',
+                'q',
+            ],
+            include_t => 1,
+            prog => '../lib/perl5db/t/filename-line-breakpoint'
+        }
+    );
+say Dumper($wrapper);
+
+    $wrapper->output_like(qr/
+        ^Var=Bar$
+            .*
+        ^In\ MyModule\.$
+            .*
+        ^In\ Main\ File\.$
+            .*
+        /msx,
+        "Can set breakpoint in a line in the middle of the file.");
+}
+
+END {
+    1 while unlink ($rc_filename, $out_fn);
+}
-- 
2.7.4

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 30, 2016

From @hakonhagland

Hi James E Keenan.

Thanks for the quick response!

Can you provide the output of './perl -Ilib -V' from the build of perl
after which this error occurred?

I think this was just what I needed to get on the right track!
Now, I noticed that the output of './perl -Ilib -V' included this line​:

PERLDB_OPTS="NonStop"

then I remembered that I some years ago had experimented with this
environment variable... So I tried​:

export PERLDB_OPTS=
make clean

and then rerunning

sh Configure -de -Dprefix='/opt/perl/blead' -Dusedevel
make
make test

and then everything seemed to work. None failed tests. Everything looking
good
so far!

(Maybe perl5db.t should check this environment variable in the future
to guard against this problem?)

Best regards
Håkon

2016-12-30 15​:37 GMT+01​:00 James E Keenan via RT <perlbug-followup@​perl.org>
:

On Fri, 30 Dec 2016 13​:35​:40 GMT, jkeenan wrote​:

On Thu, 29 Dec 2016 21​:54​:58 GMT, hakon.hagland@​gmail.com wrote​:

Hi.

The script lib/perl5db.t fails when trying to install Perl 5.25.9 on
my
Ubuntu laptop.

Here is the commands I ran after having cloned the Perl 5 Git
repository​:

sh Configure -de -Dprefix='/opt/perl/blead' -Dusedevel
make
make test

Some relevant output from "make test" :

lib/Net/servent ................................................ ok
lib/open ....................................................... ok
lib/overload ................................................... ok
lib/overload64 ................................................. ok
lib/overloading ................................................ ok
lib/perl5db ....................................................

# Failed test 19 - Can set breakpoint in a line in the middle of the
file.
at ../lib/perl5db.t line 555
# got 'In MyModule.\nIn Main File.\n'
# expected /(?^msx​:
# ^Var=Bar$
# .*
# ^In\ MyModule\.$
# .*
# ^In\ Main\ File\.$
# .*
# )/
#

Then, several other tests also fail in lib/perl5db.t; the last one is
number 118​:

# Failed test 118 - Test w for lexical values. at ../lib/perl5db.t
line 2691
# got ''
# expected /(?^msx​:
# \s+old\ value​:\s+'1'\n
# \s+new\ value​:\s+'2'\n
# )/

After this it seems "make test" crashes. I must press CTRL-C to exit
"make
test", or if
I don't interrupt with CTRL-C, and wait some minutes (as I did the
first time) my laptop freezes (i.e. becomes unreponsive to input)
after a
while (I can hear the disk is very active, though).

The complete log from running Configure, make, and "make test" is
here​:

http​://pastebin.com/Ds2hxd2s

Also note, I had a similar problem two years ago​:

http​://stackoverflow.com/q/28433032/2173773

So there seems to be something with my system that confuses the
perl5db.t script.

Best regards,
Håkon Hægland

Can you provide the output of './perl -Ilib -V' from the build of perl
after which this error occurred? Please attach it, preferably with a
'.txt' extension to this ticket or your email response.

Thank you very much.

Also, can you create a git branch to which you apply the attached patch,
configure and build perl (up through 'make test_prep') and then run the
file in the attachment by itself (./perl -Ilib lib/xperl5db.t) and attach
the output?

Thank you very much.

--
James E Keenan (jkeenan@​cpan.org)

From 735a87dcb4d56316cba387ea2f4bfd454a0fa77c Mon Sep 17 00​:00​:00 2001
From​: James E Keenan <jkeenan@​cpan.org>
Date​: Fri, 30 Dec 2016 09​:33​:19 -0500
Subject​: [PATCH] For diagnosis, cut down the test file to the first failing
test.

---
lib/xperl5db.t | 571 ++++++++++++++++++++++++++++++
+++++++++++++++++++++++++++
1 file changed, 571 insertions(+)
create mode 100644 lib/xperl5db.t

diff --git a/lib/xperl5db.t b/lib/xperl5db.t
new file mode 100644
index 0000000..fbd12b3
--- /dev/null
+++ b/lib/xperl5db.t
@​@​ -0,0 +1,571 @​@​
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @​INC = '../lib';
+ require './test.pl';
+}
+
+use strict;
+use warnings;
+use Config;
+use feature 'say';
+use Data​::Dumper;
+
+BEGIN {
+ if (! -c "/dev/null") {
+ print "1..0 # Skip​: no /dev/null\n";
+ exit 0;
+ }
+
+ my $dev_tty = '/dev/tty';
+ $dev_tty = 'TT​:' if ($^O eq 'VMS');
+ if (! -c $dev_tty) {
+ print "1..0 # Skip​: no $dev_tty\n";
+ exit 0;
+ }
+ if ($ENV{PERL5DB}) {
+ print "1..0 # Skip​: \$ENV{PERL5DB} is already set to
'$ENV{PERL5DB}'\n";
+ exit 0;
+ }
+ $ENV{PERL_RL} = 'Perl'; # Suppress system Term​::ReadLine​::Gnu
+}
+
+plan(19);
+
+my $rc_filename = '.perldb';
+
+sub rc {
+ open my $rc_fh, '>', $rc_filename
+ or die $!;
+ print {$rc_fh} @​_;
+ close ($rc_fh);
+
+ # overly permissive perms gives "Must not source insecure rcfile"
+ # and hangs at the DB(1> prompt
+ chmod 0644, $rc_filename;
+}
+
+sub _slurp
+{
+ my $filename = shift;
+
+ open my $in, '<', $filename
+ or die "Cannot open '$filename' for slurping - $!";
+
+ local $/;
+ my $contents = <$in>;
+
+ close($in);
+
+ return $contents;
+}
+
+my $out_fn = 'db.out';
+
+sub _out_contents
+{
+ return _slurp($out_fn);
+}
+
+
+# Test for Proxy constants
+{
+ rc(
+ <<'EOF',
+
+&parse_options("NonStop=0 ReadLine=0 TTY=db.out");
+
+sub afterinit {
+ push(@​DB​::typeahead,
+ 'm main->s1',
+ 'q',
+ );
+}
+
+EOF
+ );
+
+ my $output = runperl(switches => [ '-d' ], stderr => 1, progfile =>
'../lib/perl5db/t/proxy-constants');
+ is($output, "", "proxy constant subroutines");
+}
+
+# [perl #66110] Call a subroutine inside a regex
+{
+ local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
+ my $output = runperl(switches => [ '-d' ], stderr => 1, progfile =>
'../lib/perl5db/t/rt-66110');
+ like($output, qr/\bAll tests successful\.$/, "[perl #66110]");
+}
+# [ perl #116769] Frame=2
+{
+ local $ENV{PERLDB_OPTS} = "frame=2 nonstop";
+ my $output = runperl( switches => [ '-d' ], prog => 'print
qq{success\n}' );
+ is( $?, 0, '[perl #116769] frame=2 does not crash debugger, exit ==
0' );
+ is( $output, "success\n" , '[perl #116769] code is run' );
+}
+# [ perl #116771] autotrace
+{
+ local $ENV{PERLDB_OPTS} = "autotrace nonstop";
+ my $output = runperl( switches => [ '-d' ], prog => 'print
qq{success\n}' );
+ is( $?, 0, '[perl #116771] autotrace does not crash debugger, exit ==
0' );
+ is( $output, "success\n" , '[perl #116771] code is run' );
+}
+# [ perl #41461] Frame=2 noTTY
+{
+ local $ENV{PERLDB_OPTS} = "frame=2 noTTY nonstop";
+ rc('');
+ my $output = runperl( switches => [ '-d' ], prog => 'print
qq{success\n}' );
+ is( $?, 0, '[perl #41461] frame=2 noTTY does not crash debugger, exit
== 0' );
+ is( $output, "success\n" , '[perl #41461] code is run' );
+}
+
+package DebugWrap;
+
+sub new {
+ my $class = shift;
+
+ my $self = bless {}, $class;
+
+ $self->_init(@​_);
+
+ return $self;
+}
+
+sub _cmds {
+ my $self = shift;
+
+ if (@​_) {
+ $self->{_cmds} = shift;
+ }
+
+ return $self->{_cmds};
+}
+
+sub _prog {
+ my $self = shift;
+
+ if (@​_) {
+ $self->{_prog} = shift;
+ }
+
+ return $self->{_prog};
+}
+
+sub _output {
+ my $self = shift;
+
+ if (@​_) {
+ $self->{_output} = shift;
+ }
+
+ return $self->{_output};
+}
+
+sub _include_t
+{
+ my $self = shift;
+
+ if (@​_)
+ {
+ $self->{_include_t} = shift;
+ }
+
+ return $self->{_include_t};
+}
+
+sub _stderr_val
+{
+ my $self = shift;
+
+ if (@​_)
+ {
+ $self->{_stderr_val} = shift;
+ }
+
+ return $self->{_stderr_val};
+}
+
+sub field
+{
+ my $self = shift;
+
+ if (@​_)
+ {
+ $self->{field} = shift;
+ }
+
+ return $self->{field};
+}
+
+sub _switches
+{
+ my $self = shift;
+
+ if (@​_)
+ {
+ $self->{_switches} = shift;
+ }
+
+ return $self->{_switches};
+}
+
+sub _contents
+{
+ my $self = shift;
+
+ if (@​_)
+ {
+ $self->{_contents} = shift;
+ }
+
+ return $self->{_contents};
+}
+
+sub _init
+{
+ my ($self, $args) = @​_;
+
+ my $cmds = $args->{cmds};
+
+ if (ref($cmds) ne 'ARRAY') {
+ die "cmds must be an array of commands.";
+ }
+
+ $self->_cmds($cmds);
+
+ my $prog = $args->{prog};
+
+ if (ref($prog) ne '' or !defined($prog)) {
+ die "prog should be a path to a program file.";
+ }
+
+ $self->_prog($prog);
+
+ $self->_include_t($args->{include_t} ? 1 : 0);
+
+ $self->_stderr_val(exists($args->{stderr}) ? $args->{stderr} : 1);
+
+ if (exists($args->{switches}))
+ {
+ $self->_switches($args->{switches});
+ }
+
+ $self->_run();
+
+ return;
+}
+
+sub _quote
+{
+ my ($self, $str) = @​_;
+
+ $str =~ s/(["\@​\$\\])/\\$1/g;
+ $str =~ s/\n/\\n/g;
+ $str =~ s/\r/\\r/g;
+
+ return qq{"$str"};
+}
+
+sub _run {
+ my $self = shift;
+
+ my $rc = qq{&parse_options("NonStop=0 TTY=db.out");\n};
+
+ $rc .= join('',
+ map { "$_\n"}
+ (q#sub afterinit {#,
+ q#push (@​DB​::typeahead,#,
+ (map { $self->_quote($_) . "," } @​{$self->_cmds()}),
+ q#);#,
+ q#}#,
+ )
+ );
+
+ # I guess two objects like that cannot be used at the same time.
+ # Oh well.
+ :​:rc($rc);
+
+ my $output =
+ :​:runperl(
+ switches =>
+ [
+ ($self->_switches ? (@​{$self->_switches()}) : ('-d')),
+ ($self->_include_t ? ('-I', '../lib/perl5db/t') : ())
+ ],
+ (defined($self->_stderr_val())
+ ? (stderr => $self->_stderr_val())
+ : ()
+ ),
+ progfile => $self->_prog()
+ );
+
+ $self->_output($output);
+
+ $self->_contents(​::_out_contents());
+
+ return;
+}
+
+sub get_output
+{
+ return shift->_output();
+}
+
+sub output_like {
+ my ($self, $re, $msg) = @​_;
+
+ local $​::Level = $​::Level + 1;
+ :​:like($self->_output(), $re, $msg);
+}
+
+sub output_unlike {
+ my ($self, $re, $msg) = @​_;
+
+ local $​::Level = $​::Level + 1;
+ :​:unlike($self->_output(), $re, $msg);
+}
+
+sub contents_like {
+ my ($self, $re, $msg) = @​_;
+
+ local $​::Level = $​::Level + 1;
+ :​:like($self->_contents(), $re, $msg);
+}
+
+sub contents_unlike {
+ my ($self, $re, $msg) = @​_;
+
+ local $​::Level = $​::Level + 1;
+ :​:unlike($self->_contents(), $re, $msg);
+}
+
+package main;
+
+{
+ local $ENV{PERLDB_OPTS} = "ReadLine=0";
+ my $target = '../lib/perl5db/t/eval-line-bug';
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'b 23',
+ 'n',
+ 'n',
+ 'n',
+ 'c', # line 23
+ 'n',
+ "p \@​{'main​::_<$target'}",
+ 'q',
+ ],
+ prog => $target,
+ }
+ );
+ $wrapper->contents_like(
+ qr/sub factorial/,
+ 'The ${main​::_<filename} variable in the debugger was not
destroyed',
+ );
+}
+
+sub _calc_generic_wrapper
+{
+ my $args = shift;
+
+ my $extra_opts = delete($args->{extra_opts});
+ $extra_opts ||= '';
+ local $ENV{PERLDB_OPTS} = "ReadLine=0" . $extra_opts;
+ return DebugWrap->new(
+ {
+ cmds => delete($args->{cmds}),
+ prog => delete($args->{prog}),
+ %$args,
+ }
+ );
+}
+
+sub _calc_new_var_wrapper
+{
+ my ($args) = @​_;
+ return _calc_generic_wrapper(
+ {
+ cmds =>
+ [
+ 'b 23',
+ 'c',
+ '$new_var = "Foo"',
+ 'x "new_var = <$new_var>\\n"',
+ 'q',
+ ],
+ %$args,
+ }
+ );
+}
+
+sub _calc_threads_wrapper
+{
+ my $args = shift;
+
+ return _calc_new_var_wrapper(
+ {
+ switches => [ '-dt', ],
+ stderr => 1,
+ %$args
+ }
+ );
+}
+
+{
+ _calc_new_var_wrapper({ prog => '../lib/perl5db/t/eval-line-bug'})
+ ->contents_like(
+ qr/new_var = <Foo>/,
+ "no strict 'vars' in evaluated lines.",
+ );
+}
+
+{
+ _calc_new_var_wrapper(
+ {
+ prog => '../lib/perl5db/t/lvalue-bug',
+ stderr => undef(),
+ },
+ )->output_like(
+ qr/foo is defined/,
+ 'lvalue subs work in the debugger',
+ );
+}
+
+{
+ _calc_new_var_wrapper(
+ {
+ prog => '../lib/perl5db/t/symbol-table-bug',
+ extra_opts => "NonStop=1",
+ stderr => undef(),
+ }
+ )->output_like(
+ qr/Undefined symbols 0/,
+ 'there are no undefined values in the symbol table',
+ );
+}
+
+SKIP​:
+{
+ if ( $Config{usethreads} ) {
+ skip('This perl has threads, skipping non-threaded debugger
tests');
+ }
+ else {
+ my $error = 'This Perl not built to support threads';
+ _calc_threads_wrapper(
+ {
+ prog => '../lib/perl5db/t/eval-line-bug',
+ }
+ )->output_like(
+ qr/\Q$error\E/,
+ 'Perl debugger correctly complains that it was not built with
threads',
+ );
+ }
+}
+
+SKIP​:
+{
+ if ( $Config{usethreads} ) {
+ _calc_threads_wrapper(
+ {
+ prog => '../lib/perl5db/t/symbol-table-bug',
+ }
+ )->output_like(
+ qr/Undefined symbols 0/,
+ 'there are no undefined values in the symbol table when
running with thread support',
+ );
+ }
+ else {
+ skip("This perl is not threaded, skipping threaded debugger
tests");
+ }
+}
+
+# Test [perl #61222]
+{
+ local $ENV{PERLDB_OPTS};
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'm Pie',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/rt-61222',
+ }
+ );
+
+ $wrapper->contents_unlike(qr/INCORRECT/, "[perl #61222]");
+}
+
+sub _calc_trace_wrapper
+{
+ my ($args) = @​_;
+
+ return _calc_generic_wrapper(
+ {
+ cmds =>
+ [
+ 't 2',
+ 'c',
+ 'q',
+ ],
+ %$args,
+ }
+ );
+}
+
+# [perl 104168] level option for tracing
+{
+ my $wrapper = _calc_trace_wrapper({ prog =>
'../lib/perl5db/t/rt-104168' });
+ $wrapper->contents_like(qr/level 2/, "[perl #104168] - level 2
appears");
+ $wrapper->contents_unlike(qr/baz/, "[perl #104168] - no 'baz'");
+}
+
+# taint tests
+{
+ my $wrapper = _calc_trace_wrapper(
+ {
+ prog => '../lib/perl5db/t/taint',
+ extra_opts => ' NonStop=1',
+ switches => [ '-d', '-T', ],
+ }
+ );
+
+ my $output = $wrapper->get_output();
+ chomp $output if $^O eq 'VMS'; # newline guaranteed at EOF
+ is($output, '[$^X][done]', "taint");
+}
+
+# Testing that we can set a line in the middle of the file.
+{
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'b ../lib/perl5db/t/MyModule.pm​:12',
+ 'c',
+ q/do { use IO​::Handle; STDOUT->autoflush(1); print
"Var=$var\n"; }/,
+ 'c',
+ 'q',
+ ],
+ include_t => 1,
+ prog => '../lib/perl5db/t/filename-line-breakpoint'
+ }
+ );
+say Dumper($wrapper);
+
+ $wrapper->output_like(qr/
+ ^Var=Bar$
+ .*
+ ^In\ MyModule\.$
+ .*
+ ^In\ Main\ File\.$
+ .*
+ /msx,
+ "Can set breakpoint in a line in the middle of the file.");
+}
+
+END {
+ 1 while unlink ($rc_filename, $out_fn);
+}
--
2.7.4

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 30, 2016

From @jkeenan

On Fri, 30 Dec 2016 16​:29​:10 GMT, hakon.hagland@​gmail.com wrote​:

Hi James E Keenan.

Thanks for the quick response!

Can you provide the output of './perl -Ilib -V' from the build of
perl
after which this error occurred?

I think this was just what I needed to get on the right track!
Now, I noticed that the output of './perl -Ilib -V' included this
line​:

PERLDB_OPTS="NonStop"

then I remembered that I some years ago had experimented with this
environment variable... So I tried​:

export PERLDB_OPTS=
make clean

and then rerunning

sh Configure -de -Dprefix='/opt/perl/blead' -Dusedevel
make
make test

and then everything seemed to work. None failed tests. Everything
looking
good
so far!

(Maybe perl5db.t should check this environment variable in the future
to guard against this problem?)

Best regards
Håkon

Let's see what P5P thinks of that suggestion. Please review patch attached.

Thank you very much.

--
James E Keenan (jkeenan@​cpan.org)

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 30, 2016

From @jkeenan

0001-Prevent-tests-from-getting-hung-up-on-NonStop-option.patch
From 7678f324d40bfde3a4c198062883011947737da2 Mon Sep 17 00:00:00 2001
From: James E Keenan <jkeenan@cpan.org>
Date: Fri, 30 Dec 2016 12:30:17 -0500
Subject: [PATCH] Prevent tests from getting hung up on 'NonStop' option.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

For:  https://rt.perl.org/Ticket/Display.html?id=130445

Thanks to Håkon Hægland for report and suggestion.
---
 lib/perl5db.t | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/lib/perl5db.t b/lib/perl5db.t
index e216685..2dde233 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -10,6 +10,9 @@ use strict;
 use warnings;
 use Config;
 
+my $prevailing_PERLDB_OPTS = $ENV{PERLDB_OPTS};
+local $ENV{PERLDB_OPTS} = undef;
+
 BEGIN {
     if (! -c "/dev/null") {
         print "1..0 # Skip: no /dev/null\n";
@@ -2817,4 +2820,5 @@ SKIP:
 
 END {
     1 while unlink ($rc_filename, $out_fn);
+    $ENV{PERLDB_OPTS} = $prevailing_PERLDB_OPTS;
 }
-- 
2.7.4

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 30, 2016

From @jkeenan

On Fri, 30 Dec 2016 17​:34​:48 GMT, jkeenan wrote​:

On Fri, 30 Dec 2016 16​:29​:10 GMT, hakon.hagland@​gmail.com wrote​:

Hi James E Keenan.

Thanks for the quick response!

Can you provide the output of './perl -Ilib -V' from the build of
perl
after which this error occurred?

I think this was just what I needed to get on the right track!
Now, I noticed that the output of './perl -Ilib -V' included this
line​:

PERLDB_OPTS="NonStop"

then I remembered that I some years ago had experimented with this
environment variable... So I tried​:

export PERLDB_OPTS=
make clean

and then rerunning

sh Configure -de -Dprefix='/opt/perl/blead' -Dusedevel
make
make test

and then everything seemed to work. None failed tests. Everything
looking
good
so far!

(Maybe perl5db.t should check this environment variable in the future
to guard against this problem?)

Best regards
Håkon

Let's see what P5P thinks of that suggestion. Please review patch attached.

Thank you very much.

#####
(01​:40​:46 PM) arc​: kid51​: i'm not a debugger expert, but that looks to me like it should work. two things, though. first, why reset PERLDB_OPTS in the END block? it looks to me like the "local" should have that effect anyway. second, "delete local $ENV{PERLDB_OPTS}" might be better than setting it to undef
#####

Agreed. Revised and pushed to blead in commit a4deefe.

Marking ticket Resolved.

Thank you very much.

--
James E Keenan (jkeenan@​cpan.org)

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 30, 2016

@jkeenan - Status changed from 'open' to 'resolved'

@p5pRT p5pRT closed this Dec 30, 2016
@p5pRT p5pRT added the Severity Low label Oct 19, 2019
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
1 participant
You can’t perform that action at this time.