#!/usr/local/bin/perl
# -*- perl -*-
# Tests...
use lib '..';
use Lisp::Fmt;
my $testno = 0;
sub test {
my( $f, $r ) = @_;
my( $g );
$testno ++;
$g = fmt( @{$f} );
print "got <$g> expected <$r>\n";
if( $g eq $r ){
print "ok $testno\n";
}else{
print "not ok $testno\n";
}
}
my($fmt) = "Items:~#[ none~; ~a~; ~a and ~a~:;~!{~#[~; and~] ~a~^,~}~].";
@tests = (
# field test
[ ["~10a", "abc"], "abc "],
[ ["~10!a", "abc"], " abc"],
[ ["~10a", "0123456789abc"], "0123456789abc"],
[ ["~10!a", "0123456789abc"], "0123456789abc"],
# pad character test
[ ["~10,,,'*a", "abc"], "abc*******"],
[ ["~10,,,'Xa", "abc"], "abcXXXXXXX"],
[ ["~10,,,42a", "abc"], "abc*******"],
[ ["~10,,,'*!a", "abc"], "*******abc"],
[ ["~10,,3,'*a", "abc"], "abc*******"],
[ ["~10,,3,'*a", "0123456789abc"], "0123456789abc***"],
[ ["~10,,3,'*!a", "0123456789abc"], "***0123456789abc"],
# colinc, minpad padding test
[ ["~10,8,0,'*a", 123], "123********"],
[ ["~10,9,0,'*a", 123], "123*********"],
[ ["~10,10,0,'*a", 123], "123**********"],
[ ["~10,11,0,'*a", 123], "123***********"],
[ ["~8,1,0,'*a", 123], "123*****"],
[ ["~8,2,0,'*a", 123], "123******"],
[ ["~8,3,0,'*a", 123], "123******"],
[ ["~8,4,0,'*a", 123], "123********"],
[ ["~8,5,0,'*a", 123], "123*****"],
[ ["~8,1,3,'*a", 123], "123*****"],
[ ["~8,1,5,'*a", 123], "123*****"],
[ ["~8,1,6,'*a", 123], "123******"],
[ ["~8,1,9,'*a", 123], "123*********"],
# plural test
[ ["test~p", 1], "test"],
[ ["test~p", 2], "tests"],
[ ["test~p", 0], "tests"],
[ ["tr~!p", 1], "try"],
[ ["tr~!p", 2], "tries"],
[ ["tr~!p", 0], "tries"],
[ ["~a test~:p", 10], "10 tests"],
[ ["~a test~:p", 1], "1 test"],
# tilde test
[ ["~~~~"], "~~"],
[ ["~3~"], "~~~"],
# indirection test
[ ["~a ~? ~a", 10, "~a ~a", [20, 30], 40], "10 20 30 40"],
[ ["~a ~@? ~a", 10, "~a ~a", 20, 30, 40], "10 20 30 40"],
# variable parameter
[ ["~va", 10, "abc"], "abc "],
[ ["~v,,,va", 10, 42, "abc"], "abc*******"],
# number of remaining arguments as parameter
[ ["~#,,,'*!a ~a ~a ~a", 1, 1, 1, 1], "***1 1 1 1"],
# argument jumping
[ ["~a ~* ~a", 10, 20, 30], "10 30"],
[ ["~a ~2* ~a", 10, 20, 30, 40], "10 40"],
[ ["~a ~:* ~a", 10], "10 10"],
[ ["~a ~a ~2:* ~a ~a", 10, 20], "10 20 10 20"],
[ ["~a ~a ~!* ~a ~a", 10, 20], "10 20 10 20"],
[ ["~a ~a ~4!* ~a ~a", 10, 20, 30, 40, 50, 60], "10 20 50 60"],
# char test
[ ["~c", "a"], "a"],
[ ["~!c", "a"], "\"a\""],
[ ["~65c"], "A"],
[ ["~7!c"], '"\07"'],
[ ["~!c" , 32], '"\040"'],
[ ["~!c" , 0], '"\00"'],
[ ["~!c" , 27], '"\033"'],
[ ["~!c" , 127], '"\0177"'],
[ ["~!c" , 128], '"\0200"'],
[ ["~!c" , 255], '"\0377"'],
[ ["~:c", "a"], "a"],
[ ["~7:c"], "BEL"],
[ ["~:c" ,1], "SOH"],
[ ["~:c" ,27], "ESC"],
[ ["~:c" ,128], "\\0200"],
[ ["~:c" ,127], "\\0177"],
[ ["~:c" ,255], "\\0377"],
# case conversion
[ ["~a ~(~a~) ~a", "abc", "HELLO WORLD", "xyz"], "abc hello world xyz"],
[ ["~a ~:(~a~) ~a", "abc", "HELLO WORLD", "xyz"], "abc Hello World xyz"],
[ ["~a ~!(~a~) ~a", "abc", "HELLO WORLD", "xyz"], "abc Hello world xyz"],
[ ["~a ~:!(~a~) ~a", "abc", "hello world", "xyz"], "abc HELLO WORLD xyz"],
[ ["~:!(~p~)",2],"S"],
[ ["~:(~a ~a ~a~) ~a", "abc", "xyz", "123", "world"], "Abc Xyz 123 world"],
# conditionals
[ ["~[abc~;xyz~]", 0], "abc"],
[ ["~[abc~;xyz~]", 1], "xyz"],
[ ["~[abc~;xyz~:;456~]", 99], "456"],
[ ["~0[abc~;xyz~:;456~]"], "abc"],
[ ["~1[abc~;xyz~:;456~] ~a", 100], "xyz 100"],
[ ["~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]"], "no arg"],
[ ["~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]", 10], "10"],
[ ["~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]", 10, 20], "10 and 20"],
[ ["~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]", 10, 20, 30], "10, 20 and 30"],
[ ["~:[hello~;world~] ~a", 1, 10], "world 10"],
[ ["~:[hello~;world~] ~a","", 10], "hello 10"],
[ ["~![~a tests~]", ""], ""],
[ ["~![~a tests~]", 10], "10 tests"],
[ ["~![~a test~:p~] ~a", 10, "done"], "10 tests done"],
[ ["~![~a test~:p~] ~a", 1, "done"], "1 test done"],
[ ["~![~a test~:p~] ~a", 0, "done"], "0 tests done"],
[ ["~![~a test~:p~] ~a", "", "done"], " done"],
[ ["~![ level = ~A~]~![ length = ~A~]", "", 5], " length = 5"],
[ ["~[abc~;~[4~;5~;6~]~;xyz~]", 0], "abc"], # ; nested conditionals (irrghh]
[ ["~[abc~;~[4~;5~;6~]~;xyz~]", 2], "xyz"],
[ ["~[abc~;~[4~;5~;6~]~;xyz~]", 1, 2], "6"],
# iteration
[ ["~{ ~a ~}", [qw(a b c)]], " a b c "],
[ ["~{ ~a ~}", []], ""],
[ ["~{ ~a ~5,,,'*a~}", [qw(a b c d)]], " a b**** c d****"],
[ ["~{ ~a,~a ~}", [qw(a 1 b 2 c 3)]], " a,1 b,2 c,3 "],
[ ["~2{ ~a,~a ~}", [qw(a 1 b 2 c 3)]], " a,1 b,2 "],
[ ["~3{~a ~} ~a", [qw(a b c d e)], 100], "a b c 100"],
[ ["~0{~a ~} ~a", [qw(a b c d e)], 100], " 100"],
[ ["~:{ ~a,~a ~}", [[qw(a b)], [qw(c d e f)], [qw(g h)]]], " a,b c,d g,h "],
[ ["~2:{ ~a,~a ~}", [[qw(a b)], [qw(c d e f)], [qw(g h)]]], " a,b c,d "],
[ ["~!{ ~a,~a ~}", qw(a 1 b 2 c 3)], " a,1 b,2 c,3 "],
[ ["~2!{ ~a,~a ~} <~a|~a>", qw(a 1 b 2 c 3)], " a,1 b,2 <c|3>"],
[ ["~:!{ ~a,~a ~}", [qw(a 1)], [qw(b 2)], [qw(c 3)]], " a,1 b,2 c,3 "],
[ ["~2:!{ ~a,~a ~} ~a", [qw(a 1)], [qw(b 2)], [qw(c 3)]], " a,1 b,2 [c, 3]"],
[ ["~{~}", "<~a,~a>", [qw(a 1 b 2 c 3)]], "<a,1><b,2><c,3>"],
[ ["~{ ~a ~{<~a>~}~} ~a", ["a", [1, 2], "b", [3, 4]], 10], " a <1><2> b <3><4> 10"],
# up and out
[ ["abc ~^ xyz"], "abc "],
[ ["~!(abc ~^ xyz~) ~a", 10], "Abc xyz 10"],
[ ["done. ~^ ~A warning~:p. ~^ ~A error~:p."], "done. "],
[ ["done. ~^ ~A warning~:p. ~^ ~A error~:p.", 10], "done. 10 warnings. "],
[ ["done. ~^ ~A warning~:p. ~^ ~A error~:p.", 10, 1], "done. 10 warnings. 1 error."],
[ ["~{ ~a ~^<~a>~} ~a", [qw(a b c d e f)], 10], " a <b> c <d> e <f> 10"],
[ ["~{ ~a ~^<~a>~} ~a", [qw(a b c d e)], 10], " a <b> c <d> e 10"],
[ ["abc~0^ xyz"], "abc"],
[ ["abc~9^ xyz"], "abc xyz"],
[ ["abc~7,4^ xyz"], "abc xyz"],
[ ["abc~7,7^ xyz"], "abc"],
[ ["abc~3,7,9^ xyz"], "abc"],
[ ["abc~8,7,9^ xyz"], "abc xyz"],
[ ["abc~3,7,5^ xyz"], "abc xyz"],
# numerical test
[ ["~d", 100], "100"],
[ ["~x", 100], "64"],
[ ["~o", 100], "144"],
[ ["~b", 100], "1100100"],
[ ["~!d", 100], "+100"],
[ ["~!d", -100], "-100"],
[ ["~!x", 100], "+64"],
[ ["~!o", 100], "+144"],
[ ["~!b", 100], "+1100100"],
[ ["~10d", 100], " 100"],
[ ["~:d", 123], "123"],
[ ["~:d", 1234], "1,234"],
[ ["~:d", 12345], "12,345"],
[ ["~:d", 123456], "123,456"],
[ ["~:d", 12345678], "12,345,678"],
[ ["~:d", -123], "-123"],
[ ["~:d", -1234], "-1,234"],
[ ["~:d", -12345], "-12,345"],
[ ["~:d", -123456], "-123,456"],
[ ["~:d", -12345678], "-12,345,678"],
[ ["~10:d", 1234], " 1,234"],
[ ["~10:d", -1234], " -1,234"],
[ ["~10,'*d", 100], "*******100"],
[ ["~10,,'|:d", 12345678], "12|345|678"],
[ ["~10,,,2:d", 12345678], "12,34,56,78"],
[ ["~14,'*,'|,4:!d", 12345678], "****+1234|5678"],
[ ["~10r", 100], "100"],
[ ["~2r", 100], "1100100"],
[ ["~8r", 100], "144"],
[ ["~16r", 100], "64"],
[ ["~16,10,'*r", 100], "********64"],
# complexity tests
[ [$fmt ], "Items: none."],
[ [$fmt, "foo"], "Items: foo."],
[ [$fmt, "foo", "bar"], "Items: foo and bar."],
[ [$fmt, "foo", "bar", "baz"], "Items: foo, bar, and baz."],
[ [$fmt, "foo", "bar", "baz", "zok"], "Items: foo, bar, baz, and zok."],
# tab tests
[ ["~0&~3t"], " "],
[ ["~0&~10t"], " "],
[ ["~0&1234567890~,8tABC"], "1234567890 ABC"],
[ ["~0&1234567890~0,8tABC"], "1234567890 ABC"],
[ ["~0&1234567890~1,8tABC"], "1234567890 ABC"],
[ ["~0&1234567890~2,8tABC"], "1234567890ABC"],
[ ["~0&1234567890~3,8tABC"], "1234567890 ABC"],
[ ["~0&1234567890~4,8tABC"], "1234567890 ABC"],
[ ["~0&1234567890~5,8tABC"], "1234567890 ABC"],
[ ["~0&1234567890~6,8tABC"], "1234567890 ABC"],
[ ["~0&1234567890~7,8tABC"], "1234567890 ABC"],
[ ["~0&1234567890~8,8tABC"], "1234567890 ABC"],
[ ["~0&1234567890~9,8tABC"], "1234567890 ABC"],
[ ["~0&1234567890~10,8tABC"], "1234567890ABC"],
[ ["~0&1234567890~11,8tABC"], "1234567890 ABC"],
[ ["~0&12345~,8tABCDE~,8tXYZ"], "12345 ABCDE XYZ"],
[ ["~,8t+++~,8t==="], " +++ ==="],
[ ["~0&ABC~,8,'.tDEF"], "ABC......DEF"],
[ ["~0&~3,8!tABC"], " ABC"],
[ ["~0&1234~3,8!tABC"], "1234 ABC"],
[ ["~0&12~3,8!tABC~3,8!tDEF"], "12 ABC DEF"],
# justification tests
[ ["~10<~A~>", "foo"], " foo"],
[ ["~10!<~A~>", "foo"], "foo "],
[ ["~10!:<~A~>", "foo"], " foo "],
[ ["~10<~A~;~A~>", "foo", "bar"], "foo bar"],
[ ["~10:<~A~;~A~>", "foo", "bar"], " foo bar"],
[ ["~10!<~A~;~A~>", "foo", "bar"], "foo bar "],
[ ["~10!:<~A~;~A~>", "foo", "bar"], " foobar "],
[ ["~15<~A~;~A~;~A~>", "foo", "bar", "baz"], "foo bar baz"],
[ ["~15:<~A~;~A~;~A~>", "foo", "bar", "baz"], " foobar baz"],
[ ["~15!<~A~;~A~;~A~>", "foo", "bar", "baz"], "foo bar baz "],
[ ["~15!:<~A~;~A~;~A~>", "foo", "bar", "baz"], " foobar baz "],
# roman numeral test
[ ["~!r", 4], "IV"],
[ ["~!r", 19], "XIX"],
[ ["~!r", 50], "L"],
[ ["~!r", 100], "C"],
[ ["~!r", 1000], "M"],
[ ["~!r", 99], "XCIX"],
[ ["~!r", 1994], "MCMXCIV"],
# old roman numeral test
[ ["~:!r", 4], "IIII"],
[ ["~:!r", 5], "V"],
[ ["~:!r", 10], "X"],
[ ["~:!r", 9], "VIIII"],
# cardinal/ordinal English number test
[ ["~r", 4], "four"],
[ ["~r", 10], "ten"],
[ ["~r", 19], "nineteen"],
[ ["~r", 1984], "one thousand, nine hundred eighty four"],
[ ["~:r", -1984], "minus one thousand, nine hundred eighty fourth"],
# perl-esque formats
[ ["~<<<<<<", "foo"], "foo "],
[ ["~>>>>>>", "bar"], " bar"],
[ ["~||||||", "baz"], " baz "],
[ ["~>>>>>~<<<<<~||", "foo", "bar", "."], " foobar . "],
# implementation specific extensions
[ ["~=(~A~A~=)", "~", "A", "foo"], "foo"],
);
print "1..", scalar(@tests), "\n";
foreach (@tests){
test( @{$_} );
}