# Created with: ./make_t.pl

# Contents:
#1 novalign.def
#2 novalign.novalign1
#3 novalign.novalign2
#4 novalign.novalign3
#5 lp2.def
#6 lp2.lp
#7 braces.braces8
#8 rt140025.def
#9 rt140025.rt140025
#10 xlp1.def
#11 xlp1.xlp1
#12 git74.def
#13 git74.git74
#14 git77.def
#15 git77.git77
#16 vxl.def
#17 vxl.vxl1
#18 vxl.vxl2
#19 bal.bal1

# 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 = {
        'bal1'    => "-bal=1",
        'braces8' => <<'----------',
-bl -bbvt=1 -blxl=' ' -bll='sub do asub'
----------
        'def'   => "",
        'git74' => <<'----------',
-xlp
--iterations=2
--maximum-line-length=120
--line-up-parentheses
--continuation-indentation=4
--closing-token-indentation=1
--want-left-space="= -> ( )"
--want-right-space="= -> ( )"
--space-function-paren
--space-keyword-paren
--space-terminal-semicolon
--opening-brace-on-new-line
--opening-sub-brace-on-new-line
--opening-anonymous-sub-brace-on-new-line
--brace-left-and-indent
--brace-left-and-indent-list="*"
--break-before-hash-brace=3
----------
        'git77' => <<'----------',
-gal='Grep Map'
----------
        'lp'        => "-lp",
        'novalign1' => "-novalign",
        'novalign2' => "-nvsc -nvbc -msc=2",
        'novalign3' => "-nvc",
        'rt140025'  => "-lp -xci -ci=4 -ce",
        'vxl1'      => <<'----------',
-vxl='='
-nvco
----------
        'vxl2' => <<'----------',
-vxl='*' -vil='= <=>'
----------
        'xlp1' => "-xlp",
    };

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

        'bal' => <<'----------',
{
  L1:
  L2:
  L3: return;
};
----------

        'braces' => <<'----------',
sub message {
    if ( !defined( $_[0] ) ) {
        print("Hello, World\n");
    }
    else {
        print( $_[0], "\n" );
    }
}

$myfun = sub {
    print("Hello, World\n");
};

eval {
    my $app = App::perlbrew->new( "install-patchperl", "-q" );
    $app->run();
} or do {
    $error          = $@;
    $produced_error = 1;
};

Mojo::IOLoop->next_tick(
    sub {
        $ua->get(
            '/' => sub {
                push @kept_alive, pop->kept_alive;
                Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
            }
        );
    }
);

$r = do {
    sswitch( $words[ rand @words ] ) {
        case $words[0]:
        case $words[1]:
        case $words[2]:
        case $words[3]: { 'ok' }
      default: { 'wtf' }
    }
};

try {
    die;
}
catch {
    die;
};
----------

        'git74' => <<'----------',
$self->func(
  {
    command  => [ 'command', 'argument1', 'argument2' ],
    callback => sub {
      my ($res) = @_;
      print($res);
    }
  }
);

my $test_var = $self->test_call(    #
    $arg1,
    $arg2
);

my $test_var = $self->test_call(
    $arg1,                          #
    $arg2
);

my $test_var = $self->test_call(
    #
    $arg1,
    $arg2,
);

my $test_var = $self->test_call(

    $arg1,
    $arg2,
);

my $test_var = $self->test_call(
    $arg1,
    $arg2

);

my $test_var = $self->test_call(

    $arg1,
    $arg2,

);

my $test_var =

  $self->test_call(
    $arg1,
    $arg2

  );

----------

        'git77' => <<'----------',
# These should format about the same with -gal='Map Grep'.
# NOTE: The braces only align if the internal code flag ALIGN_GREP_ALIASES is set
    return +{
        Map  {
$_->init_arg => $_->get_value($instance) }
        Grep { $_->has_value($instance) }
        Grep {
defined( $_->init_arg ) }
$class->get_all_attributes
    };

    return +{
        map  {
$_->init_arg => $_->get_value($instance) }
        grep { $_->has_value($instance) }
        grep {
defined( $_->init_arg ) }
$class->get_all_attributes
    };
----------

        'lp2' => <<'----------',
# test issue git #74, lost -lp when final anon sub brace followed by '}'
Util::Parser->new(
    Handlers => {
        Init  => sub { $self->init(@_) },
        Mid =>  { sub { shift; $self->mid(@_) } },
        Final => sub { shift; $self->final(@_) }
    }
)->parse( $_[0] );
----------

        'novalign' => <<'----------',
{
# simple vertical alignment of '=' and '#'
# A long line to test -nvbc ... normally this will cause the previous line to move left
my $lines = 0;    # checksum: #lines
my $bytes = 0;    # checksum: #bytes
my $sum = 0;    # checksum: system V sum
my $patchdata = 0;    # saw patch data
my $pos = 0;    # start of patch data
                                         # a hanging side comment
my $endkit = 0;    # saw end of kit
my $fail = 0;    # failed
}

