--- /dev/null
+ # side comments limit gnu type formatting with l=80; note extra comma
+ push @tests, [
+ "Lowest code point requiring 13 bytes to represent", # 2**36
+ "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80",
+ ($::is64bit) ? 0x1000000000 : -1, # overflows on 32bit
+ ],
+ ;
--- /dev/null
+ # side comments limit gnu type formatting with l=80; note extra comma
+ push @tests, [
+ "Lowest code point requiring 13 bytes to represent", # 2**36
+ "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80",
+ ($::is64bit) ? 0x1000000000 : -1, # overflows on 32bit
+ ],
+ ;
--- /dev/null
+# a variety of line types for testing -kgb
+use strict;
+use Test;
+use Encode qw(from_to encode decode
+ encode_utf8 decode_utf8
+ find_encoding is_utf8);
+
+use charnames qw(greek);
+our $targetdir = "/usr/local/doc/HTML/Perl";
+
+local (
+ $tocfile, $loffile, $lotfile, $footfile,
+ $citefile, $idxfile, $figure_captions, $table_captions,
+ $footnotes, $citations, %font_size, %index,
+ %done, $t_title, $t_author, $t_date,
+ $t_address, $t_affil, $changed
+);
+my @UNITCHECKs =
+ B::unitcheck_av->isa("B::AV")
+ ? B::unitcheck_av->ARRAY
+ : ();
+
+my @CHECKs = B::check_av->isa("B::AV") ? B::check_av->ARRAY : ();
+my $dna = Bio::LiveSeq::DNA->new( -seq => $dnasequence );
+my $min = 1;
+my $max = length($dnasequence);
+my $T = $G->_strongly_connected;
+
+my %R = $T->vertex_roots;
+my @C; # We're not calling the strongly_connected_components()
+ # Do not separate this hanging side comment from previous
+
+my $G = shift;
+
+my $exon = Bio::LiveSeq::Exon->new(
+ -seq => $dna,
+ -start => $min,
+ -end => $max,
+ -strand => 1
+);
+my @inputs = (
+ 0777, 0700, 0470, 0407, 0433, 0400, 0430, 0403, 0111, 0100,
+ 0110, 0101, 0731, 0713, 0317, 0371, 0173, 0137
+);
+my $impulse =
+ ( 1 - $factor ) * ( 170 - $u ) + ( 350 / $u**0.65 + 500 / $u**5 ) * $factor;
+my $r = q{
+pm_to_blib: $(TO_INST_PM)
+};
+my $regcomp_re =
+ "(?<routine>ckWARN(?:\\d+)?reg\\w*|vWARN\\d+|$regcomp_fail_re)";
+my $position = List::MoreUtils::firstidx {
+ refaddr $_ == $key
+}
+
+my $alignprogram =
+"/usr/local/etc/bioinfo/fasta2/align -s /usr/local/etc/bioinfo/fasta2/idnaa.mat $fastafile1 $fastafile2 2>/dev/null | $grepcut"
+ ; # ALIGN
+my $skel_name =
+ ( exists( $xml_tree->{'name'} ) ) ? $xml_tree->{'name'} : "";
+my $grp = GroupGetValues( $conf->{dbh}, $group_id );
+
+my $adm_profile =
+ ProfileGetUser( $conf->{dbh}, $grp->{id_admin}, $group_id );
+my $harness = TAP::Harness->new(
+ { verbosity => 1, formatter_class => "TAP::Formatter::Console" } );
+require File::Temp;
+
+require Time::HiRes;
+
+my ( $fh, $filename ) = File::Temp::tempfile("Time-HiRes-utime-XXXXXXXXX");
+use File::Basename qw[dirname];
+my $dirname = dirname($filename);
+my $CUT = qr/\n=cut.*$EOP/;
+
+my $pod_or_DATA = qr/
+ ^=(?:head[1-4]|item) .*? $CUT
+ | ^=pod .*? $CUT
+ | ^=for .*? $CUT
+ | ^=begin .*? $CUT
+ | ^__(DATA|END)__\r?\n.*
+ /smx;
+
+require Cwd;
+print "continuing\n";
+exit 1;
if ( $PLATFORM eq 'aix' ) {
skip_symbols( [ qw(
- Perl_dump_fds
- Perl_ErrorNo
- Perl_GetVars
- PL_sys_intern
- ) ] );
+ Perl_dump_fds
+ Perl_ErrorNo
+ Perl_GetVars
+ PL_sys_intern
+ ) ] );
}
# qw weld with -wn
use_all_ok( qw{
- PPI
- PPI::Tokenizer
- PPI::Lexer
- PPI::Dumper
- PPI::Find
- PPI::Normal
- PPI::Util
- PPI::Cache
- } );
+ PPI
+ PPI::Tokenizer
+ PPI::Lexer
+ PPI::Dumper
+ PPI::Find
+ PPI::Normal
+ PPI::Util
+ PPI::Cache
+} );
--- /dev/null
+ # test with -wn -gnu
+ foreach my $parameter (
+ qw(
+ set_themes
+ add_themes
+ severity
+ maximum_violations_per_document
+ _non_public_data
+ )
+ )
+ {
+ is(
+ $config->get($parameter),
+ undef,
+ qq<"$parameter" is not defined via get() for $policy_short_name.>,
+ );
+ }
--- /dev/null
+ # side comments limit gnu type formatting with l=80; note extra comma
+ push @tests, [
+ "Lowest code point requiring 13 bytes to represent", # 2**36
+ "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80",
+ ($::is64bit) ? 0x1000000000 : -1, # overflows on 32bit
+ ],
+ ;
--- /dev/null
+-nkgbi -kgbb=0 -kgba=2 -kgbs=1 -kgbd
--- /dev/null
+# a variety of line types for testing -kgb
+use strict;
+use Test;
+use Encode qw(from_to encode decode
+ encode_utf8 decode_utf8
+ find_encoding is_utf8);
+
+use charnames qw(greek);
+our $targetdir = "/usr/local/doc/HTML/Perl";
+
+local (
+ $tocfile, $loffile, $lotfile, $footfile,
+ $citefile, $idxfile, $figure_captions, $table_captions,
+ $footnotes, $citations, %font_size, %index,
+ %done, $t_title, $t_author, $t_date,
+ $t_address, $t_affil, $changed
+);
+my @UNITCHECKs =
+ B::unitcheck_av->isa("B::AV")
+ ? B::unitcheck_av->ARRAY
+ : ();
+
+my @CHECKs = B::check_av->isa("B::AV") ? B::check_av->ARRAY : ();
+my $dna = Bio::LiveSeq::DNA->new( -seq => $dnasequence );
+my $min = 1;
+my $max = length($dnasequence);
+my $T = $G->_strongly_connected;
+
+my %R = $T->vertex_roots;
+my @C; # We're not calling the strongly_connected_components()
+ # Do not separate this hanging side comment from previous
+
+my $G = shift;
+
+my $exon = Bio::LiveSeq::Exon->new(
+ -seq => $dna,
+ -start => $min,
+ -end => $max,
+ -strand => 1
+);
+my @inputs = (
+ 0777, 0700, 0470, 0407, 0433, 0400, 0430, 0403, 0111, 0100,
+ 0110, 0101, 0731, 0713, 0317, 0371, 0173, 0137
+);
+my $impulse =
+ ( 1 - $factor ) * ( 170 - $u ) +
+ ( 350 / $u**0.65 + 500 / $u**5 ) * $factor;
+my $r = q{
+pm_to_blib: $(TO_INST_PM)
+};
+my $regcomp_re =
+ "(?<routine>ckWARN(?:\\d+)?reg\\w*|vWARN\\d+|$regcomp_fail_re)";
+my $position = List::MoreUtils::firstidx {
+ refaddr $_ == $key
+}
+
+my $alignprogram =
+"/usr/local/etc/bioinfo/fasta2/align -s /usr/local/etc/bioinfo/fasta2/idnaa.mat $fastafile1 $fastafile2 2>/dev/null | $grepcut"
+ ; # ALIGN
+my $skel_name =
+ ( exists( $xml_tree->{'name'} ) ) ? $xml_tree->{'name'} : "";
+my $grp = GroupGetValues( $conf->{dbh}, $group_id );
+
+my $adm_profile =
+ ProfileGetUser( $conf->{dbh}, $grp->{id_admin}, $group_id );
+my $harness = TAP::Harness->new(
+ { verbosity => 1, formatter_class => "TAP::Formatter::Console" } );
+require File::Temp;
+
+require Time::HiRes;
+
+my ( $fh, $filename ) = File::Temp::tempfile("Time-HiRes-utime-XXXXXXXXX");
+use File::Basename qw[dirname];
+my $dirname = dirname($filename);
+my $CUT = qr/\n=cut.*$EOP/;
+
+my $pod_or_DATA = qr/
+ ^=(?:head[1-4]|item) .*? $CUT
+ | ^=pod .*? $CUT
+ | ^=for .*? $CUT
+ | ^=begin .*? $CUT
+ | ^__(DATA|END)__\r?\n.*
+ /smx;
+
+require Cwd;
+print "continuing\n";
+exit 1;
../snippets14.t kgb4.kgb
../snippets14.t kgb5.def
../snippets14.t kgb5.kgb
+../snippets14.t kgbd.def
+../snippets14.t kgbd.kgbd
+../snippets14.t kgb_tight.def
../snippets2.t angle.def
../snippets2.t arrows1.def
../snippets2.t arrows2.def
../snippets9.t rt98902.def
../snippets9.t rt98902.rt98902
../snippets9.t rt99961.def
-../snippets14.t kgbd.def
-../snippets14.t kgbd.kgbd
+../snippets14.t gnu5.def
+../snippets15.t gnu5.gnu
+../snippets15.t wngnu1.def
--- /dev/null
+ # test with -wn -gnu
+ foreach my $parameter (
+ qw(
+ set_themes
+ add_themes
+ severity
+ maximum_violations_per_document
+ _non_public_data
+ )
+ )
+ {
+ is(
+ $config->get($parameter),
+ undef,
+ qq<"$parameter" is not defined via get() for $policy_short_name.>,
+ );
+ }
expect => <<'#12...........',
if ( $PLATFORM eq 'aix' ) {
skip_symbols( [ qw(
- Perl_dump_fds
- Perl_ErrorNo
- Perl_GetVars
- PL_sys_intern
- ) ] );
+ Perl_dump_fds
+ Perl_ErrorNo
+ Perl_GetVars
+ PL_sys_intern
+ ) ] );
}
#12...........
},
expect => <<'#18...........',
# qw weld with -wn
use_all_ok( qw{
- PPI
- PPI::Tokenizer
- PPI::Lexer
- PPI::Dumper
- PPI::Find
- PPI::Normal
- PPI::Util
- PPI::Cache
- } );
+ PPI
+ PPI::Tokenizer
+ PPI::Lexer
+ PPI::Dumper
+ PPI::Find
+ PPI::Normal
+ PPI::Util
+ PPI::Cache
+} );
#18...........
},
#15 kgb5.kgb
#16 kgbd.def
#17 kgbd.kgbd
+#18 kgb_tight.def
+#19 gnu5.def
# To locate test #13 you can search for its name or the string '#13'
else { print " " }
----------
+ 'gnu5' => <<'----------',
+ # side comments limit gnu type formatting with l=80; note extra comma
+ push @tests, [
+ "Lowest code point requiring 13 bytes to represent", # 2**36
+ "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80",
+ ($::is64bit) ? 0x1000000000 : -1, # overflows on 32bit
+ ],
+ ;
+----------
+
'kgb1' => <<'----------',
# a variety of line types for testing -kgb
use strict;
: "-A";
my $F = "0";
print "with -kgb, put blank above this line; result=$result\n";
+----------
+
+ 'kgb_tight' => <<'----------',
+# a variety of line types for testing -kgb
+use strict;
+use Test;
+use Encode qw(from_to encode decode
+ encode_utf8 decode_utf8
+ find_encoding is_utf8);
+
+use charnames qw(greek);
+our $targetdir = "/usr/local/doc/HTML/Perl";
+
+local (
+ $tocfile, $loffile, $lotfile, $footfile,
+ $citefile, $idxfile, $figure_captions, $table_captions,
+ $footnotes, $citations, %font_size, %index,
+ %done, $t_title, $t_author, $t_date,
+ $t_address, $t_affil, $changed
+);
+my @UNITCHECKs =
+ B::unitcheck_av->isa("B::AV")
+ ? B::unitcheck_av->ARRAY
+ : ();
+
+my @CHECKs = B::check_av->isa("B::AV") ? B::check_av->ARRAY : ();
+my $dna = Bio::LiveSeq::DNA->new( -seq => $dnasequence );
+my $min = 1;
+my $max = length($dnasequence);
+my $T = $G->_strongly_connected;
+
+my %R = $T->vertex_roots;
+my @C; # We're not calling the strongly_connected_components()
+ # Do not separate this hanging side comment from previous
+
+my $G = shift;
+
+my $exon = Bio::LiveSeq::Exon->new(
+ -seq => $dna,
+ -start => $min,
+ -end => $max,
+ -strand => 1
+);
+my @inputs = (
+ 0777, 0700, 0470, 0407, 0433, 0400, 0430, 0403, 0111, 0100,
+ 0110, 0101, 0731, 0713, 0317, 0371, 0173, 0137
+);
+my $impulse =
+ ( 1 - $factor ) * ( 170 - $u ) +
+ ( 350 / $u**0.65 + 500 / $u**5 ) * $factor;
+my $r = q{
+pm_to_blib: $(TO_INST_PM)
+};
+my $regcomp_re =
+ "(?<routine>ckWARN(?:\\d+)?reg\\w*|vWARN\\d+|$regcomp_fail_re)";
+my $position = List::MoreUtils::firstidx {
+ refaddr $_ == $key
+}
+
+my $alignprogram =
+"/usr/local/etc/bioinfo/fasta2/align -s /usr/local/etc/bioinfo/fasta2/idnaa.mat $fastafile1 $fastafile2 2>/dev/null | $grepcut"
+ ; # ALIGN
+my $skel_name =
+ ( exists( $xml_tree->{'name'} ) ) ? $xml_tree->{'name'} : "";
+my $grp = GroupGetValues( $conf->{dbh}, $group_id );
+
+my $adm_profile =
+ ProfileGetUser( $conf->{dbh}, $grp->{id_admin}, $group_id );
+my $harness = TAP::Harness->new(
+ { verbosity => 1, formatter_class => "TAP::Formatter::Console" } );
+require File::Temp;
+
+require Time::HiRes;
+
+my ( $fh, $filename ) = File::Temp::tempfile("Time-HiRes-utime-XXXXXXXXX");
+use File::Basename qw[dirname];
+my $dirname = dirname($filename);
+my $CUT = qr/\n=cut.*$EOP/;
+
+my $pod_or_DATA = qr/
+ ^=(?:head[1-4]|item) .*? $CUT
+ | ^=pod .*? $CUT
+ | ^=for .*? $CUT
+ | ^=begin .*? $CUT
+ | ^__(DATA|END)__\r?\n.*
+ /smx;
+
+require Cwd;
+print "continuing\n";
+exit 1;
----------
'kgbd' => <<'----------',
$VERSION = 0.01;
#17...........
},
+
+ 'kgb_tight.def' => {
+ source => "kgb_tight",
+ params => "def",
+ expect => <<'#18...........',
+# a variety of line types for testing -kgb
+use strict;
+use Test;
+use Encode qw(from_to encode decode
+ encode_utf8 decode_utf8
+ find_encoding is_utf8);
+
+use charnames qw(greek);
+our $targetdir = "/usr/local/doc/HTML/Perl";
+
+local (
+ $tocfile, $loffile, $lotfile, $footfile,
+ $citefile, $idxfile, $figure_captions, $table_captions,
+ $footnotes, $citations, %font_size, %index,
+ %done, $t_title, $t_author, $t_date,
+ $t_address, $t_affil, $changed
+);
+my @UNITCHECKs =
+ B::unitcheck_av->isa("B::AV")
+ ? B::unitcheck_av->ARRAY
+ : ();
+
+my @CHECKs = B::check_av->isa("B::AV") ? B::check_av->ARRAY : ();
+my $dna = Bio::LiveSeq::DNA->new( -seq => $dnasequence );
+my $min = 1;
+my $max = length($dnasequence);
+my $T = $G->_strongly_connected;
+
+my %R = $T->vertex_roots;
+my @C; # We're not calling the strongly_connected_components()
+ # Do not separate this hanging side comment from previous
+
+my $G = shift;
+
+my $exon = Bio::LiveSeq::Exon->new(
+ -seq => $dna,
+ -start => $min,
+ -end => $max,
+ -strand => 1
+);
+my @inputs = (
+ 0777, 0700, 0470, 0407, 0433, 0400, 0430, 0403, 0111, 0100,
+ 0110, 0101, 0731, 0713, 0317, 0371, 0173, 0137
+);
+my $impulse =
+ ( 1 - $factor ) * ( 170 - $u ) + ( 350 / $u**0.65 + 500 / $u**5 ) * $factor;
+my $r = q{
+pm_to_blib: $(TO_INST_PM)
+};
+my $regcomp_re =
+ "(?<routine>ckWARN(?:\\d+)?reg\\w*|vWARN\\d+|$regcomp_fail_re)";
+my $position = List::MoreUtils::firstidx {
+ refaddr $_ == $key
+}
+
+my $alignprogram =
+"/usr/local/etc/bioinfo/fasta2/align -s /usr/local/etc/bioinfo/fasta2/idnaa.mat $fastafile1 $fastafile2 2>/dev/null | $grepcut"
+ ; # ALIGN
+my $skel_name =
+ ( exists( $xml_tree->{'name'} ) ) ? $xml_tree->{'name'} : "";
+my $grp = GroupGetValues( $conf->{dbh}, $group_id );
+
+my $adm_profile =
+ ProfileGetUser( $conf->{dbh}, $grp->{id_admin}, $group_id );
+my $harness = TAP::Harness->new(
+ { verbosity => 1, formatter_class => "TAP::Formatter::Console" } );
+require File::Temp;
+
+require Time::HiRes;
+
+my ( $fh, $filename ) = File::Temp::tempfile("Time-HiRes-utime-XXXXXXXXX");
+use File::Basename qw[dirname];
+my $dirname = dirname($filename);
+my $CUT = qr/\n=cut.*$EOP/;
+
+my $pod_or_DATA = qr/
+ ^=(?:head[1-4]|item) .*? $CUT
+ | ^=pod .*? $CUT
+ | ^=for .*? $CUT
+ | ^=begin .*? $CUT
+ | ^__(DATA|END)__\r?\n.*
+ /smx;
+
+require Cwd;
+print "continuing\n";
+exit 1;
+#18...........
+ },
+
+ 'gnu5.def' => {
+ source => "gnu5",
+ params => "def",
+ expect => <<'#19...........',
+ # side comments limit gnu type formatting with l=80; note extra comma
+ push @tests, [
+ "Lowest code point requiring 13 bytes to represent", # 2**36
+ "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80",
+ ($::is64bit) ? 0x1000000000 : -1, # overflows on 32bit
+ ],
+ ;
+#19...........
+ },
};
my $ntests = 0 + keys %{$rtests};
--- /dev/null
+# Created with: ./make_t.pl
+
+# Contents:
+#1 gnu5.gnu
+#2 wngnu1.def
+
+# To locate test #13 you can search for its name or the string '#13'
+
+use strict;
+use Test;
+use Carp;
+use Perl::Tidy;
+my $rparams;
+my $rsources;
+my $rtests;
+
+BEGIN {
+
+ ###########################################
+ # BEGIN SECTION 1: Parameter combinations #
+ ###########################################
+ $rparams = {
+ 'def' => "",
+ 'gnu' => "-gnu",
+ };
+
+ ############################
+ # BEGIN SECTION 2: Sources #
+ ############################
+ $rsources = {
+
+ 'gnu5' => <<'----------',
+ # side comments limit gnu type formatting with l=80; note extra comma
+ push @tests, [
+ "Lowest code point requiring 13 bytes to represent", # 2**36
+ "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80",
+ ($::is64bit) ? 0x1000000000 : -1, # overflows on 32bit
+ ],
+ ;
+----------
+
+ 'wngnu1' => <<'----------',
+ # test with -wn -gnu
+ foreach my $parameter (
+ qw(
+ set_themes
+ add_themes
+ severity
+ maximum_violations_per_document
+ _non_public_data
+ )
+ )
+ {
+ is(
+ $config->get($parameter),
+ undef,
+ qq<"$parameter" is not defined via get() for $policy_short_name.>,
+ );
+ }
+----------
+ };
+
+ ####################################
+ # BEGIN SECTION 3: Expected output #
+ ####################################
+ $rtests = {
+
+ 'gnu5.gnu' => {
+ source => "gnu5",
+ params => "gnu",
+ expect => <<'#1...........',
+ # side comments limit gnu type formatting with l=80; note extra comma
+ push @tests, [
+ "Lowest code point requiring 13 bytes to represent", # 2**36
+ "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80",
+ ($::is64bit) ? 0x1000000000 : -1, # overflows on 32bit
+ ],
+ ;
+#1...........
+ },
+
+ 'wngnu1.def' => {
+ source => "wngnu1",
+ params => "def",
+ expect => <<'#2...........',
+ # test with -wn -gnu
+ foreach my $parameter (
+ qw(
+ set_themes
+ add_themes
+ severity
+ maximum_violations_per_document
+ _non_public_data
+ )
+ )
+ {
+ is(
+ $config->get($parameter),
+ undef,
+ qq<"$parameter" is not defined via get() for $policy_short_name.>,
+ );
+ }
+#2...........
+ },
+ };
+
+ my $ntests = 0 + keys %{$rtests};
+ plan tests => $ntests;
+}
+
+###############
+# EXECUTE TESTS
+###############
+
+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 => '', # for safety; hide any ARGV from perltidy
+ stderr => \$stderr_string,
+ errorfile => \$errorfile_string, # not used when -se flag is set
+ );
+ if ( $err || $stderr_string || $errorfile_string ) {
+ if ($err) {
+ print STDERR
+"This error received calling Perl::Tidy with '$sname' + '$pname'\n";
+ ok( !$err );
+ }
+ if ($stderr_string) {
+ print STDERR "---------------------\n";
+ print STDERR "<<STDERR>>\n$stderr_string\n";
+ print STDERR "---------------------\n";
+ print STDERR
+"This error received calling Perl::Tidy with '$sname' + '$pname'\n";
+ ok( !$stderr_string );
+ }
+ if ($errorfile_string) {
+ print STDERR "---------------------\n";
+ print STDERR "<<.ERR file>>\n$errorfile_string\n";
+ print STDERR "---------------------\n";
+ print STDERR
+"This error received calling Perl::Tidy with '$sname' + '$pname'\n";
+ ok( !$errorfile_string );
+ }
+ }
+ else {
+ ok( $output, $expect );
+ }
+}
projects / perltidy.git / commitdiff