my $rparams;
my $rsources;
my $rtests;
BEGIN {
$rparams = {
'ce_wn' => <<'----------',
-cuddled-blocks
-wn
----------
'colin' => <<'----------',
-l=0
-pt=2
-nsfs
-sbt=2
-ohbr
-opr
-osbr
-pvt=2
-schb
-scp
-scsb
-sohb
-sop
-sosb
----------
'def' => "",
'essential1' => <<'----------',
-syn
-i=0
-l=100000
-nasc
-naws
-dws
-nanl
-blbp=0
-blbs=0
-nbbb
-kbl=0
-mbl=0
----------
'essential2' => "-extrude",
'extrude' => "--extrude",
'fabrice_bug' => "-bt=0",
};
$rsources = {
'ce_wn1' => <<'----------',
if ($BOLD_MATH) {
(
$labels, $comment,
join( '', ' < B > ', &make_math( $mode, '', '', $_ ), ' < /B>' )
)
}
else {
(
&process_math_in_latex( $mode, $math_style, $slevel, "\\mbox{$text}" ),
$after
)
}
----------
'colin' => <<'----------',
env(0, 15, 0, 10, {
Xtitle => 'X-data',
Ytitle => 'Y-data',
Title => 'An example of errb and points',
Font => 'Italic'
});
----------
'essential' => <<'----------',
# Run with mangle to squeeze out the white space
# also run with extrude
# never combine two bare words or numbers
status and ::ok(1);
return ::spw(...);
for bla::bla:: abc;
# do not combine 'overload::' and 'and'
if $self->{bareStringify} and ref $_
and defined %overload:: and defined &{'overload::StrVal'};
# do not combine 'SINK' and 'if'
my $size=-s::SINK if $file;
# do not combine to make $inputeq"quit"
if ($input eq"quit");
# do not combine a number with a concatenation dot to get a float '78.'
$vt100_compatible ? "\e[0;0H" : ('-' x 78 . "\n");
# do not join a minus with a bare word, because you might form
# a file test operator. Here "z-i" would be taken as a file test.
if (CORE::abs($z - i) < $eps);
# '= -' should not become =- or you will get a warning
# and something like these could become ambiguous without space
# after the '-':
use constant III=>1;
$a = $b - III;
$a = - III;
# keep a space between a token ending in '$' and any word;
die @$ if $@;
# avoid combining tokens to create new meanings. Example:
# this must not become $a++$b
$a+ +$b;
# another example: do not combine these two &'s:
allow_options & &OPT_EXECCGI;
# Perl is sensitive to whitespace after the + here:
$b = xvals $a + 0.1 * yvals $a;
# keep paren separate here:
use Foo::Bar ();
# need space after foreach my; for example, this will fail in
# older versions of Perl:
foreach my$ft(@filetypes)...
# must retain space between grep and left paren; "grep(" may fail
my $match = grep (m/^-extrude$/, @list) ? 1 : 0;
# don't stick numbers next to left parens, as in:
use Mail::Internet 1.28 ();
# do not remove space between an '&' and a bare word because
# it may turn into a function evaluation, like here
# between '&' and 'O_ACCMODE', producing a syntax error [File.pm]
$opts{rdonly} = (($opts{mode} & O_ACCMODE) == O_RDONLY);
----------
'extrude1' => <<'----------',
# do not break before the ++
print $x++ . "\n";
----------
'extrude2' => <<'----------',
if (-l pid_filename()) {
return readlink(pid_filename());
}
----------
'extrude3' => <<'----------',
# Breaking before a ++ can cause perl to guess wrong
print( ( $i++ & 1 ) ? $_ : ( $change{$_} || $_ ) );
# Space between '&' and 'O_ACCMODE' is essential here
$opts{rdonly} = (($opts{mode} & O_ACCMODE) == O_RDONLY);
----------
'extrude4' => <<'----------',
# From Safe.pm caused trouble with extrude
use Opcode 1.01, qw(
opset opset_to_ops opmask_add
empty_opset full_opset invert_opset verify_opset
opdesc opcodes opmask define_optag opset_to_hex
);
----------
'fabrice_bug' => <<'----------',
# no space around ^variable with -bt=0
my $before = ${^PREMATCH};
my $after = ${PREMATCH};
----------
'format1' => <<'----------',
if (/^--list$/o) {
format =
@<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$_, $val
.
print "Available strips:\n";
for ( split ( /\|/, $known_strips ) ) {
$val = $defs{$_}{'name'};
write;
}
}
----------
'given1' => <<'----------',
given ([9,"a",11]) {
when (qr/\d/) {
given ($count) {
when (1) { ok($count==1) }
else { ok($count!=1) }
when ([5,6]) { ok(0) } else { ok(1) }
}
}
ok(1) when 11;
}
----------
'gnu1' => <<'----------',
@common_sometimes = (
"aclocal.m4", "acconfig.h", "config.h.top", "config.h.bot",
"stamp-h.in", 'stamp-vti'
);
----------
};
$rtests = {
'ce_wn1.ce_wn' => {
source => "ce_wn1",
params => "ce_wn",
expect => <<'#1...........',
if ($BOLD_MATH) { (
$labels, $comment,
join( '', ' < B > ', &make_math( $mode, '', '', $_ ), ' < /B>' )
) } else { (
&process_math_in_latex( $mode, $math_style, $slevel, "\\mbox{$text}" ),
$after
) }
#1...........
},
'ce_wn1.def' => {
source => "ce_wn1",
params => "def",
expect => <<'#2...........',
if ($BOLD_MATH) {
(
$labels, $comment,
join( '', ' < B > ', &make_math( $mode, '', '', $_ ), ' < /B>' )
)
}
else {
(
&process_math_in_latex( $mode, $math_style, $slevel, "\\mbox{$text}" ),
$after
)
}
#2...........
},
'colin.colin' => {
source => "colin",
params => "colin",
expect => <<'#3...........',
env(0, 15, 0, 10, {
Xtitle => 'X-data',
Ytitle => 'Y-data',
Title => 'An example of errb and points',
Font => 'Italic'
});
#3...........
},
'colin.def' => {
source => "colin",
params => "def",
expect => <<'#4...........',
env(
0, 15, 0, 10,
{
Xtitle => 'X-data',
Ytitle => 'Y-data',
Title => 'An example of errb and points',
Font => 'Italic'
}
);
#4...........
},
'essential.def' => {
source => "essential",
params => "def",
expect => <<'#5...........',
# Run with mangle to squeeze out the white space
# also run with extrude
# never combine two bare words or numbers
status and ::ok(1);
return ::spw(...);
for bla::bla:: abc;
# do not combine 'overload::' and 'and'
if $self->{bareStringify}
and ref $_
and defined %overload::
and defined &{'overload::StrVal'};
# do not combine 'SINK' and 'if'
my $size = -s ::SINK if $file;
# do not combine to make $inputeq"quit"
if ( $input eq "quit" );
# do not combine a number with a concatenation dot to get a float '78.'
$vt100_compatible ? "\e[0;0H" : ( '-' x 78 . "\n" );
# do not join a minus with a bare word, because you might form
# a file test operator. Here "z-i" would be taken as a file test.
if ( CORE::abs( $z - i ) < $eps );
# '= -' should not become =- or you will get a warning
# and something like these could become ambiguous without space
# after the '-':
use constant III => 1;
$a = $b - III;
$a = - III;
# keep a space between a token ending in '$' and any word;
die @$ if $@;
# avoid combining tokens to create new meanings. Example:
# this must not become $a++$b
$a + +$b;
# another example: do not combine these two &'s:
allow_options & &OPT_EXECCGI;
# Perl is sensitive to whitespace after the + here:
$b = xvals $a + 0.1 * yvals $a;
# keep paren separate here:
use Foo::Bar ();
# need space after foreach my; for example, this will fail in
# older versions of Perl:
foreach my $ft (@filetypes) ...
# must retain space between grep and left paren; "grep(" may fail
my $match = grep ( m/^-extrude$/, @list ) ? 1 : 0;
# don't stick numbers next to left parens, as in:
use Mail::Internet 1.28 ();
# do not remove space between an '&' and a bare word because
# it may turn into a function evaluation, like here
# between '&' and 'O_ACCMODE', producing a syntax error [File.pm]
$opts{rdonly} = ( ( $opts{mode} & O_ACCMODE ) == O_RDONLY );
#5...........
},
'essential.essential1' => {
source => "essential",
params => "essential1",
expect => <<'#6...........',
# Run with mangle to squeeze out the white space
# also run with extrude
# never combine two bare words or numbers
status and ::ok(1);
return ::spw(...);
for bla::bla:: abc;
# do not combine 'overload::' and 'and'
if$self->{bareStringify}and ref$_ and defined%overload:: and defined&{'overload::StrVal'};
# do not combine 'SINK' and 'if'
my$size=-s::SINK if$file;
# do not combine to make $inputeq"quit"
if($input eq"quit");
# do not combine a number with a concatenation dot to get a float '78.'
$vt100_compatible?"\e[0;0H":('-' x 78 ."\n");
# do not join a minus with a bare word, because you might form
# a file test operator. Here "z-i" would be taken as a file test.
if(CORE::abs($z- i)<$eps);
# '= -' should not become =- or you will get a warning
# and something like these could become ambiguous without space
# after the '-':
use constant III=>1;
$a=$b- III;
$a=- III;
# keep a space between a token ending in '$' and any word;
die@$ if$@;
# avoid combining tokens to create new meanings. Example:
# this must not become $a++$b
$a+ +$b;
# another example: do not combine these two &'s:
allow_options& &OPT_EXECCGI;
# Perl is sensitive to whitespace after the + here:
$b=xvals$a + 0.1*yvals$a;
# keep paren separate here:
use Foo::Bar ();
# need space after foreach my; for example, this will fail in
# older versions of Perl:
foreach my$ft(@filetypes)...
# must retain space between grep and left paren; "grep(" may fail
my$match=grep (m/^-extrude$/,@list)?1:0;
# don't stick numbers next to left parens, as in:
use Mail::Internet 1.28 ();
# do not remove space between an '&' and a bare word because
# it may turn into a function evaluation, like here
# between '&' and 'O_ACCMODE', producing a syntax error [File.pm]
$opts{rdonly}=(($opts{mode}& O_ACCMODE)==O_RDONLY);
#6...........
},
'essential.essential2' => {
source => "essential",
params => "essential2",
expect => <<'#7...........',
# Run with mangle to squeeze out the white space
# also run with extrude
# never combine two bare words or numbers
status
and
::ok(
1
)
;
return
::spw(
...
)
;
for
bla::bla::
abc
;
# do not combine 'overload::' and 'and'
if
$self
->
{bareStringify}
and
ref
$_
and
defined
%overload::
and
defined
&{
'overload::StrVal'
}
;
# do not combine 'SINK' and 'if'
my$size
=
-s::SINK
if
$file
;
# do not combine to make $inputeq"quit"
if
(
$input
eq
"quit"
)
;
# do not combine a number with a concatenation dot to get a float '78.'
$vt100_compatible?
"\e[0;0H"
:
(
'-'
x
78
.
"\n"
)
;
# do not join a minus with a bare word, because you might form
# a file test operator. Here "z-i" would be taken as a file test.
if
(
CORE::abs
(
$z
-
i
)
<
$eps
)
;
# '= -' should not become =- or you will get a warning
# and something like these could become ambiguous without space
# after the '-':
use
constant
III=>
1
;
$a
=
$b
-
III
;
$a
=
-
III
;
# keep a space between a token ending in '$' and any word;
die
@$
if
$@
;
# avoid combining tokens to create new meanings. Example:
# this must not become $a++$b
$a
+
+
$b
;
# another example: do not combine these two &'s:
allow_options
&
&OPT_EXECCGI
;
# Perl is sensitive to whitespace after the + here:
$b
=
xvals$a
+
0.1
*
yvals$a;
# keep paren separate here:
use
Foo::Bar (
)
;
# need space after foreach my; for example, this will fail in
# older versions of Perl:
foreach
my$ft
(
@filetypes
)
...
# must retain space between grep and left paren; "grep(" may fail
my$match
=
grep
(
m/^-extrude$/
,
@list
)
?
1
:
0
;
# don't stick numbers next to left parens, as in:
use
Mail::Internet
1.28
(
)
;
# do not remove space between an '&' and a bare word because
# it may turn into a function evaluation, like here
# between '&' and 'O_ACCMODE', producing a syntax error [File.pm]
$opts{rdonly}
=
(
(
$opts{mode}
&
O_ACCMODE
)
==
O_RDONLY
)
;
#7...........
},
'extrude1.def' => {
source => "extrude1",
params => "def",
expect => <<'#8...........',
# do not break before the ++
print $x++ . "\n";
#8...........
},
'extrude1.extrude' => {
source => "extrude1",
params => "extrude",
expect => <<'#9...........',
# do not break before the ++
print$x++
.
"\n"
;
#9...........
},
'extrude2.def' => {
source => "extrude2",
params => "def",
expect => <<'#10...........',
if ( -l pid_filename() ) {
return readlink( pid_filename() );
}
#10...........
},
'extrude2.extrude' => {
source => "extrude2",
params => "extrude",
expect => <<'#11...........',
if
(
-l pid_filename(
)
)
{
return
readlink
(
pid_filename(
)
)
;
}
#11...........
},
'extrude3.def' => {
source => "extrude3",
params => "def",
expect => <<'#12...........',
# Breaking before a ++ can cause perl to guess wrong
print( ( $i++ & 1 ) ? $_ : ( $change{$_} || $_ ) );
# Space between '&' and 'O_ACCMODE' is essential here
$opts{rdonly} = ( ( $opts{mode} & O_ACCMODE ) == O_RDONLY );
#12...........
},
'extrude3.extrude' => {
source => "extrude3",
params => "extrude",
expect => <<'#13...........',
# Breaking before a ++ can cause perl to guess wrong
print
(
(
$i++
&
1
)
?
$_
:
(
$change{
$_
}
||
$_
)
)
;
# Space between '&' and 'O_ACCMODE' is essential here
$opts{rdonly}
=
(
(
$opts{mode}
&
O_ACCMODE
)
==
O_RDONLY
)
;
#13...........
},
'extrude4.def' => {
source => "extrude4",
params => "def",
expect => <<'#14...........',
# From Safe.pm caused trouble with extrude
use Opcode 1.01, qw(
opset opset_to_ops opmask_add
empty_opset full_opset invert_opset verify_opset
opdesc opcodes opmask define_optag opset_to_hex
);
#14...........
},
'extrude4.extrude' => {
source => "extrude4",
params => "extrude",
expect => <<'#15...........',
# From Safe.pm caused trouble with extrude
use
Opcode
1.01
,
qw(
opset opset_to_ops opmask_add
empty_opset full_opset invert_opset verify_opset
opdesc opcodes opmask define_optag opset_to_hex
)
;
#15...........
},
'fabrice_bug.def' => {
source => "fabrice_bug",
params => "def",
expect => <<'#16...........',
# no space around ^variable with -bt=0
my $before = ${^PREMATCH};
my $after = ${PREMATCH};
#16...........
},
'fabrice_bug.fabrice_bug' => {
source => "fabrice_bug",
params => "fabrice_bug",
expect => <<'#17...........',
# no space around ^variable with -bt=0
my $before = ${^PREMATCH};
my $after = ${ PREMATCH };
#17...........
},
'format1.def' => {
source => "format1",
params => "def",
expect => <<'#18...........',
if (/^--list$/o) {
format =
@<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$_, $val
.
print "Available strips:\n";
for ( split( /\|/, $known_strips ) ) {
$val = $defs{$_}{'name'};
write;
}
}
#18...........
},
'given1.def' => {
source => "given1",
params => "def",
expect => <<'#19...........',
given ( [ 9, "a", 11 ] ) {
when (qr/\d/) {
given ($count) {
when (1) { ok( $count == 1 ) }
else { ok( $count != 1 ) }
when ( [ 5, 6 ] ) { ok(0) }
else { ok(1) }
}
}
ok(1) when 11;
}
#19...........
},
'gnu1.def' => {
source => "gnu1",
params => "def",
expect => <<'#20...........',
@common_sometimes = (
"aclocal.m4", "acconfig.h", "config.h.top", "config.h.bot",
"stamp-h.in", 'stamp-vti'
);
#20...........
},
};
my $ntests = 0 + keys %{$rtests};
plan tests => $ntests;
}
foreach my $key ( sort keys %{$rtests} ) {
my $output;
my $sname = $rtests->{$key}->{source};
my $expect = $rtests->{$key}->{expect};
my $pname = $rtests->{$key}->{params};
my $source = $rsources->{$sname};
my $params = defined($pname) ? $rparams->{$pname} : "";
my $stderr_string;
my $errorfile_string;
my $err = Perl::Tidy::perltidy(
source => \$source,
destination => \$output,
perltidyrc => \$params,
argv => '',
stderr => \$stderr_string,
errorfile => \$errorfile_string,
);
if ( $err || $stderr_string || $errorfile_string ) {
print STDERR "Error output received for test '$key'\n";
if ($err) {
print STDERR "An error flag '$err' was returned\n";
ok( !$err );
}
if ($stderr_string) {
print STDERR "---------------------\n";
print STDERR "<<STDERR>>\n$stderr_string\n";
print STDERR "---------------------\n";
ok( !$stderr_string );
}
if ($errorfile_string) {
print STDERR "---------------------\n";
print STDERR "<<.ERR file>>\n$errorfile_string\n";
print STDERR "---------------------\n";
ok( !$errorfile_string );
}
}
else {
if ( !is( $output, $expect, $key ) ) {
my $leno = length($output);
my $lene = length($expect);
if ( $leno == $lene ) {
print STDERR
"#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
}
else {
print STDERR
"#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";
}
}
}
}