The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -w   -- -*- tab-width: 4; mode: perl -*-

use strict;
use warnings;

#use lib 't/lib';
use Test::More;
use Test::Differences;
my $haveTestNoWarnings = eval { require Test::NoWarnings; import Test::NoWarnings; 1; };

if ( !$ENV{HARNESS_ACTIVE} ) {
	# not executing under Test::Harness
	use lib qw{ lib };		# for ease of testing from command line and testing immediacy, use the 'lib' version (so 'blib/arch' version doesn't have to be updated 1st)
	}

use Win32::CommandLine;

sub add_test;
sub test_num;
sub do_tests;

# setup a known environment
$ENV{nullglob} = 0;  	## no critic ( RequireLocalizedPunctuationVars ) ## ToDO: remove/revisit

# Tests

## accumulate tests

add_test( [ qq{$0} ], qw( ) );

add_test( [ qq{ $0} ], qw( ) );

add_test( [ qq{$0 } ], qw( ) );

add_test( [ qq{ $0 } ], qw( ) );

add_test( [ qq{ a } ], qw( ) );

add_test( [ qq{ a b c } ], qw( ) );

add_test( [ qq{ a 'b' c } ], qw( ) );

add_test( [ qq{$0 a '' } ], ( qq{a}, qq{} ) );

add_test( [ qq{$0 a b c} ], qw( a b c ) );

add_test( [ qq{$0 "a b" c} ], ( "a b", "c" ) );

add_test( [ qq{$0 'a b' c'' } ], ( "a b", "c" ) );

add_test( [ qq{$0 "a b" c"" } ], ( "a b", "c" ) );

add_test( [ qq{$0 "a b" c""d } ], ( "a b", "cd" ) );

