#!/usr/bin/perl

use strict;
use warnings;

# Create test environment...
package local::t75;

sub LineFromPosition {
	return 0;
}

package Wx;

sub gettext {
	return $_[0];
}

package Padre;

sub ide {
	return bless {}, __PACKAGE__;
}

sub config {
	return $_[0];
}

sub lang_perl5_beginner_chomp { 1; }

sub lang_perl5_beginner_close { 1; }

sub lang_perl5_beginner_debugger { 1; }

sub lang_perl5_beginner_elseif { 1; }

sub lang_perl5_beginner_ifsetvar { 1; }

sub lang_perl5_beginner_map { 1; }

sub lang_perl5_beginner_map2 { 1; }

sub lang_perl5_beginner_perl6 { 1; }

sub lang_perl5_beginner_pipe2open { 1; }

sub lang_perl5_beginner_pipeopen { 1; }

sub lang_perl5_beginner_regexq { 1; }

sub lang_perl5_beginner_split { 1; }

sub lang_perl5_beginner_warning { 1; }

# The real test...
package main;

use Test::More;

#use Test::NoWarnings;
use File::Spec ();

# Don't run tests for installs
unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) {
	plan( skip_all => "Author tests not required for installation" );
}

# enable NoWarning if this is fixed

my %TEST = (
	'split1.pl'                 => "Line 6: The second parameter of split is a string, not an array",
	'split2.pl'                 => "Line 6: The second parameter of split is a string, not an array",
	'warning.pl'                => "Line 3: You need to write use warnings (with an s at the end) and not use warning.",
	'boolean_expressions_or.pl' => 'TODO',
	'boolean_expressions_pipes.pl' => 'TODO',
	'match_default_scalar.pl'      => 'TODO',
	'chomp.pl'                     => 'TODO',
	'substitute_in_map.pl'         => 'TODO',
	'unintented_glob.pl'           => 'TODO',
	'return_stronger_than_or.pl'   => 'TODO',
	'grep_always_true.pl'          => 'TODO',
	'my_argv.pl'                   => 'TODO', # "my" variable @ARGV masks global variable at ...
	'else_if.pl'    => "Line 9: 'else if' is wrong syntax, correct if 'elsif'.",
	'elseif.pl'     => "Line 9: 'elseif' is wrong syntax, correct if 'elsif'.",
	'SearchTask.pm' => undef,

	# @ARGV, $ARGV, @INC, %INC, %ENV, %SIG, @ISA,
	# other special variables ? $a, $b, $ARGV, $AUTOLOAD, etc ? $_ in perls older than 5.10?
	# @_ ?
);

plan( tests => scalar( keys %TEST ) * 2 + 20 );

use Padre::Document::Perl::Beginner;
my $b = Padre::Document::Perl::Beginner->new( document => { editor => bless {}, 'local::t75' } );

isa_ok $b, 'Padre::Document::Perl::Beginner';


# probably already in some Perl Critic rules
# lack of use strict; and lack of use warnings; should be also reported.

# this might be also in some Perl Critic rules
#my $filename = 'input.txt';
#open my $fh, '<', $filename || die $!;
# problem: precedence of || is higher than that of , so the above code is actually
# the same as:
# open my $fh, '<', ($filename || die $!);
# which will only die if the $filename is false, nothing to do with
# success of failure of open()


# without "use warning" this 'works' noiselessly
# I am not sure we need to look for such as we should always
# tell users to 'use warnings'
#my $x = 23;
#my $z = 3;
#if ($x = 7) {
#	print "xx\n";
#}
#

foreach my $file ( keys %TEST ) {
	if ( defined $TEST{$file} and $TEST{$file} eq 'TODO' ) {
		TODO: {
			local $TODO = "$file not yet implemented";
			ok(0);
			ok(0);
		}
		next;
	}

	my $data = slurp( File::Spec->catfile( 't', 'files', 'beginner', $file ) );
	my $result = $b->check($data);
	if ( defined $TEST{$file} ) {
		is( $result, undef, $file ) or diag "Result: '$result'";
	} else {
		is( $result, 1, $file );
	}
	is( $b->error, $TEST{$file}, "$file error" );
}