----------

        'rt140025' => <<'----------',
eval {
my $cpid;
my $cmd;

 FORK: {
 if( $cpid = fork ) {
 close( STDOUT );
 last;
 } elsif( defined $cpid ) {
 close( STDIN );
 open( STDIN, '<', '/dev/null' ) or die( "open3: $!\n" );
 exec $cmd or die( "exec: $!\n" );
 } elsif( $! == EAGAIN ) {
 sleep 3;
 redo FORK;
 } else {
 die( "Can't fork: $!\n" );
 }
 }
};
----------

        'vxl' => <<'----------',
# if equals is excluded then ternary is automatically excluded
# side comment alignments always remain
$co_description = ($color) ? 'bold cyan' : '';          # description
$co_prompt      = ($color) ? 'bold green' : '';         # prompt
$co_unused      = ($color) ? 'on_green' : 'reverse';    # unused

sub sortName       { $a->{"file"} cmp $b->{"file"}; }
sub sortNameNoCase { uc( $a->{"file"} ) cmp uc( $b->{"file"} ); }
sub sortSize       { $b->{"size"} <=> $a->{"size"}; }
sub sortDate       { $b->{"mtime"} <=> $a->{"mtime"}; }
----------

        'xlp1' => <<'----------',
# test -xlp with comments, broken sub blocks, blank line, line length limit
$cb1 = $act_page->Checkbutton(
  -text     => M "Verwenden",
  -variable => \$qualitaet_s_optimierung,
  -command  => sub {
    change_state_all( $act_page1, $qualitaet_s_optimierung, { $cb1 => 1 } )
      ;    # sc
  },
)->grid(

  # block comment
  -row    => $gridy++,
  -column => 2,
  -sticky => 'e'
);
----------
    };

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

        'novalign.def' => {
            source => "novalign",
            params => "def",
            expect => <<'#1...........',
{
# simple vertical alignment of '=' and '#'
# A long line to test -nvbc ... normally this will cause the previous line to move left
    my $lines     = 0;    # checksum: #lines
    my $bytes     = 0;    # checksum: #bytes
    my $sum       = 0;    # checksum: system V sum
    my $patchdata = 0;    # saw patch data
    my $pos       = 0;    # start of patch data
                          # a hanging side comment
    my $endkit    = 0;    # saw end of kit
    my $fail      = 0;    # failed
}

#1...........
        },

        'novalign.novalign1' => {
            source => "novalign",
            params => "novalign1",
            expect => <<'#2...........',
{
    # simple vertical alignment of '=' and '#'
# A long line to test -nvbc ... normally this will cause the previous line to move left
    my $lines = 0;    # checksum: #lines
    my $bytes = 0;    # checksum: #bytes
    my $sum = 0;    # checksum: system V sum
    my $patchdata = 0;    # saw patch data
    my $pos = 0;    # start of patch data
                    # a hanging side comment
    my $endkit = 0;    # saw end of kit
    my $fail = 0;    # failed
}

#2...........
        },

        'novalign.novalign2' => {
            source => "novalign",
            params => "novalign2",
            expect => <<'#3...........',
{
    # simple vertical alignment of '=' and '#'
# A long line to test -nvbc ... normally this will cause the previous line to move left
    my $lines     = 0;  # checksum: #lines
    my $bytes     = 0;  # checksum: #bytes
    my $sum       = 0;  # checksum: system V sum
    my $patchdata = 0;  # saw patch data
    my $pos       = 0;  # start of patch data
      # a hanging side comment
    my $endkit = 0;  # saw end of kit
    my $fail = 0;  # failed
}

#3...........
        },

        'novalign.novalign3' => {
            source => "novalign",
            params => "novalign3",
            expect => <<'#4...........',
{
# simple vertical alignment of '=' and '#'
# A long line to test -nvbc ... normally this will cause the previous line to move left
    my $lines = 0;        # checksum: #lines
    my $bytes = 0;        # checksum: #bytes
    my $sum = 0;          # checksum: system V sum
    my $patchdata = 0;    # saw patch data
    my $pos = 0;          # start of patch data
                          # a hanging side comment
    my $endkit = 0;       # saw end of kit
    my $fail = 0;         # failed
}

#4...........
        },

        'lp2.def' => {
            source => "lp2",
            params => "def",
            expect => <<'#5...........',
# test issue git #74, lost -lp when final anon sub brace followed by '}'
Util::Parser->new(
    Handlers => {
        Init  => sub { $self->init(@_) },
        Mid   => { sub { shift; $self->mid(@_) } },
        Final => sub { shift; $self->final(@_) }
    }
)->parse( $_[0] );
#5...........
        },

        'lp2.lp' => {
            source => "lp2",
            params => "lp",
            expect => <<'#6...........',
# test issue git #74, lost -lp when final anon sub brace followed by '}'
Util::Parser->new(
                   Handlers => {
                                 Init  => sub { $self->init(@_) },
                                 Mid   => { sub { shift; $self->mid(@_) } },
                                 Final => sub { shift; $self->final(@_) }
                   }
)->parse( $_[0] );
#6...........
        },

        'braces.braces8' => {
            source => "braces",
            params => "braces8",
            expect => <<'#7...........',
sub message
{   if ( !defined( $_[0] ) ) {
        print("Hello, World\n");
    }
    else {
        print( $_[0], "\n" );
    }
}

$myfun = sub
{   print("Hello, World\n");
};

eval {
    my $app = App::perlbrew->new( "install-patchperl", "-q" );
    $app->run();
} or do
{   $error          = $@;
    $produced_error = 1;
};

Mojo::IOLoop->next_tick(
    sub
    {   $ua->get(
            '/' => sub
            {   push @kept_alive, pop->kept_alive;
                Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
            }
        );
    }
);

$r = do
{   sswitch( $words[ rand @words ] ) {
        case $words[0]:
        case $words[1]:
        case $words[2]:
        case $words[3]: { 'ok' }
      default: { 'wtf' }
    }
};

try {
    die;
}
catch {
    die;
};
#7...........
        },

        'rt140025.def' => {
            source => "rt140025",
            params => "def",
            expect => <<'#8...........',
eval {
    my $cpid;
    my $cmd;

  FORK: {
        if ( $cpid = fork ) {
            close(STDOUT);
            last;
        }
        elsif ( defined $cpid ) {
            close(STDIN);
            open( STDIN, '<', '/dev/null' ) or die("open3: $!\n");
            exec $cmd                       or die("exec: $!\n");
        }
        elsif ( $! == EAGAIN ) {
            sleep 3;
            redo FORK;
        }
        else {
            die("Can't fork: $!\n");
        }
    }
};
#8...........
        },

        'rt140025.rt140025' => {
            source => "rt140025",
            params => "rt140025",
            expect => <<'#9...........',
eval {
    my $cpid;
    my $cmd;

FORK: {
        if ( $cpid = fork ) {
            close(STDOUT);
            last;
        } elsif ( defined $cpid ) {
            close(STDIN);
            open( STDIN, '<', '/dev/null' ) or die("open3: $!\n");
            exec $cmd                       or die("exec: $!\n");
        } elsif ( $! == EAGAIN ) {
            sleep 3;
            redo FORK;
        } else {
            die("Can't fork: $!\n");
        }
    }
};
#9...........
        },

        'xlp1.def' => {
            source => "xlp1",
            params => "def",
            expect => <<'#10...........',
# test -xlp with comments, broken sub blocks, blank line, line length limit
$cb1 = $act_page->Checkbutton(
    -text     => M "Verwenden",
    -variable => \$qualitaet_s_optimierung,
    -command  => sub {
        change_state_all( $act_page1, $qualitaet_s_optimierung, { $cb1 => 1 } )
          ;    # sc
    },
)->grid(

    # block comment
    -row    => $gridy++,
    -column => 2,
    -sticky => 'e'
);
#10...........
        },

        'xlp1.xlp1' => {
            source => "xlp1",
            params => "xlp1",
            expect => <<'#11...........',
# test -xlp with comments, broken sub blocks, blank line, line length limit
$cb1 = $act_page->Checkbutton(
                              -text     => M "Verwenden",
                              -variable => \$qualitaet_s_optimierung,
                              -command  => sub {
                                  change_state_all( $act_page1,
                                       $qualitaet_s_optimierung, { $cb1 => 1 } )
                                    ;    # sc
                              },
)->grid(

        # block comment
        -row    => $gridy++,
        -column => 2,
        -sticky => 'e'
);
#11...........
        },

        'git74.def' => {
            source => "git74",
            params => "def",
            expect => <<'#12...........',
$self->func(
    {
        command  => [ 'command', 'argument1', 'argument2' ],
        callback => sub {
            my ($res) = @_;
            print($res);
        }
    }
);

my $test_var = $self->test_call(    #
    $arg1,
    $arg2
);

my $test_var = $self->test_call(
    $arg1,                          #
    $arg2
);

my $test_var = $self->test_call(
    #
    $arg1,
    $arg2,
);

my $test_var = $self->test_call(

    $arg1,
    $arg2,
);

my $test_var = $self->test_call(
    $arg1,
    $arg2

);

my $test_var = $self->test_call(

    $arg1,
    $arg2,

);

my $test_var =

  $self->test_call(
    $arg1,
    $arg2

  );

#12...........
        },

        'git74.git74' => {
            source => "git74",
            params => "git74",
            expect => <<'#13...........',
$self -> func (
                {
                   command  => [ 'command', 'argument1', 'argument2' ],
                   callback => sub
                       {
                       my ($res) = @_ ;
                       print ($res) ;
                       }
                }
              ) ;

my $test_var = $self -> test_call (    #
                                    $arg1,
                                    $arg2
                                  ) ;

my $test_var = $self -> test_call (
                                    $arg1,    #
                                    $arg2
                                  ) ;

my $test_var = $self -> test_call (
                                   #
                                   $arg1,
                                   $arg2,
                                  ) ;

my $test_var = $self -> test_call (

                                   $arg1,
                                   $arg2,
                                  ) ;

my $test_var = $self -> test_call (
                                    $arg1,
                                    $arg2

                                  ) ;

my $test_var = $self -> test_call (

                                   $arg1,
                                   $arg2,

                                  ) ;

my $test_var =

    $self -> test_call (
                         $arg1,
                         $arg2

                       ) ;

#13...........
        },

        'git77.def' => {
            source => "git77",
            params => "def",
            expect => <<'#14...........',
# These should format about the same with -gal='Map Grep'.
# NOTE: The braces only align if the internal code flag ALIGN_GREP_ALIASES is set
    return +{
        Map {
            $_->init_arg => $_->get_value($instance)
        } Grep { $_->has_value($instance) }
        Grep {
            defined( $_->init_arg )
        }
        $class->get_all_attributes
    };

    return +{
        map  { $_->init_arg => $_->get_value($instance) }
        grep { $_->has_value($instance) }
        grep { defined( $_->init_arg ) } $class->get_all_attributes
    };
#14...........
        },

        'git77.git77' => {
            source => "git77",
            params => "git77",
            expect => <<'#15...........',
# These should format about the same with -gal='Map Grep'.
# NOTE: The braces only align if the internal code flag ALIGN_GREP_ALIASES is set
    return +{
        Map { $_->init_arg => $_->get_value($instance) }
        Grep { $_->has_value($instance) }
        Grep { defined( $_->init_arg ) } $class->get_all_attributes
    };

    return +{
        map  { $_->init_arg => $_->get_value($instance) }
        grep { $_->has_value($instance) }
        grep { defined( $_->init_arg ) } $class->get_all_attributes
    };
#15...........
        },

        'vxl.def' => {
            source => "vxl",
            params => "def",
            expect => <<'#16...........',
# if equals is excluded then ternary is automatically excluded
# side comment alignments always remain
$co_description = ($color) ? 'bold cyan'  : '';           # description
$co_prompt      = ($color) ? 'bold green' : '';           # prompt
$co_unused      = ($color) ? 'on_green'   : 'reverse';    # unused

sub sortName       { $a->{"file"}       cmp $b->{"file"}; }
sub sortNameNoCase { uc( $a->{"file"} ) cmp uc( $b->{"file"} ); }
sub sortSize       { $b->{"size"}       <=> $a->{"size"}; }
sub sortDate       { $b->{"mtime"}      <=> $a->{"mtime"}; }
#16...........
        },

        'vxl.vxl1' => {
            source => "vxl",
            params => "vxl1",
            expect => <<'#17...........',
# if equals is excluded then ternary is automatically excluded
# side comment alignments always remain
$co_description = ($color) ? 'bold cyan' : '';     # description
$co_prompt = ($color) ? 'bold green' : '';         # prompt
$co_unused = ($color) ? 'on_green' : 'reverse';    # unused

sub sortName       { $a->{"file"}       cmp $b->{"file"}; }
sub sortNameNoCase { uc( $a->{"file"} ) cmp uc( $b->{"file"} ); }
sub sortSize       { $b->{"size"}  <=> $a->{"size"}; }
sub sortDate       { $b->{"mtime"} <=> $a->{"mtime"}; }
#17...........
        },

        'vxl.vxl2' => {
            source => "vxl",
            params => "vxl2",
            expect => <<'#18...........',
# if equals is excluded then ternary is automatically excluded
# side comment alignments always remain
$co_description = ($color) ? 'bold cyan' : '';          # description
$co_prompt      = ($color) ? 'bold green' : '';         # prompt
$co_unused      = ($color) ? 'on_green' : 'reverse';    # unused

sub sortName { $a->{"file"} cmp $b->{"file"}; }
sub sortNameNoCase { uc( $a->{"file"} ) cmp uc( $b->{"file"} ); }
sub sortSize { $b->{"size"} <=> $a->{"size"}; }
sub sortDate { $b->{"mtime"} <=> $a->{"mtime"}; }
#18...........
        },

        'bal.bal1' => {
            source => "bal",
            params => "bal1",
            expect => <<'#19...........',
{
  L1:
  L2:
  L3:
    return;
};
#19...........
        },
    };

    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";
            }
        }
    }
}
