# Created with: ./make_t.pl

# Contents:
#1 git54.def
#2 git54.git54
#3 fpva.def
#4 fpva.fpva1
#5 fpva.fpva2
#6 lpxl.def
#7 lpxl.lpxl1
#8 lpxl.lpxl3
#9 lpxl.lpxl4
#10 lpxl.lpxl5
#11 git63.def
#12 align35.def
#13 rt136417.def
#14 rt136417.rt136417
#15 numbers.def
#16 code_skipping.def

# To locate test #13 you can search for its name or the string '#13'

use strict;
use Test::More;
use Carp;
use Perl::Tidy;
my $rparams;
my $rsources;
my $rtests;

BEGIN {

    ###########################################
    # BEGIN SECTION 1: Parameter combinations #
    ###########################################
    $rparams = {
        'def'   => "",
        'fpva1' => "-sfp",
        'fpva2' => "-sfp -nfpva",
        'git54' => "-bbp=3 -bbpi=2 -ci=4 -lp",
        'lpxl1' => "-lp",
        'lpxl3' => <<'----------',
-lp -lpxl='{ [ ('
----------
        'lpxl4' => <<'----------',
-lp -lpxl='{ [ W(1'
----------
        'lpxl5' => <<'----------',
-lp -lpxl='{ [ F(2'
----------
        'rt136417' => "-vtc=3",
    };

    ############################
    # BEGIN SECTION 2: Sources #
    ############################
    $rsources = {

        'align35' => <<'----------',
# different module names, do not align commas (fixes rt136416)
use File::Spec::Functions 'catfile', 'catdir';
use Mojo::Base 'Mojolicious', '-signatures';

# same module names, align fat commas
use constant PI => 4 * atan2 1, 1;
use constant TWOPI => 2 * PI;
use constant FOURPI => 4 * PI;

# same module names, align commas
use TestCounter '3rd-party', 0, '3rd-party no longer visible';
use TestCounter 'replace', 1, 'replacement now visible';
use TestCounter 'root';

# same module name, align fat commas but not commas
use constant COUNTDOWN => scalar reverse 1, 2, 3, 4, 5;
use constant COUNTUP => reverse 1, 2, 3, 4, 5;
use constant COUNTDOWN => scalar reverse 1, 2, 3, 4, 5;
----------

        'code_skipping' => <<'----------',
%Hdr=%U2E=%E2U=%Fallback=();
$in_charmap=$nerror=$nwarning=0;
$.=0;
#<<V  code skipping: perltidy will pass this verbatim without error checking

    }}} {{{

#>>V
my $self=shift;
my $cloning=shift;
----------

        'fpva' => <<'----------',
log_something_with_long_function( 'This is a log message.', 2 );
Coro::AnyEvent::sleep( 3, 4 );
use Carp ();
use File::Spec ();
use File::Path ();
----------

        'git54' => <<'----------',
# testing sensitivity to excess commas
my $definition =>
    (
    {
        key1 => value1
    },
    {
        key2 => value2
    },
    );

my $definition =>
    (
    {
        key => value
    }
    );

my $definition =>
    (
    {
        key => value
    },
    );

my $definition =>
    (
    {
        key => value,
    },
    );

my $list =
    (
      {
        key => $value,
        key => $value,
        key => $value,
        key => $value,
        key => $value,
      },
    ) ;

my $list =
    (
      {
        key => $value,
        key => $value,
        key => $value,
        key => $value,
        key => $value,
      }
    ) ;
----------

        'git63' => <<'----------',
my $fragment = $parser-> #parse_html_string
  parse_balanced_chunk($I);
----------

        'lpxl' => <<'----------',
# simple function call
my $loanlength = getLoanLength(
                                $borrower->{'categorycode'},    # sc1
                                $iteminformation->{'itemtype'},
                                $borrower->{'branchcode'}       # sc3
);

# function call, more than one level deep
my $o = very::long::class::name->new(
    {
        propA => "a",
        propB => "b",
        propC => "c",
    }
);

# function call with sublist
debug(
      "Connecting to DB.",
      "Extra-Parameters: " . join("<->", $extra_parms),
      "Config: " . join("<->", %config)
     );

# simple function call with code block
$m->command(-label   => 'Save',
            -command => sub { print "DOS\n"; save_dialog($win); });

# function call, ternary in list
return
  OptArgs2::Result->usage(
    $style == OptArgs2::STYLE_FULL ? 'FullUsage' : 'NormalUsage',
    'usage: ' . $usage . "\n" );

# not a function call
%blastparam = (
    -run            => \%runparam,
    -file           => '',
    -parse          => 1,
    -signif         => 1e-5,
);

# 'local' is a keyword, not a user function
    local (
        $len,    $pts,      @colspec, $char, $cols,
        $repeat, $celldata, $at_text, $after_text
    );

# square bracket with sublists
$data = [
         ListElem->new(id => 0, val => 100),
         ListElem->new(id => 2, val => 50),
         ListElem->new(id => 1, val => 10),
        ];

# curly brace with sublists
$behaviour = {
              cat   => {nap    => "lap",   eat  => "meat"},
              dog   => {prowl  => "growl", pool => "drool"},
              mouse => {nibble => "kibble"},
             };
----------

        'numbers' => <<'----------',
# valid numbers
my @vals = (

    12345,
    12345.67,
    .23E-10,
    3.14_15_92,
    4_294_967_296,
    0xff,
    0xdead_beef,
    0377,
    0b011011,
    0x1.999ap-4,
    1e34,
    1e+34,
    1e+034,
    -1e+034,
    0.00000000000000000000000000000000000000000000000000000000000000000001,
    0Xabcdef,
    0B1101,
    0o12_345,  # optional 'o' and 'O' added in perl v5.33.5
    0O12_345,
);
----------

        'rt136417' => <<'----------',
function(
  #
  a, b, c);

%hash = (
  a => b,
  c => d,
);
----------
    };

    ####################################
    # BEGIN SECTION 3: Expected output #
    ####################################
    $rtests = {

        'git54.def' => {
            source => "git54",
            params => "def",
            expect => <<'#1...........',
# testing sensitivity to excess commas
my $definition => (
    {
        key1 => value1
    },
    {
        key2 => value2
    },
);

my $definition => (
    {
        key => value
    }
);

my $definition => (
    {
        key => value
    },
);

my $definition => (
    {
        key => value,
    },
);

my $list = (
    {
        key => $value,
        key => $value,
        key => $value,
        key => $value,
        key => $value,
    },
);

my $list = (
    {
        key => $value,
        key => $value,
        key => $value,
        key => $value,
        key => $value,
    }
);
#1...........
        },

        'git54.git54' => {
            source => "git54",
            params => "git54",
            expect => <<'#2...........',
# testing sensitivity to excess commas
my $definition =>
    (
      {
         key1 => value1
      },
      {
         key2 => value2
      },
    );

my $definition =>
    (
      {
        key => value
      }
    );

my $definition =>
    (
      {
         key => value
      },
    );

my $definition =>
    (
      {
         key => value,
      },
    );

my $list =
    (
      {
         key => $value,
         key => $value,
         key => $value,
         key => $value,
         key => $value,
      },
    );

my $list =
    (
      {
        key => $value,
        key => $value,
        key => $value,
        key => $value,
        key => $value,
      }
    );
#2...........
        },

        'fpva.def' => {
            source => "fpva",
            params => "def",
            expect => <<'#3...........',
log_something_with_long_function( 'This is a log message.', 2 );
Coro::AnyEvent::sleep( 3, 4 );
use Carp       ();
use File::Spec ();
use File::Path ();
#3...........
        },

        'fpva.fpva1' => {
            source => "fpva",
            params => "fpva1",
            expect => <<'#4...........',
log_something_with_long_function ( 'This is a log message.', 2 );
Coro::AnyEvent::sleep            ( 3, 4 );
use Carp       ();
use File::Spec ();
use File::Path ();
#4...........
        },

        'fpva.fpva2' => {
            source => "fpva",
            params => "fpva2",
            expect => <<'#5...........',
log_something_with_long_function ( 'This is a log message.', 2 );
Coro::AnyEvent::sleep ( 3, 4 );
use Carp ();
use File::Spec ();
use File::Path ();
#5...........
        },

        'lpxl.def' => {
            source => "lpxl",
            params => "def",
            expect => <<'#6...........',
# simple function call
my $loanlength = getLoanLength(
    $borrower->{'categorycode'},    # sc1
    $iteminformation->{'itemtype'},
    $borrower->{'branchcode'}       # sc3
);

# function call, more than one level deep
my $o = very::long::class::name->new(
    {
        propA => "a",
        propB => "b",
        propC => "c",
    }
);

# function call with sublist
debug(
    "Connecting to DB.",
    "Extra-Parameters: " . join( "<->", $extra_parms ),
    "Config: " . join( "<->", %config )
);

# simple function call with code block
$m->command(
    -label   => 'Save',
    -command => sub { print "DOS\n"; save_dialog($win); }
);

# function call, ternary in list
return OptArgs2::Result->usage(
    $style == OptArgs2::STYLE_FULL ? 'FullUsage' : 'NormalUsage',
    'usage: ' . $usage . "\n" );

# not a function call
%blastparam = (
    -run    => \%runparam,
    -file   => '',
    -parse  => 1,
    -signif => 1e-5,
);

# 'local' is a keyword, not a user function
local (
    $len,    $pts,      @colspec, $char, $cols,
    $repeat, $celldata, $at_text, $after_text
);

# square bracket with sublists
$data = [
    ListElem->new( id => 0, val => 100 ),
    ListElem->new( id => 2, val => 50 ),
    ListElem->new( id => 1, val => 10 ),
];

# curly brace with sublists
$behaviour = {
    cat   => { nap    => "lap",   eat  => "meat" },
    dog   => { prowl  => "growl", pool => "drool" },
    mouse => { nibble => "kibble" },
};
#6...........
        },

        'lpxl.lpxl1' => {
            source => "lpxl",
            params => "lpxl1",
            expect => <<'#7...........',
# simple function call
my $loanlength = getLoanLength(
                                $borrower->{'categorycode'},    # sc1
                                $iteminformation->{'itemtype'},
                                $borrower->{'branchcode'}       # sc3
);

# function call, more than one level deep
my $o = very::long::class::name->new(
                                      {
                                        propA => "a",
                                        propB => "b",
                                        propC => "c",
                                      }
);

# function call with sublist
debug(
       "Connecting to DB.",
       "Extra-Parameters: " . join( "<->", $extra_parms ),
       "Config: " . join( "<->", %config )
);

# simple function call with code block
$m->command( -label   => 'Save',
             -command => sub { print "DOS\n"; save_dialog($win); } );

# function call, ternary in list
return
  OptArgs2::Result->usage(
                   $style == OptArgs2::STYLE_FULL ? 'FullUsage' : 'NormalUsage',
                   'usage: ' . $usage . "\n" );

# not a function call
%blastparam = (
                -run    => \%runparam,
                -file   => '',
                -parse  => 1,
                -signif => 1e-5,
);

# 'local' is a keyword, not a user function
local (
        $len,    $pts,      @colspec, $char, $cols,
        $repeat, $celldata, $at_text, $after_text
);

# square bracket with sublists
$data = [
          ListElem->new( id => 0, val => 100 ),
          ListElem->new( id => 2, val => 50 ),
          ListElem->new( id => 1, val => 10 ),
];

# curly brace with sublists
$behaviour = {
               cat   => { nap    => "lap",   eat  => "meat" },
               dog   => { prowl  => "growl", pool => "drool" },
               mouse => { nibble => "kibble" },
};
#7...........
        },

        'lpxl.lpxl3' => {
            source => "lpxl",
            params => "lpxl3",
            expect => <<'#8...........',
# simple function call
my $loanlength = getLoanLength(
    $borrower->{'categorycode'},    # sc1
    $iteminformation->{'itemtype'},
    $borrower->{'branchcode'}       # sc3
);

# function call, more than one level deep
my $o = very::long::class::name->new(
    {
        propA => "a",
        propB => "b",
        propC => "c",
    }
);

# function call with sublist
debug(
    "Connecting to DB.",
    "Extra-Parameters: " . join( "<->", $extra_parms ),
    "Config: " . join( "<->", %config )
);

# simple function call with code block
$m->command(
    -label   => 'Save',
    -command => sub { print "DOS\n"; save_dialog($win); } );

# function call, ternary in list
return
  OptArgs2::Result->usage(
    $style == OptArgs2::STYLE_FULL ? 'FullUsage' : 'NormalUsage',
    'usage: ' . $usage . "\n" );

# not a function call
%blastparam = (
    -run    => \%runparam,
    -file   => '',
    -parse  => 1,
    -signif => 1e-5,
);

# 'local' is a keyword, not a user function
local (
    $len,    $pts,      @colspec, $char, $cols,
    $repeat, $celldata, $at_text, $after_text
);

# square bracket with sublists
$data = [
    ListElem->new( id => 0, val => 100 ),
    ListElem->new( id => 2, val => 50 ),
    ListElem->new( id => 1, val => 10 ),
];

# curly brace with sublists
$behaviour = {
    cat   => { nap    => "lap",   eat  => "meat" },
    dog   => { prowl  => "growl", pool => "drool" },
    mouse => { nibble => "kibble" },
};
#8...........
        },

        'lpxl.lpxl4' => {
            source => "lpxl",
            params => "lpxl4",
            expect => <<'#9...........',
# simple function call
my $loanlength = getLoanLength(
                                $borrower->{'categorycode'},    # sc1
                                $iteminformation->{'itemtype'},
                                $borrower->{'branchcode'}       # sc3
);

# function call, more than one level deep
my $o = very::long::class::name->new(
    {
        propA => "a",
        propB => "b",
        propC => "c",
    }
);

# function call with sublist
debug(
    "Connecting to DB.",
    "Extra-Parameters: " . join( "<->", $extra_parms ),
    "Config: " . join( "<->", %config )
);

# simple function call with code block
$m->command( -label   => 'Save',
             -command => sub { print "DOS\n"; save_dialog($win); } );

# function call, ternary in list
return
  OptArgs2::Result->usage(
                   $style == OptArgs2::STYLE_FULL ? 'FullUsage' : 'NormalUsage',
                   'usage: ' . $usage . "\n" );

# not a function call
%blastparam = (
    -run    => \%runparam,
    -file   => '',
    -parse  => 1,
    -signif => 1e-5,
);

# 'local' is a keyword, not a user function
local (
        $len,    $pts,      @colspec, $char, $cols,
        $repeat, $celldata, $at_text, $after_text
);

# square bracket with sublists
$data = [
    ListElem->new( id => 0, val => 100 ),
    ListElem->new( id => 2, val => 50 ),
    ListElem->new( id => 1, val => 10 ),
];

# curly brace with sublists
$behaviour = {
    cat   => { nap    => "lap",   eat  => "meat" },
    dog   => { prowl  => "growl", pool => "drool" },
    mouse => { nibble => "kibble" },
};
#9...........
        },

        'lpxl.lpxl5' => {
            source => "lpxl",
            params => "lpxl5",
            expect => <<'#10...........',
# simple function call
my $loanlength = getLoanLength(
                                $borrower->{'categorycode'},    # sc1
                                $iteminformation->{'itemtype'},
                                $borrower->{'branchcode'}       # sc3
);

# function call, more than one level deep
my $o = very::long::class::name->new(
    {
        propA => "a",
        propB => "b",
        propC => "c",
    }
);

# function call with sublist
debug(
    "Connecting to DB.",
    "Extra-Parameters: " . join( "<->", $extra_parms ),
    "Config: " . join( "<->", %config )
);

# simple function call with code block
$m->command(
    -label   => 'Save',
    -command => sub { print "DOS\n"; save_dialog($win); } );

# function call, ternary in list
return
  OptArgs2::Result->usage(
    $style == OptArgs2::STYLE_FULL ? 'FullUsage' : 'NormalUsage',
    'usage: ' . $usage . "\n" );

# not a function call
%blastparam = (
    -run    => \%runparam,
    -file   => '',
    -parse  => 1,
    -signif => 1e-5,
);

# 'local' is a keyword, not a user function
local (
    $len,    $pts,      @colspec, $char, $cols,
    $repeat, $celldata, $at_text, $after_text
);

# square bracket with sublists
$data = [
    ListElem->new( id => 0, val => 100 ),
    ListElem->new( id => 2, val => 50 ),
    ListElem->new( id => 1, val => 10 ),
];

# curly brace with sublists
$behaviour = {
    cat   => { nap    => "lap",   eat  => "meat" },
    dog   => { prowl  => "growl", pool => "drool" },
    mouse => { nibble => "kibble" },
};
#10...........
        },

        'git63.def' => {
            source => "git63",
            params => "def",
            expect => <<'#11...........',
my $fragment = $parser->    #parse_html_string
  parse_balanced_chunk($I);
#11...........
        },

        'align35.def' => {
            source => "align35",
            params => "def",
            expect => <<'#12...........',
# different module names, do not align commas (fixes rt136416)
use File::Spec::Functions 'catfile', 'catdir';
use Mojo::Base 'Mojolicious', '-signatures';

# same module names, align fat commas
use constant PI     => 4 * atan2 1, 1;
use constant TWOPI  => 2 * PI;
use constant FOURPI => 4 * PI;

# same module names, align commas
use TestCounter '3rd-party', 0, '3rd-party no longer visible';
use TestCounter 'replace',   1, 'replacement now visible';
use TestCounter 'root';

# same module name, align fat commas but not commas
use constant COUNTDOWN => scalar reverse 1, 2, 3, 4, 5;
use constant COUNTUP   => reverse 1, 2, 3, 4, 5;
use constant COUNTDOWN => scalar reverse 1, 2, 3, 4, 5;
#12...........
        },

        'rt136417.def' => {
            source => "rt136417",
            params => "def",
            expect => <<'#13...........',
function(
    #
    a, b, c
);

%hash = (
    a => b,
    c => d,
);
#13...........
        },

        'rt136417.rt136417' => {
            source => "rt136417",
            params => "rt136417",
            expect => <<'#14...........',
function(
    #
    a, b, c );

%hash = (
    a => b,
    c => d,
);
#14...........
        },

        'numbers.def' => {
            source => "numbers",
            params => "def",
            expect => <<'#15...........',
# valid numbers
my @vals = (

    12345,
    12345.67,
    .23E-10,
    3.14_15_92,
    4_294_967_296,
    0xff,
    0xdead_beef,
    0377,
    0b011011,
    0x1.999ap-4,
    1e34,
    1e+34,
    1e+034,
    -1e+034,
    0.00000000000000000000000000000000000000000000000000000000000000000001,
    0Xabcdef,
    0B1101,
    0o12_345,    # optional 'o' and 'O' added in perl v5.33.5
    0O12_345,
);
#15...........
        },

        'code_skipping.def' => {
            source => "code_skipping",
            params => "def",
            expect => <<'#16...........',
%Hdr        = %U2E    = %E2U      = %Fallback = ();
$in_charmap = $nerror = $nwarning = 0;
$.          = 0;
#<<V  code skipping: perltidy will pass this verbatim without error checking

    }}} {{{

#>>V
my $self    = shift;
my $cloning = shift;
#16...........
        },
    };

    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 ) {
        print STDERR "Error output received for test '$key'\n";
        if ($err) {
            print STDERR "An error flag '$err' was returned\n";
            ok( !$err );
        }
        if ($stderr_string) {
            print STDERR "---------------------\n";
            print STDERR "<<STDERR>>\n$stderr_string\n";
            print STDERR "---------------------\n";
            ok( !$stderr_string );
        }
        if ($errorfile_string) {
            print STDERR "---------------------\n";
            print STDERR "<<.ERR file>>\n$errorfile_string\n";
            print STDERR "---------------------\n";
            ok( !$errorfile_string );
        }
    }
    else {
        if ( !is( $output, $expect, $key ) ) {
            my $leno = length($output);
            my $lene = length($expect);
            if ( $leno == $lene ) {
                print STDERR
"#> Test '$key' gave unexpected output.  Strings differ but both have length $leno\n";
            }
            else {
                print STDERR
"#> Test '$key' gave unexpected output.  String lengths differ: output=$leno, expected=$lene\n";
            }
        }
    }
}
