Index: generic/gentclAPI.tcl =================================================================== diff -u -r6b8a44994346c77d822eabbd9b5ce890542b5401 -r67f901aeccddd0ef42d927686e9eadb217cb1c8a --- generic/gentclAPI.tcl (.../gentclAPI.tcl) (revision 6b8a44994346c77d822eabbd9b5ce890542b5401) +++ generic/gentclAPI.tcl (.../gentclAPI.tcl) (revision 67f901aeccddd0ef42d927686e9eadb217cb1c8a) @@ -140,13 +140,13 @@ } proc gencall {methodName fn parameterDefinitions clientData - cDefsVar ifDefVar arglistVar preVar postVar introVar nnVar + cDefsVar ifDefVar arglistVar preVar postVar introVar nnVar cleanupVar } { upvar $cDefsVar cDefs $ifDefVar ifDef $arglistVar arglist $preVar pre $postVar post \ - $introVar intro $nnVar nn + $introVar intro $nnVar nn $cleanupVar cleanup set c [list] set i 0 - set pre ""; set post "" + set pre ""; set post ""; set cleanup "" set intro "" switch $clientData { @@ -243,6 +243,8 @@ DECR_REF_COUNT2("patternObj", ${varName}); } }] + set cleanup [subst -nocommands {$type$varName = ($type)pc.clientData[$i];}] + append cleanup \n$post # end of obj pattern } *|* {set type "int "} @@ -283,7 +285,7 @@ set arglist [join $a ", "] } -proc genStub {stub intro obj idx cDefs pre call post} { +proc genStub {stub intro obj idx cDefs pre call post cleanup} { # Tiny optimization for calls without parameters; # ParseContextExtendObjv() is just called for procs, so no need to # free non-static objvs. Actually, the api for c-methods does @@ -310,12 +312,14 @@ $call $post } else { + $cleanup return TCL_ERROR; } } }]} -proc genSimpleStub {stub intro idx cDefs pre call post} { +proc genSimpleStub {stub intro idx cDefs pre call post cleanup} { + if {$cleanup ne ""} {error "$stub cleanup code '$cleanup' must be empty"} return [subst -nocommands { static int ${stub}(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { @@ -346,7 +350,7 @@ set nn "" gencall $d(methodName) $d(stub) $d(parameterDefinitions) $d(clientData) \ - cDefs ifDef arglist pre post intro nn + cDefs ifDef arglist pre post intro nn cleanup # # Check, if spec tells us to pass the original "objv[0]" as an @@ -383,11 +387,11 @@ if {$nrParams == 1 && $arglist eq "objc, objv"} { # TODO we would not need to generate a stub at all.... #set ifd "{\"$d(ns)::$d(methodName)\", $d(implementation), $nrParams, {\n [genifd $d(parameterDefinitions)]}\n}" - append fns [genSimpleStub $d(stub) $intro $d(idx) $cDefs $pre $call $post] + append fns [genSimpleStub $d(stub) $intro $d(idx) $cDefs $pre $call $post $cleanup] } elseif {$nrParams == 1 && $arglist eq "obj, objc, objv"} { # no need to call objv parser #puts stderr "$d(stub) => '$arglist'" - append fns [genSimpleStub $d(stub) $intro $d(idx) $cDefs $pre $call $post] + append fns [genSimpleStub $d(stub) $intro $d(idx) $cDefs $pre $call $post $cleanup] } elseif {$nrParams == 0} { append pre [subst -nocommands { if (unlikely(objc != 1)) { @@ -396,7 +400,7 @@ NULL, objv[0]); } }] - append fns [genSimpleStub $d(stub) $intro $d(idx) $cDefs $pre $call $post] + append fns [genSimpleStub $d(stub) $intro $d(idx) $cDefs $pre $call $post $cleanup] } elseif {$nrParams == 1 && [string match "Tcl_Obj *" $cDefs]} { array set defs [list -required 0] @@ -424,14 +428,14 @@ } regsub ", $arglist\\)" $call ", $newArglist\)" call - append fns [genSimpleStub $d(stub) $intro $d(idx) "" $pre $call $post] + append fns [genSimpleStub $d(stub) $intro $d(idx) "" $pre $call $post $cleanup] } else { switch $d(methodType) { objectMethod {set obj "obj"} classMethod {set obj "(NsfObject *) cl"} default {set obj "NULL"} } - append fns [genStub $d(stub) $intro $obj $d(idx) $cDefs $pre $call $post] + append fns [genStub $d(stub) $intro $obj $d(idx) $cDefs $pre $call $post $cleanup] } lappend ifds $ifd append stubDecls $stubDecl Index: generic/nsfAPI.h =================================================================== diff -u -r3016e6466668218392140bc884fa8bf489721eda -r67f901aeccddd0ef42d927686e9eadb217cb1c8a --- generic/nsfAPI.h (.../nsfAPI.h) (revision 3016e6466668218392140bc884fa8bf489721eda) +++ generic/nsfAPI.h (.../nsfAPI.h) (revision 67f901aeccddd0ef42d927686e9eadb217cb1c8a) @@ -877,6 +877,7 @@ return NsfCCreateMethod(interp, cl, objectName, objc-pc.lastObjc, objv+pc.lastObjc); } else { + return TCL_ERROR; } } @@ -919,6 +920,7 @@ return NsfCFilterGuardMethod(interp, cl, filter, guard); } else { + return TCL_ERROR; } } @@ -961,6 +963,7 @@ return NsfCMixinGuardMethod(interp, cl, mixin, guard); } else { + return TCL_ERROR; } } @@ -983,6 +986,7 @@ return NsfCNewMethod(interp, cl, withChildof, objc-pc.lastObjc, objv+pc.lastObjc); } else { + return TCL_ERROR; } } @@ -1005,6 +1009,7 @@ return NsfCRecreateMethod(interp, cl, objectName, objc-pc.lastObjc, objv+pc.lastObjc); } else { + return TCL_ERROR; } } @@ -1046,6 +1051,7 @@ return NsfClassInfoFilterguardMethod(interp, cl, filter); } else { + return TCL_ERROR; } } @@ -1069,6 +1075,7 @@ return NsfClassInfoFiltersMethod(interp, cl, withGuards, pattern); } else { + return TCL_ERROR; } } @@ -1092,6 +1099,7 @@ return NsfClassInfoForwardMethod(interp, cl, withDefinition, name); } else { + return TCL_ERROR; } } @@ -1114,6 +1122,7 @@ return NsfClassInfoHeritageMethod(interp, cl, pattern); } else { + return TCL_ERROR; } } @@ -1151,6 +1160,12 @@ } return returnCode; } else { + Tcl_Obj *pattern = (Tcl_Obj *)pc.clientData[1]; + + if (pattern) { + DECR_REF_COUNT2("patternObj", pattern); + } + return TCL_ERROR; } } @@ -1174,6 +1189,7 @@ return NsfClassInfoMethodMethod(interp, cl, subcmd, name); } else { + return TCL_ERROR; } } @@ -1201,6 +1217,7 @@ return NsfClassInfoMethodsMethod(interp, cl, withCallprotection, withClosure, withType, withPath, withSource, pattern); } else { + return TCL_ERROR; } } @@ -1239,6 +1256,12 @@ } return returnCode; } else { + Tcl_Obj *pattern = (Tcl_Obj *)pc.clientData[2]; + + if (pattern) { + DECR_REF_COUNT2("patternObj", pattern); + } + return TCL_ERROR; } } @@ -1261,6 +1284,7 @@ return NsfClassInfoMixinguardMethod(interp, cl, mixin); } else { + return TCL_ERROR; } } @@ -1300,6 +1324,12 @@ } return returnCode; } else { + Tcl_Obj *pattern = (Tcl_Obj *)pc.clientData[3]; + + if (pattern) { + DECR_REF_COUNT2("patternObj", pattern); + } + return TCL_ERROR; } } @@ -1325,6 +1355,7 @@ return NsfClassInfoSlotobjectsMethod(interp, cl, withClosure, withSource, withType, pattern); } else { + return TCL_ERROR; } } @@ -1363,6 +1394,12 @@ } return returnCode; } else { + Tcl_Obj *pattern = (Tcl_Obj *)pc.clientData[2]; + + if (pattern) { + DECR_REF_COUNT2("patternObj", pattern); + } + return TCL_ERROR; } } @@ -1386,6 +1423,7 @@ return NsfClassInfoSuperclassMethod(interp, cl, withClosure, pattern); } else { + return TCL_ERROR; } } @@ -1412,6 +1450,7 @@ return NsfAsmMethodCreateCmd(interp, object, withCheckalways, withInner_namespace, withPer_object, withReg_object, methodName, arguments, body); } else { + return TCL_ERROR; } } @@ -1435,6 +1474,7 @@ return NsfAsmProcCmd(interp, withAd, withCheckalways, procName, arguments, body); } else { + return TCL_ERROR; } } @@ -1457,6 +1497,7 @@ return NsfCmdInfoCmd(interp, subcmd, withContext, methodName, pattern); } else { + return TCL_ERROR; } } @@ -1487,6 +1528,7 @@ return NsfConfigureCmd(interp, option, value); } else { + return TCL_ERROR; } } @@ -1506,6 +1548,7 @@ return NsfCurrentCmd(interp, option); } else { + return TCL_ERROR; } } @@ -1575,6 +1618,7 @@ return NsfDirectDispatchCmd(interp, object, withFrame, command, objc-pc.lastObjc, objv+pc.lastObjc); } else { + return TCL_ERROR; } } @@ -1597,6 +1641,7 @@ return NsfDispatchCmd(interp, object, withIntrinsic, withSystem, command, objc-pc.lastObjc, objv+pc.lastObjc); } else { + return TCL_ERROR; } } @@ -1616,6 +1661,7 @@ return NsfFinalizeCmd(interp, withKeepvars); } else { + return TCL_ERROR; } } @@ -1635,6 +1681,7 @@ return NsfInterpObjCmd(interp, name, objc, objv); } else { + return TCL_ERROR; } } @@ -1658,6 +1705,7 @@ return NsfIsCmd(interp, withComplain, withConfigure, withName, constraint, value); } else { + return TCL_ERROR; } } @@ -1682,6 +1730,7 @@ return NsfMethodAliasCmd(interp, object, withPer_object, methodName, withFrame, withProtection, cmdName); } else { + return TCL_ERROR; } } @@ -1703,6 +1752,7 @@ return NsfMethodAssertionCmd(interp, object, subcmd, arg); } else { + return TCL_ERROR; } } @@ -1731,6 +1781,7 @@ return NsfMethodCreateCmd(interp, object, withCheckalways, withInner_namespace, withPer_object, withReg_object, methodName, arguments, body, withPrecondition, withPostcondition); } else { + return TCL_ERROR; } } @@ -1752,6 +1803,7 @@ return NsfMethodDeleteCmd(interp, object, withPer_object, methodName); } else { + return TCL_ERROR; } } @@ -1780,6 +1832,7 @@ return NsfMethodForwardCmd(interp, object, withPer_object, method, withDefault, withEarlybinding, withOnerror, withPrefix, withFrame, withVerbose, target, objc-pc.lastObjc, objv+pc.lastObjc); } else { + return TCL_ERROR; } } @@ -1803,6 +1856,7 @@ return NsfMethodPropertyCmd(interp, object, withPer_object, methodName, methodProperty, value); } else { + return TCL_ERROR; } } @@ -1840,6 +1894,7 @@ return NsfMethodSetterCmd(interp, object, withPer_object, parameter); } else { + return TCL_ERROR; } } @@ -1862,6 +1917,7 @@ return NsfMyCmd(interp, withIntrinsic, withLocal, withSystem, methodName, objc-pc.lastObjc, objv+pc.lastObjc); } else { + return TCL_ERROR; } } @@ -1882,6 +1938,7 @@ return NsfNSCopyVarsCmd(interp, fromNs, toNs); } else { + return TCL_ERROR; } } @@ -1919,6 +1976,7 @@ return NsfObjectAllocCmd(interp, class, name, initcmd); } else { + return TCL_ERROR; } } @@ -1956,6 +2014,7 @@ return NsfObjectPropertyCmd(interp, objectName, objectProperty, value); } else { + return TCL_ERROR; } } @@ -1993,6 +2052,7 @@ return NsfObjectSystemCreateCmd(interp, rootClass, rootMetaClass, systemMethods); } else { + return TCL_ERROR; } } @@ -2012,6 +2072,7 @@ return NsfParameterCacheClassInvalidateCmd(interp, class); } else { + return TCL_ERROR; } } @@ -2031,6 +2092,7 @@ return NsfParameterCacheObjectInvalidateCmd(interp, object); } else { + return TCL_ERROR; } } @@ -2052,6 +2114,7 @@ return NsfParameterInfoCmd(interp, subcmd, spec, varname); } else { + return TCL_ERROR; } } @@ -2073,6 +2136,7 @@ return NsfParameterSpecsCmd(interp, withConfigure, withNonposargs, slotobjs); } else { + return TCL_ERROR; } } @@ -2096,6 +2160,7 @@ return NsfProcCmd(interp, withAd, withCheckalways, procName, arguments, body); } else { + return TCL_ERROR; } } @@ -2148,6 +2213,7 @@ return NsfRelationGetCmd(interp, object, type); } else { + return TCL_ERROR; } } @@ -2169,6 +2235,7 @@ return NsfRelationSetCmd(interp, object, type, value); } else { + return TCL_ERROR; } } @@ -2238,6 +2305,7 @@ return NsfVarExistsCmd(interp, withArray, object, varName); } else { + return TCL_ERROR; } } @@ -2259,6 +2327,7 @@ return NsfVarGetCmd(interp, withArray, object, varName); } else { + return TCL_ERROR; } } @@ -2278,6 +2347,7 @@ return NsfVarImportCmd(interp, object, objc-pc.lastObjc, objv+pc.lastObjc); } else { + return TCL_ERROR; } } @@ -2300,6 +2370,7 @@ return NsfVarSetCmd(interp, withArray, object, varName, value); } else { + return TCL_ERROR; } } @@ -2321,6 +2392,7 @@ return NsfVarUnsetCmd(interp, withNocomplain, object, varName); } else { + return TCL_ERROR; } } @@ -2345,6 +2417,7 @@ return NsfOAutonameMethod(interp, obj, withInstance, withReset, name); } else { + return TCL_ERROR; } } @@ -2424,6 +2497,7 @@ return NsfOConfigureMethod(interp, obj, objc-pc.lastObjc, objv+pc.lastObjc, objv[0]); } else { + return TCL_ERROR; } } @@ -2465,6 +2539,7 @@ return NsfOExistsMethod(interp, obj, varName); } else { + return TCL_ERROR; } } @@ -2488,6 +2563,7 @@ return NsfOFilterGuardMethod(interp, obj, filter, guard); } else { + return TCL_ERROR; } } @@ -2524,6 +2600,7 @@ return NsfOMixinGuardMethod(interp, obj, mixin, guard); } else { + return TCL_ERROR; } } @@ -2643,6 +2720,7 @@ return NsfObjInfoChildrenMethod(interp, obj, withType, pattern); } else { + return TCL_ERROR; } } @@ -2684,6 +2762,7 @@ return NsfObjInfoFilterguardMethod(interp, obj, filter); } else { + return TCL_ERROR; } } @@ -2707,6 +2786,7 @@ return NsfObjInfoFiltersMethod(interp, obj, withGuards, pattern); } else { + return TCL_ERROR; } } @@ -2730,6 +2810,7 @@ return NsfObjInfoForwardMethod(interp, obj, withDefinition, name); } else { + return TCL_ERROR; } } @@ -2752,6 +2833,7 @@ return NsfObjInfoHasMixinMethod(interp, obj, class); } else { + return TCL_ERROR; } } @@ -2774,6 +2856,7 @@ return NsfObjInfoHasTypeMethod(interp, obj, class); } else { + return TCL_ERROR; } } @@ -2815,6 +2898,7 @@ return NsfObjInfoLookupFilterMethod(interp, obj, filter); } else { + return TCL_ERROR; } } @@ -2838,6 +2922,7 @@ return NsfObjInfoLookupFiltersMethod(interp, obj, withGuards, pattern); } else { + return TCL_ERROR; } } @@ -2885,6 +2970,7 @@ return NsfObjInfoLookupMethodsMethod(interp, obj, withCallprotection, withIncontext, withType, withNomixins, withPath, withSource, pattern); } else { + return TCL_ERROR; } } @@ -2922,6 +3008,12 @@ } return returnCode; } else { + Tcl_Obj *pattern = (Tcl_Obj *)pc.clientData[1]; + + if (pattern) { + DECR_REF_COUNT2("patternObj", pattern); + } + return TCL_ERROR; } } @@ -2946,6 +3038,7 @@ return NsfObjInfoLookupSlotsMethod(interp, obj, withSource, withType, pattern); } else { + return TCL_ERROR; } } @@ -2969,6 +3062,7 @@ return NsfObjInfoMethodMethod(interp, obj, subcmd, name); } else { + return TCL_ERROR; } } @@ -2994,6 +3088,7 @@ return NsfObjInfoMethodsMethod(interp, obj, withCallprotection, withType, withPath, pattern); } else { + return TCL_ERROR; } } @@ -3016,6 +3111,7 @@ return NsfObjInfoMixinguardMethod(interp, obj, mixin); } else { + return TCL_ERROR; } } @@ -3053,6 +3149,12 @@ } return returnCode; } else { + Tcl_Obj *pattern = (Tcl_Obj *)pc.clientData[1]; + + if (pattern) { + DECR_REF_COUNT2("patternObj", pattern); + } + return TCL_ERROR; } } @@ -3095,6 +3197,7 @@ return NsfObjInfoObjectparameterMethod(interp, obj, subcmd, pattern); } else { + return TCL_ERROR; } } @@ -3137,6 +3240,7 @@ return NsfObjInfoPrecedenceMethod(interp, obj, withIntrinsic, pattern); } else { + return TCL_ERROR; } } @@ -3160,6 +3264,7 @@ return NsfObjInfoSlotobjectsMethod(interp, obj, withType, pattern); } else { + return TCL_ERROR; } } @@ -3182,6 +3287,7 @@ return NsfObjInfoVarsMethod(interp, obj, pattern); } else { + return TCL_ERROR; } }