1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
#!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*-
BEGIN {
require Config; import Config;
if (!$Config{'d_fork'}
# open2/3 supported on win32 (but not Borland due to CRT bugs)
&& (($^O ne 'MSWin32' && $^O ne 'NetWare') || $Config{'cc'} =~ /^bcc/i))
{
print "1..0\n";
exit 0;
}
chdir 't' if -d 't';
@INC = '../lib';
$ENV{PERL5LIB} = '../lib'; # so children will see it too
}
use strict;
use IPC::Open3 qw(open3);
use IO::Select;
$|=1;
my @prgs;
{
local $/;
@prgs = split "########\n", <DATA>;
close DATA;
}
use Test::More;
plan tests => scalar @prgs;
require "dumpvar.pl";
$ENV{PERLDB_OPTS} = "TTY=0";
my($ornament1,$ornament2,$wtrfh,$rdrfh);
open3 $wtrfh, $rdrfh, 0, $^X, "-de0";
my $ios = IO::Select->new();
$ios->add($rdrfh);
for (@prgs){
my($prog,$expected) = split(/\nEXPECT\n?/, $_);
print $wtrfh $prog, "\n";
my $got;
while (not defined $got) {
while ($ios->can_read(0.25)) {
sysread $rdrfh, $got, 1024, length($got);
}
}
$got =~ s/^\s*Loading.*\nEditor.*\n\nEnter.*\n\nmain::\(-e:1\):\s0\n//;
unless (defined $ornament1) {
$got =~ s/^\s*Loading.*\nEditor.*\n\nEnter.*\n\nmain::\(-e:1\):\s0\n//;
($ornament1,$ornament2) = $got =~
/(.*?)0\s+'reserved example for calibrating the ornaments'\n(.*)/
}
$got =~ s/^\Q$ornament1\E//;
$got =~ s/\Q$ornament2\E\z//;
like($got, qr:$expected:i, $prog);
}
__END__
x "reserved example for calibrating the ornaments"
EXPECT
0 'reserved example for calibrating the ornaments'
########
x "foo"
EXPECT
0 'foo'
########
x "\x{100}"
EXPECT
0 '\\x\{0100\}'
########
x *a
EXPECT
0 \*main::a
########
x 1..3
EXPECT
0 1
1 2
2 3
########
x +{1..4}
EXPECT
0\s+HASH\(0x[0-9a-f]+\)
\s+1 => 2
\s+3 => 4
########
|