add_test( [ qq{$0 'a b" c'} ], ( qq{a b" c} ) );	##"

add_test( [ qq{$0 'a bb" c'} ], ( qq{a bb" c} ) );	##"

add_test( [ qq{$0 \$'test'} ], ( qq{test} ) );

add_test( [ qq{$0 \$'\\x34\\x34'} ], ( qq{44} ) );

add_test( [ qq{$0 '\\x34\\x34'} ], ( qq{\\x34\\x34} ) );

add_test( [ qq{$0 \*.t} ], ( q{*.t} ) );

#add_test( [ qq{$0 '*.t} ], ( q{*.t} ) );   # exception: unbalanced quotes

add_test( [ qq{$0 a b c \*.t} ], ( qw{a b c}, q{*.t} ) );

add_test( [ qq{$0 a b c t/\*.t} ], ( qw{a b c}, glob('t/*.t') ) );

add_test( [ qq{$0 a t/\*.t b} ], ( "a", glob('t/*.t'), "b" ) );

add_test( [ qq{$0 t/\"*".t} ], ( q{t/*.t} ) );	##"

add_test( [ qq{$0 t/\'*'.t} ], ( q{t/*.t} ) );

add_test( [ qq{$0 t/{0}\*.t} ], ( glob('t/{0}*.t') ) );

add_test( [ qq{$0 t/{0,}\*.t} ], ( glob('t/{0,}*.t') ) );

add_test( [ qq{$0 t/{0,p}\*.t}, { 'nullglob' => 1 } ], ( glob('t/{0,p}*.t') ) );

add_test( [ qq{$0 t/\{0,t,p\}\*.t}, { 'nullglob' => 1 } ], ( glob('t/{0,t,p}*.t') ) );

add_test( [ qq{$0 t/\{t,p,0\}\*.t}, { 'nullglob' => 1 } ], ( glob('t/{t,p,0}*.t') ) );

add_test( [ qq{$0 t/\*} ], ( glob('t/*') ) );

add_test( [ qq{$0 '\\\\'} ], ( '\\\\' ) );

add_test( [ qq{$0 'a\\a' '\\a\\x\\'} ], ( 'a\\a', '\\a\\x\\' ) );

add_test( [ qq{$0 '/a\a'} ], ( qq{/a\a} ) );

add_test( [ qq{$0 '//foo\\bar'} ], ( q{//foo\\bar} ) );

add_test( [ qq{$0 '/a\a' /foo\\\\bar} ], ( qq{/a\a}, q{/foo\\\\bar} ) );

add_test( [ qq{$0 1 't\\glob-file.tests'/*} ], ( 1, glob('t/glob-file.tests/*') ) );

add_test( [ qq{$0 2 't\\glob-file.tests'\\*} ], ( 2, glob('t/glob-file.tests/*') ) );

add_test( [ qq{$0 3 't\\glob-file.tests/'*} ], ( 3, glob('t/glob-file.tests/*') ) );

add_test( [ qq{$0 4 't\\glob-file.tests\\'*} ], ( 4, glob('t/glob-file.tests/*') ) );

add_test( [ qq{$0 5 't\\glob-file.tests\\*'} ], ( 5, q{t\\glob-file.tests\\*} ) );

add_test( [ qq{$0 t ""} ], ( q{t}, q{} ) );

add_test( [ qq{$0 t 0} ], ( q{t}, q{0} ) );

add_test( [ qq{$0 t 0""} ], ( q{t}, q{0} ) );

add_test( [ qq{$0 't\\glob-file.tests\\'*x} ], ( q{t\\glob-file.tests\\*x} ) );
#

if ($ENV{TEST_FRAGILE}) {
	## ToDO: This is really not a fair test on all computers unless we make sure the specific account(s) exist and know what the expansions should be...
	##    :: using $ENV{USERPROFILE} should be safe, but backtest on XP with early perl's before removing the TEST_FRAGILE gate
	add_test( [ qq{$0 ~*} ], ( q{~*} ) );
	add_test( [ qq{$0 ~} ], ( unixify($ENV{USERPROFILE}) ) );
	add_test( [ qq{$0 ~ ~$ENV{USERNAME}} ], ( unixify($ENV{USERPROFILE}), unixify($ENV{USERPROFILE}) ) );
	add_test( [ qq{$0 ~$ENV{USERNAME}/} ], ( unixify($ENV{USERPROFILE}.q{/}) ) );
	add_test( [ qq{$0 x ~$ENV{USERNAME}\\ x} ], ( 'x', unixify($ENV{USERPROFILE}.q{/}), 'x' ) );
	##
	}

# rule tests
# non-globbed tokens should stay the same
add_test( [ qq{$0 1 foo\\bar} ], ( 1, q{foo\\bar} ) );
add_test( [ qq{$0 2 \\foo/bar} ], ( 2, q{\\foo/bar} ) );
add_test( [ qq{$0 1 't\\glob-file.tests\\'*} ], ( 1, glob('t/glob-file.tests/*') ) );

# dosify
add_test( [ qq{$0 foo\\bar} ], ( q{foo\\bar} ) );



## TODO: check both with and without nullglob, including using %opts for argv()
add_test( [ qq{$0 foo\\bar}, { nullglob => 0 } ], ( q{foo\\bar} ) );

## do tests

#plan tests => test_num() + ($Test::NoWarnings::VERSION ? 1 : 0);
plan tests => test_num() + ($haveTestNoWarnings ? 1 : 0);

do_tests(); # test re-parsing of command_line() by argv()
##
my @tests;
sub add_test { push @tests, [ (caller(0))[2], @_ ]; return; }		## NOTE: caller(EXPR) => ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller($i);
sub test_num { return scalar(@tests); }
## no critic (Subroutines::ProtectPrivateSubs)
sub do_tests { foreach my $t (@tests) { my $line = shift @{$t}; my @args = @{shift @{$t}}; my @exp = @{$t}; my @got; eval { @got = Win32::CommandLine::_argv(@args); 1; } or ( @got = ( $@ =~ /^(.*)\s+at.*$/ ) ); eq_or_diff \@got, \@exp, "[line:$line] testing: `@args`"; } return; }

#### SUBs

sub dosify{
	# use Win32::CommandLine::_dosify
	use Win32::CommandLine;
	return Win32::CommandLine::_dosify(@_);	## no critic ( ProtectPrivateSubs )
}

sub unixify{
	# _unixify( <null>|$|@ ): returns <null>|$|@ ['shortcut' function]
	# unixify string, returning a string which has unix correct slashes
	@_ = @_ ? @_ : $_ if defined wantarray;		## no critic (ProhibitPostfixControls)	## break aliasing if non-void return context

	## no critic ( ProhibitUnusualDelimiters )

	for (@_ ? @_ : $_)
		{
		s:\\:\/:g;
		}

	return wantarray ? @_ : "@_";
}