# Created with: ./make_t.pl

# Contents:
#1 rt102451.def
#2 rt104427.def
#3 rt106492.def
#4 rt107832.def
#5 rt107832.rt107832
#6 rt111519.def
#7 rt111519.rt111519
#8 rt112534.def
#9 rt113689.def
#10 rt113689.rt113689
#11 rt113792.def
#12 rt114359.def
#13 rt114909.def
#14 rt116344.def
#15 rt119140.def
#16 rt119588.def
#17 rt119970.def
#18 rt119970.rt119970
#19 rt123492.def
#20 rt123749.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'      => "",
        'rt107832' => <<'----------',
-lp
-boc
----------
        'rt111519' => <<'----------',
-io
-dac
----------
        'rt113689' => <<'----------',
-blao=2
-blbc=1
-blaol='*'
-blbcl='*'
-mbl=2
----------
        'rt119970' => "-wn",
    };

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

        'rt102451' => <<'----------',
# RT#102451 bug test; unwanted spaces added before =head1 on each pass
#<<<

=head1 NAME

=cut

my %KA_CACHE; # indexed by uhost currently, points to [$handle...] array


=head1 NAME

=cut

#>>>
----------

        'rt104427' => <<'----------',
#!/usr/bin/env perl 
use v5.020;    #includes strict
use warnings;
use experimental 'signatures';
setidentifier();
exit;
sub setidentifier ( $href = {} ) { say 'hi'; }
----------

        'rt106492' => <<'----------',
my $ct = Courriel::Header::ContentType->new( mime_type => 'multipart/alternative', attributes => { boundary => unique_boundary }, );
----------

        'rt107832' => <<'----------',
my %temp = 
( 
supsup => 123, 
nested => { 
asdf => 456, 
yarg => 'yarp', 
}, );
----------

        'rt111519' => <<'----------',
use strict;
use warnings;
my $x = 1; # comment not removed
# comment will be removed
my $y = 2; # comment also not removed
----------

        'rt112534' => <<'----------',
get( on_ready => sub ($worker) { $on_ready->end; return; }, on_exit => sub ( $worker, $status ) { return; }, on_data => sub ($data) { $self->_on_data(@_) if $self; return; } );
----------

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

        'rt113792' => <<'----------',
print "hello world\n";
__DATA__ 
=> 1/2 : 0.5 
----------

        'rt114359' => <<'----------',
my $x = 2; print $x ** 0.5;
----------

        'rt114909' => <<'----------',
#!perl
use strict;
use warnings;

use experimental 'signatures';

sub reader ( $line_sep, $chomp ) {
    return sub ( $fh, $out ) : prototype(*$) {
        local $/ = $line_sep;
        my $content = <$fh>;
        return undef unless defined $content;
        chomp $content if $chomp;
        $$out .= $content;
        return 1;
    };
}

BEGIN {
    *get_line = reader( "\n", 1 );
}

while ( get_line( STDIN, \my $buf ) ) {
    print "Got: $buf\n";
}
----------

        'rt116344' => <<'----------',
# Rt116344
# Attempting to tidy the following code failed:
sub broken {
    return ref {} ? 1 : 0;
    something();
}
----------

        'rt119140' => <<'----------',
while (<<>>) { }
----------

        'rt119588' => <<'----------',
sub demo {
    my $self     = shift;
    my $longname = shift // "xyz";
}
----------

        'rt119970' => <<'----------',
my $x = [
    {
        fooxx => 1,
        bar => 1,
    }
];
----------

        'rt123492' => <<'----------',
if (1) {
    print <<~EOF;
    Hello there
    EOF
}
----------

        'rt123749' => <<'----------',
