package Test;

use /BI;
use /ErrorConsumer;
use /InteractiveSession;
use /Lex;
use /Types;
use /Package;
use /Proc;
use /Exec;
use /CharBuffer;
use /Fmt;

/* Want a single context so that the generated proc names are all different. */

Package/PContext_t PCtx;

string ErrorResource;
uint ErrorCode;

/*
 * handler - this proc is the error handler that we put into the Proc/Context_t
 *	that we create to do our work in. This allows us to catch any error
 *	messages that the Zed system wants to emit while we are creating code.
 *	In particular we want to catch errors from the Fmt code, when we are
 *	specifically trying to trigger those errors.
 */

ErrorConsumer/Handler_t: proc
handler(InteractiveSession/OContext_t opctx; string resource; bool warning;
	uint prefixCode; string nameOne; uint infixCode;
	string nameTwo; uint postfixCode)void:
    if ErrorCode = 0 then
	/* Only track the first one - there are Proc errors afterwards. We
	   get those since we create a proc per test run, unlike the bintest
	   code which uses one proc for all tests. We do a proc per test since
	   we want to actually run the procs. */
	ErrorResource := resource;
	ErrorCode := prefixCode;
    fi;
corp;

enum TestEnum_t {
    te_red,
    te_green,
    te_blue
};

oneof TestSetOneof_t {
    tso_zero = 0,
    tso_ten = 10,
    tso_billion = 1000000000
};

record TestVariant_t {
    case TestVariantKind_t tv_kind
    incase tvk_string:
	string tv_string;
    incase tvk_floatVec:
	[] float tv_floatVec;
    incase tvk_context:
	Package/PContext_t tv_context;
    esac;
};

record Stuff_t {
    float st_fl;
    string st_tag;
    [3] uint st_nums;
    char st_char;
    bool st_flag;
};

Stuff_t StuffVar;

proc
setupStuff()void:
    Fmt/FmtAdd(Stuff_t, nil);
    StuffVar := Stuff_t(11.2233, "stuffy", 'Q', true);
    StuffVar.st_nums[0] := 11;
    StuffVar.st_nums[1] := 2222;
    StuffVar.st_nums[2] := 333333;
corp;

