Itcl - the [incr Tcl] extension

The following code gives a seg fault:

itcl::class Object { 
  public variable n {} 
  constructor {} { 
    set n test 
  } {}
}
Object #auto

This does not happen with 3.4.2/8.5 or 4.0.3/8.6

Reproduced.  Backtrace:

#3  0x000000000053ebc8 in Tcl_Panic (
    format=0x7fffefb83ba8 "itcl: bad implementation flag for %s")
    at /home/dgp/fossil/tcl-only/generic/tclPanic.c:153
#4  0x00007fffefb7e6b7 in Itcl_EvalMemberCode.part.2 () from ./libitcl3.4.so
#5  0x00007fffefb7e3aa in Itcl_InvokeMethodIfExists () from ./libitcl3.4.so
#6  0x00007fffefb7ff08 in Itcl_CreateObject () from ./libitcl3.4.so
#7  0x00007fffefb76577 in Itcl_HandleClass.part.0 () from ./libitcl3.4.so
#8  0x0000000000414c40 in Dispatch (data=0x869258, interp=0x81f680, result=0)
    at /home/dgp/fossil/tcl-only/generic/tclBasic.c:4359
#9  0x0000000000414cce in TclNRRunCallbacks (interp=0x81f680, result=0, 
    rootPtr=0x0) at /home/dgp/fossil/tcl-only/generic/tclBasic.c:4392
#10 0x00000000004177f5 in TclEvalObjEx (interp=0x81f680, objPtr=0x0, 
    flags=131072, invoker=0x0, word=0)
    at /home/dgp/fossil/tcl-only/generic/tclBasic.c:5958
#11 0x000000000041778e in Tcl_EvalObjEx (interp=0x81f680, objPtr=0x0, 
    flags=131072) at /home/dgp/fossil/tcl-only/generic/tclBasic.c:5939
#12 0x00000000005bec01 in Tcl_RecordAndEvalObj (interp=0x81f680, 
    cmdPtr=0x865560, flags=131072)
    at /home/dgp/fossil/tcl-only/generic/tclHistory.c:190
#13 0x000000000053298b in Tcl_MainEx (argc=-1, argv=0x7fffffffd550, 
    appInitProc=0x40f1d6 <Tcl_AppInit>, interp=0x81f680)
    at /home/dgp/fossil/tcl-only/generic/tclMain.c:534
#14 0x000000000040f1cf in main (argc=1, argv=0x7fffffffd548)
    at /home/dgp/fossil/tcl-only/unix/tclAppInit.c:84

Sorry, let's try that again:

#0  0x0000000000576978 in TclObjVarErrMsg (interp=0x81f680, part1Ptr=0x0, 
    part2Ptr=0x0, operation=0x5d94af "set", 
    reason=0x5d9341 "variable is array", index=0)
    at /home/dgp/fossil/tcl-only/generic/tclVar.c:5624
#1  0x0000000000570fcc in TclPtrSetVar (interp=0x81f680, 
    varPtr=0x7fffffffc838, arrayPtr=0x0, part1Ptr=0x0, part2Ptr=0x0, 
    newValuePtr=0x8d12d0, flags=512, index=0)
    at /home/dgp/fossil/tcl-only/generic/tclVar.c:1880
#2  0x00000000004e9ad2 in TEBCresume (data=0x8cc5f8, interp=0x81f680, 
    result=0) at /home/dgp/fossil/tcl-only/generic/tclExecute.c:3574
#3  0x0000000000414cce in TclNRRunCallbacks (interp=0x81f680, result=0, 
    rootPtr=0x8652c0) at /home/dgp/fossil/tcl-only/generic/tclBasic.c:4392
#4  0x00000000004177f5 in TclEvalObjEx (interp=0x81f680, objPtr=0x8, flags=0, 
    invoker=0x0, word=0) at /home/dgp/fossil/tcl-only/generic/tclBasic.c:5958
#5  0x000000000041778e in Tcl_EvalObjEx (interp=0x81f680, objPtr=0x8, flags=0)
    at /home/dgp/fossil/tcl-only/generic/tclBasic.c:5939
#6  0x00007fffefb7de84 in Itcl_ConstructBase (interp=0x81f680, 
    contextObj=0x87d7c0, contextClass=0x87f640)
    at ./generic/itcl_methods.c:2322
