From 2e6f188af1872fd4637012b51f7c20c00479b12b Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Wed, 5 Dec 2018 18:25:36 -0800 Subject: [PATCH] added tests for -kgb and alignment --- t/snippets/{align17.t => align17.in} | 0 t/snippets/{align18.t => align18.in} | 0 t/snippets/expect/align17.def | 9 + t/snippets/expect/align18.def | 11 + t/snippets/expect/kgb1.def | 109 +++++ t/snippets/expect/kgb1.kgb | 114 +++++ t/snippets/expect/kgb2.def | 13 + t/snippets/expect/kgb2.kgb | 14 + t/snippets/expect/kgb3.def | 16 + t/snippets/expect/kgb3.kgb | 19 + t/snippets/expect/kgb4.def | 13 + t/snippets/expect/kgb4.kgb | 14 + t/snippets/expect/kgb5.def | 16 + t/snippets/expect/kgb5.kgb | 17 + t/snippets/kgb.par | 1 + t/snippets/kgb1.in | 110 +++++ t/snippets/kgb2.in | 12 + t/snippets/kgb3.in | 16 + t/snippets/kgb4.in | 13 + t/snippets/kgb5.in | 16 + t/snippets/packing_list.txt | 14 +- t/snippets14.t | 674 ++++++++++++++++++++++++++- 22 files changed, 1219 insertions(+), 2 deletions(-) rename t/snippets/{align17.t => align17.in} (100%) rename t/snippets/{align18.t => align18.in} (100%) create mode 100644 t/snippets/expect/align17.def create mode 100644 t/snippets/expect/align18.def create mode 100644 t/snippets/expect/kgb1.def create mode 100644 t/snippets/expect/kgb1.kgb create mode 100644 t/snippets/expect/kgb2.def create mode 100644 t/snippets/expect/kgb2.kgb create mode 100644 t/snippets/expect/kgb3.def create mode 100644 t/snippets/expect/kgb3.kgb create mode 100644 t/snippets/expect/kgb4.def create mode 100644 t/snippets/expect/kgb4.kgb create mode 100644 t/snippets/expect/kgb5.def create mode 100644 t/snippets/expect/kgb5.kgb create mode 100644 t/snippets/kgb.par create mode 100644 t/snippets/kgb1.in create mode 100644 t/snippets/kgb2.in create mode 100644 t/snippets/kgb3.in create mode 100644 t/snippets/kgb4.in create mode 100644 t/snippets/kgb5.in diff --git a/t/snippets/align17.t b/t/snippets/align17.in similarity index 100% rename from t/snippets/align17.t rename to t/snippets/align17.in diff --git a/t/snippets/align18.t b/t/snippets/align18.in similarity index 100% rename from t/snippets/align18.t rename to t/snippets/align18.in diff --git a/t/snippets/expect/align17.def b/t/snippets/expect/align17.def new file mode 100644 index 00000000..c417e0e9 --- /dev/null +++ b/t/snippets/expect/align17.def @@ -0,0 +1,9 @@ +# 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; + } +); diff --git a/t/snippets/expect/align18.def b/t/snippets/expect/align18.def new file mode 100644 index 00000000..0f6f1216 --- /dev/null +++ b/t/snippets/expect/align18.def @@ -0,0 +1,11 @@ +#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'; +} diff --git a/t/snippets/expect/kgb1.def b/t/snippets/expect/kgb1.def new file mode 100644 index 00000000..32cf2c45 --- /dev/null +++ b/t/snippets/expect/kgb1.def @@ -0,0 +1,109 @@ +# 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 = + "(?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; diff --git a/t/snippets/expect/kgb1.kgb b/t/snippets/expect/kgb1.kgb new file mode 100644 index 00000000..d3d2aed8 --- /dev/null +++ b/t/snippets/expect/kgb1.kgb @@ -0,0 +1,114 @@ +# 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 = + "(?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; diff --git a/t/snippets/expect/kgb2.def b/t/snippets/expect/kgb2.def new file mode 100644 index 00000000..98e8f1fc --- /dev/null +++ b/t/snippets/expect/kgb2.def @@ -0,0 +1,13 @@ +# 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 ] || ''; +} + diff --git a/t/snippets/expect/kgb2.kgb b/t/snippets/expect/kgb2.kgb new file mode 100644 index 00000000..889c85ac --- /dev/null +++ b/t/snippets/expect/kgb2.kgb @@ -0,0 +1,14 @@ +# 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 ] || ''; +} + diff --git a/t/snippets/expect/kgb3.def b/t/snippets/expect/kgb3.def new file mode 100644 index 00000000..0f805444 --- /dev/null +++ b/t/snippets/expect/kgb3.def @@ -0,0 +1,16 @@ +#!/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"; diff --git a/t/snippets/expect/kgb3.kgb b/t/snippets/expect/kgb3.kgb new file mode 100644 index 00000000..61e1c6d5 --- /dev/null +++ b/t/snippets/expect/kgb3.kgb @@ -0,0 +1,19 @@ +#!/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"; diff --git a/t/snippets/expect/kgb4.def b/t/snippets/expect/kgb4.def new file mode 100644 index 00000000..07ea6e47 --- /dev/null +++ b/t/snippets/expect/kgb4.def @@ -0,0 +1,13 @@ +print "hello"; # with -kgb, break after this line +use strict; +use warnings; +use Test::More tests => 1; +use Pod::Simple::XHTML; +my $c = < 1; +use Pod::Simple::XHTML; +my $c = <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 = + "(?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; diff --git a/t/snippets/kgb2.in b/t/snippets/kgb2.in new file mode 100644 index 00000000..e03f6fe5 --- /dev/null +++ b/t/snippets/kgb2.in @@ -0,0 +1,12 @@ +# 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] || ''; +} + diff --git a/t/snippets/kgb3.in b/t/snippets/kgb3.in new file mode 100644 index 00000000..b935f8b8 --- /dev/null +++ b/t/snippets/kgb3.in @@ -0,0 +1,16 @@ +#!/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"; diff --git a/t/snippets/kgb4.in b/t/snippets/kgb4.in new file mode 100644 index 00000000..5c4833ab --- /dev/null +++ b/t/snippets/kgb4.in @@ -0,0 +1,13 @@ +print "hello"; # with -kgb, break after this line +use strict; +use warnings; +use Test::More tests => 1; +use Pod::Simple::XHTML; +my $c = < "", }; + $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 = ''; } @@ -40,6 +81,188 @@ else { $rslt = vmspath($dir); } 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 = + "(?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 = < <<'----------', +# 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, @@ -91,6 +314,455 @@ push( #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 = + "(?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 = + "(?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 = < { + 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 = < { + 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}; -- 2.47.3