1 # Created with: ./make_t.pl
24 # To locate test #13 you can search for its name or the string '#13'
36 ###########################################
37 # BEGIN SECTION 1: Parameter combinations #
38 ###########################################
42 'kgbd' => "-kgbd -kgb",
45 ############################
46 # BEGIN SECTION 2: Sources #
47 ############################
50 'align17' => <<'----------',
51 # align => even at broken sub block
53 'cc'=>sub{$param::cachecom=1;},
54 'cd'=>sub{$param::cachedisable=1;},
62 'align18' => <<'----------',
64 for($ENV{HTTP_USER_AGENT}){
66 /Mac/&&'m/Macintrash.html'
67 ||/Win(dows)?NT/&&'e/evilandrude.html'
68 ||/Win|MSIE|WebTV/&&'m/MicroslothWindows.html'
69 ||/Linux/&&'l/Linux.html'
70 ||/HP-UX/&&'h/HP-SUX.html'
71 ||/SunOS/&&'s/ScumOS.html'
76 'else1' => <<'----------',
77 # pad after 'if' when followed by 'elsif'
78 if ( not defined $dir or not length $dir ) { $rslt = ''; }
79 elsif ( $dir =~ /^\$\([^\)]+\)\Z(?!\n)/s ) { $rslt = $dir; }
80 else { $rslt = vmspath($dir); }
83 'else2' => <<'----------',
84 # no pad after 'if' when followed by 'else'
85 if ( $m = $g[$x][$y] ) { print $$m{v}; $$m{i}->() }
89 'gnu5' => <<'----------',
90 # side comments limit gnu type formatting with l=80; note extra comma
92 "Lowest code point requiring 13 bytes to represent", # 2**36
93 "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80",
94 ($::is64bit) ? 0x1000000000 : -1, # overflows on 32bit
99 'kgb1' => <<'----------',
100 # a variety of line types for testing -kgb
103 use Encode qw(from_to encode decode
104 encode_utf8 decode_utf8
105 find_encoding is_utf8);
106 use charnames qw(greek);
107 our $targetdir = "/usr/local/doc/HTML/Perl";
109 $tocfile, $loffile, $lotfile, $footfile,
110 $citefile, $idxfile, $figure_captions, $table_captions,
111 $footnotes, $citations, %font_size, %index,
112 %done, $t_title, $t_author, $t_date,
113 $t_address, $t_affil, $changed
116 B::unitcheck_av->isa("B::AV")
117 ? B::unitcheck_av->ARRAY
119 my @CHECKs = B::check_av->isa("B::AV") ? B::check_av->ARRAY : ();
120 my $dna = Bio::LiveSeq::DNA->new( -seq => $dnasequence );
122 my $max = length($dnasequence);
123 my $T = $G->_strongly_connected;
124 my %R = $T->vertex_roots;
125 my @C; # We're not calling the strongly_connected_components()
126 # Do not separate this hanging side comment from previous
128 my $exon = Bio::LiveSeq::Exon->new(
136 0777, 0700, 0470, 0407, 0433, 0400, 0430, 0403, 0111, 0100,
137 0110, 0101, 0731, 0713, 0317, 0371, 0173, 0137
140 ( 1 - $factor ) * ( 170 - $u ) +
141 ( 350 / $u**0.65 + 500 / $u**5 ) * $factor;
143 pm_to_blib: $(TO_INST_PM)
146 "(?<routine>ckWARN(?:\\d+)?reg\\w*|vWARN\\d+|$regcomp_fail_re)";
147 my $position = List::MoreUtils::firstidx {
151 my $fastafile2 = "/tmp/tmpfastafile2";
152 my $grepcut = 'egrep -v "[[:digit:]]|^ *$|sequences" | cut -c8-'; # grep/cut
154 "/usr/local/etc/bioinfo/fasta2/align -s /usr/local/etc/bioinfo/fasta2/idnaa.mat $fastafile1 $fastafile2 2>/dev/null | $grepcut"
156 my $xml = new Mioga::XML::Simple( forcearray => 1 );
157 my $xml_tree = $xml->XMLin($skel_file);
159 ( exists( $xml_tree->{'name'} ) ) ? $xml_tree->{'name'} : "";
160 my $grp = GroupGetValues( $conf->{dbh}, $group_id );
162 ProfileGetUser( $conf->{dbh}, $grp->{id_admin}, $group_id );
163 my $harness = TAP::Harness->new(
164 { verbosity => 1, formatter_class => "TAP::Formatter::Console" } );
167 my ( $fh, $filename ) = File::Temp::tempfile("Time-HiRes-utime-XXXXXXXXX");
168 use File::Basename qw[dirname];
169 my $dirname = dirname($filename);
170 my $CUT = qr/\n=cut.*$EOP/;
171 my $pod_or_DATA = qr/
172 ^=(?:head[1-4]|item) .*? $CUT
176 | ^__(DATA|END)__\r?\n.*
179 ( my $boot = $self->{NAME} ) =~ s/:/_/g;
181 sub { @E::ISA = qw/F/ },
182 sub { @E::ISA = qw/D/; @C::ISA = qw/F/ },
183 sub { @C::ISA = qw//; @A::ISA = qw/K/ },
184 sub { @A::ISA = qw//; @J::ISA = qw/F K/ },
185 sub { @J::ISA = qw/F/; @H::ISA = qw/K G/ },
186 sub { @H::ISA = qw/G/; @B::ISA = qw/B/ },
187 sub { @B::ISA = qw//; @K::ISA = qw/K J I/ },
188 sub { @K::ISA = qw/J I/; @D::ISA = qw/A H B C/ },
191 my %extractor_for = (
192 quotelike => [ $ws, $variable, $id, { MATCH => \&extract_quotelike } ],
193 regex => [ $ws, $pod_or_DATA, $id, $exql ],
194 string => [ $ws, $pod_or_DATA, $id, $exql ],
196 $ws, { DONT_MATCH => $pod_or_DATA },
197 $variable, $id, { DONT_MATCH => \&extract_quotelike }
199 code_no_comments => [
200 { DONT_MATCH => $comment },
201 $ncws, { DONT_MATCH => $pod_or_DATA },
202 $variable, $id, { DONT_MATCH => \&extract_quotelike }
204 executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ],
205 executable_no_comments =>
206 [ { DONT_MATCH => $comment }, $ncws, { DONT_MATCH => $pod_or_DATA } ],
207 all => [ { MATCH => qr/(?s:.*)/ } ],
212 'kgb2' => <<'----------',
213 # with -kgb, do no break after last my
216 my $parent = $_PARENT{refaddr $self} or return '';
217 my $key = refaddr $self;
218 my $elements = $parent->{children};
219 my $position = List::MoreUtils::firstidx {
222 $elements->[$position + 1] || '';
227 'kgb3' => <<'----------',
229 use strict; # with -kgb, no break after hash bang
230 our ( @Changed, $TAP ); # break after isolated 'our'
235 use Blast::IPS::MathUtils qw(
236 set_interpolation_points
237 table_row_interpolation
238 two_point_interpolation
239 ); # with -kgb, break around isolated 'local' below
241 local($delta2print) =
242 (defined $size) ? int($size/50) : $defaultdelta2print;
243 print "break before this line\n";
246 'kgb4' => <<'----------',
247 print "hello"; # with -kgb, break after this line
250 use Test::More tests => 1;
251 use Pod::Simple::XHTML;
254 The keyword group dies here
255 Do not put a blank line in this here-doc
257 my $d = $c ."=cut\n";
262 'kgb5' => <<'----------',
263 # with -kgb, do not put blank in ternary
264 print "Starting\n"; # with -kgb, break after this line
278 print "with -kgb, put blank above this line; result=$result\n";
281 'kgb_tight' => <<'----------',
282 # a variety of line types for testing -kgb
285 use Encode qw(from_to encode decode
286 encode_utf8 decode_utf8
287 find_encoding is_utf8);
289 use charnames qw(greek);
290 our $targetdir = "/usr/local/doc/HTML/Perl";
293 $tocfile, $loffile, $lotfile, $footfile,
294 $citefile, $idxfile, $figure_captions, $table_captions,
295 $footnotes, $citations, %font_size, %index,
296 %done, $t_title, $t_author, $t_date,
297 $t_address, $t_affil, $changed
300 B::unitcheck_av->isa("B::AV")
301 ? B::unitcheck_av->ARRAY
304 my @CHECKs = B::check_av->isa("B::AV") ? B::check_av->ARRAY : ();
305 my $dna = Bio::LiveSeq::DNA->new( -seq => $dnasequence );
307 my $max = length($dnasequence);
308 my $T = $G->_strongly_connected;
310 my %R = $T->vertex_roots;
311 my @C; # We're not calling the strongly_connected_components()
312 # Do not separate this hanging side comment from previous
316 my $exon = Bio::LiveSeq::Exon->new(
323 0777, 0700, 0470, 0407, 0433, 0400, 0430, 0403, 0111, 0100,
324 0110, 0101, 0731, 0713, 0317, 0371, 0173, 0137
327 ( 1 - $factor ) * ( 170 - $u ) +
328 ( 350 / $u**0.65 + 500 / $u**5 ) * $factor;
330 pm_to_blib: $(TO_INST_PM)
333 "(?<routine>ckWARN(?:\\d+)?reg\\w*|vWARN\\d+|$regcomp_fail_re)";
334 my $position = List::MoreUtils::firstidx {
339 "/usr/local/etc/bioinfo/fasta2/align -s /usr/local/etc/bioinfo/fasta2/idnaa.mat $fastafile1 $fastafile2 2>/dev/null | $grepcut"
342 ( exists( $xml_tree->{'name'} ) ) ? $xml_tree->{'name'} : "";
343 my $grp = GroupGetValues( $conf->{dbh}, $group_id );
346 ProfileGetUser( $conf->{dbh}, $grp->{id_admin}, $group_id );
347 my $harness = TAP::Harness->new(
348 { verbosity => 1, formatter_class => "TAP::Formatter::Console" } );
353 my ( $fh, $filename ) = File::Temp::tempfile("Time-HiRes-utime-XXXXXXXXX");
354 use File::Basename qw[dirname];
355 my $dirname = dirname($filename);
356 my $CUT = qr/\n=cut.*$EOP/;
358 my $pod_or_DATA = qr/
359 ^=(?:head[1-4]|item) .*? $CUT
363 | ^__(DATA|END)__\r?\n.*
367 print "continuing\n";
371 'kgbd' => <<'----------',
384 use vars qw($VERSION @ISA @EXPORT);
388 'ternary3' => <<'----------',
389 # this previously caused trouble because of the = and =~
391 ( ( $a = shift @a ) =~ /[^n]/ ) ? $a
398 ####################################
399 # BEGIN SECTION 3: Expected output #
400 ####################################
406 expect => <<'#1...........',
407 # pad after 'if' when followed by 'elsif'
408 if ( not defined $dir or not length $dir ) { $rslt = ''; }
409 elsif ( $dir =~ /^\$\([^\)]+\)\Z(?!\n)/s ) { $rslt = $dir; }
410 else { $rslt = vmspath($dir); }
417 expect => <<'#2...........',
418 # no pad after 'if' when followed by 'else'
419 if ( $m = $g[$x][$y] ) { print $$m{v}; $$m{i}->() }
425 source => "ternary3",
427 expect => <<'#3...........',
428 # this previously caused trouble because of the = and =~
431 ( ( $a = shift @a ) =~ /[^n]/ ) ? $a
441 expect => <<'#4...........',
442 # align => even at broken sub block
444 'cc' => sub { $param::cachecom = 1; },
445 'cd' => sub { $param::cachedisable = 1; },
457 expect => <<'#5...........',
459 for ( $ENV{HTTP_USER_AGENT} ) {
461 /Mac/ && 'm/Macintrash.html'
462 || /Win(dows)?NT/ && 'e/evilandrude.html'
463 || /Win|MSIE|WebTV/ && 'm/MicroslothWindows.html'
464 || /Linux/ && 'l/Linux.html'
465 || /HP-UX/ && 'h/HP-SUX.html'
466 || /SunOS/ && 's/ScumOS.html'
467 || 'a/AppendixB.html';
475 expect => <<'#6...........',
476 # a variety of line types for testing -kgb
479 use Encode qw(from_to encode decode
480 encode_utf8 decode_utf8
481 find_encoding is_utf8);
482 use charnames qw(greek);
483 our $targetdir = "/usr/local/doc/HTML/Perl";
485 $tocfile, $loffile, $lotfile, $footfile,
486 $citefile, $idxfile, $figure_captions, $table_captions,
487 $footnotes, $citations, %font_size, %index,
488 %done, $t_title, $t_author, $t_date,
489 $t_address, $t_affil, $changed
492 B::unitcheck_av->isa("B::AV")
493 ? B::unitcheck_av->ARRAY
495 my @CHECKs = B::check_av->isa("B::AV") ? B::check_av->ARRAY : ();
496 my $dna = Bio::LiveSeq::DNA->new( -seq => $dnasequence );
498 my $max = length($dnasequence);
499 my $T = $G->_strongly_connected;
500 my %R = $T->vertex_roots;
501 my @C; # We're not calling the strongly_connected_components()
502 # Do not separate this hanging side comment from previous
504 my $exon = Bio::LiveSeq::Exon->new(
512 0777, 0700, 0470, 0407, 0433, 0400, 0430, 0403, 0111, 0100,
513 0110, 0101, 0731, 0713, 0317, 0371, 0173, 0137
516 ( 1 - $factor ) * ( 170 - $u ) + ( 350 / $u**0.65 + 500 / $u**5 ) * $factor;
518 pm_to_blib: $(TO_INST_PM)
521 "(?<routine>ckWARN(?:\\d+)?reg\\w*|vWARN\\d+|$regcomp_fail_re)";
522 my $position = List::MoreUtils::firstidx {
526 my $fastafile2 = "/tmp/tmpfastafile2";
527 my $grepcut = 'egrep -v "[[:digit:]]|^ *$|sequences" | cut -c8-'; # grep/cut
529 "/usr/local/etc/bioinfo/fasta2/align -s /usr/local/etc/bioinfo/fasta2/idnaa.mat $fastafile1 $fastafile2 2>/dev/null | $grepcut"
531 my $xml = new Mioga::XML::Simple( forcearray => 1 );
532 my $xml_tree = $xml->XMLin($skel_file);
534 ( exists( $xml_tree->{'name'} ) ) ? $xml_tree->{'name'} : "";
535 my $grp = GroupGetValues( $conf->{dbh}, $group_id );
537 ProfileGetUser( $conf->{dbh}, $grp->{id_admin}, $group_id );
538 my $harness = TAP::Harness->new(
539 { verbosity => 1, formatter_class => "TAP::Formatter::Console" } );
542 my ( $fh, $filename ) = File::Temp::tempfile("Time-HiRes-utime-XXXXXXXXX");
543 use File::Basename qw[dirname];
544 my $dirname = dirname($filename);
545 my $CUT = qr/\n=cut.*$EOP/;
546 my $pod_or_DATA = qr/
547 ^=(?:head[1-4]|item) .*? $CUT
551 | ^__(DATA|END)__\r?\n.*
554 ( my $boot = $self->{NAME} ) =~ s/:/_/g;
556 sub { @E::ISA = qw/F/ },
557 sub { @E::ISA = qw/D/; @C::ISA = qw/F/ },
558 sub { @C::ISA = qw//; @A::ISA = qw/K/ },
559 sub { @A::ISA = qw//; @J::ISA = qw/F K/ },
560 sub { @J::ISA = qw/F/; @H::ISA = qw/K G/ },
561 sub { @H::ISA = qw/G/; @B::ISA = qw/B/ },
562 sub { @B::ISA = qw//; @K::ISA = qw/K J I/ },
563 sub { @K::ISA = qw/J I/; @D::ISA = qw/A H B C/ },
566 my %extractor_for = (
567 quotelike => [ $ws, $variable, $id, { MATCH => \&extract_quotelike } ],
568 regex => [ $ws, $pod_or_DATA, $id, $exql ],
569 string => [ $ws, $pod_or_DATA, $id, $exql ],
571 $ws, { DONT_MATCH => $pod_or_DATA },
572 $variable, $id, { DONT_MATCH => \&extract_quotelike }
574 code_no_comments => [
575 { DONT_MATCH => $comment },
576 $ncws, { DONT_MATCH => $pod_or_DATA },
577 $variable, $id, { DONT_MATCH => \&extract_quotelike }
579 executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ],
580 executable_no_comments =>
581 [ { DONT_MATCH => $comment }, $ncws, { DONT_MATCH => $pod_or_DATA } ],
582 all => [ { MATCH => qr/(?s:.*)/ } ],
591 expect => <<'#7...........',
592 # a variety of line types for testing -kgb
595 use Encode qw(from_to encode decode
596 encode_utf8 decode_utf8
597 find_encoding is_utf8);
598 use charnames qw(greek);
599 our $targetdir = "/usr/local/doc/HTML/Perl";
601 $tocfile, $loffile, $lotfile, $footfile,
602 $citefile, $idxfile, $figure_captions, $table_captions,
603 $footnotes, $citations, %font_size, %index,
604 %done, $t_title, $t_author, $t_date,
605 $t_address, $t_affil, $changed
609 B::unitcheck_av->isa("B::AV")
610 ? B::unitcheck_av->ARRAY
612 my @CHECKs = B::check_av->isa("B::AV") ? B::check_av->ARRAY : ();
613 my $dna = Bio::LiveSeq::DNA->new( -seq => $dnasequence );
615 my $max = length($dnasequence);
616 my $T = $G->_strongly_connected;
617 my %R = $T->vertex_roots;
618 my @C; # We're not calling the strongly_connected_components()
619 # Do not separate this hanging side comment from previous
621 my $exon = Bio::LiveSeq::Exon->new(
629 0777, 0700, 0470, 0407, 0433, 0400, 0430, 0403, 0111, 0100,
630 0110, 0101, 0731, 0713, 0317, 0371, 0173, 0137
633 ( 1 - $factor ) * ( 170 - $u ) + ( 350 / $u**0.65 + 500 / $u**5 ) * $factor;
635 pm_to_blib: $(TO_INST_PM)
638 "(?<routine>ckWARN(?:\\d+)?reg\\w*|vWARN\\d+|$regcomp_fail_re)";
639 my $position = List::MoreUtils::firstidx {
643 my $fastafile2 = "/tmp/tmpfastafile2";
644 my $grepcut = 'egrep -v "[[:digit:]]|^ *$|sequences" | cut -c8-'; # grep/cut
646 "/usr/local/etc/bioinfo/fasta2/align -s /usr/local/etc/bioinfo/fasta2/idnaa.mat $fastafile1 $fastafile2 2>/dev/null | $grepcut"
648 my $xml = new Mioga::XML::Simple( forcearray => 1 );
649 my $xml_tree = $xml->XMLin($skel_file);
651 ( exists( $xml_tree->{'name'} ) ) ? $xml_tree->{'name'} : "";
652 my $grp = GroupGetValues( $conf->{dbh}, $group_id );
654 ProfileGetUser( $conf->{dbh}, $grp->{id_admin}, $group_id );
655 my $harness = TAP::Harness->new(
656 { verbosity => 1, formatter_class => "TAP::Formatter::Console" } );
660 my ( $fh, $filename ) = File::Temp::tempfile("Time-HiRes-utime-XXXXXXXXX");
661 use File::Basename qw[dirname];
662 my $dirname = dirname($filename);
663 my $CUT = qr/\n=cut.*$EOP/;
664 my $pod_or_DATA = qr/
665 ^=(?:head[1-4]|item) .*? $CUT
669 | ^__(DATA|END)__\r?\n.*
673 ( my $boot = $self->{NAME} ) =~ s/:/_/g;
675 sub { @E::ISA = qw/F/ },
676 sub { @E::ISA = qw/D/; @C::ISA = qw/F/ },
677 sub { @C::ISA = qw//; @A::ISA = qw/K/ },
678 sub { @A::ISA = qw//; @J::ISA = qw/F K/ },
679 sub { @J::ISA = qw/F/; @H::ISA = qw/K G/ },
680 sub { @H::ISA = qw/G/; @B::ISA = qw/B/ },
681 sub { @B::ISA = qw//; @K::ISA = qw/K J I/ },
682 sub { @K::ISA = qw/J I/; @D::ISA = qw/A H B C/ },
685 my %extractor_for = (
686 quotelike => [ $ws, $variable, $id, { MATCH => \&extract_quotelike } ],
687 regex => [ $ws, $pod_or_DATA, $id, $exql ],
688 string => [ $ws, $pod_or_DATA, $id, $exql ],
690 $ws, { DONT_MATCH => $pod_or_DATA },
691 $variable, $id, { DONT_MATCH => \&extract_quotelike }
693 code_no_comments => [
694 { DONT_MATCH => $comment },
695 $ncws, { DONT_MATCH => $pod_or_DATA },
696 $variable, $id, { DONT_MATCH => \&extract_quotelike }
698 executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ],
699 executable_no_comments =>
700 [ { DONT_MATCH => $comment }, $ncws, { DONT_MATCH => $pod_or_DATA } ],
701 all => [ { MATCH => qr/(?s:.*)/ } ],
710 expect => <<'#8...........',
711 # with -kgb, do no break after last my
714 my $parent = $_PARENT{ refaddr $self} or return '';
715 my $key = refaddr $self;
716 my $elements = $parent->{children};
717 my $position = List::MoreUtils::firstidx {
721 $elements->[ $position + 1 ] || '';
730 expect => <<'#9...........',
731 # with -kgb, do no break after last my
735 my $parent = $_PARENT{ refaddr $self} or return '';
736 my $key = refaddr $self;
737 my $elements = $parent->{children};
738 my $position = List::MoreUtils::firstidx {
742 $elements->[ $position + 1 ] || '';
751 expect => <<'#10...........',
753 use strict; # with -kgb, no break after hash bang
754 our ( @Changed, $TAP ); # break after isolated 'our'
759 use Blast::IPS::MathUtils qw(
760 set_interpolation_points
761 table_row_interpolation
762 two_point_interpolation
763 ); # with -kgb, break around isolated 'local' below
765 local ($delta2print) =
766 ( defined $size ) ? int( $size / 50 ) : $defaultdelta2print;
767 print "break before this line\n";
774 expect => <<'#11...........',
776 use strict; # with -kgb, no break after hash bang
777 our ( @Changed, $TAP ); # break after isolated 'our'
783 use Blast::IPS::MathUtils qw(
784 set_interpolation_points
785 table_row_interpolation
786 two_point_interpolation
787 ); # with -kgb, break around isolated 'local' below
790 local ($delta2print) =
791 ( defined $size ) ? int( $size / 50 ) : $defaultdelta2print;
793 print "break before this line\n";
800 expect => <<'#12...........',
801 print "hello"; # with -kgb, break after this line
804 use Test::More tests => 1;
805 use Pod::Simple::XHTML;
808 The keyword group dies here
809 Do not put a blank line in this here-doc
811 my $d = $c . "=cut\n";
820 expect => <<'#13...........',
821 print "hello"; # with -kgb, break after this line
825 use Test::More tests => 1;
826 use Pod::Simple::XHTML;
829 The keyword group dies here
830 Do not put a blank line in this here-doc
832 my $d = $c . "=cut\n";
841 expect => <<'#14...........',
842 # with -kgb, do not put blank in ternary
843 print "Starting\n"; # with -kgb, break after this line
857 print "with -kgb, put blank above this line; result=$result\n";
864 expect => <<'#15...........',
865 # with -kgb, do not put blank in ternary
866 print "Starting\n"; # with -kgb, break after this line
881 print "with -kgb, put blank above this line; result=$result\n";
888 expect => <<'#16...........',
901 use vars qw($VERSION @ISA @EXPORT);
909 expect => <<'#17...........',
920 use vars qw($VERSION @ISA @EXPORT);
927 source => "kgb_tight",
929 expect => <<'#18...........',
930 # a variety of line types for testing -kgb
933 use Encode qw(from_to encode decode
934 encode_utf8 decode_utf8
935 find_encoding is_utf8);
937 use charnames qw(greek);
938 our $targetdir = "/usr/local/doc/HTML/Perl";
941 $tocfile, $loffile, $lotfile, $footfile,
942 $citefile, $idxfile, $figure_captions, $table_captions,
943 $footnotes, $citations, %font_size, %index,
944 %done, $t_title, $t_author, $t_date,
945 $t_address, $t_affil, $changed
948 B::unitcheck_av->isa("B::AV")
949 ? B::unitcheck_av->ARRAY
952 my @CHECKs = B::check_av->isa("B::AV") ? B::check_av->ARRAY : ();
953 my $dna = Bio::LiveSeq::DNA->new( -seq => $dnasequence );
955 my $max = length($dnasequence);
956 my $T = $G->_strongly_connected;
958 my %R = $T->vertex_roots;
959 my @C; # We're not calling the strongly_connected_components()
960 # Do not separate this hanging side comment from previous
964 my $exon = Bio::LiveSeq::Exon->new(
971 0777, 0700, 0470, 0407, 0433, 0400, 0430, 0403, 0111, 0100,
972 0110, 0101, 0731, 0713, 0317, 0371, 0173, 0137
975 ( 1 - $factor ) * ( 170 - $u ) + ( 350 / $u**0.65 + 500 / $u**5 ) * $factor;
977 pm_to_blib: $(TO_INST_PM)
980 "(?<routine>ckWARN(?:\\d+)?reg\\w*|vWARN\\d+|$regcomp_fail_re)";
981 my $position = List::MoreUtils::firstidx {
986 "/usr/local/etc/bioinfo/fasta2/align -s /usr/local/etc/bioinfo/fasta2/idnaa.mat $fastafile1 $fastafile2 2>/dev/null | $grepcut"
989 ( exists( $xml_tree->{'name'} ) ) ? $xml_tree->{'name'} : "";
990 my $grp = GroupGetValues( $conf->{dbh}, $group_id );
993 ProfileGetUser( $conf->{dbh}, $grp->{id_admin}, $group_id );
994 my $harness = TAP::Harness->new(
995 { verbosity => 1, formatter_class => "TAP::Formatter::Console" } );
1000 my ( $fh, $filename ) = File::Temp::tempfile("Time-HiRes-utime-XXXXXXXXX");
1001 use File::Basename qw[dirname];
1002 my $dirname = dirname($filename);
1003 my $CUT = qr/\n=cut.*$EOP/;
1005 my $pod_or_DATA = qr/
1006 ^=(?:head[1-4]|item) .*? $CUT
1010 | ^__(DATA|END)__\r?\n.*
1014 print "continuing\n";
1022 expect => <<'#19...........',
1023 # side comments limit gnu type formatting with l=80; note extra comma
1025 "Lowest code point requiring 13 bytes to represent", # 2**36
1026 "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80",
1027 ($::is64bit) ? 0x1000000000 : -1, # overflows on 32bit
1034 my $ntests = 0 + keys %{$rtests};
1035 plan tests => $ntests;
1042 foreach my $key ( sort keys %{$rtests} ) {
1044 my $sname = $rtests->{$key}->{source};
1045 my $expect = $rtests->{$key}->{expect};
1046 my $pname = $rtests->{$key}->{params};
1047 my $source = $rsources->{$sname};
1048 my $params = defined($pname) ? $rparams->{$pname} : "";
1050 my $errorfile_string;
1051 my $err = Perl::Tidy::perltidy(
1053 destination => \$output,
1054 perltidyrc => \$params,
1055 argv => '', # for safety; hide any ARGV from perltidy
1056 stderr => \$stderr_string,
1057 errorfile => \$errorfile_string, # not used when -se flag is set
1059 if ( $err || $stderr_string || $errorfile_string ) {
1060 print STDERR "Error output received for test '$key'\n";
1062 print STDERR "An error flag '$err' was returned\n";
1065 if ($stderr_string) {
1066 print STDERR "---------------------\n";
1067 print STDERR "<<STDERR>>\n$stderr_string\n";
1068 print STDERR "---------------------\n";
1069 ok( !$stderr_string );
1071 if ($errorfile_string) {
1072 print STDERR "---------------------\n";
1073 print STDERR "<<.ERR file>>\n$errorfile_string\n";
1074 print STDERR "---------------------\n";
1075 ok( !$errorfile_string );
1079 if ( !is( $output, $expect, $key ) ) {
1080 my $leno = length($output);
1081 my $lene = length($expect);
1082 if ( $leno == $lene ) {
1084 "#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
1088 "#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";