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

######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)

BEGIN { $| = 1; print "1..1\n"; }
END {print "not ok 1\n" unless $loaded;}
use Sort::Fields;
$loaded = 1;
print "ok 1\n";

######################### End of black magic.

# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):

$^W = 1;

my $n = 2;

sub array_compare {
	my($a1, $a2) = @_;
	return 0 unless $#$a1 == $#$a2;
	for (my $i = 0; $i <= $#$a1; $i++) {
		return 0 unless $$a1[$i] eq $$a2[$i];
	}
	1;
}
sub test {
	print array_compare(@_) ?  "ok $n\n" : "not ok $n\n";
	$n++;
}

sub test_msg {
	my ($warn, $die) = ('', '');
	local $SIG{__WARN__} = sub { $warn = shift };
	local $SIG{__DIE__} = sub { $die = shift };
	my $code = shift;
	eval $code;
	$warn =~ s/ at (?!.*\bat\b)[\w\W]*$//;
	$die =~ s/ at (?!.*\bat\b)[\w\W]*$//;
	if ($warn eq $_[0] and $die eq $_[1]) {
		print "ok $n\n";
	} else {
		print "not ok $n\n";
		print "code: $code";
		print " warn: $warn\n" if $warn;
		print " die: $die\n" if $die;
	}
	$n++;
}

@data = <DATA>;

# test warnings, errors

for (qw(fieldsort stable_fieldsort make_fieldsort make_stable_fieldsort)) {
	test_msg qq{
		$_();
	}, "", "$_ requires argument(s)";
	test_msg qq{
		$_(1);
	}, "", "$_ field specifiers must be in anon array";
	test_msg qq{
		$_([]);
	}, "", "$_ must have at least one field specifier";
	test_msg qq{
		$_(['x']);
	}, "", "improperly formatted $_ column specifier 'x'";
	test_msg qq{
		$_(q/(/, ['1n']);
	}, "", "probable regexp error in $_ arg: /(/
/(/: unmatched () in regexp";
}
for (qw(fieldsort stable_fieldsort)) {
	test_msg qq{
		scalar $_([1], qw(a b c));
	}, "fieldsort called in scalar or void context", "";
}	


# ascending numeric
test(
	[fieldsort(['1n'], @data)],
	[map {$_->[0]} sort {$a->[1]<=>$b->[1]} map {[$_, split /\s+/]} @data]
);

# ascending alpha
test(
	[fieldsort([2], @data)],
	[map {$_->[0]} sort {$a->[2]cmp$b->[2]} map {[$_, split /\s+/]} @data]
);

# ascending numeric
test(
	[fieldsort(['3n'], @data)],
	[map {$_->[0]} sort {$a->[3]<=>$b->[3]} map {[$_, split /\s+/]} @data]
);

# ascending numeric
test(
	[fieldsort(['4n'], @data)],
	[map {$_->[0]} sort {$a->[4]<=>$b->[4]} map {[$_, split /\s+/]} @data]
);

# descending numeric
test(
	[fieldsort(['-1n'], @data)],
	[map {$_->[0]} sort {$b->[1]<=>$a->[1]} map {[$_, split /\s+/]} @data]
);

# descending alpha
test(
	[fieldsort([-2], @data)],
	[map {$_->[0]} sort {$b->[2]cmp$a->[2]} map {[$_, split /\s+/]} @data]
);

# descending numeric
test(
	[fieldsort(['-3n'], @data)],
	[map {$_->[0]} sort {$b->[3]<=>$a->[3]} map {[$_, split /\s+/]} @data]
);

# descending numeric
test(
	[fieldsort(['-4n'], @data)],
	[map {$_->[0]} sort {$b->[4]<=>$a->[4]} map {[$_, split /\s+/]} @data]
);

# ascending alpha, then ascending numeric
test(
	[fieldsort([1, '4n'], @data)],
	[map {$_->[0]} sort {$a->[1]cmp$b->[1] or $a->[4]<=>$b->[4]} map {[$_, split /\s+/]} @data]
);

# ascending alpha, then descending numeric
test(
	[fieldsort([1, '-4n'], @data)],
	[map {$_->[0]} sort {$a->[1]cmp$b->[1] or $b->[4]<=>$a->[4]} map {[$_, split /\s+/]} @data]
);

# ascending alpha, then ascending alpha
test(
	[fieldsort([2, 0], @data)],
	[map {$_->[0]} sort {$a->[2]cmp$b->[2] or $a->[0]cmp$b->[0]} map {[$_, split /\s+/]} @data]
);

# ascending alpha, then descending numeric
test(
	[fieldsort([2, '-0'], @data)],
	[map {$_->[0]} sort {$a->[2]cmp$b->[2] or $b->[0]cmp$a->[0]} map {[$_, split /\s+/]} @data]
);

# stable, ascending numeric
my $i = 0;
test(
	[fieldsort(['-', '1n'], @data)],
	[map {$_->[0]} sort {$a->[2]<=>$b->[2] or $a->[1]<=>$b->[1]} map {[$_, $i++, split /\s+/]} @data]
);

# stable, ascending numeric
$i = 0;
test(
	[stable_fieldsort(['1n'], @data)],
	[map {$_->[0]} sort {$a->[2]<=>$b->[2] or $a->[1]<=>$b->[1]} map {[$_, $i++, split /\s+/]} @data]
);

# stable, ascending numeric, then descending alphabetic
$i = 0;
test(
	[stable_fieldsort(['1n', -2], @data)],
	[map {$_->[0]} sort {$a->[2]<=>$b->[2] or $b->[3]cmp$a->[3] or $a->[1]<=>$b->[1]} map {[$_, $i++, split /\s+/]} @data]
);

$i = 0;

__END__
0 a 1  -4.5
0 a 2  -2.5
0 b 3  1e2
1 b 4  123456
1 b 5  1e3
1 b 6  2e5
0 b 7  .00001
0 a 8  .00002
1 a 9  -.234e2
1 b 10  1e-1
0 a 12  1e-2
0 a 13  .123
0 a 14  .234
0 b 15  1.234
0 a 16  12345.6789
1 a 17  12345.6788
1 a 18  12345.6787
1 a 19  -2222
0 b 20  -2223
0 b 21  -1e1
1 b 22  -1e-1
1 b 23  -2e2
0 b 24  -2e-2
0 b 25  -3e3
0 b 26  -3e-3
0 b 27  123345.123234
0 a 28  123345.123235
0 a 29  123345.123233
0 a 30  -4.6
0 b 31  -4.7
0 b 32  -4.8
1 b 33  -4.5e1
1 a 34  1.23
1 a 35  2.345
1 b 36  345.456
1 a 37  45678.67567
0 b 38  23423422.34234234
1 a 39  123124123