#7  0x00007fffefb7b7a3 in Itcl_EvalMemberCode (interp=0x81f680, 
    mfunc=0x940310, member=0x8c1cd0, contextObj=0x87d7c0, objc=1, 
    objv=0x8efe80) at ./generic/itcl_methods.c:967
#8  0x00007fffefb7e063 in Itcl_InvokeMethodIfExists (interp=0x81f680, 
    name=0x7fffefb84ff0 "constructor", contextClass=0x87f640, 
    contextObj=0x87d7c0, objc=0, objv=0x82cd50)
    at ./generic/itcl_methods.c:2429
#9  0x00007fffefb7ee33 in Itcl_CreateObject (interp=0x81f680, 
    name=0x7fffffffd030 "object0", cdefn=0x87f640, objc=0, objv=0x82cd50, 
    roPtr=0x7fffffffd018) at ./generic/itcl_objects.c:218
#10 0x00007fffefb72471 in Itcl_HandleClass (clientData=0x87f640, 
    interp=0x81f680, objc=2, objv=0x82cd40) at ./generic/itcl_class.c:899
#11 0x0000000000414c40 in Dispatch (data=0x869258, interp=0x81f680, result=0)
    at /home/dgp/fossil/tcl-only/generic/tclBasic.c:4359
#12 0x0000000000414cce in TclNRRunCallbacks (interp=0x81f680, result=0, 
    rootPtr=0x0) at /home/dgp/fossil/tcl-only/generic/tclBasic.c:4392
#13 0x00000000004177f5 in TclEvalObjEx (interp=0x81f680, objPtr=0x8, 
    flags=131072, invoker=0x0, word=0)
    at /home/dgp/fossil/tcl-only/generic/tclBasic.c:5958
#14 0x000000000041778e in Tcl_EvalObjEx (interp=0x81f680, objPtr=0x8, 
    flags=131072) at /home/dgp/fossil/tcl-only/generic/tclBasic.c:5939
#15 0x00000000005bec01 in Tcl_RecordAndEvalObj (interp=0x81f680, 
    cmdPtr=0x865560, flags=131072)
    at /home/dgp/fossil/tcl-only/generic/tclHistory.c:190
#16 0x000000000053298b in Tcl_MainEx (argc=-1, argv=0x7fffffffd550, 
    appInitProc=0x40f1d6 <Tcl_AppInit>, interp=0x81f680)
    at /home/dgp/fossil/tcl-only/generic/tclMain.c:534
#17 0x000000000040f1cf in main (argc=1, argv=0x7fffffffd548)
    at /home/dgp/fossil/tcl-only/unix/tclAppInit.c:84

This demo script begins segfaulting with the
following checkin to Tcl development:

http://core.tcl.tk/tcl/info/47649f8b79

I disable the code introduced in that checkin
on the Tcl trunk, then the Itcl segfault stops.

Have to guess Itcl 3 is intruding in unexpected
ways into the CompiledLocal lists.

This patch to the Itcl 3.4.2 sources will workaround
the segfault observed in the submitted demo script:

Index: generic/itcl_methods.c
==================================================================
--- generic/itcl_methods.c
+++ generic/itcl_methods.c
@@ -823,11 +823,11 @@
 
     /*
      *  If the member is a constructor and the class has an
      *  initialization command, compile it here.
      */
-    if ((member->flags & ITCL_CONSTRUCTOR) != 0 &&
+    if (0 && (member->flags & ITCL_CONSTRUCTOR) != 0 &&
         (member->classDefn->initCode != NULL)) {
         result = TclProcCompileProc(interp, mcode->procPtr,
             member->classDefn->initCode, (Namespace*)member->classDefn->namesp,
             "initialization code for", member->fullname);


It's not yet clear whether this is a generally suitable patch
for all situations, or whether the segfault is a symptom of a
deeper flaw in the Itcl/Tcl interplay itself.

The trouble here is that Itcl constructors have an optional syntax

   constructor $argSpec $intializer $body

and then implement that as a single Tcl Proc with two different
bodies.  That is, two compiled scripts end up sharing a single
Proc struct.

The Tcl code assumes that each compiled script that is a Proc
body has its own Proc struct, so that it can stash things in
it.  Sharing does not work.

Fix and test committed.