]> git.donarmstrong.com Git - perltidy.git/blobdiff - t/snippets6.t
New upstream version 20190601
[perltidy.git] / t / snippets6.t
diff --git a/t/snippets6.t b/t/snippets6.t
new file mode 100644 (file)
index 0000000..4836fff
--- /dev/null
@@ -0,0 +1,461 @@
+# Created with: ./make_t.pl
+
+# Contents:
+#1 otr1.otr
+#2 pbp1.def
+#3 pbp1.pbp
+#4 pbp2.def
+#5 pbp2.pbp
+#6 pbp3.def
+#7 pbp3.pbp
+#8 pbp4.def
+#9 pbp4.pbp
+#10 pbp5.def
+#11 pbp5.pbp
+#12 print1.def
+#13 q1.def
+#14 q2.def
+#15 recombine1.def
+#16 recombine2.def
+#17 recombine3.def
+#18 recombine4.def
+#19 rt101547.def
+#20 rt102371.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' => "",
+        'otr' => <<'----------',
+-ohbr
+-opr
+-osbr
+----------
+        'pbp' => "-pbp -nst -nse",
+    };
+
+    ############################
+    # BEGIN SECTION 2: Sources #
+    ############################
+    $rsources = {
+
+        'otr1' => <<'----------',
+return $pdl->slice(
+    join ',',
+    (
+        map {
+                $_ eq "X" ? ":"
+              : ref $_ eq "ARRAY" ? join ':', @$_
+              : !ref $_ ? $_
+              : die "INVALID SLICE DEF $_"
+        } @_
+    )
+);
+----------
+
+        'pbp1' => <<'----------',
+            # break after '+' if default, before + if pbp
+            my $min_gnu_indentation = $standard_increment +
+              $gnu_stack[$max_gnu_stack_index]->get_SPACES();
+----------
+
+        'pbp2' => <<'----------',
+$tmp = $day - 32075 + 1461 * ( $year + 4800 - ( 14 - $month ) / 12 ) / 4 + 367 * ( $month - 2 + ( ( 14 - $month ) / 12 ) * 12 ) / 12 - 3 * ( ( $year + 4900 - ( 14 - $month ) / 12 ) / 100 ) / 4;
+----------
+
+        'pbp3' => <<'----------',
+return $sec + $SecOff + ( SECS_PER_MINUTE * $min ) + ( SECS_PER_HOUR * $hour ) + ( SECS_PER_DAY * $days );
+
+
+----------
+
+        'pbp4' => <<'----------',
+# with defaults perltidy will break after the '=' here
+my @host_seq = $level eq "easy" ?
+           @reordered : 0..$last;  # reordered has CDROM up front
+----------
+
+        'pbp5' => <<'----------',
+# illustates problem with -pbp: -ci should not equal -i
+say 'ok_200_24_hours.value '.average({'$and'=>[{time=>{'$gt',$time-60*60*24}},{status=>200}]});
+
+----------
+
+        'print1' => <<'----------',
+# same text twice. Has uncontained commas; -- leave as is
+print "conformability (Not the same dimension)\n",
+  "\t",
+  $have, " is ",
+  text_unit($hu), "\n", "\t", $want, " is ", text_unit($wu), "\n",;
+
+print
+  "conformability (Not the same dimension)\n",
+  "\t", $have, " is ", text_unit($hu), "\n",
+  "\t", $want, " is ", text_unit($wu), "\n",
+  ;
+----------
+
+        'q1' => <<'----------',
+print qq(You are in zone $thisTZ
+Difference with respect to GMT is ), $offset / 3600, qq( hours
+And local time is $hour hours $min minutes $sec seconds
+);
+----------
+
+        'q2' => <<'----------',
+$a=qq
+XHello World\nX;
+print "$a";
+----------
+
+        'recombine1' => <<'----------',
+# recombine '= [' here:
+$retarray =
+  [ &{ $sth->{'xbase_parsed_sql'}{'selectfn'} }
+      ( $xbase, $values, $sth->{'xbase_bind_values'} ) ]
+  if defined $values;
+----------
+
+        'recombine2' => <<'----------',
+    # recombine = unless old break there
+    $a = [ length( $self->{fb}[-1] ), $#{ $self->{fb} } ] ;    # set cursor at end of buffer and print this cursor
+----------
+
+        'recombine3' => <<'----------',
+        # recombine final line
+        $command = (
+                    ($catpage =~ m:\.gz:)
+                    ? $ZCAT
+                    : $CAT
+                   )
+          . " < $catpage";
+----------
+
+        'recombine4' => <<'----------',
+    # do not recombine into two lines after a comma if
+    # the term is complex (has parens) or changes level
+    $delta_time = sprintf "%.4f", ( ( $done[0] + ( $done[1] / 1e6 ) ) - ( $start[0] + ( $start[1] / 1e6 ) ) );
+----------
+
+        'rt101547' => <<'----------',
+{ source_host => MM::Config->instance->host // q{}, }
+----------
+
+        'rt102371' => <<'----------',
+state $b //= ccc();
+----------
+    };
+
+    ####################################
+    # BEGIN SECTION 3: Expected output #
+    ####################################
+    $rtests = {
+
+        'otr1.otr' => {
+            source => "otr1",
+            params => "otr",
+            expect => <<'#1...........',
+return $pdl->slice(
+    join ',', (
+        map {
+                $_ eq "X" ? ":"
+              : ref $_ eq "ARRAY" ? join ':', @$_
+              : !ref $_ ? $_
+              : die "INVALID SLICE DEF $_"
+        } @_
+    )
+);
+#1...........
+        },
+
+        'pbp1.def' => {
+            source => "pbp1",
+            params => "def",
+            expect => <<'#2...........',
+            # break after '+' if default, before + if pbp
+            my $min_gnu_indentation = $standard_increment +
+              $gnu_stack[$max_gnu_stack_index]->get_SPACES();
+#2...........
+        },
+
+        'pbp1.pbp' => {
+            source => "pbp1",
+            params => "pbp",
+            expect => <<'#3...........',
+            # break after '+' if default, before + if pbp
+            my $min_gnu_indentation = $standard_increment
+                + $gnu_stack[$max_gnu_stack_index]->get_SPACES();
+#3...........
+        },
+
+        'pbp2.def' => {
+            source => "pbp2",
+            params => "def",
+            expect => <<'#4...........',
+$tmp =
+  $day - 32075 +
+  1461 * ( $year + 4800 - ( 14 - $month ) / 12 ) / 4 +
+  367 * ( $month - 2 + ( ( 14 - $month ) / 12 ) * 12 ) / 12 -
+  3 * ( ( $year + 4900 - ( 14 - $month ) / 12 ) / 100 ) / 4;
+#4...........
+        },
+
+        'pbp2.pbp' => {
+            source => "pbp2",
+            params => "pbp",
+            expect => <<'#5...........',
+$tmp
+    = $day - 32075
+    + 1461 * ( $year + 4800 - ( 14 - $month ) / 12 ) / 4
+    + 367 * ( $month - 2 + ( ( 14 - $month ) / 12 ) * 12 ) / 12
+    - 3 * ( ( $year + 4900 - ( 14 - $month ) / 12 ) / 100 ) / 4;
+#5...........
+        },
+
+        'pbp3.def' => {
+            source => "pbp3",
+            params => "def",
+            expect => <<'#6...........',
+return $sec + $SecOff +
+  ( SECS_PER_MINUTE * $min ) +
+  ( SECS_PER_HOUR * $hour ) +
+  ( SECS_PER_DAY * $days );
+
+#6...........
+        },
+
+        'pbp3.pbp' => {
+            source => "pbp3",
+            params => "pbp",
+            expect => <<'#7...........',
+return
+      $sec + $SecOff
+    + ( SECS_PER_MINUTE * $min )
+    + ( SECS_PER_HOUR * $hour )
+    + ( SECS_PER_DAY * $days );
+
+#7...........
+        },
+
+        'pbp4.def' => {
+            source => "pbp4",
+            params => "def",
+            expect => <<'#8...........',
+# with defaults perltidy will break after the '=' here
+my @host_seq =
+  $level eq "easy" ? @reordered : 0 .. $last;    # reordered has CDROM up front
+#8...........
+        },
+
+        'pbp4.pbp' => {
+            source => "pbp4",
+            params => "pbp",
+            expect => <<'#9...........',
+# with defaults perltidy will break after the '=' here
+my @host_seq
+    = $level eq "easy"
+    ? @reordered
+    : 0 .. $last;    # reordered has CDROM up front
+#9...........
+        },
+
+        'pbp5.def' => {
+            source => "pbp5",
+            params => "def",
+            expect => <<'#10...........',
+# illustates problem with -pbp: -ci should not equal -i
+say 'ok_200_24_hours.value '
+  . average(
+    {
+        '$and' =>
+          [ { time => { '$gt', $time - 60 * 60 * 24 } }, { status => 200 } ]
+    }
+  );
+
+#10...........
+        },
+
+        'pbp5.pbp' => {
+            source => "pbp5",
+            params => "pbp",
+            expect => <<'#11...........',
+# illustates problem with -pbp: -ci should not equal -i
+say 'ok_200_24_hours.value '
+    . average(
+    {   '$and' => [
+            { time => { '$gt', $time - 60 * 60 * 24 } }, { status => 200 }
+        ]
+    }
+    );
+
+#11...........
+        },
+
+        'print1.def' => {
+            source => "print1",
+            params => "def",
+            expect => <<'#12...........',
+# same text twice. Has uncontained commas; -- leave as is
+print "conformability (Not the same dimension)\n",
+  "\t",
+  $have, " is ",
+  text_unit($hu), "\n", "\t", $want, " is ", text_unit($wu), "\n",;
+
+print
+  "conformability (Not the same dimension)\n",
+  "\t", $have, " is ", text_unit($hu), "\n",
+  "\t", $want, " is ", text_unit($wu), "\n",
+  ;
+#12...........
+        },
+
+        'q1.def' => {
+            source => "q1",
+            params => "def",
+            expect => <<'#13...........',
+print qq(You are in zone $thisTZ
+Difference with respect to GMT is ), $offset / 3600, qq( hours
+And local time is $hour hours $min minutes $sec seconds
+);
+#13...........
+        },
+
+        'q2.def' => {
+            source => "q2",
+            params => "def",
+            expect => <<'#14...........',
+$a = qq
+XHello World\nX;
+print "$a";
+#14...........
+        },
+
+        'recombine1.def' => {
+            source => "recombine1",
+            params => "def",
+            expect => <<'#15...........',
+# recombine '= [' here:
+$retarray =
+  [ &{ $sth->{'xbase_parsed_sql'}{'selectfn'} }
+      ( $xbase, $values, $sth->{'xbase_bind_values'} ) ]
+  if defined $values;
+#15...........
+        },
+
+        'recombine2.def' => {
+            source => "recombine2",
+            params => "def",
+            expect => <<'#16...........',
+    # recombine = unless old break there
+    $a = [ length( $self->{fb}[-1] ), $#{ $self->{fb} } ]
+      ;    # set cursor at end of buffer and print this cursor
+#16...........
+        },
+
+        'recombine3.def' => {
+            source => "recombine3",
+            params => "def",
+            expect => <<'#17...........',
+        # recombine final line
+        $command = (
+            ( $catpage =~ m:\.gz: )
+            ? $ZCAT
+            : $CAT
+        ) . " < $catpage";
+#17...........
+        },
+
+        'recombine4.def' => {
+            source => "recombine4",
+            params => "def",
+            expect => <<'#18...........',
+    # do not recombine into two lines after a comma if
+    # the term is complex (has parens) or changes level
+    $delta_time = sprintf "%.4f",
+      ( ( $done[0] + ( $done[1] / 1e6 ) ) -
+          ( $start[0] + ( $start[1] / 1e6 ) ) );
+#18...........
+        },
+
+        'rt101547.def' => {
+            source => "rt101547",
+            params => "def",
+            expect => <<'#19...........',
+{ source_host => MM::Config->instance->host // q{}, }
+#19...........
+        },
+
+        'rt102371.def' => {
+            source => "rt102371",
+            params => "def",
+            expect => <<'#20...........',
+state $b //= ccc();
+#20...........
+        },
+    };
+
+    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 );
+    }
+}