proc
runTest(string sig; uint err; string res, val, fmt; uint width, precision)void:
    ErrorResource := nil;
    ErrorCode := 0;
    /* The 'val' string contains the value we want "FmtS" to format for us. So,
       it can be of several different types. The easiest way to decode and
       use it is to use the Zed tokenizer, after a quick pre-check for a
       leading '-' or '+' on a number (those are separate tokens in Zed). */
    uint len := getBound(val);
    bool isNeg := false, isSigned := false;
    if val[0] = '-' then
	isNeg := true;
	val := val[1 upto *];
    elif val[0] = '+' then
	isSigned := true;
	val := val[1 upto *];
    fi;
    Lex/LexState_t ls := Lex/StartString(val);
    Lex/GetToken(ls);
    Exec/Exec_t valExec;
    case ls.ls_kind
    incase Lex/tk_uintConstant:
	if isNeg then
	    valExec := Exec/SintConstantNew(- fromUint(sint, ls.ls_uintValue));
	elif isSigned then
	    valExec := Exec/SintConstantNew(fromUint(sint, ls.ls_uintValue));
	else
	    valExec := Exec/UintConstantNew(val, ls.ls_uintValue);
	fi;
    incase Lex/tk_floatConstant:
	if isNeg then
	    ls.ls_floatValue := - ls.ls_floatValue;
	    val := "-" + val;
	fi;
	valExec := Exec/FloatConstantNew(val, ls.ls_floatValue);
    incase Lex/tk_stringConstant:
	valExec := Exec/StringConstantNew(ls.ls_stringValue);
    incase Lex/tk_charConstant:
	valExec := Exec/CharConstantNew(ls.ls_uintValue + '\0');
    incase Lex/tk_name:
	Package/NameReference_t nr :=
	    Package/CreateReference(PCtx, ., ls.ls_stringValue);
	valExec := Exec/PackageNameRefNew(PCtx, nr);
    incase Lex/tk_nil:
	valExec := Exec/NilNew();
    incase Lex/tk_true:
	valExec := Exec/BoolConstantNew(true)
    incase Lex/tk_false:
	valExec := Exec/BoolConstantNew(false)
    default:
	BI/Abort("runTest: " + sig + " - bad value token");
    esac;
    Lex/Term(ls);

    /* We construct a proc, returning a string, whose body consists of a
       call to Fmt/FmtS with the provided parameters. */
    Proc/TempDefineProc_t tdp;
    Proc/DefineProcStart(@tdp, PCtx, nil, Package/nl_private, Proc/pt_regular);
    Proc/DefineProcMiddle(@tdp, Types/String);
    /* The code we are creating is the body of the proc, so the context we
       are working in is the context created for that proc. */
    Package/PContext_t pctx := tdp.tdp_pctx;
    Package/NameReference_t nr := Package/CreateReference(pctx, Fmt, "FmtS");
    Exec/Exec_t ex := Exec/PackageNameRefNew(pctx, nr);
    Exec/TempCall_t tcal;
    Exec/CallStart(@tcal, pctx, ex);
    Exec/Call_t cl;
    eval Exec/CallNew(@tcal, @cl);
    Exec/TempIoCall_t tioc := Exec/IoCallStart(pctx, cl);
    Exec/IoCallPhase(tioc, valExec, Exec/iop_main);
    if fmt ~== nil then
	Exec/IoCallFormat(tioc, fmt);
    fi;
    if width ~= 0 then
	Exec/IoCallPhase(tioc, Exec/UintConstantNew(nil, width),
			 Exec/iop_width);
	if precision ~= 0 then
	    Exec/IoCallPhase(tioc, Exec/UintConstantNew(nil, precision),
			     Exec/iop_precision);
	fi;
    fi;
    Exec/IoCallPhase(tioc, nil, Exec/iop_done);
    ex := Exec/IoCallDone(tioc);
    Proc/Proc_t theP := Proc/DefineProcEnd(@tdp, ex);

    if ErrorCode ~= 0 then
	/* We got an error - did we expect it? */
	if ErrorCode ~= err or ErrorResource ~= "Fmt" then
	    Fmt/Fmt("*** test ", sig, " got error ", ErrorResource, '/',
		    ErrorCode, " instead of expected ");
	    if err ~= 0 then
		Fmt/FmtL("Fmt/", err);
	    else
		Fmt/Fmt("none\n");
	    fi;
	fi;
    else
	if err ~= 0 then
	    Fmt/FmtL("*** test ", sig, " did not get expected error Fmt/",
		     err);
	else
	    /* Now call it, getting the string result. */
	    proc()string p;
	    procAssign(p, theP);
	    if p ~= nil then
		string got := {p}();
		if got ~= res then
		    Fmt/Fmt("*** test ", sig, " got '", got, "' instead of '",
			    res, "'\n");
		fi;
	    else
		Fmt/Fmt("*** test ", sig, ": procAssign failed\n");
	    fi;
	fi;
    fi;
corp;

/* parameters to "runTest" are:
    sig - signature of the test, used to identify it if it fails
    err - expected Fmt error, 0 if none expected
    res - the expected output of the FmtS call
    val - the value to be formatted
    fmt - the format string to be used (can be nil)
    width - the output field width (0 means "not specified")
    precision - digits after the decimal point, as allowed (float values)
 */

