static Tcl_ObjCmdProc	TestNREUnwind;
static Tcl_ObjCmdProc	TestNRELevels;
static Tcl_ObjCmdProc	TestInterpResolverCmd;
#if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL)
static Tcl_ObjCmdProc	TestcpuidCmd;
#endif
static Tcl_ObjCmdProc	TestApplyLambdaObjCmd;
static Tcl_ObjCmdProc	C99Format;

static const Tcl_Filesystem testReportingFilesystem = {
    "reporting",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_1,
    TestReportInFilesystem, /* path in */
    TestReportDupInternalRep,

    Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testapplylambda", TestApplyLambdaObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "c99format", C99Format,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testlutil", TestLutilCmd,
	    NULL, NULL);

    if (TclObjTest_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }

    }
    if (l2Obj) {
	Tcl_DecrRefCount(l2Obj);
    }
    return ret;
}


/*
 *------------------------------------------------------------------------
 *
 * C99Format --
 *
 *      Returns a C99 formatted printf string as interpreter result.
 *      Does not actually *test* anything.
 *
 *      Does not handle XPG3 or presence of "*" in width/precision.
 *
 * Results:
 *	TCL_OK
 *	TCL_ERROR
 *
 *------------------------------------------------------------------------
 */
static int
C99Format(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    double dbl;
    Tcl_WideInt wide;
    char fmt[100];
    char buf[256];
    Tcl_Size len;
    const char *otherSpec;
    const char *sizeSpec;
    const char *typeSpec;
    Tcl_Obj *valueObj;

    if (objc < 3 || objc > 5) {
	/*
	 * Order of components is same as in format specifier but some optional 
	 */
	Tcl_WrongNumArgs(interp, 1, objv, "? ?otherspec? size? type value");
	return TCL_ERROR;
    }
    valueObj = objv[objc - 1];
    typeSpec = Tcl_GetStringFromObj(objv[objc - 2], &len);
    if (len != 1) {
	Tcl_AppendResult(
	    interp, "Invalid type specifier: ", typeSpec, (char *)NULL);

	return TCL_ERROR;
    }
    sizeSpec = otherSpec = "";
    if (objc > 3) {
	sizeSpec = Tcl_GetString(objv[objc-3]);
	if (objc > 4) {
	    otherSpec = Tcl_GetString(objv[objc - 4]);
	}
    }

    snprintf(fmt, sizeof(fmt), "%%%s%s%s", otherSpec, sizeSpec, typeSpec);


#define PRINTIF(spec_, type_, val_)                          \
    do {                                                     \
	if (!strcmp(spec_, sizeSpec)) {                      \
	    snprintf(buf, sizeof(buf), fmt, (type_)(val_)); \
	    goto done;                                           \
	}                                                    \
    } while (0)

    buf[0] = 0;
    switch (*typeSpec) {
    /* Doubles */
    case 'f':
    case 'a':
    case 'A':
    case 'e':
    case 'E':
    case 'g':
    case 'G':
	if (Tcl_GetDoubleFromObj(interp, valueObj, &dbl) != TCL_OK) {
	    return TCL_ERROR;
	}
	snprintf(buf, sizeof(buf), fmt, dbl);
	break;

    /* Integers */
    case 'd':
    case 'u':
    case 'i':
    case 'o':
    case 'x':
    case 'X':
    case 'p':
	/*
	 * C does not distinguish between signed vs unsigned passed to printf.
	 * Below assumes Tcl_WideInt enough for all C integer types of interest.
	 */
	if (Tcl_GetWideIntFromObj(NULL, valueObj, &wide) != TCL_OK) {
	    Tcl_WideUInt uwide;
	    if (Tcl_GetWideUIntFromObj(interp, valueObj, &uwide) !=
		TCL_OK) {
		return TCL_ERROR;
	    }
	    wide = (Tcl_WideInt)uwide;
	}

	/*
	 * Code below relies on printf passing signed/unsigned the same way
	 * else we would have to distinguish between "d" and "u" etc.
	 */
	PRINTIF("", int, wide);
	PRINTIF("hh", int, wide);
	PRINTIF("h", int, wide);
	PRINTIF("l", long, wide);
	PRINTIF("ll", long long, wide);
	PRINTIF("t", ptrdiff_t, wide);
	PRINTIF("z", size_t, wide);
	PRINTIF("j", intmax_t, wide);
#ifdef _WIN32
	PRINTIF("I32", int32_t, wide);
	PRINTIF("I64", int64_t, wide);
#endif
	Tcl_AppendResult(
	    interp, "Invalid size specifier: ", sizeSpec, (char *)NULL);
	return TCL_ERROR;

    default:
	Tcl_AppendResult(
	    interp, "Invalid type specifier: ", typeSpec, (char *)NULL);
	return TCL_ERROR;
    }

done:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# %z/%t/%p output depends on pointerSize, so some tests are not portable.
testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) >= 8}]
# MSVC uses a broken libc that gets sprintf("%g") wrong. This is a pain
# particularly in Continuous Integration, and there isn't anything much we can
# do about it.
testConstraint knownMsvcBug [expr {![string match msvc-* [tcl::build-info compiler]]}]
testConstraint c99format [expr {[llength [info commands ::c99format]] != 0}]

test format-1.1 {integer formatting} {
    format "%*d %d %d %d" 6 34 16923 -12 -1
} {    34 16923 -12 -1}
test format-1.2 {integer formatting} {
    format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12
} {   6   34 16923  -12 -1 0xe 0xC}

    format %s $x
    # After this, obj in $x should be a dict
    # We are testing to make sure it has not been shimmered to a
    # different internalrep when that is not necessary.
    # Whether or not there is a string rep - we should not care!
    tcl::unsupported::representation $x
} -match glob -result {value is a dict *}

#
# Match up formatting against C99
foreach type {f a A e E g G} {
    set testNum 0
    foreach dbl {0} {
        test format-c99-$type-[incr testNum] \
            "Compare c99format %$type $dbl" \
            -constraints c99format -body {
                format %$type $dbl
            } -result [c99format $type $dbl]
    }
}

set sizeSpecs [list {} h l t z j]
if {$::tcl_platform(platform) eq "windows"} {
    lappend sizeSpecs I32 I64
}
foreach type {d u i o x X} {
    set testNum 0
    foreach size $sizeSpecs {
        foreach ival {
            0 0x1 0x7fff 0xffff
            0x10001 0x7fffffff 0x80000000 0xffffffff
            0x100000001 0x7fffffffffffffff 0x8000000000000000 0xffffffffffffffff
        } {
            test format-c99-$type-$size-[incr testNum] \
                "Compare c99format %$size$type $ival" \
                -constraints {c99format longIs64bit} -body {
                    format %$size$type $ival
                } -result [c99format $size $type $ival]
        }
    }
}



# cleanup
catch {unset a}
catch {unset b}
catch {unset c}
catch {unset d}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End: