This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Test skeleton for debugger commands
[perl5.git] / lib / perl5db / de0.t
CommitLineData
fafebdf5
A
1#!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*-
2
3BEGIN {
4 if ($^O eq 'VMS') {
5 print "1..0 # skip on VMS\n";
6 exit 0;
7 }
8 chdir 't' if -d 't';
9 @INC = '../lib';
10 $ENV{PERL5LIB} = '../lib'; # so children will see it too
11}
12
13use strict;
14
15$|=1;
16undef $/;
17my @prgs = split "########\n", <DATA>;
18close DATA;
19print "1..", scalar @prgs, "\n";
20require "dumpvar.pl";
21
22our $tmpfile = "perl5db0";
231 while -f ++$tmpfile;
24END { if ($tmpfile) { 1 while unlink $tmpfile; } }
25
26my $i = 0;
27$ENV{PERLDB_OPTS} = "TTY=0";
28my($ornament1,$ornament2);
29for (@prgs){
30 my($prog,$expected) = split(/\nEXPECT\n?/, $_);
31 open my $select, "| $^X -de0 2> $tmpfile" or die $!;
32 print $select $prog;
33 close $select;
34 my $got = do { open my($fh), $tmpfile or die; local $/; <$fh>; };
35 $got =~ s/^\s*Loading.*\nEditor.*\n\nEnter.*\n\nmain::\(-e:1\):\s0\n//;
36 unless (defined $ornament1) {
37 ($ornament1,$ornament2) = $got =~
38 /(.*?)0\s+'reserved example for calibrating the ornaments'\n(.*)/
39 }
40 $got =~ s/^\Q$ornament1\E//;
41 $got =~ s/\Q$ornament2\E\z//;
42 my $not = "";
43 my $why = "";
44 if ($got !~ /$expected/) {
45 $not = "not ";
46 $got = dumpvar::unctrl($got);
47 $why = " # prog[$prog]got[$got]expected[$expected]";
48 }
49 print $not, "ok ", ++$i, $why, "\n";
50}
51
52__END__
53x "reserved example for calibrating the ornaments"
54EXPECT
550 'reserved example for calibrating the ornaments'
56########
57x "foo"
58EXPECT
590 'foo'
60########
61x 1..3
62EXPECT
630 1
641 2
652 3
66########
67x +{1..4}
68EXPECT
690\s+HASH\(0x[\da-f]+\)
70\s+1 => 2
71\s+3 => 4
72########