diff options
author | Andreas König <a.koenig@mind.de> | 2003-09-07 20:51:56 +0200 |
---|---|---|
committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2003-09-07 21:17:23 +0000 |
commit | fafebdf5c0e135737397bc4ab8fec007553101e7 (patch) | |
tree | 17b63d4b2efba1c2a651f359023548e06e9dfae9 /lib/perl5db | |
parent | 06c8fc8f09dc8f7e52006b1a902e84e1587b786f (diff) | |
download | perl-fafebdf5c0e135737397bc4ab8fec007553101e7.tar.gz |
Test skeleton for debugger commands
Message-ID: <87fzj8k0cz.fsf@franz.ak.mind.de>
With minor adjustments
p4raw-id: //depot/perl@21065
Diffstat (limited to 'lib/perl5db')
-rw-r--r-- | lib/perl5db/de0.t | 72 | ||||
-rw-r--r-- | lib/perl5db/dumpvar.t | 61 |
2 files changed, 133 insertions, 0 deletions
diff --git a/lib/perl5db/de0.t b/lib/perl5db/de0.t new file mode 100644 index 0000000000..b5a416ffef --- /dev/null +++ b/lib/perl5db/de0.t @@ -0,0 +1,72 @@ +#!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*- + +BEGIN { + if ($^O eq 'VMS') { + print "1..0 # skip on VMS\n"; + exit 0; + } + chdir 't' if -d 't'; + @INC = '../lib'; + $ENV{PERL5LIB} = '../lib'; # so children will see it too +} + +use strict; + +$|=1; +undef $/; +my @prgs = split "########\n", <DATA>; +close DATA; +print "1..", scalar @prgs, "\n"; +require "dumpvar.pl"; + +our $tmpfile = "perl5db0"; +1 while -f ++$tmpfile; +END { if ($tmpfile) { 1 while unlink $tmpfile; } } + +my $i = 0; +$ENV{PERLDB_OPTS} = "TTY=0"; +my($ornament1,$ornament2); +for (@prgs){ + my($prog,$expected) = split(/\nEXPECT\n?/, $_); + open my $select, "| $^X -de0 2> $tmpfile" or die $!; + print $select $prog; + close $select; + my $got = do { open my($fh), $tmpfile or die; local $/; <$fh>; }; + $got =~ s/^\s*Loading.*\nEditor.*\n\nEnter.*\n\nmain::\(-e:1\):\s0\n//; + unless (defined $ornament1) { + ($ornament1,$ornament2) = $got =~ + /(.*?)0\s+'reserved example for calibrating the ornaments'\n(.*)/ + } + $got =~ s/^\Q$ornament1\E//; + $got =~ s/\Q$ornament2\E\z//; + my $not = ""; + my $why = ""; + if ($got !~ /$expected/) { + $not = "not "; + $got = dumpvar::unctrl($got); + $why = " # prog[$prog]got[$got]expected[$expected]"; + } + print $not, "ok ", ++$i, $why, "\n"; +} + +__END__ +x "reserved example for calibrating the ornaments" +EXPECT +0 'reserved example for calibrating the ornaments' +######## +x "foo" +EXPECT +0 'foo' +######## +x 1..3 +EXPECT +0 1 +1 2 +2 3 +######## +x +{1..4} +EXPECT +0\s+HASH\(0x[\da-f]+\) +\s+1 => 2 +\s+3 => 4 +######## diff --git a/lib/perl5db/dumpvar.t b/lib/perl5db/dumpvar.t new file mode 100644 index 0000000000..74fb1f9514 --- /dev/null +++ b/lib/perl5db/dumpvar.t @@ -0,0 +1,61 @@ +#!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*- + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +use strict; + +$|=1; +undef $/; +my @prgs = split "########\n", <DATA>; +close DATA; +print "1..", scalar @prgs, "\n"; +require "dumpvar.pl"; + +my $i = 0; +for (@prgs){ + my($prog,$expected) = split(/\nEXPECT\n?/, $_); + open my $select, ">", \my $got or die; + select $select; + eval $prog; + my $not = ""; + my $why = ""; + if ($@) { + $not = "not "; + $why = " # prog[$prog]\$\@[$@]"; + } elsif ($got ne $expected) { + $not = "not "; + $why = " # prog[$prog]got[$got]expected[$expected]"; + } + close $select; + select STDOUT; + print $not, "ok ", ++$i, $why, "\n"; +} + +__END__ +""; +EXPECT +######## +dumpValue(1); +EXPECT +1 +######## +dumpValue("1\n2\n3"); +EXPECT +'1 +2 +3' +######## +dumpValue([1..3],1); +EXPECT +0 1 +1 2 +2 3 +######## +dumpValue({1..4},1); +EXPECT +1 => 2 +3 => 4 +######## |