--- /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 $octal_mode;
+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 @exons = ($exon);
+my $fastafile2 = "/tmp/tmpfastafile2";
+my $grepcut = 'egrep -v "[[:digit:]]|^ *$|sequences" | cut -c8-'; # grep/cut
+my $alignprogram =
+"/usr/local/etc/bioinfo/fasta2/align -s /usr/local/etc/bioinfo/fasta2/idnaa.mat $fastafile1 $fastafile2 2>/dev/null | $grepcut"
+ ; # ALIGN
+my $xml = new Mioga::XML::Simple( forcearray => 1 );
+my $xml_tree = $xml->XMLin($skel_file);
+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;
+( my $boot = $self->{NAME} ) =~ s/:/_/g;
+doit(
+ sub { @E::ISA = qw/F/ },
+ sub { @E::ISA = qw/D/; @C::ISA = qw/F/ },
+ sub { @C::ISA = qw//; @A::ISA = qw/K/ },
+ sub { @A::ISA = qw//; @J::ISA = qw/F K/ },
+ sub { @J::ISA = qw/F/; @H::ISA = qw/K G/ },
+ sub { @H::ISA = qw/G/; @B::ISA = qw/B/ },
+ sub { @B::ISA = qw//; @K::ISA = qw/K J I/ },
+ sub { @K::ISA = qw/J I/; @D::ISA = qw/A H B C/ },
+ return;
+);
+my %extractor_for = (
+ quotelike => [ $ws, $variable, $id, { MATCH => \&extract_quotelike } ],
+ regex => [ $ws, $pod_or_DATA, $id, $exql ],
+ string => [ $ws, $pod_or_DATA, $id, $exql ],
+ code => [
+ $ws, { DONT_MATCH => $pod_or_DATA },
+ $variable, $id, { DONT_MATCH => \&extract_quotelike }
+ ],
+ code_no_comments => [
+ { DONT_MATCH => $comment },
+ $ncws, { DONT_MATCH => $pod_or_DATA },
+ $variable, $id, { DONT_MATCH => \&extract_quotelike }
+ ],
+ executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ],
+ executable_no_comments =>
+ [ { DONT_MATCH => $comment }, $ncws, { DONT_MATCH => $pod_or_DATA } ],
+ all => [ { MATCH => qr/(?s:.*)/ } ],
+);
+exit 1;
--- /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 $octal_mode;
+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 @exons = ($exon);
+my $fastafile2 = "/tmp/tmpfastafile2";
+my $grepcut = 'egrep -v "[[:digit:]]|^ *$|sequences" | cut -c8-'; # grep/cut
+my $alignprogram =
+"/usr/local/etc/bioinfo/fasta2/align -s /usr/local/etc/bioinfo/fasta2/idnaa.mat $fastafile1 $fastafile2 2>/dev/null | $grepcut"
+ ; # ALIGN
+my $xml = new Mioga::XML::Simple( forcearray => 1 );
+my $xml_tree = $xml->XMLin($skel_file);
+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;
+
+( my $boot = $self->{NAME} ) =~ s/:/_/g;
+doit(
+
+ sub { @E::ISA = qw/F/ },
+ sub { @E::ISA = qw/D/; @C::ISA = qw/F/ },
+ sub { @C::ISA = qw//; @A::ISA = qw/K/ },
+ sub { @A::ISA = qw//; @J::ISA = qw/F K/ },
+ sub { @J::ISA = qw/F/; @H::ISA = qw/K G/ },
+ sub { @H::ISA = qw/G/; @B::ISA = qw/B/ },
+ sub { @B::ISA = qw//; @K::ISA = qw/K J I/ },
+ sub { @K::ISA = qw/J I/; @D::ISA = qw/A H B C/ },
+
+ return;
+);
+my %extractor_for = (
+ quotelike => [ $ws, $variable, $id, { MATCH => \&extract_quotelike } ],
+ regex => [ $ws, $pod_or_DATA, $id, $exql ],
+ string => [ $ws, $pod_or_DATA, $id, $exql ],
+ code => [
+ $ws, { DONT_MATCH => $pod_or_DATA },
+ $variable, $id, { DONT_MATCH => \&extract_quotelike }
+ ],
+ code_no_comments => [
+ { DONT_MATCH => $comment },
+ $ncws, { DONT_MATCH => $pod_or_DATA },
+ $variable, $id, { DONT_MATCH => \&extract_quotelike }
+ ],
+ executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ],
+ executable_no_comments =>
+ [ { DONT_MATCH => $comment }, $ncws, { DONT_MATCH => $pod_or_DATA } ],
+ all => [ { MATCH => qr/(?s:.*)/ } ],
+);
+exit 1;
--- /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 $octal_mode;
+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 @exons = ($exon);
+my $fastafile2 = "/tmp/tmpfastafile2";
+my $grepcut = 'egrep -v "[[:digit:]]|^ *$|sequences" | cut -c8-'; # grep/cut
+my $alignprogram =
+"/usr/local/etc/bioinfo/fasta2/align -s /usr/local/etc/bioinfo/fasta2/idnaa.mat $fastafile1 $fastafile2 2>/dev/null | $grepcut"
+ ; # ALIGN
+my $xml = new Mioga::XML::Simple( forcearray => 1 );
+my $xml_tree = $xml->XMLin($skel_file);
+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;
+( my $boot = $self->{NAME} ) =~ s/:/_/g;
+doit(
+sub { @E::ISA = qw/F/ },
+sub { @E::ISA = qw/D/; @C::ISA = qw/F/ },
+sub { @C::ISA = qw//; @A::ISA = qw/K/ },
+sub { @A::ISA = qw//; @J::ISA = qw/F K/ },
+sub { @J::ISA = qw/F/; @H::ISA = qw/K G/ },
+sub { @H::ISA = qw/G/; @B::ISA = qw/B/ },
+sub { @B::ISA = qw//; @K::ISA = qw/K J I/ },
+sub { @K::ISA = qw/J I/; @D::ISA = qw/A H B C/ },
+return;
+);
+my %extractor_for = (
+ quotelike => [ $ws, $variable, $id, { MATCH => \&extract_quotelike } ],
+ regex => [ $ws, $pod_or_DATA, $id, $exql ],
+ string => [ $ws, $pod_or_DATA, $id, $exql ],
+ code => [
+ $ws, { DONT_MATCH => $pod_or_DATA },
+ $variable, $id, { DONT_MATCH => \&extract_quotelike }
+ ],
+ code_no_comments => [
+ { DONT_MATCH => $comment },
+ $ncws, { DONT_MATCH => $pod_or_DATA },
+ $variable, $id, { DONT_MATCH => \&extract_quotelike }
+ ],
+ executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ],
+ executable_no_comments =>
+ [ { DONT_MATCH => $comment }, $ncws, { DONT_MATCH => $pod_or_DATA } ],
+ all => [ { MATCH => qr/(?s:.*)/ } ],
+);
+exit 1;
#1 else1.def
#2 else2.def
#3 ternary3.def
+#4 align17.def
+#5 align18.def
+#6 kgb1.def
+#7 kgb1.kgb
+#8 kgb2.def
+#9 kgb2.kgb
+#10 kgb3.def
+#11 kgb3.kgb
+#12 kgb4.def
+#13 kgb4.kgb
+#14 kgb5.def
+#15 kgb5.kgb
# To locate test #13 you can search for its name or the string '#13'
###########################################
# BEGIN SECTION 1: Parameter combinations #
###########################################
- $rparams = { 'def' => "", };
+ $rparams = {
+ 'def' => "",
+ 'kgb' => "-kgb",
+ };
############################
# BEGIN SECTION 2: Sources #
############################
$rsources = {
+ 'align17' => <<'----------',
+# align => even at broken sub block
+my%opt=(
+'cc'=>sub{$param::cachecom=1;},
+'cd'=>sub{$param::cachedisable=1;},
+'p'=>sub{
+$param::pflag=1;
+$param::build=0;
+}
+);
+----------
+
+ 'align18' => <<'----------',
+#align '&&'
+for($ENV{HTTP_USER_AGENT}){
+$page=
+/Mac/&&'m/Macintrash.html'
+||/Win(dows)?NT/&&'e/evilandrude.html'
+||/Win|MSIE|WebTV/&&'m/MicroslothWindows.html'
+||/Linux/&&'l/Linux.html'
+||/HP-UX/&&'h/HP-SUX.html'
+||/SunOS/&&'s/ScumOS.html'
+||'a/AppendixB.html';
+}
+----------
+
'else1' => <<'----------',
# pad after 'if' when followed by 'elsif'
if ( not defined $dir or not length $dir ) { $rslt = ''; }
else { print " " }
----------
+ 'kgb1' => <<'----------',
+# 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 $octal_mode;
+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 @exons = ($exon);
+my $fastafile2 = "/tmp/tmpfastafile2";
+my $grepcut = 'egrep -v "[[:digit:]]|^ *$|sequences" | cut -c8-'; # grep/cut
+my $alignprogram =
+"/usr/local/etc/bioinfo/fasta2/align -s /usr/local/etc/bioinfo/fasta2/idnaa.mat $fastafile1 $fastafile2 2>/dev/null | $grepcut"
+ ; # ALIGN
+my $xml = new Mioga::XML::Simple( forcearray => 1 );
+my $xml_tree = $xml->XMLin($skel_file);
+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;
+( my $boot = $self->{NAME} ) =~ s/:/_/g;
+doit(
+sub { @E::ISA = qw/F/ },
+sub { @E::ISA = qw/D/; @C::ISA = qw/F/ },
+sub { @C::ISA = qw//; @A::ISA = qw/K/ },
+sub { @A::ISA = qw//; @J::ISA = qw/F K/ },
+sub { @J::ISA = qw/F/; @H::ISA = qw/K G/ },
+sub { @H::ISA = qw/G/; @B::ISA = qw/B/ },
+sub { @B::ISA = qw//; @K::ISA = qw/K J I/ },
+sub { @K::ISA = qw/J I/; @D::ISA = qw/A H B C/ },
+return;
+);
+my %extractor_for = (
+ quotelike => [ $ws, $variable, $id, { MATCH => \&extract_quotelike } ],
+ regex => [ $ws, $pod_or_DATA, $id, $exql ],
+ string => [ $ws, $pod_or_DATA, $id, $exql ],
+ code => [
+ $ws, { DONT_MATCH => $pod_or_DATA },
+ $variable, $id, { DONT_MATCH => \&extract_quotelike }
+ ],
+ code_no_comments => [
+ { DONT_MATCH => $comment },
+ $ncws, { DONT_MATCH => $pod_or_DATA },
+ $variable, $id, { DONT_MATCH => \&extract_quotelike }
+ ],
+ executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ],
+ executable_no_comments =>
+ [ { DONT_MATCH => $comment }, $ncws, { DONT_MATCH => $pod_or_DATA } ],
+ all => [ { MATCH => qr/(?s:.*)/ } ],
+);
+exit 1;
+----------
+
+ 'kgb2' => <<'----------',
+# with -kgb, do no break after last my
+sub next_sibling {
+ my $self = shift;
+ my $parent = $_PARENT{refaddr $self} or return '';
+ my $key = refaddr $self;
+ my $elements = $parent->{children};
+ my $position = List::MoreUtils::firstidx {
+ refaddr $_ == $key
+ } @$elements;
+ $elements->[$position + 1] || '';
+}
+
+----------
+
+ 'kgb3' => <<'----------',
+#!/usr/bin/perl -w
+use strict; # with -kgb, no break after hash bang
+our ( @Changed, $TAP ); # break after isolated 'our'
+use File::Compare;
+use Symbol;
+use Text::Wrap();
+use Text::Warp();
+use Blast::IPS::MathUtils qw(
+ set_interpolation_points
+ table_row_interpolation
+ two_point_interpolation
+); # with -kgb, break around isolated 'local' below
+use Text::Warp();
+local($delta2print) =
+ (defined $size) ? int($size/50) : $defaultdelta2print;
+print "break before this line\n";
+----------
+
+ 'kgb4' => <<'----------',
+print "hello"; # with -kgb, break after this line
+use strict;
+use warnings;
+use Test::More tests => 1;
+use Pod::Simple::XHTML;
+my $c = <<EOF;
+=head1 Documentation
+The keyword group dies here
+Do not put a blank line in this here-doc
+EOF
+my $d = $c ."=cut\n";
+exit 1;
+_END_
+----------
+
+ 'kgb5' => <<'----------',
+# with -kgb, do not put blank in ternary
+print "Starting\n"; # with -kgb, break after this line
+my $A = "1";
+my $B = "0";
+my $C = "1";
+my $D = "1";
+my $result =
+ $A
+ ? $B
+ ? $C
+ ? "+A +B +C"
+ : "+A +B -C"
+ : "+A -B"
+ : "-A";
+my $F = "0";
+print "with -kgb, put blank above this line; result=$result\n";
+----------
+
'ternary3' => <<'----------',
# this previously caused trouble because of the = and =~
push( @aligns,
#3...........
},
+
+ 'align17.def' => {
+ source => "align17",
+ params => "def",
+ expect => <<'#4...........',
+# align => even at broken sub block
+my %opt = (
+ 'cc' => sub { $param::cachecom = 1; },
+ 'cd' => sub { $param::cachedisable = 1; },
+ 'p' => sub {
+ $param::pflag = 1;
+ $param::build = 0;
+ }
+);
+#4...........
+ },
+
+ 'align18.def' => {
+ source => "align18",
+ params => "def",
+ expect => <<'#5...........',
+#align '&&'
+for ( $ENV{HTTP_USER_AGENT} ) {
+ $page =
+ /Mac/ && 'm/Macintrash.html'
+ || /Win(dows)?NT/ && 'e/evilandrude.html'
+ || /Win|MSIE|WebTV/ && 'm/MicroslothWindows.html'
+ || /Linux/ && 'l/Linux.html'
+ || /HP-UX/ && 'h/HP-SUX.html'
+ || /SunOS/ && 's/ScumOS.html'
+ || 'a/AppendixB.html';
+}
+#5...........
+ },
+
+ 'kgb1.def' => {
+ source => "kgb1",
+ params => "def",
+ expect => <<'#6...........',
+# 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 $octal_mode;
+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 @exons = ($exon);
+my $fastafile2 = "/tmp/tmpfastafile2";
+my $grepcut = 'egrep -v "[[:digit:]]|^ *$|sequences" | cut -c8-'; # grep/cut
+my $alignprogram =
+"/usr/local/etc/bioinfo/fasta2/align -s /usr/local/etc/bioinfo/fasta2/idnaa.mat $fastafile1 $fastafile2 2>/dev/null | $grepcut"
+ ; # ALIGN
+my $xml = new Mioga::XML::Simple( forcearray => 1 );
+my $xml_tree = $xml->XMLin($skel_file);
+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;
+( my $boot = $self->{NAME} ) =~ s/:/_/g;
+doit(
+ sub { @E::ISA = qw/F/ },
+ sub { @E::ISA = qw/D/; @C::ISA = qw/F/ },
+ sub { @C::ISA = qw//; @A::ISA = qw/K/ },
+ sub { @A::ISA = qw//; @J::ISA = qw/F K/ },
+ sub { @J::ISA = qw/F/; @H::ISA = qw/K G/ },
+ sub { @H::ISA = qw/G/; @B::ISA = qw/B/ },
+ sub { @B::ISA = qw//; @K::ISA = qw/K J I/ },
+ sub { @K::ISA = qw/J I/; @D::ISA = qw/A H B C/ },
+ return;
+);
+my %extractor_for = (
+ quotelike => [ $ws, $variable, $id, { MATCH => \&extract_quotelike } ],
+ regex => [ $ws, $pod_or_DATA, $id, $exql ],
+ string => [ $ws, $pod_or_DATA, $id, $exql ],
+ code => [
+ $ws, { DONT_MATCH => $pod_or_DATA },
+ $variable, $id, { DONT_MATCH => \&extract_quotelike }
+ ],
+ code_no_comments => [
+ { DONT_MATCH => $comment },
+ $ncws, { DONT_MATCH => $pod_or_DATA },
+ $variable, $id, { DONT_MATCH => \&extract_quotelike }
+ ],
+ executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ],
+ executable_no_comments =>
+ [ { DONT_MATCH => $comment }, $ncws, { DONT_MATCH => $pod_or_DATA } ],
+ all => [ { MATCH => qr/(?s:.*)/ } ],
+);
+exit 1;
+#6...........
+ },
+
+ 'kgb1.kgb' => {
+ source => "kgb1",
+ params => "kgb",
+ expect => <<'#7...........',
+# 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 $octal_mode;
+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 @exons = ($exon);
+my $fastafile2 = "/tmp/tmpfastafile2";
+my $grepcut = 'egrep -v "[[:digit:]]|^ *$|sequences" | cut -c8-'; # grep/cut
+my $alignprogram =
+"/usr/local/etc/bioinfo/fasta2/align -s /usr/local/etc/bioinfo/fasta2/idnaa.mat $fastafile1 $fastafile2 2>/dev/null | $grepcut"
+ ; # ALIGN
+my $xml = new Mioga::XML::Simple( forcearray => 1 );
+my $xml_tree = $xml->XMLin($skel_file);
+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;
+
+( my $boot = $self->{NAME} ) =~ s/:/_/g;
+doit(
+
+ sub { @E::ISA = qw/F/ },
+ sub { @E::ISA = qw/D/; @C::ISA = qw/F/ },
+ sub { @C::ISA = qw//; @A::ISA = qw/K/ },
+ sub { @A::ISA = qw//; @J::ISA = qw/F K/ },
+ sub { @J::ISA = qw/F/; @H::ISA = qw/K G/ },
+ sub { @H::ISA = qw/G/; @B::ISA = qw/B/ },
+ sub { @B::ISA = qw//; @K::ISA = qw/K J I/ },
+ sub { @K::ISA = qw/J I/; @D::ISA = qw/A H B C/ },
+
+ return;
+);
+my %extractor_for = (
+ quotelike => [ $ws, $variable, $id, { MATCH => \&extract_quotelike } ],
+ regex => [ $ws, $pod_or_DATA, $id, $exql ],
+ string => [ $ws, $pod_or_DATA, $id, $exql ],
+ code => [
+ $ws, { DONT_MATCH => $pod_or_DATA },
+ $variable, $id, { DONT_MATCH => \&extract_quotelike }
+ ],
+ code_no_comments => [
+ { DONT_MATCH => $comment },
+ $ncws, { DONT_MATCH => $pod_or_DATA },
+ $variable, $id, { DONT_MATCH => \&extract_quotelike }
+ ],
+ executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ],
+ executable_no_comments =>
+ [ { DONT_MATCH => $comment }, $ncws, { DONT_MATCH => $pod_or_DATA } ],
+ all => [ { MATCH => qr/(?s:.*)/ } ],
+);
+exit 1;
+#7...........
+ },
+
+ 'kgb2.def' => {
+ source => "kgb2",
+ params => "def",
+ expect => <<'#8...........',
+# with -kgb, do no break after last my
+sub next_sibling {
+ my $self = shift;
+ my $parent = $_PARENT{ refaddr $self} or return '';
+ my $key = refaddr $self;
+ my $elements = $parent->{children};
+ my $position = List::MoreUtils::firstidx {
+ refaddr $_ == $key
+ }
+ @$elements;
+ $elements->[ $position + 1 ] || '';
+}
+
+#8...........
+ },
+
+ 'kgb2.kgb' => {
+ source => "kgb2",
+ params => "kgb",
+ expect => <<'#9...........',
+# with -kgb, do no break after last my
+sub next_sibling {
+
+ my $self = shift;
+ my $parent = $_PARENT{ refaddr $self} or return '';
+ my $key = refaddr $self;
+ my $elements = $parent->{children};
+ my $position = List::MoreUtils::firstidx {
+ refaddr $_ == $key
+ }
+ @$elements;
+ $elements->[ $position + 1 ] || '';
+}
+
+#9...........
+ },
+
+ 'kgb3.def' => {
+ source => "kgb3",
+ params => "def",
+ expect => <<'#10...........',
+#!/usr/bin/perl -w
+use strict; # with -kgb, no break after hash bang
+our ( @Changed, $TAP ); # break after isolated 'our'
+use File::Compare;
+use Symbol;
+use Text::Wrap();
+use Text::Warp();
+use Blast::IPS::MathUtils qw(
+ set_interpolation_points
+ table_row_interpolation
+ two_point_interpolation
+ ); # with -kgb, break around isolated 'local' below
+use Text::Warp();
+local ($delta2print) =
+ ( defined $size ) ? int( $size / 50 ) : $defaultdelta2print;
+print "break before this line\n";
+#10...........
+ },
+
+ 'kgb3.kgb' => {
+ source => "kgb3",
+ params => "kgb",
+ expect => <<'#11...........',
+#!/usr/bin/perl -w
+use strict; # with -kgb, no break after hash bang
+our ( @Changed, $TAP ); # break after isolated 'our'
+
+use File::Compare;
+use Symbol;
+use Text::Wrap();
+use Text::Warp();
+use Blast::IPS::MathUtils qw(
+ set_interpolation_points
+ table_row_interpolation
+ two_point_interpolation
+ ); # with -kgb, break around isolated 'local' below
+use Text::Warp();
+
+local ($delta2print) =
+ ( defined $size ) ? int( $size / 50 ) : $defaultdelta2print;
+
+print "break before this line\n";
+#11...........
+ },
+
+ 'kgb4.def' => {
+ source => "kgb4",
+ params => "def",
+ expect => <<'#12...........',
+print "hello"; # with -kgb, break after this line
+use strict;
+use warnings;
+use Test::More tests => 1;
+use Pod::Simple::XHTML;
+my $c = <<EOF;
+=head1 Documentation
+The keyword group dies here
+Do not put a blank line in this here-doc
+EOF
+my $d = $c . "=cut\n";
+exit 1;
+_END_
+#12...........
+ },
+
+ 'kgb4.kgb' => {
+ source => "kgb4",
+ params => "kgb",
+ expect => <<'#13...........',
+print "hello"; # with -kgb, break after this line
+
+use strict;
+use warnings;
+use Test::More tests => 1;
+use Pod::Simple::XHTML;
+my $c = <<EOF;
+=head1 Documentation
+The keyword group dies here
+Do not put a blank line in this here-doc
+EOF
+my $d = $c . "=cut\n";
+exit 1;
+_END_
+#13...........
+ },
+
+ 'kgb5.def' => {
+ source => "kgb5",
+ params => "def",
+ expect => <<'#14...........',
+# with -kgb, do not put blank in ternary
+print "Starting\n"; # with -kgb, break after this line
+my $A = "1";
+my $B = "0";
+my $C = "1";
+my $D = "1";
+my $result =
+ $A
+ ? $B
+ ? $C
+ ? "+A +B +C"
+ : "+A +B -C"
+ : "+A -B"
+ : "-A";
+my $F = "0";
+print "with -kgb, put blank above this line; result=$result\n";
+#14...........
+ },
+
+ 'kgb5.kgb' => {
+ source => "kgb5",
+ params => "kgb",
+ expect => <<'#15...........',
+# with -kgb, do not put blank in ternary
+print "Starting\n"; # with -kgb, break after this line
+
+my $A = "1";
+my $B = "0";
+my $C = "1";
+my $D = "1";
+my $result =
+ $A
+ ? $B
+ ? $C
+ ? "+A +B +C"
+ : "+A +B -C"
+ : "+A -B"
+ : "-A";
+my $F = "0";
+print "with -kgb, put blank above this line; result=$result\n";
+#15...........
+ },
};
my $ntests = 0 + keys %{$rtests};
projects / perltidy.git / commitdiff