Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | If TCL_NO_DEPRECATED is defined, don't depend on Tcl_CreateMathFunc()/Tcl_SaveResult() in testcases any more. Prevent endless loop in Tcl_AddObjErrorInfo, when TCL_NO_DEPRECATED is defined. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
8c696d020384483d64c2eaf118a39522 |
User & Date: | jan.nijtmans 2013-03-22 13:22:40 |
Context
2013-03-22
| ||
23:08 | Update to tzdata2013b check-in: 2fa10e0214 user: venkat tags: trunk | |
14:15 | merge trunk check-in: d836fd6c98 user: jan.nijtmans tags: novem | |
13:22 | If TCL_NO_DEPRECATED is defined, don't depend on Tcl_CreateMathFunc()/Tcl_SaveResult() in testcases ... check-in: 8c696d0203 user: jan.nijtmans tags: trunk | |
2013-03-21
| ||
14:56 | merge-mark check-in: 5d80e6de9b user: jan.nijtmans tags: trunk | |
Changes
Changes to generic/tclBasic.c.
︙ | ︙ | |||
6738 6739 6740 6741 6742 6743 6744 6745 6746 6747 6748 6749 6750 6751 | * The value of the Tcl_obj is appended to the errorInfo field. If we are * just starting to log an error, errorInfo is initialized from the error * message in the interpreter's result. * *---------------------------------------------------------------------- */ void Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ { int length; | > | 6738 6739 6740 6741 6742 6743 6744 6745 6746 6747 6748 6749 6750 6751 6752 | * The value of the Tcl_obj is appended to the errorInfo field. If we are * just starting to log an error, errorInfo is initialized from the error * message in the interpreter's result. * *---------------------------------------------------------------------- */ #undef Tcl_AddObjErrorInfo void Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ { int length; |
︙ | ︙ | |||
6802 6803 6804 6805 6806 6807 6808 | * "length" is negative, use bytes up to the first NULL byte. If we are * just starting to log an error, errorInfo is initialized from the error * message in the interpreter's result. * *---------------------------------------------------------------------- */ | < | 6803 6804 6805 6806 6807 6808 6809 6810 6811 6812 6813 6814 6815 6816 | * "length" is negative, use bytes up to the first NULL byte. If we are * just starting to log an error, errorInfo is initialized from the error * message in the interpreter's result. * *---------------------------------------------------------------------- */ void Tcl_AddObjErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ const char *message, /* Points to the first byte of an array of * bytes of the message. */ int length) /* The number of bytes in the message. If < 0, |
︙ | ︙ |
Changes to generic/tclDecls.h.
︙ | ︙ | |||
3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 | # define Tcl_MainEx Tcl_MainExW EXTERN void Tcl_MainExW(int argc, wchar_t **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); #endif #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT /* * Deprecated Tcl procedures: */ #if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) # undef Tcl_EvalObj # define Tcl_EvalObj(interp,objPtr) \ | > > > | 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 | # define Tcl_MainEx Tcl_MainExW EXTERN void Tcl_MainExW(int argc, wchar_t **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); #endif #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT #undef Tcl_SeekOld #undef Tcl_TellOld /* * Deprecated Tcl procedures: */ #if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) # undef Tcl_EvalObj # define Tcl_EvalObj(interp,objPtr) \ |
︙ | ︙ |
Changes to generic/tclIntDecls.h.
︙ | ︙ | |||
1352 1353 1354 1355 1356 1357 1358 1359 | # define Tcl_GetCommandFromObj \ (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */ # undef Tcl_GetCommandFullName # define Tcl_GetCommandFullName \ (tclStubsPtr->tcl_GetCommandFullName) /* 517 */ #endif #endif /* _TCLINTDECLS */ | > > > | 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 | # define Tcl_GetCommandFromObj \ (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */ # undef Tcl_GetCommandFullName # define Tcl_GetCommandFullName \ (tclStubsPtr->tcl_GetCommandFullName) /* 517 */ #endif #undef TclCopyChannelOld #undef TclSockMinimumBuffersOld #endif /* _TCLINTDECLS */ |
Changes to generic/tclTest.c.
︙ | ︙ | |||
323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 | Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestreturnObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void TestregexpXflags(const char *string, int length, int *cflagsPtr, int *eflagsPtr); static int TestsaveresultCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void TestsaveresultFree(char *blockPtr); static int TestsetassocdataCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestsetCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int Testset2Cmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestseterrorcodeCmd(ClientData dummy, | > > | 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 | Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestreturnObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void TestregexpXflags(const char *string, int length, int *cflagsPtr, int *eflagsPtr); #ifndef TCL_NO_DEPRECATED static int TestsaveresultCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void TestsaveresultFree(char *blockPtr); #endif /* TCL_NO_DEPRECATED */ static int TestsetassocdataCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestsetCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int Testset2Cmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestseterrorcodeCmd(ClientData dummy, |
︙ | ︙ | |||
519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 | *---------------------------------------------------------------------- */ int Tcltest_Init( Tcl_Interp *interp) /* Interpreter for application. */ { Tcl_ValueType t3ArgTypes[2]; Tcl_Obj *listPtr; Tcl_Obj **objv; int objc, index; static const char *const specialOptions[] = { "-appinitprocerror", "-appinitprocdeleteinterp", "-appinitprocclosestderr", "-appinitprocsetrcfile", NULL | > > | 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 | *---------------------------------------------------------------------- */ int Tcltest_Init( Tcl_Interp *interp) /* Interpreter for application. */ { #ifndef TCL_NO_DEPRECATED Tcl_ValueType t3ArgTypes[2]; #endif /* TCL_NO_DEPRECATED */ Tcl_Obj *listPtr; Tcl_Obj **objv; int objc, index; static const char *const specialOptions[] = { "-appinitprocerror", "-appinitprocdeleteinterp", "-appinitprocclosestderr", "-appinitprocsetrcfile", NULL |
︙ | ︙ | |||
638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 | NULL, NULL); Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd, NULL, NULL); Tcl_CreateCommand(interp, "testseterr", TestsetCmd, (ClientData) TCL_LEAVE_ERR_MSG, NULL); Tcl_CreateCommand(interp, "testset2", Testset2Cmd, | > > | 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 | NULL, NULL); Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, NULL, NULL); #ifndef TCL_NO_DEPRECATED Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd, NULL, NULL); #endif /* TCL_NO_DEPRECATED */ Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd, NULL, NULL); Tcl_CreateCommand(interp, "testseterr", TestsetCmd, (ClientData) TCL_LEAVE_ERR_MSG, NULL); Tcl_CreateCommand(interp, "testset2", Testset2Cmd, |
︙ | ︙ | |||
661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 | Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd, NULL, NULL); Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd, NULL, NULL); Tcl_CreateCommand(interp, "testtranslatefilename", TesttranslatefilenameCmd, NULL, NULL); Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL); Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123); Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345); Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd, NULL, NULL); Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd, NULL, NULL); #if defined(HAVE_CPUID) || defined(__WIN32__) Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, (ClientData) 0, NULL); #endif t3ArgTypes[0] = TCL_EITHER; t3ArgTypes[1] = TCL_EITHER; Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2, NULL); Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels, NULL, NULL); Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd, NULL, NULL); if (TclObjTest_Init(interp) != TCL_OK) { | > > > > | 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 | Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd, NULL, NULL); Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd, NULL, NULL); Tcl_CreateCommand(interp, "testtranslatefilename", TesttranslatefilenameCmd, NULL, NULL); Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL); #ifndef TCL_NO_DEPRECATED Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123); Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345); #endif /* TCL_NO_DEPRECATED */ Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd, NULL, NULL); Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd, NULL, NULL); #if defined(HAVE_CPUID) || defined(__WIN32__) Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, (ClientData) 0, NULL); #endif #ifndef TCL_NO_DEPRECATED t3ArgTypes[0] = TCL_EITHER; t3ArgTypes[1] = TCL_EITHER; Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2, NULL); #endif /* TCL_NO_DEPRECATED */ Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels, NULL, NULL); Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd, NULL, NULL); if (TclObjTest_Init(interp) != TCL_OK) { |
︙ | ︙ | |||
4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 | } else { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " varName elemName ?newValue?\"", NULL); return TCL_ERROR; } } /* *---------------------------------------------------------------------- * * TestsaveresultCmd -- * * Implements the "testsaveresult" cmd that is used when testing the * Tcl_SaveResult, Tcl_RestoreResult, and Tcl_DiscardResult interfaces. | > | 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 | } else { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " varName elemName ?newValue?\"", NULL); return TCL_ERROR; } } #ifndef TCL_NO_DEPRECATED /* *---------------------------------------------------------------------- * * TestsaveresultCmd -- * * Implements the "testsaveresult" cmd that is used when testing the * Tcl_SaveResult, Tcl_RestoreResult, and Tcl_DiscardResult interfaces. |
︙ | ︙ | |||
5132 5133 5134 5135 5136 5137 5138 5139 5140 5141 5142 5143 5144 5145 | static void TestsaveresultFree( char *blockPtr) { freeCount++; } /* *---------------------------------------------------------------------- * * TestmainthreadCmd -- * * Implements the "testmainthread" cmd that is used to test the | > | 5143 5144 5145 5146 5147 5148 5149 5150 5151 5152 5153 5154 5155 5156 5157 | static void TestsaveresultFree( char *blockPtr) { freeCount++; } #endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- * * TestmainthreadCmd -- * * Implements the "testmainthread" cmd that is used to test the |
︙ | ︙ | |||
6166 6167 6168 6169 6170 6171 6172 | /* This is bad, but not much we can do about it */ } else { /* * No idea why I decided to program this up using the old string-based * API, but there you go. We should convert it to objects. */ | | > | > > | > | | 6178 6179 6180 6181 6182 6183 6184 6185 6186 6187 6188 6189 6190 6191 6192 6193 6194 6195 6196 6197 6198 6199 6200 6201 6202 6203 6204 6205 6206 6207 6208 6209 6210 6211 6212 6213 6214 | /* This is bad, but not much we can do about it */ } else { /* * No idea why I decided to program this up using the old string-based * API, but there you go. We should convert it to objects. */ Tcl_Obj *savedResult; Tcl_DString ds; Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, "lappend filesystemReport ", -1); Tcl_DStringStartSublist(&ds); Tcl_DStringAppendElement(&ds, cmd); if (path != NULL) { Tcl_DStringAppendElement(&ds, Tcl_GetString(path)); } if (arg2 != NULL) { Tcl_DStringAppendElement(&ds, Tcl_GetString(arg2)); } Tcl_DStringEndSublist(&ds); savedResult = Tcl_GetObjResult(interp); Tcl_IncrRefCount(savedResult); Tcl_SetObjResult(interp, Tcl_NewObj()); Tcl_Eval(interp, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); Tcl_ResetResult(interp); Tcl_SetObjResult(interp, savedResult); Tcl_DecrRefCount(savedResult); } } static int TestReportStat( Tcl_Obj *path, /* Path of file to stat (in current CP). */ Tcl_StatBuf *buf) /* Filled with results of stat call. */ { |
︙ | ︙ |