--- shell_src/goshGraph.cpp.orig 2013-06-04 14:51:44.000000000 +0200 +++ shell_src/goshGraph.cpp 2013-06-04 16:26:04.000000000 +0200 @@ -173,7 +173,7 @@ { TNode u = atol(argv[2]); TNode v = G -> SwapNode(u); - sprintf(interp->result,"%lu",static_cast(v)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(v))); return TCL_OK; } @@ -384,12 +384,12 @@ try { - sprintf(interp->result,"%f",G->FlowValue(sourceNode,sourceNode^1)); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->FlowValue(sourceNode,sourceNode^1))); return TCL_OK; } catch (ERCheck) { - sprintf(interp->result,"Flow is corrupted"); + Tcl_SetObjResult(interp, Tcl_NewStringObj("Flow is corrupted", -1)); return TCL_ERROR; } } @@ -400,12 +400,12 @@ try { G -> FlowValue(sourceNode,sourceNode^1); - sprintf(interp->result,"%f",ret); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(ret)); return TCL_OK; } catch (ERCheck) { - interp->result = "Flow is corrupted"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Flow is corrupted", -1)); return TCL_ERROR; } } @@ -453,6 +453,8 @@ int Goblin_Sparse_Cmd (abstractMixedGraph *G,Tcl_Interp* interp,int argc, _CONST_QUAL_ char* argv[]) throw(ERRejected,ERRange) { + Tcl_ResetResult(interp); + if (strcmp(argv[1],"reorder")==0) { if (argc!=4) @@ -466,29 +468,27 @@ if (strcmp(argv[3],"-planar")==0) { if (G->PlanarizeIncidenceOrder()) - interp->result = "1"; - else interp->result = "0"; + Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); + else + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); return GOSH_OK; } if (strcmp(argv[3],"-shuffle")==0) { G -> RandomizeIncidenceOrder(); - interp->result = ""; return GOSH_OK; } if (strcmp(argv[3],"-geometric")==0) { G -> IncidenceOrderFromDrawing(); - interp->result = ""; return GOSH_OK; } if (strcmp(argv[3],"-outerplanar")==0) { G -> GrowExteriorFace(); - interp->result = ""; return GOSH_OK; } @@ -517,14 +517,13 @@ else { delete[] keyValue; - interp->result = "Missing key value specification"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing key value specification", -1)); return TCL_OK; } GR -> ReorderNodeIndices(keyValue); delete[] keyValue; - interp->result = ""; return TCL_OK; } @@ -550,18 +549,17 @@ else { delete[] keyValue; - interp->result = "Missing key value specification"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing key value specification", -1)); return TCL_OK; } GR -> ReorderEdgeIndices(keyValue); delete[] keyValue; - interp->result = ""; return TCL_OK; } - sprintf(interp->result,"Unknown option: %s reorder %s",argv[0],argv[2]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " reorder ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -600,12 +598,11 @@ sourceNode,targetNode) ) { - interp->result = ""; return GOSH_OK; } else { - interp->result = "Graph is not edge series parallel"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Graph is not edge series parallel", -1)); return GOSH_ERROR; } } @@ -625,7 +622,7 @@ return TCL_ERROR; } - sprintf(interp->result,"%lu",static_cast((G->N1()))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast((G->N1())))); return TCL_OK; } @@ -637,7 +634,7 @@ return TCL_ERROR; } - sprintf(interp->result,"%lu",static_cast((G->N2()))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast((G->N2())))); return TCL_OK; } @@ -648,9 +645,11 @@ int Goblin_Undirected_Cmd (abstractGraph *G,Tcl_Interp* interp,int argc, _CONST_QUAL_ char* argv[]) throw(ERRejected,ERRange) { + Tcl_ResetResult(interp); + if (argc<2) { - interp->result = "Missing arguments"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing arguments", -1)); return TCL_ERROR; } @@ -669,7 +668,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -687,7 +685,6 @@ Goblin_Dense_Graph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Dense_Graph); - interp->result = ""; return TCL_OK; } @@ -701,7 +698,7 @@ TFloat ret = G -> MaximumMatching(); - sprintf(interp->result,"%f",ret); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(ret)); return TCL_OK; } @@ -715,12 +712,12 @@ if (G -> MinCMatching()) { - sprintf(interp->result,"%f",G->Weight()); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->Weight())); return TCL_OK; } else { - interp->result = "No such structure exists"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("No such structure exists", -1)); return TCL_ERROR; } } @@ -735,7 +732,7 @@ TFloat ret = G -> MinCEdgeCover(); - sprintf(interp->result,"%f",ret); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(ret)); return TCL_OK; } @@ -750,12 +747,12 @@ try { G -> MinCTJoin(demandNodes(*G)); - sprintf(interp->result,"%f",G->Weight()); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->Weight())); return TCL_OK; } catch (ERRejected) { - interp->result = "No such structure exists"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("No such structure exists", -1)); return TCL_ERROR; } } @@ -767,9 +764,11 @@ int Goblin_Directed_Cmd (abstractDiGraph *G,Tcl_Interp* interp,int argc, _CONST_QUAL_ char* argv[]) throw(ERRejected,ERRange) { + Tcl_ResetResult(interp); + if (argc<2) { - interp->result = "Missing arguments"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing arguments", -1)); return TCL_ERROR; } @@ -788,7 +787,6 @@ Goblin_Sparse_Digraph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Digraph); - interp->result = ""; return TCL_OK; } @@ -806,7 +804,6 @@ Goblin_Sparse_Digraph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Digraph); - interp->result = ""; return TCL_OK; } @@ -824,7 +821,6 @@ Goblin_Sparse_Digraph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Digraph); - interp->result = ""; return TCL_OK; } @@ -842,7 +838,6 @@ Goblin_Ilp_Cmd,reinterpret_cast(XLP), (Tcl_CmdDeleteProc *)Goblin_Delete_Ilp); - interp->result = ""; return TCL_OK; } @@ -860,7 +855,6 @@ Goblin_Balanced_FNW_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Balanced_FNW); - interp->result = ""; return TCL_OK; } @@ -876,11 +870,10 @@ if (v==NoNode) { - interp->result = "*"; return TCL_OK; } - sprintf(interp->result,"%lu",static_cast(v)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(v))); return TCL_OK; } @@ -896,11 +889,11 @@ if (v==NoNode) { - interp->result = "Graph is not a DAG"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Graph is not a DAG", -1)); return TCL_ERROR; } - sprintf(interp->result,"%lu",static_cast(v)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(v))); return TCL_OK; } @@ -916,7 +909,7 @@ } TCap ret = G->TreePacking(rootNode); - sprintf(interp->result,"%f",ret); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(ret)); return TCL_OK; } @@ -927,9 +920,11 @@ int Goblin_Generic_Graph_Cmd (abstractMixedGraph *G,Tcl_Interp* interp,int argc, _CONST_QUAL_ char* argv[]) throw(ERRejected,ERRange) { + Tcl_ResetResult(interp); + if (argc<2) { - interp->result = "Missing arguments"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing arguments", -1)); return TCL_ERROR; } @@ -947,7 +942,6 @@ Goblin_Graph_Display_Proxy_Cmd,reinterpret_cast(DP), (Tcl_CmdDeleteProc *)Goblin_Delete_Graph_Display_Proxy); - interp->result = ""; return TCL_OK; } @@ -966,7 +960,6 @@ Goblin_Mixed_Graph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Mixed_Graph); - interp->result = ""; return TCL_OK; } @@ -1003,7 +996,6 @@ (Tcl_CmdDeleteProc *)Goblin_Delete_Mixed_Graph); } - interp->result = ""; return TCL_OK; } @@ -1032,7 +1024,6 @@ (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Digraph); } - interp->result = ""; return TCL_OK; } @@ -1050,7 +1041,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -1068,7 +1058,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -1099,7 +1088,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -1117,7 +1105,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -1135,7 +1122,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -1153,7 +1139,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -1204,7 +1189,6 @@ Goblin_Mixed_Graph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Mixed_Graph); - interp->result = ""; return TCL_OK; } @@ -1222,7 +1206,6 @@ Goblin_Sparse_Digraph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Digraph); - interp->result = ""; return TCL_OK; } @@ -1252,7 +1235,6 @@ Goblin_Sparse_Bigraph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Bigraph); - interp->result = ""; return TCL_OK; } @@ -1270,7 +1252,6 @@ Goblin_Mixed_Graph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Mixed_Graph); - interp->result = ""; return TCL_OK; } @@ -1288,7 +1269,6 @@ Goblin_Sparse_Digraph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Digraph); - interp->result = ""; return TCL_OK; } @@ -1306,7 +1286,6 @@ Goblin_Sparse_Digraph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Digraph); - interp->result = ""; return TCL_OK; } @@ -1324,7 +1303,6 @@ Goblin_Mixed_Graph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Mixed_Graph); - interp->result = ""; return TCL_OK; } @@ -1342,7 +1320,6 @@ Goblin_Dense_Digraph_Cmd,reinterpret_cast(H), (Tcl_CmdDeleteProc *)Goblin_Delete_Dense_Digraph); - interp->result = ""; return TCL_OK; } @@ -1361,7 +1338,6 @@ Goblin_Ilp_Cmd,reinterpret_cast(XLP), (Tcl_CmdDeleteProc *)Goblin_Delete_Ilp); - interp->result = ""; return TCL_OK; } @@ -1378,7 +1354,7 @@ if (!X->IsGraphObject()) { - sprintf(interp->result,"Not a graph object ID: %s",argv[argc-1]); + Tcl_AppendResult(interp, "Not a graph object ID: ", argv[argc-1], (char *)NULL); return TCL_ERROR; } @@ -1386,7 +1362,7 @@ if (Y==NULL || !(Y->IsSparse())) { - interp->result = "Unhandled object type"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Unhandled object type", -1)); return TCL_ERROR; } @@ -1417,7 +1393,6 @@ G -> AddGraphByNodes(*Y,mergeLayoutMode); } - interp->result = ""; return TCL_OK; } @@ -1443,7 +1418,7 @@ { if (argc==5) { - interp->result = "Missing coordinate values"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing coordinate values", -1)); return TCL_ERROR; } @@ -1454,7 +1429,6 @@ G->Representation() -> SetC(p,TDim(i-5),pos); } - interp->result = ""; return TCL_OK; } @@ -1462,13 +1436,13 @@ { if (!G->IsSparse()) { - interp->result = "Operation applies to sparse graphs only"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Operation applies to sparse graphs only", -1)); return TCL_ERROR; } sparseRepresentation* GR = static_cast(G->Representation()); - sprintf(interp->result,"%lu",static_cast(GR->InsertThreadSuccessor(p))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(GR->InsertThreadSuccessor(p)))); return TCL_OK; } @@ -1476,27 +1450,27 @@ { if (strcmp(argv[5],"-cx")==0) { - sprintf(interp->result,"%f",G->C(p,0)); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->C(p,0))); } else if (strcmp(argv[5],"-cy")==0) { - sprintf(interp->result,"%f",G->C(p,1)); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->C(p,1))); } else if (strcmp(argv[5],"-successor")==0) { if (G->ThreadSuccessor(p)!=NoNode) { - sprintf(interp->result,"%lu",static_cast(G->ThreadSuccessor(p))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->ThreadSuccessor(p)))); } - else interp->result = "*"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); } else if (strcmp(argv[5],"-hidden")==0) { - sprintf(interp->result,"%d",G->HiddenNode(p)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->HiddenNode(p))); } else { - sprintf(interp->result,"Unknown layout point attribute: %s",argv[5]); + Tcl_AppendResult(interp, "Unknown layout point attribute: ", argv[5], (char *)NULL); return TCL_ERROR; } @@ -1507,13 +1481,12 @@ if (strcmp(argv[2],"alignWithOrigin")==0) { G -> Layout_AlignWithOrigin(); - interp->result = ""; return TCL_OK; } if (strcmp(argv[2],"#points")==0) { - sprintf(interp->result,"%lu",static_cast(G->L())); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->L()))); return TCL_OK; } @@ -1522,21 +1495,18 @@ if (strcmp(argv[3],"freeze")==0) { G -> Layout_FreezeBoundingBox(); - interp->result = ""; return TCL_OK; } if (strcmp(argv[3],"default")==0) { G -> Layout_DefaultBoundingBox(); - interp->result = ""; return TCL_OK; } if (strcmp(argv[3],"release")==0) { G -> Layout_ReleaseBoundingBox(); - interp->result = ""; return TCL_OK; } @@ -1546,7 +1516,7 @@ if (pos<=0 || pos>=argc-1) { - interp->result = "Missing value for parameter \"-coordinate\""; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing value for parameter \"-coordinate\"", -1)); return TCL_ERROR; } @@ -1554,7 +1524,7 @@ if (coordinate>=G->Dim()) { - interp->result = "Invalid coordinate index"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid coordinate index", -1)); return TCL_ERROR; } @@ -1564,7 +1534,7 @@ if (pos<=0 || pos>=argc-2) { - interp->result = "Missing values for parameter \"-range\""; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing values for parameter \"-range\"", -1)); return TCL_ERROR; } @@ -1572,7 +1542,6 @@ TFloat cMax = TFloat(atol(argv[pos+2])); G -> Layout_TransformCoordinate(coordinate,cMin,cMax); - interp->result = ""; return TCL_OK; } @@ -1585,7 +1554,7 @@ if (pos>0 && posresult,"%f",cMax); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(cMax)); return TCL_OK; } @@ -1593,7 +1562,7 @@ if (pos>0 && posresult,"%f",cMin); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(cMin)); return TCL_OK; } @@ -1603,15 +1572,15 @@ { TFloat spacing = 1.0; G -> GetLayoutParameter(TokLayoutBendSpacing,spacing); - sprintf(interp->result,"%lu",static_cast((cMax-cMin)/spacing)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast((cMax-cMin)/spacing))); return TCL_OK; } - interp->result = "Missing parameter specification"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing parameter specification", -1)); return TCL_ERROR; } - sprintf(interp->result,"Unknown option: %s layout boundingBox %s",argv[0],argv[3]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " layout boundingBox ", argv[3], (char *)NULL); return TCL_ERROR; } @@ -1630,15 +1599,14 @@ if ( argv[keyCount][0]!='-' || !G->SetLayoutParameter(&(argv[keyCount][1]),argv[keyCount+1])) { - sprintf(interp->result,"Invalid assignment: %s layout configure %s %s", - argv[0],argv[keyCount],argv[keyCount+1]); + Tcl_AppendResult(interp, "Invalid assignment: ", argv[0], " layout configure ", + argv[keyCount], argv[keyCount+1], (char *)NULL); return TCL_ERROR; } keyCount += 2; } - interp->result = ""; return TCL_OK; } @@ -1654,16 +1622,16 @@ { if (G->Dim()>0 && G->CMax(0)>-100000 && G->CMax(1)>-100000) { - interp->result = "1"; + Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); } else { - interp->result = "0"; + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); } } - else if (!G->GetLayoutParameter(&(argv[3][1]),interp->result)) + else if (!G->GetLayoutParameter(&(argv[3][1]),(char *)Tcl_GetStringResult(interp))) { - sprintf(interp->result,"Unknown layout parameter %s",argv[3]); + Tcl_AppendResult(interp, "Unknown layout parameter ", argv[3], (char *)NULL); return TCL_ERROR; } @@ -1681,7 +1649,7 @@ } else { - interp->result = "Missing value for parameter \"-spacing\""; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing value for parameter \"-spacing\"", -1)); return TCL_ERROR; } } @@ -1690,13 +1658,12 @@ { if (!G->IsSparse()) { - interp->result = "Operation applies to sparse graphs only"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Operation applies to sparse graphs only", -1)); return TCL_ERROR; } static_cast(G->Representation()) -> Layout_ArcRouting(spacing); - interp->result = ""; return TCL_OK; } @@ -1715,7 +1682,7 @@ } else { - interp->result = "Missing value for parameter \"-dx\""; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing value for parameter \"-dx\"", -1)); return TCL_ERROR; } } @@ -1730,7 +1697,7 @@ } else { - interp->result = "Missing value for parameter \"-dy\""; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing value for parameter \"-dy\"", -1)); return TCL_ERROR; } } @@ -1761,7 +1728,6 @@ } catch (ERRejected) {} - interp->result = ""; return TCL_OK; } @@ -1800,7 +1766,6 @@ abstractMixedGraph::FDP_DEFAULT,int(spacing)); } - interp->result = ""; return TCL_OK; } @@ -1869,7 +1834,6 @@ G -> Layout_Layered(method,dx,dy); } - interp->result = ""; return TCL_OK; } @@ -1887,7 +1851,7 @@ { if (!(G->Layout_Outerplanar(spacing))) { - interp->result = "No outerplanar embedding given"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("No outerplanar embedding given", -1)); return TCL_ERROR; } } @@ -1896,7 +1860,6 @@ G -> Layout_Circular(spacing); } - interp->result = ""; return TCL_OK; } @@ -1904,7 +1867,6 @@ { G -> Layout_Equilateral(spacing); - interp->result = ""; return TCL_OK; } @@ -1916,7 +1878,7 @@ if (posresult = "Missing value for parameter \"-grid\""; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing value for parameter \"-grid\"", -1)); return TCL_ERROR; } } @@ -1932,7 +1894,7 @@ if (posresult = "Missing value for parameter \"-basis\""; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing value for parameter \"-basis\"", -1)); return TCL_ERROR; } } @@ -1946,7 +1908,6 @@ G -> Layout_StraightLineDrawing(aBasis,grid); } - interp->result = ""; return TCL_OK; } @@ -1963,7 +1924,7 @@ if (posresult = "Missing value for parameter \"-rootNode\""; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing value for parameter \"-rootNode\"", -1)); return TCL_ERROR; } } @@ -1995,7 +1956,6 @@ G -> Layout_Kandinsky(abstractMixedGraph::ORTHO_DEFAULT,grid); } - interp->result = ""; return TCL_OK; } @@ -2024,11 +1984,10 @@ abstractMixedGraph::ORTHO_VISIBILITY_TRIM,grid); } - interp->result = ""; return TCL_OK; } - sprintf(interp->result,"Unknown option: %s layout %s",argv[0],argv[2]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " layout ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -2054,11 +2013,11 @@ try { G -> ExtractTree(rootNode); - interp->result = "1"; + Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); } catch (ERCheck) { - interp->result = "Invalid input data"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid input data", -1)); return TCL_ERROR; } @@ -2087,11 +2046,11 @@ try { G -> ExtractPath(sourceNode,targetNode); - interp->result = "1"; + Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); } catch (ERCheck) { - interp->result = "Invalid input data"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid input data", -1)); return TCL_ERROR; } @@ -2108,11 +2067,11 @@ { try { - sprintf(interp->result,"%lu",static_cast(G->ExtractCycles())); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->ExtractCycles()))); } catch (ERCheck) { - interp->result = "Invalid input data"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid input data", -1)); return TCL_ERROR; } @@ -2121,7 +2080,7 @@ try { - interp->result = "1"; + Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); if (strcmp(argv[2],"matching")==0) { @@ -2159,20 +2118,20 @@ return TCL_OK; } - interp->result = "1"; + Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); } catch (ERCheck) { - interp->result = "Invalid input data"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid input data", -1)); return TCL_ERROR; } catch (ERRejected) { - interp->result = "Invalid input data"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid input data", -1)); return TCL_ERROR; } - sprintf(interp->result,"Unknown option: %s extract %s",argv[0],argv[2]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " extract ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -2185,7 +2144,6 @@ } Tcl_DeleteCommand(interp,argv[0]); - interp->result = ""; return TCL_OK; } @@ -2223,12 +2181,11 @@ } else { - sprintf(interp->result,"Unknown register attribute: %s",argv[i]); + Tcl_AppendResult(interp, "Unknown register attribute: ", argv[1], (char *)NULL); return TCL_ERROR; } } - interp->result = ""; return TCL_OK; } @@ -2240,7 +2197,7 @@ return TCL_ERROR; } - sprintf(interp->result,"%lu",static_cast(G->N())); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->N()))); return TCL_OK; } @@ -2252,7 +2209,7 @@ return TCL_ERROR; } - sprintf(interp->result,"%lu",static_cast(G->M())); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->M()))); return TCL_OK; } @@ -2270,74 +2227,83 @@ { TNode s = G->DefaultSourceNode(); - if (s==NoNode) interp->result = "*"; - else sprintf(interp->result,"%lu",static_cast(s)); + if (s==NoNode) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); + } else { + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(s))); + } } else if (strcmp(argv[2],"-targetNode")==0) { TNode t = G->DefaultTargetNode(); - if (t==NoNode) interp->result = "*"; - else sprintf(interp->result,"%lu",static_cast(t)); + if (t==NoNode) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); + } else { + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(t))); + } } else if (strcmp(argv[2],"-rootNode")==0) { TNode r = G->DefaultRootNode(); - if (r==NoNode) interp->result = "*"; - else sprintf(interp->result,"%lu",static_cast(r)); + if (r==NoNode) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); + } else { + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(r))); + } } else if (strcmp(argv[2],"-metricType")==0) { - sprintf(interp->result,"%d",G->MetricType()); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->MetricType())); } else if (strcmp(argv[2],"-sparse")==0) { - sprintf(interp->result,"%s", (G->IsSparse()) ? "1" : "0"); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->IsSparse() ? 1 : 0)); } else if (strcmp(argv[2],"-directed")==0) { - sprintf(interp->result,"%s", (G->IsDirected()) ? "1" : "0"); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->IsDirected() ? 1 : 0)); } else if (strcmp(argv[2],"-undirected")==0) { - sprintf(interp->result,"%s", (G->IsUndirected()) ? "1" : "0"); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->IsUndirected() ? 1 : 0)); } else if (strcmp(argv[2],"-bipartite")==0) { - sprintf(interp->result,"%s", (G->IsBipartite()) ? "1" : "0"); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->IsBipartite() ? 1 : 0)); } else if (strcmp(argv[2],"-planar")==0) { - sprintf(interp->result,"%s", (G->IsPlanar()) ? "1" : "0"); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->IsPlanar() ? 1 : 0)); } else if (strcmp(argv[2],"-chordal")==0) { - sprintf(interp->result,"%s", (G->IsChordal()) ? "1" : "0"); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->IsChordal() ? 1 : 0)); } else if (strcmp(argv[2],"-co-chordal")==0) { - sprintf(interp->result,"%s", (G->IsChordal(abstractMixedGraph::PERFECT_COMPLEMENT)) ? "1" : "0"); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->IsChordal(abstractMixedGraph::PERFECT_COMPLEMENT) ? 1 : 0)); } else if (strcmp(argv[2],"-balanced")==0) { - sprintf(interp->result,"%s", (G->IsBalanced()) ? "1" : "0"); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->IsBalanced() ? 1 : 0)); } else if (strcmp(argv[2],"-graphObject")==0) { - interp->result = "1"; + Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); } else if (strcmp(argv[2],"-cardinality")==0) { - sprintf(interp->result,"%f",G->Cardinality()); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->Cardinality())); } else if (strcmp(argv[2],"-edgeLength")==0) { - sprintf(interp->result,"%f",G->Length()); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->Length())); } else if (strcmp(argv[2],"-subgraphWeight")==0) { - sprintf(interp->result,"%f",G->Weight()); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->Weight())); } else { @@ -2354,12 +2320,11 @@ { if (!G->IsSparse()) { - interp->result = "Operation applies to sparse graphs only"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Operation applies to sparse graphs only", -1)); return TCL_ERROR; } static_cast(G->Representation()) -> ExplicitParallels(); - interp->result = ""; return TCL_OK; } @@ -2471,7 +2436,6 @@ } } - interp->result = ""; return TCL_OK; } @@ -2484,7 +2448,6 @@ } G -> Write(argv[2]); - interp->result = ""; return TCL_OK; } @@ -2531,18 +2494,17 @@ if (targetNode!=NoNode && G->Dist(targetNode)result,"%f",G->Dist(targetNode)); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->Dist(targetNode))); return TCL_OK; } else { - interp->result = "*"; return TCL_OK; } } catch (...) {} - interp->result = "Unable to assign distance labels"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Unable to assign distance labels", -1)); return TCL_ERROR; } @@ -2609,7 +2571,7 @@ } } - sprintf(interp->result,"%f",retCap); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(retCap)); return TCL_OK; } @@ -2632,11 +2594,11 @@ if (strongConnnectivity) { - sprintf(interp->result,"%d",G->StronglyEdgeConnected(kappa)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->StronglyEdgeConnected(kappa))); } else { - sprintf(interp->result,"%d",G->EdgeConnected(kappa)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->EdgeConnected(kappa))); } return TCL_OK; @@ -2680,12 +2642,11 @@ if (feasible) { - interp->result = ""; return TCL_OK; } else { - interp->result = "Graph is not 2-connected"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Graph is not 2-connected", -1)); return TCL_ERROR; } } @@ -2702,7 +2663,7 @@ if (threshold<=0) { - sprintf(interp->result,"Invalid bound specification: %s",argv[pos+1]); + Tcl_AppendResult(interp, "Invalid bound specification: ", argv[pos+1], (char *)NULL); return TCL_ERROR; } @@ -2712,12 +2673,12 @@ if (chi>0) { - sprintf(interp->result,"%lu",static_cast(chi)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(chi))); return TCL_OK; } else { - interp->result = "No such structure exists"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("No such structure exists", -1)); return TCL_ERROR; } } @@ -2734,7 +2695,7 @@ if (threshold<=0) { - sprintf(interp->result,"Invalid bound specification: %s",argv[pos+1]); + Tcl_AppendResult(interp, "Invalid bound specification: ", argv[pos+1], (char *)NULL); return TCL_ERROR; } @@ -2744,12 +2705,12 @@ if (chi>0) { - sprintf(interp->result,"%lu",static_cast(chi)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(chi))); return TCL_OK; } else { - interp->result = "No such structure exists"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("No such structure exists", -1)); return TCL_ERROR; } } @@ -2766,7 +2727,7 @@ if (threshold<=0) { - sprintf(interp->result,"Invalid bound specification: %s",argv[pos+1]); + Tcl_AppendResult(interp, "Invalid bound specification: ", argv[pos+1], (char *)NULL); return TCL_ERROR; } @@ -2776,12 +2737,12 @@ if (chi>0) { - sprintf(interp->result,"%lu",static_cast(chi)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(chi))); return TCL_OK; } else { - interp->result = "No such structure exists"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("No such structure exists", -1)); return TCL_ERROR; } } @@ -2794,7 +2755,7 @@ return TCL_ERROR; } - sprintf(interp->result,"%lu",static_cast(G->StableSet())); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->StableSet()))); return TCL_OK; } @@ -2806,7 +2767,7 @@ return TCL_ERROR; } - sprintf(interp->result,"%lu",static_cast(G->Clique())); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->Clique()))); return TCL_OK; } @@ -2818,7 +2779,7 @@ return TCL_ERROR; } - sprintf(interp->result,"%lu",static_cast(G->VertexCover())); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->VertexCover()))); return TCL_OK; } @@ -2830,13 +2791,13 @@ return TCL_ERROR; } - sprintf(interp->result,"%d",G->EulerianCycle()); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->EulerianCycle())); return TCL_OK; } if (strcmp(argv[1],"feedbackArcSet")==0) { - sprintf(interp->result,"%f",G->FeedbackArcSet()); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->FeedbackArcSet())); return TCL_OK; } @@ -2855,12 +2816,12 @@ if (ret!=InfFloat) { - sprintf(interp->result,"%f",ret); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(ret)); return TCL_OK; } else { - interp->result = "Graph is non-Hamiltonian"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Graph is non-Hamiltonian", -1)); return TCL_ERROR; } } @@ -2892,12 +2853,12 @@ if (ret!=InfFloat) { - sprintf(interp->result,"%f",ret); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(ret)); return TCL_OK; } else { - interp->result = "Graph is disconnected"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Graph is disconnected", -1)); return TCL_ERROR; } } @@ -2917,12 +2878,12 @@ if (ret!=InfFloat) { - sprintf(interp->result,"%f",ret); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(ret)); return TCL_OK; } else { - interp->result = "Terminal nodes are disconnected"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Terminal nodes are disconnected", -1)); return TCL_ERROR; } } @@ -2949,12 +2910,11 @@ { if (G->AdmissibleBFlow()) { - interp->result = ""; return TCL_OK; } else { - interp->result = "No such structure exists"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("No such structure exists", -1)); return TCL_ERROR; } } @@ -2964,12 +2924,12 @@ try { - sprintf(interp->result,"%f",flowValue); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(flowValue)); return TCL_OK; } catch (ERCheck) { - sprintf(interp->result,"Flow is corrupted"); + Tcl_SetObjResult(interp, Tcl_NewStringObj("FLow is corrupted", -1)); return TCL_ERROR; } } @@ -2978,12 +2938,12 @@ try { TFloat ret = G->MinCostBFlow(); - sprintf(interp->result,"%f",ret); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(ret)); return TCL_OK; } catch (ERRejected) { - interp->result = "No such structure exists"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("No such structure exists", -1)); return TCL_ERROR; } } @@ -2992,12 +2952,12 @@ try { TFloat ret = G -> MinCostSTFlow(sourceNode,targetNode); - sprintf(interp->result,"%f",ret); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(ret)); return TCL_OK; } catch (ERCheck) { - interp->result = "Flow is corrupted"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Flow is corrupted", -1)); return TCL_ERROR; } } @@ -3013,7 +2973,7 @@ } G -> ChinesePostman(adjustUCap); - sprintf(interp->result,"%f",G->Weight()); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->Weight())); return TCL_OK; } @@ -3034,7 +2994,7 @@ targetNode = atol(argv[pos+1]); } - sprintf(interp->result,"%f",G->MaxCut(sourceNode,targetNode)); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->MaxCut(sourceNode,targetNode))); G -> InitSubgraph(); @@ -3068,40 +3028,44 @@ if (G->MaxDemand()!=InfCap) { if (G->MaxDemand()!=(long int)(G->MaxDemand())) - sprintf(interp->result,"%f",G->MaxDemand()); - else sprintf(interp->result,"%ld",(long int)G->MaxDemand()); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->MaxDemand())); + else + Tcl_SetObjResult(interp, Tcl_NewLongObj(G->MaxDemand())); } - else interp->result = "*"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); } else if (strcmp(argv[2],"-lowerBound")==0) { if (G->MaxLCap()!=(long int)(G->MaxLCap())) - sprintf(interp->result,"%f",G->MaxLCap()); - else sprintf(interp->result,"%ld",(long int)G->MaxLCap()); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->MaxLCap())); + else + Tcl_SetObjResult(interp, Tcl_NewLongObj(G->MaxLCap())); } else if (strcmp(argv[2],"-upperBound")==0) { if (G->MaxUCap()!=InfCap) { if (G->MaxUCap()!=(long int)(G->MaxUCap())) - sprintf(interp->result,"%f",G->MaxUCap()); - else sprintf(interp->result,"%ld",(long int)G->MaxUCap()); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->MaxUCap())); + else + Tcl_SetObjResult(interp, Tcl_NewLongObj(G->MaxUCap())); } - else interp->result = "*"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); } else if (strcmp(argv[2],"-edgeLength")==0) { if (G->MaxLength()!=InfFloat) { if (G->MaxLength()!=(long int)(G->MaxLength())) - sprintf(interp->result,"%f",G->MaxLength()); - else sprintf(interp->result,"%ld",(long int)G->MaxLength()); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->MaxLength())); + else + Tcl_SetObjResult(interp, Tcl_NewLongObj(G->MaxLength())); } - else interp->result = "*"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); } else { - sprintf(interp->result,"Unknown graph attribute: %s",argv[2]); + Tcl_AppendResult(interp, "Unknown graph attribute: ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -3119,23 +3083,23 @@ if (strcmp(argv[2],"-nodeDemand")==0) { - sprintf(interp->result,"%d",G->CDemand()); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->CDemand())); } else if (strcmp(argv[2],"-lowerBound")==0) { - sprintf(interp->result,"%d",G->CLCap()); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->CLCap())); } else if (strcmp(argv[2],"-upperBound")==0) { - sprintf(interp->result,"%d",G->CUCap()); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->CUCap())); } else if (strcmp(argv[2],"-edgeLength")==0) { - sprintf(interp->result,"%d",G->CLength()); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->CLength())); } else { - sprintf(interp->result,"Unknown graph attribute: %s",argv[2]); + Tcl_AppendResult(interp, "Unknown graph attribute: ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -3219,7 +3183,7 @@ } else { - sprintf(interp->result,"Unknown metric type: %s",argv[i+1]); + Tcl_AppendResult(interp, "Unknown metric type: ", argv[i+1], (char *)NULL); return TCL_ERROR; } @@ -3229,17 +3193,15 @@ { TArc a = (strcmp(argv[i+1],"*")!=0) ? TArc(atol(argv[i+1])) : NoArc; G -> MarkExteriorFace(a); - interp->result = ""; return GOSH_OK; } else { - sprintf(interp->result,"Unknown graph attribute: %s",argv[i]); + Tcl_AppendResult(interp, "Unknown graph attribute: ", argv[i], (char *)NULL); return TCL_ERROR; } } - interp->result = ""; return TCL_OK; } @@ -3248,7 +3210,7 @@ { if (argc!=4) { - interp->result = "Missing end nodes"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing end nodes", -1)); return TCL_ERROR; } @@ -3256,8 +3218,8 @@ TNode v = (TArc)atol(argv[3]); TArc a = G->Adjacency(u,v); - if (a==NoArc) interp->result = "*"; - else sprintf(interp->result,"%lu",static_cast(a)); + if (a==NoArc) Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); + else Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(a))); return TCL_OK; } @@ -3275,6 +3237,8 @@ int Goblin_Node_Cmd (abstractMixedGraph *G,Tcl_Interp* interp,int argc, _CONST_QUAL_ char* argv[]) throw(ERRejected,ERRange) { + Tcl_ResetResult(interp); + if (argc<3) { WrongNumberOfArguments(interp,argc,argv); @@ -3289,7 +3253,7 @@ return TCL_ERROR; } - sprintf(interp->result,"%lu",static_cast(G->InsertNode())); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->InsertNode()))); return TCL_OK; } @@ -3304,7 +3268,6 @@ if (strcmp(argv[3],"delete")==0) { G->DeleteNode(v); - interp->result = ""; return TCL_OK; } @@ -3313,62 +3276,58 @@ if (strcmp(argv[4],"-firstIncidence")==0) { if (G->First(v)!=NoArc) - { - sprintf(interp->result,"%lu",static_cast(G->First(v))); - } - else interp->result = "*"; + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->First(v)))); + else + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); } else if (strcmp(argv[4],"-nodeDemand")==0) { - sprintf(interp->result,"%g",static_cast(G->Demand(v))); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(static_cast(G->Demand(v)))); } else if (strcmp(argv[4],"-cx")==0) { - sprintf(interp->result,"%f",static_cast(G->C(v,0))); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(static_cast(G->C(v,0)))); } else if (strcmp(argv[4],"-cy")==0) { - sprintf(interp->result,"%f",static_cast(G->C(v,1))); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(static_cast(G->C(v,1)))); } else if (strcmp(argv[4],"-distance")==0) { if (G->Dist(v)!=InfFloat) - { - sprintf(interp->result,"%g",static_cast(G->Dist(v))); - } - else interp->result = "*"; + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(static_cast(G->Dist(v)))); + else + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); } else if (strcmp(argv[4],"-potential")==0) { - sprintf(interp->result,"%g",static_cast(G->Pi(v))); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(static_cast(G->Pi(v)))); } else if (strcmp(argv[4],"-nodeColour")==0) { if (G->NodeColour(v)!=NoNode) - { - sprintf(interp->result,"%lu",static_cast(G->NodeColour(v))); - } - else interp->result = "*"; + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->NodeColour(v)))); + else + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); } else if (strcmp(argv[4],"-predecessorArc")==0) { if (G->Pred(v)!=NoArc) - { - sprintf(interp->result,"%lu",static_cast(G->Pred(v))); - } - else interp->result = "*"; + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->Pred(v)))); + else + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); } else if (strcmp(argv[4],"-degree")==0) { - sprintf(interp->result,"%g",G->Deg(v)); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->Deg(v))); } else if (strcmp(argv[4],"-hidden")==0) { - sprintf(interp->result,"%d",G->HiddenNode(v)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->HiddenNode(v))); } else { - sprintf(interp->result,"Unknown node attribute: %s",argv[4]); + Tcl_AppendResult(interp, "Unknown node attribute: ", argv[4], (char *)NULL); return TCL_ERROR; } @@ -3383,7 +3342,7 @@ { if (!G->IsSparse()) { - interp->result = "Operation applies to sparse graphs only"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Operation applies to sparse graphs only", -1)); return TCL_ERROR; } @@ -3422,16 +3381,15 @@ } else { - sprintf(interp->result,"Unknown node attribute: %s",argv[i]); + Tcl_AppendResult(interp, "Unknown node attribute: ", argv[i], (char *)NULL); return TCL_ERROR; } } - interp->result = ""; return TCL_OK; } - sprintf(interp->result,"Unknown option: %s node %s",argv[0],argv[2]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " node ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -3449,14 +3407,14 @@ { if (argc!=5) { - interp->result = "Missing end nodes"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing end nodes", -1)); return TCL_ERROR; } TNode u = TArc(atol(argv[3])); TNode v = TArc(atol(argv[4])); - sprintf(interp->result,"%lu",static_cast(G->InsertArc(u,v))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->InsertArc(u,v)))); return TCL_OK; } @@ -3466,12 +3424,11 @@ { if (!G->IsSparse()) { - interp->result = "Operation applies to sparse graphs only"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Operation applies to sparse graphs only", -1)); return TCL_ERROR; } static_cast(G->Representation()) -> DeleteArc(a); - interp->result = ""; return TCL_OK; } @@ -3479,12 +3436,11 @@ { if (!G->IsSparse()) { - interp->result = "Operation applies to sparse graphs only"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Operation applies to sparse graphs only", -1)); return TCL_ERROR; } static_cast(G->Representation()) -> ContractArc(a); - interp->result = ""; return TCL_OK; } @@ -3492,12 +3448,11 @@ { if (!G->IsSparse()) { - interp->result = "Operation applies to sparse graphs only"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Operation applies to sparse graphs only", -1)); return TCL_ERROR; } static_cast(G->Representation()) -> ReleaseEdgeControlPoints(a); - interp->result = ""; return TCL_OK; } @@ -3505,12 +3460,11 @@ { if (!G->IsSparse()) { - interp->result = "Operation applies to sparse graphs only"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Operation applies to sparse graphs only", -1)); return TCL_ERROR; } static_cast(G->Representation()) -> FlipArc(a); - interp->result = ""; return TCL_OK; } @@ -3518,75 +3472,70 @@ { if (strcmp(argv[4],"-righthandArc")==0) { - sprintf(interp->result,"%lu",static_cast(G->Right(a,G->StartNode(a)))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->Right(a,G->StartNode(a))))); } else if (strcmp(argv[4],"-endNode")==0) { - sprintf(interp->result,"%lu",static_cast(G->EndNode(a))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->EndNode(a)))); } else if (strcmp(argv[4],"-startNode")==0) { - sprintf(interp->result,"%lu",static_cast(G->StartNode(a))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->StartNode(a)))); } else if (strcmp(argv[4],"-directed")==0) { - sprintf(interp->result,"%d",G->Orientation(a)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->Orientation(a))); } else if (strcmp(argv[4],"-upperBound")==0) { if (G->UCap(a)!=InfCap) - { - sprintf(interp->result,"%g",static_cast(G->UCap(a))); - } - else sprintf(interp->result,"*"); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->UCap(a))); + else + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); } else if (strcmp(argv[4],"-lowerBound")==0) { - sprintf(interp->result,"%g",static_cast(G->LCap(a))); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(static_cast(G->LCap(a)))); } else if (strcmp(argv[4],"-edgeLength")==0) { if (G->Length(a)!=InfFloat) - { - sprintf(interp->result,"%g",static_cast(G->Length(a))); - } - else interp->result = "*"; + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->Length(a))); + else + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); } else if (strcmp(argv[4],"-edgeColour")==0) { if (G->EdgeColour(a)!=NoArc) - { - sprintf(interp->result,"%lu",static_cast(G->EdgeColour(a))); - } - else interp->result = "*"; + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->EdgeColour(a)))); + else + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); } else if (strcmp(argv[4],"-subgraph")==0) { - sprintf(interp->result,"%g",static_cast(G->Sub(a))); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(G->Sub(a))); } else if (strcmp(argv[4],"-labelAnchorPoint")==0) { if (G->ArcLabelAnchor(a)!=NoNode) - { - sprintf(interp->result,"%lu",static_cast(G->ArcLabelAnchor(a))); - } - else interp->result = "*"; + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->ArcLabelAnchor(a)))); + else + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); } else if (strcmp(argv[4],"-portNode")==0) { if (G->PortNode(a)!=NoNode) - { - sprintf(interp->result,"%lu",static_cast(G->PortNode(a))); - } - else interp->result = "*"; + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(G->PortNode(a)))); + else + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); } else if (strcmp(argv[4],"-hidden")==0) { - sprintf(interp->result,"%d",G->HiddenArc(a)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(G->HiddenArc(a))); } else { - sprintf(interp->result,"Unknown node attribute: %s",argv[4]); + Tcl_AppendResult(interp, "Unknown node attribute: ", argv[4], (char *)NULL); return TCL_ERROR; } @@ -3619,7 +3568,7 @@ { if (!G->IsSparse()) { - interp->result = "Operation applies to sparse graphs only"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Operation applies to sparse graphs only", -1)); return TCL_ERROR; } @@ -3644,12 +3593,11 @@ } else { - sprintf(interp->result,"Unknown arc attribute: %s",argv[i]); + Tcl_AppendResult(interp, "Unknown arc attribute: ", argv[i], (char *)NULL); return TCL_ERROR; } } - interp->result = ""; return TCL_OK; } @@ -3663,7 +3611,7 @@ if (!G->IsSparse()) { - interp->result = "Operation applies to sparse graphs only"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Operation applies to sparse graphs only", -1)); return TCL_ERROR; } @@ -3671,20 +3619,20 @@ if (strcmp(argv[4],"-labelAnchorPoint")==0) { - sprintf(interp->result,"%lu",static_cast(GR->ProvideArcLabelAnchor(a))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(GR->ProvideArcLabelAnchor(a)))); return TCL_OK; } if (strcmp(argv[4],"-portNode")==0) { - sprintf(interp->result,"%lu",static_cast(GR->ProvidePortNode(a))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(GR->ProvidePortNode(a)))); return TCL_OK; } - sprintf(interp->result,"Unknown layout point type: %s",argv[4]); + Tcl_AppendResult(interp, "Unknown layout point type: ", argv[4], (char *)NULL); return TCL_ERROR; } - sprintf(interp->result,"Unknown option: %s arc %s",argv[0],argv[2]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " arc ", argv[2], (char *)NULL); return TCL_ERROR; } --- shell_src/goshLin.cpp.orig 2013-06-04 16:26:29.000000000 +0200 +++ shell_src/goshLin.cpp 2013-06-04 16:49:40.000000000 +0200 @@ -16,6 +16,8 @@ int Goblin_Ilp_Cmd (ClientData clientData,Tcl_Interp* interp, int argc,_CONST_QUAL_ char* argv[]) { + Tcl_ResetResult(interp); + mipInstance* XLP = reinterpret_cast(clientData); if (setjmp(goblinThreadData[Goblin_MyThreadIndex()].jumpBuffer) != 0) @@ -27,14 +29,12 @@ if (argc==2 && strcmp(argv[1],"delete")==0) { Tcl_DeleteCommand(interp,argv[0]); - interp->result = ""; return TCL_OK; } if (argc==2 && strcmp(argv[1],"reset")==0) { XLP -> ResetBasis(); - interp->result = ""; return TCL_OK; } @@ -59,7 +59,6 @@ XLP -> Write(argv[argc-1],f); - interp->result = ""; return TCL_OK; } @@ -74,7 +73,6 @@ if (strcmp(argv[2],"bas")==0 || strcmp(argv[2],"basis")==0) { XLP -> ReadBASFile(argv[3]); - interp->result = ""; return TCL_OK; } @@ -82,17 +80,15 @@ { if (XLP->K()>0 || XLP->L()>0) { - interp->result = "Instance must be initial"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Instance must be initial", -1)); return TCL_ERROR; } XLP -> ReadMPSFile(argv[3]); - interp->result = ""; return TCL_OK; } - sprintf(interp->result,"Unknown option: %s read %s", - argv[0],argv[2]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " read ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -104,7 +100,7 @@ return TCL_ERROR; } - sprintf(interp->result,"%lu",static_cast(XLP->K())); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(XLP->K()))); return TCL_OK; } @@ -116,7 +112,7 @@ return TCL_ERROR; } - sprintf(interp->result,"%lu",static_cast(XLP->L())); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(XLP->L()))); return TCL_OK; } @@ -130,7 +126,7 @@ if (strcmp(argv[2],"-mipObject")==0) { - interp->result = "1"; + Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); return TCL_OK; } @@ -149,8 +145,9 @@ mipFactory *theMipFactory = (mipFactory*)CT->pMipFactory; if (theMipFactory->Orientation()==mipFactory::ROW_ORIENTED) - interp->result = "row"; - else interp->result = "column"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("row", -1)); + else + Tcl_SetObjResult(interp, Tcl_NewStringObj("column", -1)); return TCL_OK; } @@ -164,10 +161,11 @@ } if (XLP->ObjectSense()==managedObject::MAXIMIZE) - interp->result = "maximize"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("maximize", -1)); else if (XLP->ObjectSense()==managedObject::MINIMIZE) - interp->result = "minimize"; - else interp->result = "flat"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("minimize", -1)); + else + Tcl_SetObjResult(interp, Tcl_NewStringObj("flat", -1)); return TCL_OK; } @@ -181,7 +179,6 @@ } XLP -> SetObjectSense(managedObject::MAXIMIZE); - interp->result = ""; return TCL_OK; } @@ -194,7 +191,6 @@ } XLP -> SetObjectSense(managedObject::MINIMIZE); - interp->result = ""; return TCL_OK; } @@ -207,7 +203,6 @@ } XLP -> FlipObjectSense(); - interp->result = ""; return TCL_OK; } @@ -220,7 +215,6 @@ } XLP -> SetObjectSense(managedObject::NO_OBJECTIVE); - interp->result = ""; return TCL_OK; } @@ -233,7 +227,6 @@ } XLP -> Strip(); - interp->result = ""; return TCL_OK; } @@ -249,7 +242,6 @@ TIndex l = TIndex(atol(argv[3])); TIndex nz = TIndex(atol(argv[4])); XLP -> Resize(k,l,nz); - interp->result = ""; return TCL_OK; } @@ -263,7 +255,7 @@ TIndex i = TIndex(atol(argv[2])); TIndex j = TIndex(atol(argv[3])); - sprintf(interp->result,"%g", XLP -> Coeff(i,j)); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(XLP -> Coeff(i,j))); return TCL_OK; } @@ -285,11 +277,11 @@ TIndex j = TIndex(atol(argv[3])); TIndex i = TIndex(atol(argv[4])); - sprintf(interp->result,"%g", XLP->Tableau(j,i)); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(XLP->Tableau(j,i))); return TCL_OK; } - sprintf(interp->result,"Unknown option: %s tableau %s",argv[0],argv[2]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " tableau ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -311,11 +303,11 @@ TIndex i = TIndex(atol(argv[3])); TIndex j = TIndex(atol(argv[4])); - sprintf(interp->result,"%g", XLP->BaseInverse(i,j)); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(XLP->BaseInverse(i,j))); return TCL_OK; } - sprintf(interp->result,"Unknown option: %s inverse %s",argv[0],argv[2]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " inverse ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -329,17 +321,17 @@ if (strcmp(argv[2],"primal")==0) { - sprintf(interp->result,"%d",XLP->PrimalFeasible()); + Tcl_SetObjResult(interp, Tcl_NewIntObj(XLP->PrimalFeasible())); return TCL_OK; } if (strcmp(argv[2],"dual")==0) { - sprintf(interp->result,"%d",XLP->DualFeasible()); + Tcl_SetObjResult(interp, Tcl_NewIntObj(XLP->DualFeasible())); return TCL_OK; } - sprintf(interp->result,"Unknown option: %s feasible %s",argv[0],argv[2]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " feasible ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -357,7 +349,6 @@ TIndex j = TIndex(atol(argv[4])); TFloat a = TFloat(atof(argv[5])); XLP -> SetCoeff(i,j,a); - interp->result = ""; return TCL_OK; } @@ -376,7 +367,6 @@ XLP -> SetIndex(i,j,mipInstance::UPPER); else XLP -> SetIndex(i,j,mipInstance::LOWER); - interp->result = ""; return TCL_OK; } } @@ -387,8 +377,10 @@ { TRestr i = XLP-> PivotRow(); - if (i==NoRestr) interp->result = "*"; - else sprintf(interp->result,"%ld",i); + if (i==NoRestr) + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); + else + Tcl_SetObjResult(interp, Tcl_NewLongObj(i)); return TCL_OK; } @@ -398,12 +390,12 @@ TRestr i = XLP-> PivotRow(); mipInstance::TLowerUpper tp = XLP-> PivotDirection(); - if (i==NoRestr) interp->result = ""; - else + if (i!=NoRestr) { if (tp==mipInstance::LOWER) - interp->result = "lower"; - else interp->result = "upper"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("lower", -1)); + else + Tcl_SetObjResult(interp, Tcl_NewStringObj("upper", -1)); } return TCL_OK; @@ -413,8 +405,10 @@ { TVar i =XLP-> PivotColumn(); - if (i==NoVar) interp->result = "*"; - else sprintf(interp->result,"%ld",i); + if (i==NoVar) + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); + else + Tcl_SetObjResult(interp, Tcl_NewLongObj(i)); return TCL_OK; } @@ -433,7 +427,6 @@ if (strcmp(argv[4],"lower")==0) tp = mipInstance::LOWER; XLP -> Pivot(i,j,tp); - interp->result = ""; return TCL_OK; } @@ -441,7 +434,7 @@ { if (argc==2 || strcmp(argv[2],"primal")==0) { - sprintf(interp->result,"%g", XLP->ObjVal()); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(XLP->ObjVal())); return TCL_OK; } @@ -453,11 +446,11 @@ if (strcmp(argv[2],"dual")==0) { - interp->result = "Not implemented yet"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Not implemented yet", -1)); return TCL_OK; } - sprintf(interp->result,"Unknown option: %s objective %s",argv[0],argv[2]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " objective ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -472,32 +465,28 @@ if (strcmp(argv[2],"lp")==0) { XLP -> SolveLP(); - interp->result = ""; return TCL_OK; } if (strcmp(argv[2],"primal")==0) { XLP -> SolvePrimal(); - interp->result = ""; return TCL_OK; } if (strcmp(argv[2],"dual")==0) { XLP -> SolveDual(); - interp->result = ""; return TCL_OK; } if (strcmp(argv[2],"mixed")==0 || strcmp(argv[2],"mip")==0) { XLP -> SolveMIP(); - interp->result = ""; return TCL_OK; } - sprintf(interp->result,"Unknown option: %s solve %s",argv[0],argv[2]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " solve ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -512,18 +501,16 @@ if (strcmp(argv[2],"primal")==0) { XLP -> StartPrimal(); - interp->result = ""; return TCL_OK; } if (strcmp(argv[2],"dual")==0) { XLP -> StartDual(); - interp->result = ""; return TCL_OK; } - sprintf(interp->result,"Unknown option: %s start %s",argv[0],argv[2]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " start ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -541,7 +528,6 @@ Goblin_Ilp_Cmd,reinterpret_cast(YLP), (Tcl_CmdDeleteProc *)Goblin_Delete_Ilp); - interp->result = ""; return TCL_OK; } @@ -559,7 +545,6 @@ Goblin_Ilp_Cmd,reinterpret_cast(YLP), (Tcl_CmdDeleteProc *)Goblin_Delete_Ilp); - interp->result = ""; return TCL_OK; } @@ -577,7 +562,6 @@ Goblin_Ilp_Cmd,reinterpret_cast(YLP), (Tcl_CmdDeleteProc *)Goblin_Delete_Ilp); - interp->result = ""; return TCL_OK; } @@ -618,7 +602,7 @@ TFloat l = TFloat(atof(argv[3])); TFloat u = TFloat(atof(argv[4])); - sprintf(interp->result,"%ld",XLP->AddRestr(l,u)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(XLP->AddRestr(l,u))); return TCL_OK; } @@ -632,8 +616,10 @@ TRestr i = XLP->RestrIndex((char*)argv[3]); - if (i==NoRestr) interp->result = "*"; - else sprintf(interp->result,"%ld",i); + if (i==NoRestr) + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); + else + Tcl_SetObjResult(interp, Tcl_NewLongObj(i)); return TCL_OK; } @@ -643,51 +629,55 @@ if (strcmp(argv[3],"cancel")==0) { XLP -> DeleteRestr(i); - interp->result = ""; return TCL_OK; } if (strcmp(argv[3],"ubound")==0) { - if (XLP->UBound(i)==InfFloat) sprintf(interp->result,"*"); - else sprintf(interp->result,"%g",XLP->UBound(i)); + if (XLP->UBound(i)==InfFloat) + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); + else + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(XLP->UBound(i))); return TCL_OK; } if (strcmp(argv[3],"lbound")==0) { - if (XLP->LBound(i)==-InfFloat) sprintf(interp->result,"*"); - else sprintf(interp->result,"%g",XLP->LBound(i)); + if (XLP->LBound(i)==-InfFloat) + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); + else + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(XLP->LBound(i))); return TCL_OK; } if (strcmp(argv[3],"label")==0) { - sprintf(interp->result,"%s", - XLP->RestrLabel(i,managedObject::OWNED_BY_RECEIVER)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(XLP->RestrLabel(i,managedObject::OWNED_BY_RECEIVER), -1)); return TCL_OK; } if (strcmp(argv[3],"type")==0) { if (XLP->RestrType(i)==mipInstance::NON_BASIC) - interp->result = "non_basic"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("non_basic", -1)); if (XLP->RestrType(i)==mipInstance::BASIC_UB) - interp->result = "upper"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("upper", -1)); if (XLP->RestrType(i)==mipInstance::BASIC_LB) - interp->result = "lower"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("lower", -1)); if (XLP->RestrType(i)==mipInstance::RESTR_CANCELED) - interp->result = "canceled"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("canceled", -1)); return TCL_OK; } if (strcmp(argv[3],"index")==0) { - if (XLP->RevIndex(i)==NoIndex) sprintf(interp->result,"*"); - else sprintf(interp->result,"%ld",XLP->RevIndex(i)); + if (XLP->RevIndex(i)==NoIndex) + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); + else + Tcl_SetObjResult(interp, Tcl_NewLongObj(XLP->RevIndex(i))); return TCL_OK; } @@ -702,18 +692,25 @@ if (strcmp(argv[4],"lower")==0) { - sprintf(interp->result,"%g",XLP->Y(i,mipInstance::LOWER)); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(XLP->Y(i,mipInstance::LOWER))); return TCL_OK; } if (strcmp(argv[4],"upper")==0) { - sprintf(interp->result,"%g",XLP->Y(i,mipInstance::UPPER)); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(XLP->Y(i,mipInstance::UPPER))); return TCL_OK; } +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 5) + Tcl_Obj *resObj = Tcl_NewObj(); + Tcl_AppendPrintfToObj(resObj, "Unknown option: %s row %ld value %s", + argv[0],i,argv[4]); + Tcl_SetObjResult(interp, resObj); +#else sprintf(interp->result,"Unknown option: %s row %ld value %s", argv[0],i,argv[4]); +#endif return TCL_ERROR; } @@ -727,18 +724,25 @@ if (strcmp(argv[4],"lower")==0) { - sprintf(interp->result,"%g",XLP->Slack(i,mipInstance::LOWER)); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(XLP->Slack(i,mipInstance::LOWER))); return TCL_OK; } if (strcmp(argv[4],"upper")==0) { - sprintf(interp->result,"%g",XLP->Slack(i,mipInstance::UPPER)); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(XLP->Slack(i,mipInstance::UPPER))); return TCL_OK; } +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 5) + Tcl_Obj *resObj = Tcl_NewObj(); + Tcl_AppendPrintfToObj(resObj, "Unknown option: %s rebound %ld value %s", + argv[0],i,argv[4]); + Tcl_SetObjResult(interp, resObj); +#else sprintf(interp->result,"Unknown option: %s redbound %ld value %s", argv[0],i,argv[4]); +#endif return TCL_ERROR; } @@ -757,7 +761,6 @@ if (strcmp(argv[5],"*")!=0) uu = TFloat(atof(argv[5])); XLP -> SetUBound(i,uu); - interp->result = ""; return TCL_OK; } @@ -768,22 +771,20 @@ if (strcmp(argv[5],"*")!=0) ll = TFloat(atof(argv[5])); XLP -> SetLBound(i,ll); - interp->result = ""; return TCL_OK; } if (strcmp(argv[4],"label")==0) { XLP -> SetRestrLabel(i,(char*)argv[5],managedObject::OWNED_BY_SENDER); - interp->result = ""; return TCL_OK; } - sprintf(interp->result,"Unknown option: %s row %s set %s",argv[0],argv[2],argv[4]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " row ", argv[2], " set ", argv[4], (char *)NULL); return TCL_ERROR; } - sprintf(interp->result,"Unknown option: %s row %s",argv[0],argv[2]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " row ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -815,12 +816,12 @@ { if (strcmp(argv[3],"float")!=0) { - interp->result = "Unknown variable type"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown variable type", -1)); return TCL_ERROR; } } - sprintf(interp->result,"%ld",XLP->AddVar(l,u,tp)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(XLP->AddVar(l,u,tp))); return TCL_OK; } @@ -834,8 +835,10 @@ TVar i = XLP->VarIndex((char*)argv[3]); - if (i==NoVar) interp->result = "*"; - else sprintf(interp->result,"%ld",i); + if (i==NoVar) + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); + else + Tcl_SetObjResult(interp, Tcl_NewLongObj(i)); return TCL_OK; } @@ -845,14 +848,15 @@ if (strcmp(argv[3],"cancel")==0) { XLP -> DeleteVar(i); - interp->result = ""; return TCL_OK; } if (strcmp(argv[3],"urange")==0) { - if (XLP->URange(i)==InfFloat) sprintf(interp->result,"*"); - else sprintf(interp->result,"%g",XLP->URange(i)); + if (XLP->URange(i)==InfFloat) + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); + else + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(XLP->URange(i))); return TCL_OK; } @@ -860,46 +864,47 @@ if (strcmp(argv[3],"lrange")==0) { - if (XLP->LRange(i)==-InfFloat) sprintf(interp->result,"*"); - else sprintf(interp->result,"%g",XLP->LRange(i)); + if (XLP->LRange(i)==-InfFloat) + Tcl_SetObjResult(interp, Tcl_NewStringObj("*", -1)); + else + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(XLP->LRange(i))); return TCL_OK; } if (strcmp(argv[3],"cost")==0) { - sprintf(interp->result,"%g",XLP->Cost(i)); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(XLP->Cost(i))); return TCL_OK; } if (strcmp(argv[3],"type")==0) { if (XLP->VarType(i)==mipInstance::VAR_INT) - interp->result = "integer"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("integer", -1)); if (XLP->VarType(i)==mipInstance::VAR_FLOAT) - interp->result = "float"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("float", -1)); if (XLP->VarType(i)==mipInstance::VAR_CANCELED) - interp->result = "canceled"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("canceled", -1)); return TCL_OK; } if (strcmp(argv[3],"label")==0) { - sprintf(interp->result,"%s", - XLP->VarLabel(i,managedObject::OWNED_BY_RECEIVER)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(XLP->VarLabel(i,managedObject::OWNED_BY_RECEIVER), -1)); return TCL_OK; } if (strcmp(argv[3],"index")==0) { - sprintf(interp->result,"%ld",XLP->Index(i)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(XLP->Index(i))); return TCL_OK; } if (strcmp(argv[3],"value")==0) { - sprintf(interp->result,"%g",XLP->X(i)); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(XLP->X(i))); return TCL_OK; } @@ -908,18 +913,16 @@ if (strcmp(argv[4],"int")==0 || strcmp(argv[4],"integer")==0) { XLP -> SetVarType(i,mipInstance::VAR_INT); - interp->result = ""; return TCL_OK; } if (strcmp(argv[4],"float")==0) { XLP -> SetVarType(i,mipInstance::VAR_FLOAT); - interp->result = ""; return TCL_OK; } - sprintf(interp->result,"Unknown option: %s variable %s mark %s",argv[0],argv[2],argv[4]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " variable ", argv[2], " mark ", argv[4], (char *)NULL); return TCL_ERROR; } @@ -938,7 +941,6 @@ if (strcmp(argv[5],"*")!=0) uu = TFloat(atof(argv[5])); XLP -> SetURange(i,uu); - interp->result = ""; return TCL_OK; } @@ -947,7 +949,6 @@ TFloat ll = -InfFloat; if (strcmp(argv[5],"*")!=0) ll = TFloat(atof(argv[5])); XLP -> SetLRange(i,ll); - interp->result = ""; return TCL_OK; } @@ -955,22 +956,20 @@ { TFloat cc = TFloat(atof(argv[5])); XLP -> SetCost(i,cc); - interp->result = ""; return TCL_OK; } if (strcmp(argv[4],"label")==0) { XLP -> SetVarLabel(i,(char*)argv[5],managedObject::OWNED_BY_SENDER); - interp->result = ""; return TCL_OK; } - sprintf(interp->result,"Unknown option: %s variable %s set %s",argv[0],argv[2],argv[4]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " variable ", argv[2], " set ", argv[4], (char *)NULL); return TCL_ERROR; } - sprintf(interp->result,"Unknown option: %s variable %s",argv[0],argv[2]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " variable ", argv[2], (char *)NULL); return TCL_ERROR; } --- shell_src/goshMain.cpp.orig 2013-06-04 17:06:23.000000000 +0200 +++ shell_src/goshMain.cpp 2013-06-04 17:26:19.000000000 +0200 @@ -298,7 +298,7 @@ if (Tcl_EvalFile(interp2,(char*)scriptName)==TCL_ERROR) { - sprintf(CT->logBuffer,"...Thread exit status: %s",interp2->result); + sprintf(CT->logBuffer,"...Thread exit status: %s",Tcl_GetStringResult(interp2)); CT -> LogEntry(LOG_IO,NoHandle,CT->logBuffer); } @@ -337,6 +337,8 @@ int Goblin_Cmd (ClientData clientData,Tcl_Interp* interp,int argc, _CONST_QUAL_ char* argv[]) { + Tcl_ResetResult(interp); + if (argc<2) { WrongNumberOfArguments(interp,argc,argv); @@ -366,7 +368,6 @@ Goblin_Mixed_Graph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Mixed_Graph); - interp->result = ""; return TCL_OK; } @@ -384,7 +385,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -410,7 +410,6 @@ Goblin_Sparse_Bigraph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Bigraph); - interp->result = ""; return TCL_OK; } @@ -428,7 +427,6 @@ Goblin_Sparse_Digraph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Digraph); - interp->result = ""; return TCL_OK; } @@ -446,7 +444,6 @@ Goblin_Dense_Graph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Dense_Graph); - interp->result = ""; return TCL_OK; } @@ -470,7 +467,6 @@ Goblin_Dense_Bigraph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Dense_Bigraph); - interp->result = ""; return TCL_OK; } @@ -488,7 +484,6 @@ Goblin_Dense_Digraph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Dense_Digraph); - interp->result = ""; return TCL_OK; } @@ -539,7 +534,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -589,7 +583,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -676,7 +669,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -739,7 +731,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -755,7 +746,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -773,7 +763,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -795,7 +784,6 @@ Goblin_Sparse_Digraph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Digraph); - interp->result = ""; return TCL_OK; } @@ -818,7 +806,6 @@ Goblin_Sparse_Digraph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Digraph); - interp->result = ""; return TCL_OK; } @@ -836,7 +823,6 @@ Goblin_Sparse_Digraph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Digraph); - interp->result = ""; return TCL_OK; } @@ -851,7 +837,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -866,7 +851,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -881,7 +865,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -921,7 +904,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -937,7 +919,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -962,7 +943,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -980,7 +960,6 @@ Goblin_Sparse_Graph_Cmd,reinterpret_cast(G), (Tcl_CmdDeleteProc *)Goblin_Delete_Sparse_Graph); - interp->result = ""; return TCL_OK; } @@ -990,7 +969,7 @@ { if (goblinController::pMipFactory==NULL) { - interp->result = "No LP solver loaded"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("No LP solver loaded", -1)); return TCL_ERROR; } @@ -1016,7 +995,6 @@ Goblin_Ilp_Cmd,reinterpret_cast(XLP), (Tcl_CmdDeleteProc *)Goblin_Delete_Ilp); - interp->result = ""; return TCL_OK; } @@ -1054,7 +1032,7 @@ if (!X) { - interp->result = "Unknown format specification"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown format specification", -1)); return TCL_ERROR; } @@ -1141,7 +1119,6 @@ (Tcl_CmdDeleteProc *)Goblin_Delete_Mixed_Graph); } - interp->result = ""; return TCL_OK; } @@ -1162,13 +1139,12 @@ Tcl_CreateCommand(interp,const_cast(argv[2]), Goblin_Ilp_Cmd,reinterpret_cast(Y),NULL); - interp->result = ""; return TCL_OK; } if (!X->IsGraphObject()) { - sprintf(interp->result,"Not a graph object ID: %s",argv[3]); + Tcl_AppendResult(interp, "Not a graph object ID: ", argv[3], (char *)NULL); return TCL_ERROR; } @@ -1179,7 +1155,6 @@ Tcl_CreateCommand(interp,const_cast(argv[2]), Goblin_Mixed_Graph_Cmd,reinterpret_cast(Y),NULL); - interp->result = ""; return TCL_OK; } @@ -1190,7 +1165,6 @@ Tcl_CreateCommand(interp,const_cast(argv[2]), Goblin_Sparse_Graph_Cmd,reinterpret_cast(Y),NULL); - interp->result = ""; return TCL_OK; } @@ -1201,7 +1175,6 @@ Tcl_CreateCommand(interp,const_cast(argv[2]), Goblin_Dense_Graph_Cmd,reinterpret_cast(Y),NULL); - interp->result = ""; return TCL_OK; } @@ -1212,7 +1185,6 @@ Tcl_CreateCommand(interp,const_cast(argv[2]), Goblin_Sparse_Bigraph_Cmd,reinterpret_cast(Y),NULL); - interp->result = ""; return TCL_OK; } @@ -1223,7 +1195,6 @@ Tcl_CreateCommand(interp,const_cast(argv[2]), Goblin_Dense_Bigraph_Cmd,reinterpret_cast(Y),NULL); - interp->result = ""; return TCL_OK; } @@ -1234,7 +1205,6 @@ Tcl_CreateCommand(interp,const_cast(argv[2]), Goblin_Sparse_Digraph_Cmd,reinterpret_cast(Y),NULL); - interp->result = ""; return TCL_OK; } @@ -1245,7 +1215,6 @@ Tcl_CreateCommand(interp,const_cast(argv[2]), Goblin_Dense_Digraph_Cmd,reinterpret_cast(Y),NULL); - interp->result = ""; return TCL_OK; } @@ -1256,11 +1225,10 @@ Tcl_CreateCommand(interp,const_cast(argv[2]), Goblin_Balanced_FNW_Cmd,reinterpret_cast(Y),NULL); - interp->result = ""; return TCL_OK; } - interp->result = "Unknown object type"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown object type", -1)); return TCL_ERROR; } @@ -1293,7 +1261,7 @@ return TCL_OK; } - sprintf(interp->result,"Unknown option: goblin export %s",argv[2]); + Tcl_AppendResult(interp, "Unknown option: goblin export ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -1316,7 +1284,6 @@ else CT->LogEntry(MSG_ECHO,NoHandle,(char*)argv[2]); } - interp->result = ""; return TCL_OK; } @@ -1334,7 +1301,7 @@ if (threadIndex>=MAX_NUM_THREADS) { - interp->result = "No more thread handle available"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("No more thread handle available", -1)); return TCL_ERROR; } @@ -1344,7 +1311,6 @@ pthread_create(&goblinThreadData[threadIndex].threadID, NULL,Goblin_Thread,(void*)scriptName); - interp->result = ""; return TCL_OK; } @@ -1360,7 +1326,6 @@ sprintf(returnCode,"%s",argv[3]); errorCode = TCL_OK; - interp->result = ""; return TCL_OK; } @@ -1376,7 +1341,6 @@ sprintf(returnCode,"%s",argv[3]); errorCode = TCL_ERROR; - interp->result = ""; return TCL_OK; } @@ -1389,15 +1353,15 @@ if (strcmp(argv[2],"stop")==0) { MSG -> SolverSignalStop(); - interp->result = ""; return TCL_OK; } if (strcmp(argv[2],"idle")==0) { if (MSG->SolverIdle()) - interp->result = "1"; - else interp->result = "0"; + Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); + else + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); return TCL_OK; } @@ -1405,8 +1369,9 @@ if (strcmp(argv[2],"running")==0) { if (MSG->SolverRunning()) - interp->result = "1"; - else interp->result = "0"; + Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); + else + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); return TCL_OK; } @@ -1421,19 +1386,18 @@ { #if defined(_PROGRESS_) - sprintf(interp->result,"%g", - static_cast(CT->ProgressCounter())); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(static_cast(CT->ProgressCounter()))); #else - interp->result = "1.0"; + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(1.0)); #endif return TCL_OK; } - sprintf(interp->result,"Unknown option: goblin solver %s",argv[2]); + Tcl_AppendResult(interp, "Unknown option: goblin solver ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -1450,12 +1414,14 @@ try { unsigned long lineNumber = atol(argv[3]); - MSG->GetLineByNumber(transscriptName,interp->result, TCL_RESULT_SIZE,lineNumber); + const char *s = Tcl_GetStringResult(interp); + size_t slen = strlen(s); + MSG->GetLineByNumber(transscriptName,(char *)s,slen,lineNumber); return TCL_OK; } catch (ERRejected) { - interp->result = "Could not access transcript file"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Could not access transcript file", -1)); return TCL_ERROR; } } @@ -1466,12 +1432,11 @@ { unsigned long lineNumber = atol(argv[3]); MSG->LoadBuffer(transscriptName,lineNumber); - interp->result = ""; return TCL_OK; } catch (ERRejected) { - interp->result = "Could not access transcript file"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Could not access transcript file", -1)); return TCL_ERROR; } } @@ -1484,39 +1449,37 @@ if (strcmp(argv[2],"#bufferSize")==0) { - sprintf(interp->result,"%lu",static_cast(MSG->GetBufferSize())); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(MSG->GetBufferSize()))); return TCL_OK; } if (strcmp(argv[2],"#numLines")==0) { - sprintf(interp->result,"%lu",static_cast(MSG->GetNumLines(transscriptName))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(MSG->GetNumLines(transscriptName)))); return TCL_OK; } if (strcmp(argv[2],"restart")==0) { MSG -> Restart(); - interp->result = ""; return TCL_OK; } if (strcmp(argv[2],"reset")==0) { MSG -> MsgReset(); - interp->result = ""; return TCL_OK; } if (strcmp(argv[2],"eof")==0) { - interp->result = const_cast((MSG->MsgEndOfBuffer()) ? "1" : "0"); + Tcl_SetObjResult(interp, Tcl_NewIntObj(MSG->MsgEndOfBuffer() ? 1 : 0)); return TCL_OK; } if (strcmp(argv[2],"void")==0) { - interp->result = const_cast((MSG->MsgVoid()) ? "1" : "0"); + Tcl_SetObjResult(interp, Tcl_NewIntObj(MSG->MsgVoid() ? 1 : 0)); return TCL_OK; } @@ -1525,12 +1488,11 @@ try { MSG -> MsgSkip(); - interp->result = ""; return TCL_OK; } catch (ERRejected) { - interp->result = "Message queue is empty"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Message queue is empty", -1)); return TCL_ERROR; } } @@ -1539,12 +1501,13 @@ { try { - MSG->MsgText(interp->result, TCL_RESULT_SIZE); + const char *s = Tcl_GetStringResult(interp); + MSG->MsgText((char *)s, strlen(s)); return TCL_OK; } catch (ERRejected) { - interp->result = "Message queue is empty"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Message queue is empty", -1)); return TCL_ERROR; } } @@ -1554,12 +1517,12 @@ try { msgType ret = MSG->MsgClass(); - sprintf(interp->result,"%d",ret); + Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); return TCL_OK; } catch (ERRejected) { - interp->result = "Message queue is empty"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Message queue is empty", -1)); return TCL_ERROR; } } @@ -1569,12 +1532,12 @@ try { TModule ret = MSG->MsgModule(); - sprintf(interp->result,"%lu",static_cast(ret)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(ret))); return TCL_OK; } catch (ERRejected) { - interp->result = "Message queue is empty"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Message queue is empty", -1)); return TCL_ERROR; } } @@ -1584,12 +1547,12 @@ try { THandle ret = MSG->MsgHandle(); - sprintf(interp->result,"%lu",static_cast(ret)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(ret))); return TCL_OK; } catch (ERRejected) { - interp->result = "Message queue is empty"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Message queue is empty", -1)); return TCL_ERROR; } } @@ -1599,12 +1562,12 @@ try { int ret = MSG->MsgLevel(); - sprintf(interp->result,"%d",ret); + Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); return TCL_OK; } catch (ERRejected) { - interp->result = "Message queue is empty"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Message queue is empty", -1)); return TCL_ERROR; } } @@ -1617,16 +1580,18 @@ return TCL_ERROR; } - size_t numChars = MSG->TraceFilename(interp->result, TCL_RESULT_SIZE); + const char *s = Tcl_GetStringResult(interp); + size_t slen = strlen(s); + size_t numChars = MSG->TraceFilename((char *)s, slen); if (numChars==0) { - interp->result = "Tcl result size overflow"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Tcl result size overflow", -1)); return TCL_ERROR; } - else if (numChars>=TCL_RESULT_SIZE) + else if (numChars>=slen) { - interp->result = "No more queued trace files"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("No more queued trace files", -1)); return TCL_ERROR; } @@ -1635,25 +1600,23 @@ if (strcmp(argv[2],"blocked")==0) { - interp->result = const_cast((MSG->TraceEvent()) ? "1" : "0"); + Tcl_SetObjResult(interp, Tcl_NewIntObj(MSG->TraceEvent() ? 1 : 0)); return TCL_OK; } if (strcmp(argv[2],"unblock")==0) { MSG -> TraceUnblock(); - interp->result = ""; return TCL_OK; } - sprintf(interp->result,"Unknown option: goblin messenger %s",argv[2]); + Tcl_AppendResult(interp, "Unknown option: goblin messenger ", argv[2], (char *)NULL); return TCL_ERROR; } if (strcmp(argv[1],"configure")==0) { CT->Configure(argc,(const char**)argv); - interp->result = ""; return TCL_OK; } @@ -1670,7 +1633,6 @@ if (strcmp(argv[2],"reset")==0) { CT -> ResetTimers(); - interp->result = ""; return TCL_OK; } @@ -1678,7 +1640,7 @@ if (i>=NoTimer) { - sprintf(interp->result,"No such timer: %u",i); + Tcl_AppendResult(interp, "No such timer: ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -1694,12 +1656,11 @@ if (j>=NoTimer) { - sprintf(interp->result,"No such Timer: %u",j); + Tcl_AppendResult(interp, "No such timer: ", argv[4], (char *)NULL); return TCL_ERROR; } - sprintf(interp->result,"%g", - static_cast(CT->globalTimer[i]->ChildTime(TTimer(j)))); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(static_cast(CT->globalTimer[i]->ChildTime(TTimer(j))))); return TCL_OK; } @@ -1712,67 +1673,58 @@ if (strcmp(argv[3],"reset")==0) { CT -> globalTimer[i] -> Reset(); - interp->result = ""; return TCL_OK; } if (strcmp(argv[3],"enable")==0) { CT -> globalTimer[i] -> Enable(); - interp->result = ""; return TCL_OK; } if (strcmp(argv[3],"disable")==0) { CT -> globalTimer[i] -> Disable(); - interp->result = ""; return TCL_OK; } if (strcmp(argv[3],"label")==0) { - sprintf(interp->result,"%s", - listOfTimers[i].timerName); + Tcl_SetObjResult(interp, Tcl_NewStringObj(listOfTimers[i].timerName, -1)); return TCL_OK; } if (strcmp(argv[3],"acc")==0) { - sprintf(interp->result,"%lu", - static_cast(CT->globalTimer[i]->AccTime())); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(CT->globalTimer[i]->AccTime()))); return TCL_OK; } if (strcmp(argv[3],"av")==0) { - sprintf(interp->result,"%lu", - static_cast(CT->globalTimer[i]->AvTime())); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(CT->globalTimer[i]->AvTime()))); return TCL_OK; } if (strcmp(argv[3],"max")==0) { - sprintf(interp->result,"%lu", - static_cast(CT->globalTimer[i]->MaxTime())); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(CT->globalTimer[i]->MaxTime()))); return TCL_OK; } if (strcmp(argv[3],"min")==0) { - sprintf(interp->result,"%lu", - static_cast(CT->globalTimer[i]->MinTime())); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(CT->globalTimer[i]->MinTime()))); return TCL_OK; } if (strcmp(argv[3],"prev")==0) { - sprintf(interp->result,"%lu", - static_cast(CT->globalTimer[i]->PrevTime())); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(CT->globalTimer[i]->PrevTime()))); return TCL_OK; } - sprintf(interp->result,"Unknown option: goblin timer %s",argv[3]); + Tcl_AppendResult(interp, "Unknown option: goblin timer ", argv[3], (char *)NULL); return TCL_ERROR; } @@ -1790,71 +1742,65 @@ if (i>=NoModule) { - sprintf(interp->result,"No such module: %d",i); + Tcl_AppendResult(interp, "No such module: ", argv[2], (char *)NULL); return TCL_ERROR; } if (strcmp(argv[3],"name")==0) { - sprintf(interp->result,"%s",listOfModules[i].moduleName); + Tcl_SetObjResult(interp, Tcl_NewStringObj(listOfModules[i].moduleName, -1)); return TCL_OK; } if (strcmp(argv[3],"timer")==0) { - sprintf(interp->result,"%lu", - static_cast(listOfModules[i].moduleTimer)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(listOfModules[i].moduleTimer))); return TCL_OK; } if (strcmp(argv[3],"implementor1")==0) { - sprintf(interp->result,"%lu", - static_cast(listOfModules[i].implementor1)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(listOfModules[i].implementor1))); return TCL_OK; } if (strcmp(argv[3],"implementor2")==0) { - sprintf(interp->result,"%lu", - static_cast(listOfModules[i].implementor2)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(listOfModules[i].implementor2))); return TCL_OK; } if (strcmp(argv[3],"encoding_date")==0) { - sprintf(interp->result,"%s",listOfModules[i].encodingDate); + Tcl_SetObjResult(interp, Tcl_NewStringObj(listOfModules[i].encodingDate, -1)); return TCL_OK; } if (strcmp(argv[3],"revision_date")==0) { - sprintf(interp->result,"%s",listOfModules[i].revisionDate); + Tcl_SetObjResult(interp, Tcl_NewStringObj(listOfModules[i].revisionDate, -1)); return TCL_OK; } if (strcmp(argv[3],"original_reference")==0) { - sprintf(interp->result,"%lu", - static_cast(listOfModules[i].originalReference)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(listOfModules[i].originalReference))); return TCL_OK; } if (strcmp(argv[3],"authors_reference")==0) { - sprintf(interp->result,"%lu", - static_cast(listOfModules[i].authorsReference)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(listOfModules[i].authorsReference))); return TCL_OK; } if (strcmp(argv[3],"text_book")==0) { - sprintf(interp->result,"%lu", - static_cast(listOfModules[i].textBook)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(listOfModules[i].textBook))); return TCL_OK; } - sprintf(interp->result,"Unknown option: goblin module %s",argv[3]); + Tcl_AppendResult(interp, "Unknown option: goblin module ", argv[3], (char *)NULL); return TCL_ERROR; } @@ -1870,29 +1816,29 @@ if (i>=NoAuthor) { - sprintf(interp->result,"No such author: %d",i); + Tcl_AppendResult(interp, "No such author: ", argv[2], (char *)NULL); return TCL_ERROR; } if (strcmp(argv[3],"name")==0) { - sprintf(interp->result,"%s",listOfAuthors[i].name); + Tcl_SetObjResult(interp, Tcl_NewStringObj(listOfAuthors[i].name, -1)); return TCL_OK; } if (strcmp(argv[3],"affiliation")==0) { - sprintf(interp->result,"%s",listOfAuthors[i].affiliation); + Tcl_SetObjResult(interp, Tcl_NewStringObj(listOfAuthors[i].affiliation, -1)); return TCL_OK; } if (strcmp(argv[3],"e_mail")==0) { - sprintf(interp->result,"%s",listOfAuthors[i].e_mail); + Tcl_SetObjResult(interp, Tcl_NewStringObj(listOfAuthors[i].e_mail, -1)); return TCL_OK; } - sprintf(interp->result,"Unknown option: goblin author %s",argv[3]); + Tcl_AppendResult(interp, "Unknown option: goblin author ", argv[3], (char *)NULL); return TCL_ERROR; } @@ -1908,67 +1854,65 @@ if (i>=NoReference) { - sprintf(interp->result,"No such reference: %d",i); + Tcl_AppendResult(interp, "No such reference: ", argv[2], (char *)NULL); return TCL_ERROR; } if (strcmp(argv[3],"key")==0) { - sprintf(interp->result,"%s",listOfReferences[i].refKey); + Tcl_SetObjResult(interp, Tcl_NewStringObj(listOfReferences[i].refKey, -1)); return TCL_OK; } if (strcmp(argv[3],"authors")==0) { - sprintf(interp->result,"%s",listOfReferences[i].authors); + Tcl_SetObjResult(interp, Tcl_NewStringObj(listOfReferences[i].authors, -1)); return TCL_OK; } if (strcmp(argv[3],"title")==0) { - sprintf(interp->result,"%s",listOfReferences[i].title); + Tcl_SetObjResult(interp, Tcl_NewStringObj(listOfReferences[i].title, -1)); return TCL_OK; } if (strcmp(argv[3],"type")==0) { - sprintf(interp->result,"%s",listOfReferences[i].type); + Tcl_SetObjResult(interp, Tcl_NewStringObj(listOfReferences[i].type, -1)); return TCL_OK; } if (strcmp(argv[3],"collection")==0) { - sprintf(interp->result,"%s",listOfReferences[i].collection); + Tcl_SetObjResult(interp, Tcl_NewStringObj(listOfReferences[i].collection, -1)); return TCL_OK; } if (strcmp(argv[3],"editors")==0) { - sprintf(interp->result,"%s",listOfReferences[i].editors); + Tcl_SetObjResult(interp, Tcl_NewStringObj(listOfReferences[i].editors, -1)); return TCL_OK; } if (strcmp(argv[3],"volume")==0) { - sprintf(interp->result,"%lu", - static_cast(listOfReferences[i].volume)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(listOfReferences[i].volume))); return TCL_OK; } if (strcmp(argv[3],"publisher")==0) { - sprintf(interp->result,"%s",listOfReferences[i].publisher); + Tcl_SetObjResult(interp, Tcl_NewStringObj(listOfReferences[i].publisher, -1)); return TCL_OK; } if (strcmp(argv[3],"year")==0) { - sprintf(interp->result,"%lu", - static_cast(listOfReferences[i].year)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(listOfReferences[i].year))); return TCL_OK; } - sprintf(interp->result,"Unknown option: goblin reference %s",argv[3]); + Tcl_AppendResult(interp, "Unknown option: goblin reference ", argv[3], (char *)NULL); return TCL_ERROR; } @@ -1982,31 +1926,31 @@ if (strcmp(argv[1],"size")==0) { - sprintf(interp->result,"%lu",static_cast(goblinHeapSize)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(goblinHeapSize))); return TCL_OK; } if (strcmp(argv[1],"maxsize")==0) { - sprintf(interp->result,"%lu",static_cast(goblinMaxSize)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(goblinMaxSize))); return TCL_OK; } if (strcmp(argv[1],"#allocs")==0) { - sprintf(interp->result,"%lu",static_cast(goblinNAllocs)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(goblinNAllocs))); return TCL_OK; } if (strcmp(argv[1],"#objects")==0) { - sprintf(interp->result,"%lu",static_cast(goblinNObjects)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(goblinNObjects))); return TCL_OK; } if (strcmp(argv[1],"#fragments")==0) { - sprintf(interp->result,"%lu",static_cast(goblinNFragments)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(goblinNFragments))); return TCL_OK; } @@ -2014,25 +1958,25 @@ if (strcmp(argv[1],"#timers")==0) { - sprintf(interp->result,"%lu",static_cast(NoTimer)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(NoTimer))); return TCL_OK; } if (strcmp(argv[1],"#authors")==0) { - sprintf(interp->result,"%lu",static_cast(NoAuthor)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(NoAuthor))); return TCL_OK; } if (strcmp(argv[1],"#modules")==0) { - sprintf(interp->result,"%lu",static_cast(NoModule)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(NoModule))); return TCL_OK; } if (strcmp(argv[1],"#references")==0) { - sprintf(interp->result,"%lu",static_cast(NoReference)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(static_cast(NoReference))); return TCL_OK; } @@ -2044,7 +1988,6 @@ CT->logStream = new ofstream(transscriptName); MSG -> Restart(); - interp->result = ""; return TCL_OK; } } @@ -2053,7 +1996,7 @@ return Goblin_Propagate_Exception(interp); } - sprintf(interp->result,"Unknown option: goblin %s",argv[1]); + Tcl_AppendResult(interp, "Unknown option: goblin ", argv[1], (char *)NULL); return TCL_ERROR; } @@ -2083,9 +2026,11 @@ int Goblin_Generic_Cmd (managedObject *X,Tcl_Interp* interp,int argc, _CONST_QUAL_ char* argv[]) throw(ERRejected,ERRange) { + Tcl_ResetResult(interp); + if (argc<2) { - interp->result = "Missing arguments"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing arguments", -1)); return TCL_ERROR; } @@ -2098,7 +2043,6 @@ } CT -> SetMaster(X->Handle()); - interp->result = ""; return TCL_OK; } @@ -2110,7 +2054,7 @@ return TCL_ERROR; } - sprintf(interp->result,"%ld",X->Handle()); + Tcl_SetObjResult(interp, Tcl_NewLongObj(X->Handle())); return TCL_OK; } @@ -2123,7 +2067,6 @@ } X -> Display(); - interp->result = ""; return TCL_OK; } @@ -2144,11 +2087,11 @@ strcmp(argv[2],"-balanced")==0 ) { - interp->result = "0"; + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); return TCL_OK; } - sprintf(interp->result,"Unknown object attribute: %s",argv[2]); + Tcl_AppendResult(interp, "Unknown object attribute: ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -2163,11 +2106,10 @@ if (strcmp(argv[2],"name")==0) { X -> SetLabel((char*)argv[3]); - interp->result = ""; return TCL_OK; } - sprintf(interp->result,"Unknown option: %s set %s",argv[0],argv[2]); + Tcl_AppendResult(interp, "Unknown option: ", argv[0], " set ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -2186,46 +2128,43 @@ if (argc>4) opt = atol(argv[4]); X -> ExportToAscii(argv[3],opt); - interp->result = ""; return TCL_OK; } if (strcmp(argv[2],"goblet")==0 || strcmp(argv[2],"tk")==0) { X -> ExportToTk(argv[3]); - interp->result = ""; return TCL_OK; } if (strcmp(argv[2],"xfig")==0) { X -> ExportToXFig(argv[3]); - interp->result = ""; return TCL_OK; } if (strcmp(argv[2],"dot")==0) { X -> ExportToDot(argv[3]); - interp->result = ""; return TCL_OK; } - sprintf(interp->result,"Unknown export format: %s",argv[2]); + Tcl_AppendResult(interp, "Unknown export format: ", argv[2], (char *)NULL); return TCL_ERROR; } - sprintf(interp->result,"Unknown option: %s",argv[1]); + Tcl_AppendResult(interp, "Unknown option: ", argv[1], (char *)NULL); return TCL_ERROR; } int Goblin_Propagate_Exception (Tcl_Interp* interp) throw() { + Tcl_ResetResult(interp); + if (CT->savedErrorMsgType != NO_MSG) { - sprintf(interp->result,"%s - %s", - CT->savedErrorMethodName,CT->savedErrorDescription); + Tcl_AppendResult(interp, CT->savedErrorMethodName, " - ", CT->savedErrorDescription, (char *)NULL); CT->savedErrorMsgType = NO_MSG; } @@ -2233,7 +2172,7 @@ { CT->Error(MSG_WARN,NoHandle,"Goblin_Propagate_Exception", "An unknown exception has occured"); - sprintf(interp->result,"An unknown exception has occured"); + Tcl_SetObjResult(interp, Tcl_NewStringObj("An unknown exception has occured", -1)); } CT -> logLevel = 0; @@ -2243,14 +2182,16 @@ void WrongNumberOfArguments(Tcl_Interp* interp,int argc,_CONST_QUAL_ char* argv[]) throw() { - sprintf(interp->result,"Wrong number of arguments for command \"%s",argv[0]); + Tcl_ResetResult(interp); + + Tcl_AppendResult(interp, "Wrong number of arguments for command \"", argv[0], (char *)NULL); for (int i=1;iresult + strlen(interp->result)," %s",argv[i]); + Tcl_AppendResult(interp, " ", argv[i], (char *)NULL); } - sprintf(interp->result + strlen(interp->result),"\""); + Tcl_AppendResult(interp, "\"", (char *)NULL); } @@ -2264,7 +2205,7 @@ } else { - interp->result = "Missing number of graph nodes"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing number of graph nodes", -1)); return NoNode; } } --- shell_src/goshDisplayProxy.cpp.orig 2013-06-04 18:16:00.000000000 +0200 +++ shell_src/goshDisplayProxy.cpp 2013-06-04 18:16:07.000000000 +0200 @@ -17,6 +17,8 @@ int Goblin_Graph_Display_Proxy_Cmd (ClientData clientData,Tcl_Interp* interp, int argc,_CONST_QUAL_ char* argv[]) { + Tcl_ResetResult(interp); + graphDisplayProxy* DP = reinterpret_cast(clientData); if (setjmp(goblinThreadData[Goblin_MyThreadIndex()].jumpBuffer) != 0) @@ -25,7 +27,7 @@ } else if (argc==1) { - interp->result = "Missing object command"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing object command", -1)); return TCL_ERROR; } else try @@ -33,7 +35,6 @@ if (strcmp(argv[1],"synchronize")==0) { DP -> Synchronize(); - interp->result = ""; return TCL_OK; } @@ -41,23 +42,23 @@ { if (strcmp(argv[2],"-canvasWidth")==0) { - sprintf(interp->result,"%ld",DP->CanvasWidth()); + Tcl_SetObjResult(interp, Tcl_NewLongObj(DP->CanvasWidth())); return TCL_OK; } if (strcmp(argv[2],"-canvasHeight")==0) { - sprintf(interp->result,"%ld",DP->CanvasHeight()); + Tcl_SetObjResult(interp, Tcl_NewLongObj(DP->CanvasHeight())); return TCL_OK; } if (strcmp(argv[2],"-canvasArrowSize")==0) { - sprintf(interp->result,"%g",DP->CanvasArrowSize()); + Tcl_SetObjResult(interp, Tcl_NewLongObj(DP->CanvasArrowSize())); return TCL_OK; } - sprintf(interp->result,"Unknown option: %s",argv[2]); + Tcl_AppendResult(interp, "Unknown option: ", argv[2], (char *)NULL); return TCL_ERROR; } @@ -65,7 +66,7 @@ { if (argc==2) { - interp->result = "Missing node index"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing node index", -1)); return TCL_ERROR; } @@ -73,7 +74,7 @@ if (argc<4) { - interp->result = "Missing command option"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing command option", -1)); return TCL_ERROR; } @@ -81,39 +82,43 @@ { if (strcmp(argv[4],"-mapped")==0) { - sprintf(interp->result,"%s",DP->IsNodeMapped(v) ? "1" : "0"); + Tcl_SetObjResult(interp, Tcl_NewIntObj(DP->IsNodeMapped(v) ? 1 : 0)); return TCL_OK; } if (strcmp(argv[4],"-canvasWidth")==0) { - sprintf(interp->result,"%ld",DP->CanvasNodeWidth(v)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(DP->CanvasNodeWidth(v))); return TCL_OK; } if (strcmp(argv[4],"-canvasHeight")==0) { - sprintf(interp->result,"%ld",DP->CanvasNodeHeight(v)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(DP->CanvasNodeHeight(v))); return TCL_OK; } if (strcmp(argv[4],"-label")==0) { - DP -> CompoundNodeLabel(interp->result,256,v); + char tmp[256]; + DP -> CompoundNodeLabel(tmp,256,v); + Tcl_SetObjResult(interp, Tcl_NewStringObj(tmp, -1)); return TCL_OK; } if (strcmp(argv[4],"-colour")==0) { - DP -> CanvasNodeColour(interp->result,v); + char tmp[256]; + DP -> CanvasNodeColour(tmp,v); + Tcl_SetObjResult(interp, Tcl_NewStringObj(tmp, -1)); return TCL_OK; } - sprintf(interp->result,"Unknown option: %s",argv[4]); + Tcl_AppendResult(interp, "Unknown option: ", argv[4], (char *)NULL); return TCL_ERROR; } - sprintf(interp->result,"Unknown option: %s",argv[3]); + Tcl_AppendResult(interp, "Unknown option: ", argv[3], (char *)NULL); return TCL_ERROR; } @@ -121,7 +126,7 @@ { if (argc==2) { - interp->result = "Missing arc index"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing arc index", -1)); return TCL_ERROR; } @@ -129,7 +134,7 @@ if (argc<4) { - interp->result = "Missing command option"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing command option", -1)); return TCL_ERROR; } @@ -137,44 +142,48 @@ { if (strcmp(argv[4],"-mapped")==0) { - sprintf(interp->result,"%s",DP->IsArcMapped(a) ? "1" : "0"); + Tcl_SetObjResult(interp, Tcl_NewIntObj(DP->IsArcMapped(a) ? 1 : 0)); return TCL_OK; } if (strcmp(argv[4],"-canvasPortX")==0) { - sprintf(interp->result,"%ld",DP->CanvasCXOfPort(a)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(DP->CanvasCXOfPort(a))); return TCL_OK; } if (strcmp(argv[4],"-canvasPortY")==0) { - sprintf(interp->result,"%ld",DP->CanvasCYOfPort(a)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(DP->CanvasCYOfPort(a))); return TCL_OK; } if (strcmp(argv[4],"-label")==0) { - DP -> CompoundArcLabel(interp->result,256,a); + char tmp[256]; + DP -> CompoundArcLabel(tmp,256,a); + Tcl_SetObjResult(interp, Tcl_NewStringObj(tmp, -1)); return TCL_OK; } if (strcmp(argv[4],"-colour")==0) { - DP -> CanvasArcColour(interp->result,a); + char tmp[256]; + DP -> CanvasArcColour(tmp,a); + Tcl_SetObjResult(interp, Tcl_NewStringObj(tmp, -1)); return TCL_OK; } if (strcmp(argv[4],"-width")==0) { - sprintf(interp->result,"%ld",DP->CanvasArcWidth(a)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(DP->CanvasArcWidth(a))); return TCL_OK; } if (strcmp(argv[4],"-dash")==0) { const char* dashMode[] = {""," -dash ."," -dash -"," -dash -."}; - sprintf(interp->result,"%s",dashMode[DP->CanvasArcDashMode(a)]); + Tcl_SetObjResult(interp, Tcl_NewStringObj(dashMode[DP->CanvasArcDashMode(a)], -1)); return TCL_OK; } @@ -184,35 +193,41 @@ { case ARROW_BOTH: { - interp->result = "both"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("both", -1)); return TCL_OK; } case ARROW_FORWARD: { - interp->result = "last"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("last", -1)); return TCL_OK; } case ARROW_BACKWARD: { - interp->result = "first"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("first", -1)); return TCL_OK; } case ARROW_NONE: { - interp->result = "none"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1)); return TCL_OK; } } +#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 5) + Tcl_Obj *resObj = Tcl_NewObj(); + Tcl_AppendPrintfToObj(resObj, "Unknown arrow display mode: %d",DP->ArrowDirections(a)); + Tcl_SetObjResult(interp, resObj); +#else sprintf(interp->result,"Unknown arrow display mode: %d",DP->ArrowDirections(a)); +#endif return TCL_OK; } - sprintf(interp->result,"Unknown option: %s",argv[4]); + Tcl_AppendResult(interp, "Unknown option: ", argv[4], (char *)NULL); return TCL_ERROR; } - sprintf(interp->result,"Unknown option: %s",argv[3]); + Tcl_AppendResult(interp, "Unknown option: ", argv[3], (char *)NULL); return TCL_ERROR; } @@ -220,7 +235,7 @@ { if (argc==2) { - interp->result = "Missing layout point index"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing layout point index", -1)); return TCL_ERROR; } @@ -228,7 +243,7 @@ if (argc<4) { - interp->result = "Missing command option"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing command option", -1)); return TCL_ERROR; } @@ -236,17 +251,17 @@ { if (strcmp(argv[4],"-canvasX")==0) { - sprintf(interp->result,"%ld",DP->CanvasCXOfPoint(p)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(DP->CanvasCXOfPoint(p))); return TCL_OK; } if (strcmp(argv[4],"-canvasY")==0) { - sprintf(interp->result,"%ld",DP->CanvasCYOfPoint(p)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(DP->CanvasCYOfPoint(p))); return TCL_OK; } - sprintf(interp->result,"Unknown option: %s",argv[4]); + Tcl_AppendResult(interp, "Unknown option: ", argv[4], (char *)NULL); return TCL_ERROR; } @@ -254,16 +269,15 @@ { if (argc<6) { - interp->result = "Missing coordinate values"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing coordinate values", -1)); return TCL_ERROR; } DP -> PlaceLayoutPoint(p,atol(argv[4]),atol(argv[5])); - interp->result = ""; return TCL_OK; } - sprintf(interp->result,"Unknown option: %s",argv[3]); + Tcl_AppendResult(interp, "Unknown option: ", argv[3], (char *)NULL); return TCL_ERROR; } @@ -271,7 +285,7 @@ { if (argc==2) { - interp->result = "Missing arc index"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing arc index", -1)); return TCL_ERROR; } @@ -279,7 +293,7 @@ if (argc<4) { - interp->result = "Missing command option"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing command option", -1)); return TCL_ERROR; } @@ -287,17 +301,17 @@ { if (strcmp(argv[4],"-canvasX")==0) { - sprintf(interp->result,"%ld",DP->CanvasCXOfArcLabelAnchor(a)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(DP->CanvasCXOfArcLabelAnchor(a))); return TCL_OK; } if (strcmp(argv[4],"-canvasY")==0) { - sprintf(interp->result,"%ld",DP->CanvasCYOfArcLabelAnchor(a)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(DP->CanvasCYOfArcLabelAnchor(a))); return TCL_OK; } - sprintf(interp->result,"Unknown option: %s",argv[4]); + Tcl_AppendResult(interp, "Unknown option: ", argv[4], (char *)NULL); return TCL_ERROR; } @@ -305,20 +319,19 @@ { if (argc<6) { - interp->result = "Missing coordinate values"; + Tcl_SetObjResult(interp, Tcl_NewStringObj("Missing coordinate values", -1)); return TCL_ERROR; } DP -> PlaceArcLabelAnchor(a,atol(argv[4]),atol(argv[5])); - interp->result = ""; return TCL_OK; } - sprintf(interp->result,"Unknown option: %s",argv[3]); + Tcl_AppendResult(interp, "Unknown option: ", argv[3], (char *)NULL); return TCL_ERROR; } - sprintf(interp->result,"Unknown option: %s",argv[1]); + Tcl_AppendResult(interp, "Unknown option: ", argv[1], (char *)NULL); return TCL_ERROR; } catch (...) --- glpk_wrap/glpkInit.cpp.orig 2013-06-05 09:18:26.000000000 +0200 +++ glpk_wrap/glpkInit.cpp 2013-06-05 09:19:08.000000000 +0200 @@ -29,7 +29,7 @@ if (Tcl_PkgRequire(interp,"goblin","2.6",0)==NULL) { - sprintf(interp->result,"GOBLIN must be loaded before the GLPK plugin"); + Tcl_SetObjResult(interp, Tcl_NewStringObj("GOBLIN must be loaded before the GLPK plugin", -1)); return TCL_ERROR; }