From 46e5b17ffbd7d678e0113f8564deaeb32f137a82 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 12 Mar 2020 17:29:33 +0000 Subject: Add some testing of Tcl_SetByteArrayLength(). --- generic/tclTest.c | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ tests/binary.test | 11 +++++++++++ 2 files changed, 59 insertions(+) diff --git a/generic/tclTest.c b/generic/tclTest.c index 5e807d4..3e942bb 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -226,6 +226,9 @@ static int TestbumpinterpepochObjCmd(ClientData clientData, static int TestpurebytesobjObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int TestsetbytearraylengthObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static int TestbytestringObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -577,6 +580,7 @@ Tcltest_Init( Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testsetbytearraylength", TestsetbytearraylengthObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd, NULL, NULL); @@ -5037,6 +5041,50 @@ TestpurebytesobjObjCmd( /* *---------------------------------------------------------------------- * + * TestsetbytearraylengthObjCmd -- + * + * Testing command 'testsetbytearraylength` used to test the public + * interface routine Tcl_SetByteArrayLength(). + * + * Results: + * Returns the TCL_OK result code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestsetbytearraylengthObjCmd( + ClientData unused, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ +{ + int n; + Tcl_Obj *obj = NULL; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "value length"); + return TCL_ERROR; + } + if (TCL_OK != Tcl_GetIntFromObj(interp, objv[2], &n)) { + return TCL_ERROR; + } + if (Tcl_IsShared(objv[1])) { + obj = Tcl_DuplicateObj(objv[1]); + } else { + obj = objv[1]; + } + Tcl_SetByteArrayLength(obj, n); + Tcl_SetObjResult(interp, obj); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TestbytestringObjCmd -- * * This object-based procedure constructs a string which can diff --git a/tests/binary.test b/tests/binary.test index 8c1dedb..92fb648 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -2889,6 +2889,17 @@ test binary-76.2 {binary string appending growth algorithm} win { # Append to it string length [append str [binary format a* foo]] } 3 + +testConstraint testsetbytearraylength \ + [expr {"testsetbytearraylength" in [info commands]}] + +test binary-77.1 {Tcl_SetByteArrayLength} testsetbytearraylength { + testsetbytearraylength [string cat A B C] 1 +} A +test binary-77.2 {Tcl_SetByteArrayLength} testsetbytearraylength { + testsetbytearraylength [string cat \u0141 B C] 1 +} A + # ---------------------------------------------------------------------- # cleanup -- cgit v0.12 From 5d52fb6a3f7a73e612fadb45f4b0c09c45df7317 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 12 Mar 2020 17:37:16 +0000 Subject: Renumber tests to account for later releases. --- tests/binary.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/binary.test b/tests/binary.test index 92fb648..b872a30 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -2893,10 +2893,10 @@ test binary-76.2 {binary string appending growth algorithm} win { testConstraint testsetbytearraylength \ [expr {"testsetbytearraylength" in [info commands]}] -test binary-77.1 {Tcl_SetByteArrayLength} testsetbytearraylength { +test binary-79.1 {Tcl_SetByteArrayLength} testsetbytearraylength { testsetbytearraylength [string cat A B C] 1 } A -test binary-77.2 {Tcl_SetByteArrayLength} testsetbytearraylength { +test binary-79.2 {Tcl_SetByteArrayLength} testsetbytearraylength { testsetbytearraylength [string cat \u0141 B C] 1 } A -- cgit v0.12 From 068df4904b6c2f08348f62aa2f06b2103c8aae79 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 13 Mar 2020 11:01:34 +0000 Subject: reformat assemble-15.* test-cases --- tests/assemble.test | 80 ++++++++++++++++++----------------------------------- 1 file changed, 27 insertions(+), 53 deletions(-) diff --git a/tests/assemble.test b/tests/assemble.test index 40c132d..45368de 100644 --- a/tests/assemble.test +++ b/tests/assemble.test @@ -1535,61 +1535,35 @@ test assemble-14.7 {incrArrayStkImm} { # assemble-15 - listIndexImm -test assemble-15.1 {listIndexImm - wrong # args} { - -body { - assemble {listIndexImm} - } - -returnCodes error - -match glob - -result {wrong # args*} -} -test assemble-15.2 {listIndexImm - wrong # args} { - -body { - assemble {listIndexImm too many} - } - -returnCodes error - -match glob - -result {wrong # args*} -} -test assemble-15.3 {listIndexImm - bad substitution} { - -body { - list [catch {assemble {listIndexImm $foo}} result] $result $::errorCode - } - -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} - -cleanup {unset result} -} -test assemble-15.4 {listIndexImm - invalid index} { - -body { - assemble {listIndexImm rubbish} - } - -returnCodes error - -match glob - -result {bad index "rubbish"*} -} -test assemble-15.5 {listIndexImm} { - -body { - assemble {push {a b c}; listIndexImm 2} - } - -result c -} -test assemble-15.6 {listIndexImm} { - -body { - assemble {push {a b c}; listIndexImm end-1} - } - -result b -} -test assemble-15.7 {listIndexImm} { - -body { - assemble {push {a b c}; listIndexImm end} - } - -result c -} -test assemble-15.8 {listIndexImm} { +test assemble-15.1 {listIndexImm - wrong # args} -body { + assemble {listIndexImm} +} -returnCodes error -match glob -result {wrong # args*} +test assemble-15.2 {listIndexImm - wrong # args} -body { + assemble {listIndexImm too many} +} -returnCodes error -match glob -result {wrong # args*} +test assemble-15.3 {listIndexImm - bad substitution} -body { + list [catch {assemble {listIndexImm $foo}} result] $result $::errorCode +} -cleanup { + unset result +} -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} +test assemble-15.4 {listIndexImm - invalid index} -body { + assemble {listIndexImm rubbish} +} -returnCodes error -match glob -result {bad index "rubbish"*} +test assemble-15.5 {listIndexImm} -body { + assemble {push {a b c}; listIndexImm 2} +} -result c +test assemble-15.6 {listIndexImm} -body { + assemble {push {a b c}; listIndexImm end-1} +} -result b +test assemble-15.7 {listIndexImm} -body { + assemble {push {a b c}; listIndexImm end} +} -result c +test assemble-15.8 {listIndexImm} -body { assemble {push {a b c}; listIndexImm end+2} -} {} -test assemble-15.9 {listIndexImm} { +} -result {} +test assemble-15.9 {listIndexImm} -body { assemble {push {a b c}; listIndexImm -1-1} -} {} +} -result {} # assemble-16 - invokeStk -- cgit v0.12