#!/usr/bin/perl

# gvim=:SetNumberAndWidth

## Before 'make install' is performed this script should be runnable with
# 'make test'. After 'make install' it should work as 'perl P.t'

#########################

# change 'tests => 1' to 'tests => last_test_to_print';

#########################


# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.

our @answers;
our $sample_strlen;
our $tp;

BEGIN{
	$tp="lib/P.pm";
	
	$sample_strlen=length "Hello Perl 0";

	$_=1;
	push (@answers, [$_, qr{Hello\sPerl\s$_}]) for 1 .. 5;
	push @answers, [6, ""];
	push @answers, [7, qr{Hello Perl \d.*Perl 7}];
	push @answers, [8, qr{^\s*\[.*three.*4.*\]\s*$} ];
	push @answers, [9, qr{^\s*\{.*a.?=>.apple.*\}$} ];
	push @answers, [10, qr{Pkg.*\{.*=>.*\}} ];
	push @answers, [11, qr{fmt:Hello Perl}];
	push @answers, [12, qr(norm=3\.14159.*embed.*3.14)];
	push @answers, [13, qr{embed.*ⅴⅸ.*$}];

	#	3 setup tests, all answers have two parts except for 1 (#6)
	
}

use Test::More;


use Config;

our $win=$Config{osname} =~ m{MSWin32$};
our $unsupported_OS;


if ($win) {
	my ($OS_ex_text, $Maj, $min, $bld, $id);
	my $test = eval { 
		no warnings; no strict;
		($OS_extra_text, $Maj, $min, $bld, $id) = Win32::GetOSVersion(); 
	};
	if ($@) {
		plan skip_all => "Win32::GetOSVersion returned $@";
	} elsif (!$Maj || $Maj =~ /^[\.\d]+$/ || $Maj < 6) {
		$unsupported_os=1;
		plan skip_all => 'OS is no longer maintained.';
	}
}

unless ($unsupported_os) {

	use_ok('mem');

	use_ok('P');

	ok(!defined $ENV{PERL5OPT} || $ENV{PERL5OPT} !~ /utf8/, "check for utf8 in ENV (causes probs)");

	my $match_case_n_name=qr{^.(\d+)\s*\(([^\)]+)\)[^:]*:};
	my $match_testout=qr{\s*(.*)$};
	my $match_expr=qr{^.(\d+)\s*\(([^\)]+)\)[^:]*:\s*(.*)$};
	my $weak_match_expr=qr{^(?:.(\d+)\s*)?\(?([^\)]*)\)?[^:]*:?\s*(.*)$};

	ok( -e $tp , "P.pm exist?");
	chmod( 0755, $tp); 


	sub get_case($;$) {
		my $case = shift;
		my $cmd = @_? "$^X $tp $case ".$_[0]."|" : "$^X $tp $case |";
		open(my $fh, $cmd) || return undef;
		my $out;
		{ local $/=undef;
			$out = <$fh>;
		}
		chomp $out;
		$out;
	}

	sub sv($) { defined $_[0] ? $_[0] : "(undef)" }

	my $caseno=0;
	for my $matchp (@answers) {
		my ($rcase, $name, $rstr);
		my $re = $matchp->[1];
		++$caseno;
		if ($caseno == 5) {	# see if output was on STDERR
			my $null;
			my $dev;
			open($null, ">", $dev="/dev/null") or
				open($null, ">", $dev="NUL:") or 
				die "Cannot open /dev/null nor NUL:";
			close ($null);
			my $resp = get_case($matchp->[0],"2>$dev");
			$resp =~ m{$weak_match_expr};
			($rcase,$name, $rstr) = ($1,$2,$3);
			$resp = get_case($matchp->[0],"2>&1 >$dev");
			$resp =~ m{$weak_match_expr};
			$rstr = $2;
		} elsif ($caseno == 6) {
			my $resp = get_case($matchp->[0]);
			$resp =~ m{$match_expr};
			($rcase,$name, $rstr) = ($1,$2,$3);
			ok($caseno == $rcase, "received testcase $caseno");
			next;
		} elsif ($caseno == 7) { 
			get_case($matchp->[0]-1);
			my $resp = get_case($matchp->[0]);
			my @lns=split /\n/, $resp;
			$resp = $lns[1];
			$resp =~ m{$match_expr};
			($rcase,$name, $rstr) = ($1,$2,$3);
		} else {
			my $resp = get_case($matchp->[0]);
			$resp =~ m{$match_expr};
			($rcase,$name, $rstr) = ($1,$2,$3);
		}
		ok($rcase && $caseno == $rcase, "received testcase $caseno");
		if (length($re)) {
			ok($rstr =~ m{$re}, $name) || 
				diag( sprintf "Regex \"%s\" did not match string \"%s\" in case \"%s\".", 
					sv($re), sv($rstr), sv($name) );
		}
	}
}

done_testing();