get('http://mojolicious.org')->then(
    sub {
        my $mojo = shift;
        say $mojo->res->code;
        return get('http://metacpan.org');
    }
)->then(
    sub {
        my $cpan = shift;
        say $cpan->res->code;
    }
)->catch(
    sub {
        my $err = shift;
        warn "Something went wrong: $err";
    }
)->wait;
----------
    };

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

        'rt102451.def' => {
            source => "rt102451",
            params => "def",
            expect => <<'#1...........',
# RT#102451 bug test; unwanted spaces added before =head1 on each pass
#<<<

=head1 NAME

=cut

my %KA_CACHE; # indexed by uhost currently, points to [$handle...] array


=head1 NAME

=cut

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

        'rt104427.def' => {
            source => "rt104427",
            params => "def",
            expect => <<'#2...........',
#!/usr/bin/env perl 
use v5.020;    #includes strict
use warnings;
use experimental 'signatures';
setidentifier();
exit;
sub setidentifier ( $href = {} ) { say 'hi'; }
#2...........
        },

        'rt106492.def' => {
            source => "rt106492",
            params => "def",
            expect => <<'#3...........',
my $ct = Courriel::Header::ContentType->new(
    mime_type  => 'multipart/alternative',
    attributes => { boundary => unique_boundary },
);
#3...........
        },

        'rt107832.def' => {
            source => "rt107832",
            params => "def",
            expect => <<'#4...........',
my %temp = (
    supsup => 123,
    nested => {
        asdf => 456,
        yarg => 'yarp',
    },
);
#4...........
        },

        'rt107832.rt107832' => {
            source => "rt107832",
            params => "rt107832",
            expect => <<'#5...........',
my %temp = (
    supsup => 123,
    nested => {
                asdf => 456,
                yarg => 'yarp',
    },
);
#5...........
        },

        'rt111519.def' => {
            source => "rt111519",
            params => "def",
            expect => <<'#6...........',
use strict;
use warnings;
my $x = 1;    # comment not removed

# comment will be removed
my $y = 2;    # comment also not removed
#6...........
        },

        'rt111519.rt111519' => {
            source => "rt111519",
            params => "rt111519",
            expect => <<'#7...........',
use strict;
use warnings;
my $x = 1;
my $y = 2;
#7...........
        },

        'rt112534.def' => {
            source => "rt112534",
            params => "def",
            expect => <<'#8...........',
get(
    on_ready => sub ($worker) { $on_ready->end; return; },
    on_exit  => sub ( $worker, $status ) { return; },
    on_data  => sub ($data) { $self->_on_data(@_) if $self; return; }
);
#8...........
        },

        'rt113689.def' => {
            source => "rt113689",
            params => "def",
            expect => <<'#9...........',
$a = sub {
    if ( !defined( $_[0] ) ) {
        print("Hello, World\n");
    }
    else { print( $_[0], "\n" ); }
};
#9...........
        },

        'rt113689.rt113689' => {
            source => "rt113689",
            params => "rt113689",
            expect => <<'#10...........',
$a = sub {


    if ( !defined( $_[0] ) ) {


        print("Hello, World\n");

    }
    else { print( $_[0], "\n" ); }

};
#10...........
        },

        'rt113792.def' => {
            source => "rt113792",
            params => "def",
            expect => <<'#11...........',
print "hello world\n";
__DATA__ 
=> 1/2 : 0.5 
#11...........
        },

        'rt114359.def' => {
            source => "rt114359",
            params => "def",
            expect => <<'#12...........',
my $x = 2;
print $x **0.5;
#12...........
        },

        'rt114909.def' => {
            source => "rt114909",
            params => "def",
            expect => <<'#13...........',
#!perl
use strict;
use warnings;

use experimental 'signatures';

sub reader ( $line_sep, $chomp ) {
    return sub ( $fh, $out ) : prototype(*$) {
        local $/ = $line_sep;
        my $content = <$fh>;
        return undef unless defined $content;
        chomp $content if $chomp;
        $$out .= $content;
        return 1;
    };
}

BEGIN {
    *get_line = reader( "\n", 1 );
}

while ( get_line( STDIN, \my $buf ) ) {
    print "Got: $buf\n";
}
#13...........
        },

        'rt116344.def' => {
            source => "rt116344",
            params => "def",
            expect => <<'#14...........',
# Rt116344
# Attempting to tidy the following code failed:
sub broken {
    return ref {} ? 1 : 0;
    something();
}
#14...........
        },

        'rt119140.def' => {
            source => "rt119140",
            params => "def",
            expect => <<'#15...........',
while ( <<>> ) { }
#15...........
        },

        'rt119588.def' => {
            source => "rt119588",
            params => "def",
            expect => <<'#16...........',
sub demo {
    my $self     = shift;
    my $longname = shift // "xyz";
}
#16...........
        },

        'rt119970.def' => {
            source => "rt119970",
            params => "def",
            expect => <<'#17...........',
my $x = [
    {
        fooxx => 1,
        bar   => 1,
    }
];
#17...........
        },

        'rt119970.rt119970' => {
            source => "rt119970",
            params => "rt119970",
            expect => <<'#18...........',
my $x = [ {
    fooxx => 1,
    bar   => 1,
} ];
#18...........
        },

        'rt123492.def' => {
            source => "rt123492",
            params => "def",
            expect => <<'#19...........',
if (1) {
    print <<~EOF;
    Hello there
    EOF
}
#19...........
        },

        'rt123749.def' => {
            source => "rt123749",
            params => "def",
            expect => <<'#20...........',
get('http://mojolicious.org')->then(
    sub {
        my $mojo = shift;
        say $mojo->res->code;
        return get('http://metacpan.org');
    }
)->then(
    sub {
        my $cpan = shift;
        say $cpan->res->code;
    }
)->catch(
    sub {
        my $err = shift;
        warn "Something went wrong: $err";
    }
)->wait;
#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 ) {
        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";
            }
        }
    }
}
