The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl
use warnings; use strict; use English qw( -no_match_vars );
use Test::More;
use rlib '.'; use Helper;

my $test_prog = prog_file('gcd.pl');

my $opts = {
    filter => sub{
        my ($got_lines, $correct_lines) = @_;
        my @result = ();
	my $skip = 0;
        foreach (split("\n", $got_lines)) {
	    s/^\s+'/  '/;
	    s/^\s*\]/  ]/;
	    s/^\s*\}/}/;
            push @result, $_;
        }
        $got_lines = join("\n", @result);
        return ($got_lines, $correct_lines);
    },
    run_opts => " --no-highlight --basename -nx --fall-off-end"
};

run_debugger("$test_prog 3 5", undef, undef, $opts);
$test_prog = prog_file('eval.pl');

$opts = {
    filter => sub{
        my ($got_lines, $correct_lines) = @_;
        my @result = ();
	my $skip = 0;
        foreach (split("\n", $got_lines)) {
	    if ($skip) {
		$skip--;
		next;
	    }

	    # Some perl's mess up on eval lines, so they won't show
	    # the following source code line.
	    # So we have to skip them all the time since some Perl's miss them
	    next if $_ eq '    my @args = @_;';

            # if (/main::\(\(eval .+:\d+\).* remapped /) {
            if (/main::\(\(eval .+:\d+.* remapped /) {
                s/main::\(\(eval .+:\d+.* remapped (?:.+):(\d+)/main::((eval 1955)[eval.pl:10]:$1 remapped bogus.pl:$1/;
            } elsif (/main::\(\(eval \d+\).*:(\d+)/) {
                s/main::\(\(eval \d+\).*:(\d+)/main::((eval 1955)[eval.pl:10]:$1 remapped bogus.pl:$1/;
            } elsif (/.. \(.+\:\d+\)/) {
                if ($OSNAME eq 'MSWin32') {
                    s/\((?:.+\\)?(.+\:\d+)\)/($1)/;
                } else {
                    s/\((?:.+\/)?(.+\:\d+)\)/($1)/;
                }
            } elsif (/`\(eval \d+\)\[.+:13\]'/) {
                s/`\(eval \d+\)\[.+:13\]'/`(eval 1000)[eval.pl:13]'/;
            } elsif (/^sub five/) {
                # Perl 5.10.0 doesn't show "sub five() {"
		$skip = 3;
                next;
            } elsif ( /^\s*\}/ ) {
                next;
	    }
            push @result, $_;
        }
        $got_lines = join("\n", @result);
        return ($got_lines, $correct_lines);
    },
    run_opts => " --no-highlight --basename -nx --fall-off-end"
};

run_debugger("$test_prog", 'eval2.cmd', undef, $opts);


$test_prog = prog_file('gcd.pl');
$opts->{filter} = sub{
    my ($got_lines, $correct_lines) = @_;
    my @result = ();
    my $skip = 0;
    foreach (split("\n", $got_lines)) {
	if ($skip) {
	    $skip--;
	    next;
	}
	# FIXME
	# '/tmp/t/../example/gcd.pl', => 'gcd.pl',
	s/^\s+ '.*gcd.pl\',$/  'gcd.pl',/;
	s/^\s+ 'main',$/  'main',/;
	s/^\s+]}$/]}/;
	s/^\s+18$/  18/;
	s/^\s+21$/  21/;
	s/^\s+9$/  9/;
	push @result, $_;
    };
    $got_lines = join("\n", @result);
    return ($got_lines, $correct_lines);
};
run_debugger("$test_prog 3 5", 'eval3.cmd', undef, $opts);


done_testing();