proc
runTests()void:
    /* Test to verify that failures show up. */
    runTest("force-failure", 0, "1", "2", nil, 0, 0);

    Fmt/Fmt("Basic uint formatting\n");
    runTest("u1", 0, "1", "1", nil, 0, 0);
    runTest("u1:x", 0, "1", "1", "x", 0, 0);
    runTest("u1:X", 0, "0x1", "1", "X", 0, 0);
    runTest("u1:X0.10", 0, "0x00000001", "1", "X0", 10, 0);

    Fmt/Fmt("Floating point tests\n");
    runTest("f123.456", 0, "123.456", "123.456", nil, 0, 0);
    runTest("f123.456:f0-15.6", 0, "00000123.456000", "123.456", "f0", 15, 6);

    runTest("I", 0, "0fInf", "0fInf", nil, 0, 0);
    runTest("+I", 0, "+0fInf", "0fInf", "fp", 0, 0);
    runTest("-I", 0, "-0fInf", "-0fInf", nil, 0, 0);
    runTest("N", 0, "0fNaN", "0fNaN", nil, 0, 0);
    runTest("+N", 0, "+0fNaN", "0fNaN", "fp", 0, 0);
    runTest("-N", 0, "-0fNaN", "-0fNaN", nil, 0, 0);
    runTest("Ix", 0, "0fx7ff0000000000000", "0fInf", "x", 0, 0);
    runTest("Nx", 0, "0fx7ff8000000000000", "0fNaN", "x", 0, 0);
    runTest("xx", 0, "0fx123456789abcdef0", "0fx123456789abcdef0", "x", 0, 0);
    runTest("X10", 0, "0FX4024000000000000", "10.", "X", 0, 0);
    runTest("x.1e-308", 0, "0fx0000b8157268fdaf", ".1e-308", "x", 0, 0);
    runTest("rev", 0, "+0.1e-308", "0fx0000b8157268fdaf", "e", 0, 0);

    runTest("f01", 0, "12.34", "12.34", "f", 5, 2);
    runTest("f02", 0, "12.3", "12.34", "f", 4, 2);
    runTest("f03", 0, "  12.34", "12.34", "f", 7, 0);
    runTest("f04", 0, " 0.123456", ".123456", "f", 9, 0);
    runTest("f05", 0, "0.123", ".123456", "f", 5, 0);
    runTest("f06", 0, "0.124", ".123999", "f", 5, 0);
    runTest("f07", 21, nil, ".1e-100", "f", 9, 0);
    runTest("f08", 0, "0.00001234", ".0000123456", "f", 10, 0);
    runTest("f09", 0, "0.0000123", ".0000123456", "f", 9, 0);
    runTest("f10", 0, "0.000012", ".0000123456", "f", 8, 0);
    runTest("f11", 0, "0.00001", ".0000123456", "f", 7, 0);
    runTest("f12", 0, "   0.0", ".0000123456", "f", 6, 0);
    runTest("f13", 0, "0.0", ".000012", "f", 3, 0);
    runTest("f14", 0, "  0.0", ".000012", "f", 5, 0);
    runTest("f15", 0, "0.000", ".000012", "f", 5, 3);
    runTest("f16", 0, "  0.000", ".000012", "f", 7, 3);
    runTest("f17", 0, "1234567.", "1234567.", "f", 0, 0);
    runTest("f18", 21, nil, "12345678.", "f", 0, 0);
    runTest("f19", 0, "0.0000001", ".000000123", "f", 0, 0);
    runTest("f20", 21, nil, ".0000000123", "f", 0, 0);
    runTest("f21", 22, nil, "1.", "f", 1, 0);

    runTest("e01", 0, "+0.1e+001", "1.0", "e", 0, 0);
    runTest("e02", 0, "+0.1000e+001", "1.0", "e", 12, 0);
    runTest("e03", 0, "   +0.100e+001", "1.0", "e", 14, 3);
    runTest("e04", 0, "+0000.100e+001", "1.0", "e0", 14, 3);
    runTest("e05", 0, "+0.100000e+001", "1.0", "e0", 14, 0);
    runTest("e06", 0, "-000000.1E+001", "-1.0", "E0", 14, 1);
    runTest("e07", 0, "  +0.12e+002", "12.3456", "e", 12, 2);
    runTest("e08", 20, nil, "1.0", "e", 8, 0);
    runTest("e09", 0, "+0.1e+001", "1.0", "e", 9, 0);

    Fmt/Fmt("Miscellaneous tests\n");
    runTest("c", 0, "x", "'x'", nil, 0, 0);
    runTest("c5", 0, "    x", "'x'", nil, 5, 0);
    runTest("cl5", 0, "x    ", "'x'", "l", 5, 0);
    runTest("cc5", 0, "  x  ", "'x'", "c", 5, 0);
    runTest("cr5", 0, "    x", "'x'", "r", 5, 0);
    runTest("s", 0, "fred", "\"fred\"", nil, 0, 0);
    runTest("s10", 0, "      fred", "\"fred\"", nil, 10, 0);
    runTest("sl10", 0, "fred      ", "\"fred\"", "l", 10, 0);
    runTest("sc10", 0, "   fred   ", "\"fred\"", "c", 10, 0);
    runTest("sr10", 0, "      fred", "\"fred\"", "r", 10, 0);
    runTest("bt", 0, "T", "true", nil, 0, 0);
    runTest("bf", 0, "F", "false", nil, 0, 0);
    runTest("b5", 0, "    T", "true", nil, 5, 0);
    runTest("bl5", 0, "T    ", "true", "l", 5, 0);
    runTest("bc5", 0, "  T  ", "true", "c", 5, 0);
    runTest("br5", 0, "    T", "true", "r", 5, 0);
    runTest("nil", 0, "<nil>", "nil", nil, 0, 0);
    runTest("e", 0, "te_green", "te_green", nil, 0, 0);
    runTest("e10", 0, "  te_green", "te_green", nil, 10, 0);
    runTest("el10", 0, "te_green  ", "te_green", "l", 10, 0);
    runTest("ec10", 0, " te_green ", "te_green", "c", 10, 0);
    runTest("er10", 0, "  te_green", "te_green", "r", 10, 0);
    runTest("s", 0, "tso_billion", "tso_billion", nil, 0, 0);
    runTest("s15", 0, "    tso_billion", "tso_billion", nil, 15, 0);
    runTest("sl15", 0, "tso_billion    ", "tso_billion", "l", 15, 0);
    runTest("sc15", 0, "  tso_billion  ", "tso_billion", "c", 15, 0);
    runTest("sr15", 0, "    tso_billion", "tso_billion", "r", 15, 0);
    runTest("sc15", 0, "   tvk_floatVec", "tvk_floatVec", nil, 15, 0);
    runTest("scl15", 0, "tvk_floatVec   ", "tvk_floatVec", "l", 15, 0);
    runTest("scc15", 0, "  tvk_floatVec ", "tvk_floatVec", "c", 15, 0);
    runTest("scr15", 0, "   tvk_floatVec", "tvk_floatVec", "r", 15, 0);

    Fmt/Fmt("Compile-time error tests\n");
    runTest("e01", 1, nil, "1", nil, 5, 1);
    runTest("e02", 2, nil, "1", "z", 0, 0);
    runTest("e03", 4, nil, "tso_billion", nil, 5, 1);
    runTest("e04", 5, nil, "-1", "z", 0, 0);
    runTest("e05", 7, nil, "1.0", "z", 0, 0);
    runTest("e06", 9, nil, "'a'", "z", 0, 0);
    runTest("e07", 12, nil, "\"xxx\"", "z", 0, 0);
    runTest("e08", 15, nil, "true", "z", 0, 0);
    runTest("e09", 17, nil, "te_green", "z", 0, 0);
    runTest("e10", 25, nil, "tso_billion", "z", 0, 0);
    runTest("e11", 27, nil, "tvk_floatVec", "z", 0, 0);
    runTest("e12", 23, nil, "1.", "x", 10, 1);

    Fmt/Fmt("Extra test\n");
    runTest("x01", 0,
	    "Stuff_t(11.2233, \"stuffy\", [11, 2222, 333333], 'Q', T)",
	    "StuffVar", nil, 0, 0);

    Fmt/Fmt("All tests done\n");
corp;

export proc
main()void:
    setupStuff();
    PCtx := Package/CreatePContext(nil, handler, .);
    runTests();
    PCtx := nil;
corp;

package /;

export proc
main()void:
    Test/main();
corp;