#!./perl
$ENV
{PSEDEXTBRE} =
'<>wW'
;
our
%input
= (
bins
=>
<<'[TheEnd]',
0
111
1000
10001
[TheEnd]
text
=>
<<'[TheEnd]',
line 1
line 2
line 3
line 4
line 5
line 6
line 7
line 8
[TheEnd]
adr1
=>
<<'[TheEnd]',
#no autoprint
# This script should be run on itself
/^#__DATA__$/,${
/^#A$/p
s/^# *[0-9]* *//
/^#\*$/p
/^#\.$/p
/^#\(..\)\(..\)\2\1*$/p
/^#[abc]\{1,\}[def]\{1,\}$/p
}
#__DATA__
#A
#*
#.
#abxyxy
#abxyxyab
#abxyxyabab
#ad
#abcdef
[TheEnd]
);
our
%testcase
= (
'bin2dec'
=> {
script
=>
<<'[TheEnd]',
# binary -> decimal
s/^[ ]*\([01]\{1,\}\)[ ]*/\1/
t go
i\
is not a binary number
d
# expand binary to Xs
: go
s/^0*//
s/^1/X/
: expand
s/^\(X\{1,\}\)0/\1\1/
s/^\(X\{1,\}\)1/\1\1X/
t expand
# count Xs in decimal
: count
s/^X/1/
s/0X/1/
s/1X/2/
s/2X/3/
s/3X/4/
s/4X/5/
s/5X/6/
s/6X/7/
s/7X/8/
s/8X/9/
s/9X/X0/
t count
s/^$/0/
[TheEnd]
input
=>
'bins'
,
expect
=>
<<'[TheEnd]',
0
7
8
17
[TheEnd]
},
'='
=> {
script
=>
<<'[TheEnd]',
1=
$=
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
1
line 1
line 2
line 3
line 4
line 5
line 6
line 7
8
line 8
[TheEnd]
},
'D'
=> {
script
=>
<<'[TheEnd]',
#no autoprint
/1/{
N
N
N
D
}
p
/2/D
=
p
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
line 2
line 3
line 4
line 3
line 4
4
line 3
line 4
line 5
5
line 5
line 6
6
line 6
line 7
7
line 7
line 8
8
line 8
[TheEnd]
},
'H'
=> {
script
=>
<<'[TheEnd]',
#no autoprint
1,$H
$g
$=
$p
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
8
line 1
line 2
line 3
line 4
line 5
line 6
line 7
line 8
[TheEnd]
},
'N'
=> {
script
=>
<<'[TheEnd]',
3a\
added line
4a\
added line
5a\
added line
3,5N
=
d
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
1
2
added line
4
added line
6
7
8
[TheEnd]
},
'P'
=> {
script
=>
<<'[TheEnd]',
1N
2N
3N
4=
4P
4,$d
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
4
line 1
[TheEnd]
},
'a'
=> {
script
=>
<<'[TheEnd]',
1a\
added line 1.1\
added line 1.2
3a\
added line 3.1
3a\
added line 3.2
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
line 1
added line 1.1
added line 1.2
line 2
line 3
added line 3.1
added line 3.2
line 4
line 5
line 6
line 7
line 8
[TheEnd]
},
'b'
=> {
script
=>
<<'[TheEnd]',
#no autoprint
2 b eos
4 b eos
p
: eos
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
line 1
line 3
line 5
line 6
line 7
line 8
[TheEnd]
},
'block'
=> {
script
=>
"#no autoprint\n1,3{\n=\np\n}"
,
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
1
line 1
2
line 2
3
line 3
[TheEnd]
},
'c'
=> {
script
=>
<<'[TheEnd]',
2=
2,4c\
change 2,4 line 1\
change 2,4 line 2
2=
3,5c\
change 3,5 line 1\
change 3,5 line 2
3=
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
line 1
2
change 2,4 line 1
change 2,4 line 2
line 5
line 6
line 7
line 8
[TheEnd]
},
'c1'
=> {
script
=>
<<'[TheEnd]',
1c\
replaces line 1
2,3c\
replaces lines 2-3
/5/,/6/c\
replaces lines 3-4
8,10c\
replaces lines 6-10
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
replaces line 1
replaces lines 2-3
line 4
replaces lines 3-4
line 7
[TheEnd]
},
'c2'
=> {
script
=>
<<'[TheEnd]',
3!c\
replace all except line 3
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
replace all except line 3
replace all except line 3
line 3
replace all except line 3
replace all except line 3
replace all except line 3
replace all except line 3
replace all except line 3
[TheEnd]
},
'c3'
=> {
script
=>
<<'[TheEnd]',
1,4!c\
replace all except 1-4
/5/,/8/!c\
replace all except 5-8
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
replace all except 5-8
replace all except 5-8
replace all except 5-8
replace all except 5-8
replace all except 1-4
replace all except 1-4
replace all except 1-4
replace all except 1-4
[TheEnd]
},
'd'
=> {
script
=>
<<'[TheEnd]',
# d delete pattern space, start next cycle
2,4 d
5 d
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
line 1
line 6
line 7
line 8
[TheEnd]
},
'G'
=> {
script
=>
'G'
,
input
=>
'bins'
,
expect
=>
<<'[TheEnd]',
0
111
1000
10001
[TheEnd]
},
'G3'
=> {
script
=>
'G;'
,
input
=>
'bins'
,
expect
=>
<<'[TheEnd]',
0
111
1000
10001
[TheEnd]
},
'G2'
=> {
todo
=>
'RT #90134, GH#2'
,
script
=>
'G; s/\n/&&/; /^\([ ~-]*\n\).*\n\1/d; s/\n//; h;'
,
input
=>
'bins'
,
expect
=>
<<'[TheEnd]',
0
111
0
1000
111
0
10001
1000
111
0
[TheEnd]
},
'gh'
=> {
script
=>
<<'[TheEnd]',
1h
2g
3h
4g
5q
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
line 1
line 1
line 3
line 3
line 5
[TheEnd]
},
'H'
=> {
script
=>
'H;p'
,
input
=>
'bins'
,
expect
=>
<<'[TheEnd]',
0
0
111
111
1000
1000
10001
10001
[TheEnd]
},
'i'
=> {
script
=>
<<'[TheEnd]',
1i\
inserted line 1.1\
inserted line 1.2
3i\
inserted line 3.1
3i\
inserted line 3.2
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
inserted line 1.1
inserted line 1.2
line 1
line 2
inserted line 3.1
inserted line 3.2
line 3
line 4
line 5
line 6
line 7
line 8
[TheEnd]
},
'n'
=> {
script
=>
<<'[TheEnd]',
3a\
added line
4a\
added line
5a\
added line
3,5n
=
d
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
1
2
line 3
added line
4
line 5
added line
6
7
8
[TheEnd]
},
'o'
=> {
script
=>
<<'[TheEnd]',
/abc/,/def/ s//XXX/
// i\
cheers
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
line 1
line 2
line 3
line 4
line 5
line 6
line 7
line 8
[TheEnd]
},
'q'
=> {
script
=>
<<'[TheEnd]',
2a\
append to line 2
3a\
append to line 3 - should not appear in output
3q
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
line 1
line 2
append to line 2
line 3
[TheEnd]
},
'r'
=> {
datfil
=> [
'r.txt'
,
"r.txt line 1\nr.txt line 2\nr.txt line 3\n"
],
script
=>
<<'[TheEnd]',
2r%r.txt%
4r %r.txt%
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
line 1
line 2
r.txt line 1
r.txt line 2
r.txt line 3
line 3
line 4
r.txt line 1
r.txt line 2
r.txt line 3
line 5
line 6
line 7
line 8
[TheEnd]
},
's'
=> {
script
=>
<<'[TheEnd]',
# enclose any '(a)'.. '(c)' in '-'
s/([a-z])/-\1-/g
s/\([abc]\)/-\1-/g
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
line 1
line 2
line 3
line 4
line 5
line 6
line 7
line 8
[TheEnd]
},
's1'
=> {
script
=>
<<'[TheEnd]',
s/\w/@1/
s/\y/@2/
s/\n/@3/
# this is literal { }
s/a{3}/@4/
# proper repetition
s/a\{3\}/a rep 3/
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
@1ine 1
@1ine 2
@1ine 3
@1ine 4
@1ine 5
@1ine 6
@1ine 7
@1ine 8
[TheEnd]
},
's2'
=> {
todo
=>
'RT #115156'
,
script
=>
's/1*$/x/g'
,
input
=>
'bins'
,
expect
=>
<<'[TheEnd]',
0x
x
1000x
1000x
[TheEnd]
},
't'
=> {
script
=>
join
(
"\n"
,
'#no autoprint'
,
's/./X/p'
,
's/foo/bar/p'
,
't bye'
,
'='
,
'p'
,
':bye'
),
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
Xine 1
Xine 2
Xine 3
Xine 4
Xine 5
Xine 6
Xine 7
Xine 8
[TheEnd]
},
'w'
=> {
datfil
=> [
'w.txt'
,
''
],
script
=>
<<'[TheEnd]',
w %w.txt%
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
line 1
line 2
line 3
line 4
line 5
line 6
line 7
line 8
[TheEnd]
},
'x'
=> {
script
=>
<<'[TheEnd]',
1h
1d
2x
2,$G
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
line 1
line 2
line 3
line 2
line 4
line 2
line 5
line 2
line 6
line 2
line 7
line 2
line 8
line 2
[TheEnd]
},
'y'
=> {
script
=>
<<'[TheEnd]',
y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/
y/|/\
/
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
LINE 1
LINE 2
LINE 3
LINE 4
LINE 5
LINE 6
LINE 7
LINE 8
[TheEnd]
},
'cnt'
=> {
script
=>
<<'[TheEnd]',
#no autoprint
# delete line, append NL to hold space
s/.*//
H
$!b
# last line only: get hold
g
s/./X/g
t count
: count
s/^X/1/
s/0X/1/
s/1X/2/
s/2X/3/
s/3X/4/
s/4X/5/
s/5X/6/
s/6X/7/
s/7X/8/
s/8X/9/
s/9X/X0/
t count
p
[TheEnd]
input
=>
'text'
,
expect
=>
<<'[TheEnd]',
8
[TheEnd]
},
'adr1'
=> {
script
=>
<<'[TheEnd]',
#no autoprint
# This script should be run on itself
/^#__DATA__$/,${
/^#A$/p
s/^# *[0-9]* *//
/^#\*$/p
/^#\.$/p
/^#\(..\)\(..\)\2\1*$/p
/^#[abc]\{1,\}[def]\{1,\}$/p
}
#__DATA__
#A
#*
#.
#abxyxy
#abxyxyab
#abxyxyabab
#ad
#abcdef
[TheEnd]
input
=>
'adr1'
,
expect
=>
<<'[TheEnd]',
#A
[TheEnd]
},
);
my
@aux
= ();
my
$ntc
= 2 *
keys
%testcase
;
plan(
tests
=>
$ntc
);
my
$script
=
"s2pt$$.sed"
;
my
$stdin
=
"s2pt$$.in"
;
my
$plsed
=
"s2pt$$.pl"
;
my
$s2p
= File::Spec->catfile( File::Spec->curdir(),
qw/blib script s2p/
);
my
$psed
= File::Spec->catfile( File::Spec->curdir(),
qw/blib script psed/
);
if
($^O eq
'VMS'
) {
$s2p
= VMS::Filespec::vmsify(
$s2p
);
$psed
= VMS::Filespec::vmsify(
$psed
);
$s2p
=~ s/\.$//;
$psed
=~ s/\.$//;
$s2p
= VMS::Filespec::rmsexpand(
$s2p
,
'.com'
);
$psed
= VMS::Filespec::rmsexpand(
$psed
,
'.com'
);
}
my
$sedcmd
= [
$psed
,
'-f'
,
$script
,
$stdin
];
my
$s2pcmd
= [
$s2p
,
'-f'
,
$script
];
my
$plcmd
= [
$plsed
,
$stdin
];
my
$indat
=
''
;
for
my
$tc
(
sort
keys
%testcase
){
my
(
$psedres
,
$s2pres
);
local
$TODO
=
$testcase
{
$tc
}{todo};
open
( SED,
">$script"
) ||
goto
FAIL_BOTH;
my
$script
=
$testcase
{
$tc
}{script};
if
(
exists
(
$testcase
{
$tc
}{datfil} ) ){
my
(
$datnam
,
$datdat
) = @{
$testcase
{
$tc
}{datfil}};
my
$datfil
=
"s2pt$$"
.
$datnam
;
push
(
@aux
,
$datfil
);
open
( DAT,
">$datfil"
) ||
goto
FAIL_BOTH;
print
DAT
$datdat
;
close
( DAT );
$script
=~ s/\
%$datnam
\%/
$datfil
/eg;
}
print
SED
$script
;
close
( SED ) ||
goto
FAIL_BOTH;
if
(
$indat
ne
$testcase
{
$tc
}{input} ){
$indat
=
$testcase
{
$tc
}{input};
open
( IN,
">$stdin"
) ||
goto
FAIL_BOTH;
print
IN
$input
{
$indat
};
close
( IN ) ||
goto
FAIL_BOTH;
}
$testcase
{
$tc
}{expect} =~ s/\n\n/\n/
if
$^O eq
'VMS'
;
$psedres
= runperl(
args
=>
$sedcmd
);
is(
$psedres
,
$testcase
{
$tc
}{expect},
"psed $tc"
);
my
$perlprog
= runperl(
args
=>
$s2pcmd
);
open
( PP,
">$plsed"
) ||
goto
FAIL_S2P;
print
PP
$perlprog
;
close
( PP ) ||
goto
FAIL_S2P;
$s2pres
= runperl(
args
=>
$plcmd
);
is(
$s2pres
,
$testcase
{
$tc
}{expect},
"s2p $tc"
);
next
;
FAIL_BOTH:
fail(
"psed $tc"
);
FAIL_S2P:
fail(
"s2p $tc"
);
}
END {
for
my
$f
(
$script
,
$stdin
,
$plsed
,
@aux
){
1
while
unlink
(
$f
);
}
}
sub
runperl {
my
%args
=
@_
;
my
@args
= find_perl_interpreter();
push
@args
,
$args
{progfile}
if
$args
{progfile};
push
@args
, @{
$args
{args} }
if
$args
{args};
my
$pid
= open2(
my
(
$in
,
$out
),
@args
);
binmode
$in
,
':crlf'
if
$^O eq
'MSWin32'
;
my
$ret
=
do
{
local
$/; <
$in
> };
waitpid
$pid
, 0;
return
$ret
;
}