# No need to create files for all of these:
# Notice: Text matches are critical as texts may change without notice!
$b->check("=pod\n\nThis is a typical POD test with bad stuff.\npackage DB; if (\$x=1) {}\n\n\=cut\n");
ok( !defined( $b->error ), 'No check of POD stuff' );

$b->check('join(",",map { 1; } (@INC),"a");');
is( $b->error, q(Line 1: map (),x uses x also as list value for map.), 'map arguments' );

$b->check('package DB;');
is( $b->error, q(Line 1: This file uses the DB-namespace which is used by the Perl Debugger.),
	'kill Perl debugger (1)'
);

$b->check('package DB::Connect;');
is( $b->error, q(Line 1: This file uses the DB-namespace which is used by the Perl Debugger.),
	'kill Perl debugger (2)'
);

$b->check('$X = chomp($ARGV[0]);');
is( $b->error, q(Line 1: chomp doesn't return the chomped value, it modifies the variable given as argument.),
	'chomp return value'
);

$b->check('join(",",map { s/\//\,/g; } (@INC),"a");');
is( $b->error, q(Line 1: map (),x uses x also as list value for map.), 'substitution in map (1)' );

$b->check('join(",",map { $_ =~ s/\//\,/g; } (@INC),"a");');
is( $b->error, q(Line 1: map (),x uses x also as list value for map.), 'substitution in map (2)' );

$b->check('for (<@INC>) { 1; }');
is( $b->error, q(Line 1: (<@Foo>) is Perl6 syntax and usually not valid in Perl5.), 'Perl6 loop syntax in Perl5' );

$b->check('if ($_ = 1) { 1; }');
is( $b->error, q(Line 1: A single = in a if-condition is usually a typo, use == or eq to compare.),
	'assign instead of compare'
);

$b->check('open file,"free|tail"');
is( $b->error, q(Line 1: Using a | char in open without a | at the beginning or end is usually a typo.),
	'pipe-open without in or out redirection (2 args)'
);

$b->check('open file,">","free|tail"');
is( $b->error, q(Line 1: Using a | char in open without a | at the beginning or end is usually a typo.),
	'pipe-open3 without in or out redirection (3 args)'
);

$b->check('open file,"|cat|"');
is( $b->error, q(Line 1: You can't use open to pipe to and from a command at the same time.),
	'pipe-open with in and out redirection (2 args)'
);

$b->check('open file,"|cat|"');
is( $b->error, q(Line 1: You can't use open to pipe to and from a command at the same time.),
	'pipe-open with in and out redirection (3 args)'
);

# Thanks to meironC for this sample:
$b->check('open LYNX, "lynx -source http://www.perl.com |" or die " Cant open lynx: $!";');
ok( !$b->error, 'Open with pipe and result check' );

$b->check('elseif');
is( $b->error, q(Line 1: 'elseif' is wrong syntax, correct if 'elsif'.), 'elseif - typo' );

$b->check('$x=~/+/');
is( $b->error,
	q(Line 1: A regular expression starting with a quantifier ( + * ? { ) doesn't make sense, you may want to escape it with a \.),
	'RegExp with quantifier (1)'
);

$b->check('$x =~ /*/');
is( $b->error,
	q(Line 1: A regular expression starting with a quantifier ( + * ? { ) doesn't make sense, you may want to escape it with a \.),
	'RegExp with quantifier (2)'
);

$b->check('close; ');
is( $b->error, q(Line 1: close; usually closes STDIN, STDOUT or something else you don't want.), 'close;' );

$b->check("\nclose; ");
is( $b->error, q(Line 2: close; usually closes STDIN, STDOUT or something else you don't want.), 'close;' );

sub slurp {
	my $file = shift;
	open my $fh, '<', $file or die $!;
	local $/ = undef;
	return <$fh>;
}