Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | merge trunk |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | tip-439 | semver |
| Files: | files | file ages | folders |
| SHA1: |
70664e0bebeae0c12b61ff53943ef2c1 |
| User & Date: | jan.nijtmans 2017-04-06 12:24:36 |
Context
|
2017-04-12
| ||
| 08:40 | merge trunk check-in: 6aebbe4316 user: jan.nijtmans tags: tip-439, semver | |
|
2017-04-06
| ||
| 12:24 | merge trunk check-in: 70664e0beb user: jan.nijtmans tags: tip-439, semver | |
| 11:13 | If compiled with TCL_NO_DEPRECATED, the functions TclpGetDate/TclpLocaltime/TclpGmtime can be remove... check-in: 637ba41a2b user: jan.nijtmans tags: trunk | |
| 08:53 | merge trunk check-in: c8c1e2ae5b user: jan.nijtmans tags: tip-439, semver | |
Changes
Changes to generic/tclStubInit.c.
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 ... 135 136 137 138 139 140 141 142 143 144 145 146 147 148 ... 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 ... 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 ... 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 ... 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 |
#define TclBackgroundException Tcl_BackgroundException #undef Tcl_SetIntObj #undef TclpInetNtoa #undef TclWinGetServByName #undef TclWinGetSockOpt #undef TclWinSetSockOpt #ifdef TCL_NO_DEPRECATED # define TclSetStartupScript 0 # define TclGetStartupScript 0 # define TclCreateNamespace 0 # define TclDeleteNamespace 0 # define TclAppendExportList 0 # define TclExport 0 # define TclImport 0 # define TclForgetImport 0 # define TclGetCurrentNamespace_ 0 # define TclGetGlobalNamespace_ 0 # define TclFindNamespace 0 # define TclFindCommand 0 # define TclGetCommandFromObj 0 # define TclGetCommandFullName 0 # define TclpGetDate 0 # define TclpLocaltime 0 # define TclpGmtime 0 # define Tcl_Eval 0 # undef Tcl_EvalObj # define Tcl_EvalObj 0 # define Tcl_GlobalEval 0 # undef Tcl_GlobalEvalObj # define Tcl_GlobalEvalObj 0 # define Tcl_VarEval 0 # define Tcl_VarEvalVA 0 # define Tcl_CreateMathFunc 0 # define Tcl_EvalTokens 0 # define Tcl_GetMathFuncInfo 0 # define Tcl_ListMathFuncs 0 #else # define TclSetStartupScript Tcl_SetStartupScript # define TclGetStartupScript Tcl_GetStartupScript # define TclCreateNamespace Tcl_CreateNamespace # define TclDeleteNamespace Tcl_DeleteNamespace # define TclAppendExportList Tcl_AppendExportList # define TclExport Tcl_Export # define TclImport Tcl_Import # define TclForgetImport Tcl_ForgetImport # define TclGetCurrentNamespace_ Tcl_GetCurrentNamespace # define TclGetGlobalNamespace_ Tcl_GetGlobalNamespace # define TclFindNamespace Tcl_FindNamespace # define TclFindCommand Tcl_FindCommand # define TclGetCommandFromObj Tcl_GetCommandFromObj # define TclGetCommandFullName Tcl_GetCommandFullName #endif /* See bug 510001: TclSockMinimumBuffers needs plat imp */ #ifdef _WIN64 # define TclSockMinimumBuffersOld 0 #else #define TclSockMinimumBuffersOld sockMinimumBuffersOld static int TclSockMinimumBuffersOld(int sock, int size) { return TclSockMinimumBuffers(INT2PTR(sock), size); } #endif #define TclSetStartupScriptPath setStartupScriptPath static void TclSetStartupScriptPath(Tcl_Obj *path) { Tcl_SetStartupScript(path, NULL); } #define TclGetStartupScriptPath getStartupScriptPath static Tcl_Obj *TclGetStartupScriptPath(void) ................................................................................ #if defined(_WIN32) || defined(__CYGWIN__) #undef TclWinNToHS #define TclWinNToHS winNToHS static unsigned short TclWinNToHS(unsigned short ns) { return ntohs(ns); } #endif #ifdef _WIN32 # define TclUnixWaitForFile 0 # define TclUnixCopyFile 0 # define TclUnixOpenTemporaryFile 0 # define TclpReaddir 0 # define TclpIsAtty 0 ................................................................................ } #define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp static int formatInt(char *buffer, int n){ return TclFormatInt(buffer, (long)n); } #define TclFormatInt (int(*)(char *, long))formatInt #endif #else /* UNIX and MAC */ # ifdef TCL_NO_DEPRECATED # define TclpLocaltime_unix 0 # define TclpGmtime_unix 0 # else # define TclpLocaltime_unix TclpLocaltime # define TclpGmtime_unix TclpGmtime # endif #endif #ifdef TCL_NO_DEPRECATED # define Tcl_SeekOld 0 # define Tcl_TellOld 0 # undef Tcl_SetBooleanObj # define Tcl_SetBooleanObj 0 # undef Tcl_PkgPresent ................................................................................ # define Tcl_DiscardResult 0 # undef Tcl_SetResult # define Tcl_SetResult 0 # undef Tcl_EvalObj # define Tcl_EvalObj 0 # undef Tcl_GlobalEvalObj # define Tcl_GlobalEvalObj 0 #else /* TCL_NO_DEPRECATED */ # define Tcl_SeekOld seekOld # define Tcl_TellOld tellOld static int seekOld( Tcl_Channel chan, /* The channel on which to seek. */ int offset, /* Offset to seek to. */ int mode) /* Relative to which location to seek? */ { ................................................................................ 0, /* 105 */ 0, /* 106 */ 0, /* 107 */ TclTeardownNamespace, /* 108 */ TclUpdateReturnInfo, /* 109 */ TclSockMinimumBuffers, /* 110 */ Tcl_AddInterpResolvers, /* 111 */ TclAppendExportList, /* 112 */ TclCreateNamespace, /* 113 */ TclDeleteNamespace, /* 114 */ TclExport, /* 115 */ TclFindCommand, /* 116 */ TclFindNamespace, /* 117 */ Tcl_GetInterpResolvers, /* 118 */ Tcl_GetNamespaceResolvers, /* 119 */ Tcl_FindNamespaceVar, /* 120 */ TclForgetImport, /* 121 */ TclGetCommandFromObj, /* 122 */ TclGetCommandFullName, /* 123 */ TclGetCurrentNamespace_, /* 124 */ TclGetGlobalNamespace_, /* 125 */ Tcl_GetVariableFullName, /* 126 */ TclImport, /* 127 */ Tcl_PopCallFrame, /* 128 */ Tcl_PushCallFrame, /* 129 */ Tcl_RemoveInterpResolvers, /* 130 */ Tcl_SetNamespaceResolvers, /* 131 */ TclpHasSockets, /* 132 */ TclpGetDate, /* 133 */ 0, /* 134 */ ................................................................................ TclCheckExecutionTraces, /* 171 */ TclInThreadExit, /* 172 */ TclUniCharMatch, /* 173 */ 0, /* 174 */ TclCallVarTraces, /* 175 */ TclCleanupVar, /* 176 */ TclVarErrMsg, /* 177 */ TclSetStartupScript, /* 178 */ TclGetStartupScript, /* 179 */ 0, /* 180 */ 0, /* 181 */ TclpLocaltime, /* 182 */ TclpGmtime, /* 183 */ 0, /* 184 */ 0, /* 185 */ 0, /* 186 */ |
< < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < > > > > > > > > > | < < < < < < < < | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | | | | | | | | |
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 .. 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 ... 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 ... 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 ... 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 ... 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 |
#define TclBackgroundException Tcl_BackgroundException #undef Tcl_SetIntObj #undef TclpInetNtoa #undef TclWinGetServByName #undef TclWinGetSockOpt #undef TclWinSetSockOpt /* See bug 510001: TclSockMinimumBuffers needs plat imp */ #if defined(_WIN64) || defined(TCL_NO_DEPRECATED) # define TclSockMinimumBuffersOld 0 #else #define TclSockMinimumBuffersOld sockMinimumBuffersOld static int TclSockMinimumBuffersOld(int sock, int size) { return TclSockMinimumBuffers(INT2PTR(sock), size); } #endif #if defined(TCL_NO_DEPRECATED) # define TclSetStartupScriptPath 0 # define TclGetStartupScriptPath 0 # define TclSetStartupScriptFileName 0 # define TclGetStartupScriptFileName 0 # define TclWinNToHS 0 #else #define TclSetStartupScriptPath setStartupScriptPath static void TclSetStartupScriptPath(Tcl_Obj *path) { Tcl_SetStartupScript(path, NULL); } #define TclGetStartupScriptPath getStartupScriptPath static Tcl_Obj *TclGetStartupScriptPath(void) ................................................................................ #if defined(_WIN32) || defined(__CYGWIN__) #undef TclWinNToHS #define TclWinNToHS winNToHS static unsigned short TclWinNToHS(unsigned short ns) { return ntohs(ns); } #endif #endif /* TCL_NO_DEPRECATED */ #ifdef _WIN32 # define TclUnixWaitForFile 0 # define TclUnixCopyFile 0 # define TclUnixOpenTemporaryFile 0 # define TclpReaddir 0 # define TclpIsAtty 0 ................................................................................ } #define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp static int formatInt(char *buffer, int n){ return TclFormatInt(buffer, (long)n); } #define TclFormatInt (int(*)(char *, long))formatInt #endif /* TCL_WIDE_INT_IS_LONG */ #endif /* __CYGWIN__ */ #ifdef TCL_NO_DEPRECATED # define Tcl_SeekOld 0 # define Tcl_TellOld 0 # undef Tcl_SetBooleanObj # define Tcl_SetBooleanObj 0 # undef Tcl_PkgPresent ................................................................................ # define Tcl_DiscardResult 0 # undef Tcl_SetResult # define Tcl_SetResult 0 # undef Tcl_EvalObj # define Tcl_EvalObj 0 # undef Tcl_GlobalEvalObj # define Tcl_GlobalEvalObj 0 # define TclSetStartupScript 0 # define TclGetStartupScript 0 # define TclCreateNamespace 0 # define TclDeleteNamespace 0 # define TclAppendExportList 0 # define TclExport 0 # define TclImport 0 # define TclForgetImport 0 # define TclGetCurrentNamespace_ 0 # define TclGetGlobalNamespace_ 0 # define TclFindNamespace 0 # define TclFindCommand 0 # define TclGetCommandFromObj 0 # define TclGetCommandFullName 0 # undef TclpGetDate # define TclpGetDate 0 # undef TclpLocaltime # define TclpLocaltime 0 # undef TclpGmtime # define TclpGmtime 0 # define TclpLocaltime_unix 0 # define TclpGmtime_unix 0 #else /* TCL_NO_DEPRECATED */ # define Tcl_SeekOld seekOld # define Tcl_TellOld tellOld # define TclSetStartupScript Tcl_SetStartupScript # define TclGetStartupScript Tcl_GetStartupScript # define TclCreateNamespace Tcl_CreateNamespace # define TclDeleteNamespace Tcl_DeleteNamespace # define TclAppendExportList Tcl_AppendExportList # define TclExport Tcl_Export # define TclImport Tcl_Import # define TclForgetImport Tcl_ForgetImport # define TclGetCurrentNamespace_ Tcl_GetCurrentNamespace # define TclGetGlobalNamespace_ Tcl_GetGlobalNamespace # define TclFindNamespace Tcl_FindNamespace # define TclFindCommand Tcl_FindCommand # define TclGetCommandFromObj Tcl_GetCommandFromObj # define TclGetCommandFullName Tcl_GetCommandFullName # define TclpLocaltime_unix TclpLocaltime # define TclpGmtime_unix TclpGmtime static int seekOld( Tcl_Channel chan, /* The channel on which to seek. */ int offset, /* Offset to seek to. */ int mode) /* Relative to which location to seek? */ { ................................................................................ 0, /* 105 */ 0, /* 106 */ 0, /* 107 */ TclTeardownNamespace, /* 108 */ TclUpdateReturnInfo, /* 109 */ TclSockMinimumBuffers, /* 110 */ Tcl_AddInterpResolvers, /* 111 */ Tcl_AppendExportList, /* 112 */ Tcl_CreateNamespace, /* 113 */ Tcl_DeleteNamespace, /* 114 */ Tcl_Export, /* 115 */ Tcl_FindCommand, /* 116 */ Tcl_FindNamespace, /* 117 */ Tcl_GetInterpResolvers, /* 118 */ Tcl_GetNamespaceResolvers, /* 119 */ Tcl_FindNamespaceVar, /* 120 */ Tcl_ForgetImport, /* 121 */ Tcl_GetCommandFromObj, /* 122 */ Tcl_GetCommandFullName, /* 123 */ Tcl_GetCurrentNamespace, /* 124 */ Tcl_GetGlobalNamespace, /* 125 */ Tcl_GetVariableFullName, /* 126 */ Tcl_Import, /* 127 */ Tcl_PopCallFrame, /* 128 */ Tcl_PushCallFrame, /* 129 */ Tcl_RemoveInterpResolvers, /* 130 */ Tcl_SetNamespaceResolvers, /* 131 */ TclpHasSockets, /* 132 */ TclpGetDate, /* 133 */ 0, /* 134 */ ................................................................................ TclCheckExecutionTraces, /* 171 */ TclInThreadExit, /* 172 */ TclUniCharMatch, /* 173 */ 0, /* 174 */ TclCallVarTraces, /* 175 */ TclCleanupVar, /* 176 */ TclVarErrMsg, /* 177 */ Tcl_SetStartupScript, /* 178 */ Tcl_GetStartupScript, /* 179 */ 0, /* 180 */ 0, /* 181 */ TclpLocaltime, /* 182 */ TclpGmtime, /* 183 */ 0, /* 184 */ 0, /* 185 */ 0, /* 186 */ |
Added tests/case.test.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 |
# Commands covered: case # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {![llength [info commands case]]} { # No "case" command? So no need to test return } if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } test case-1.1 {simple pattern} { case a in a {format 1} b {format 2} c {format 3} default {format 4} } 1 test case-1.2 {simple pattern} { case b a {format 1} b {format 2} c {format 3} default {format 4} } 2 test case-1.3 {simple pattern} { case x in a {format 1} b {format 2} c {format 3} default {format 4} } 4 test case-1.4 {simple pattern} { case x a {format 1} b {format 2} c {format 3} } {} test case-1.5 {simple pattern matches many times} { case b a {format 1} b {format 2} b {format 3} b {format 4} } 2 test case-1.6 {fancier pattern} { case cx a {format 1} *c {format 2} *x {format 3} default {format 4} } 3 test case-1.7 {list of patterns} { case abc in {a b c} {format 1} {def abc ghi} {format 2} } 2 test case-2.1 {error in executed command} { list [catch {case a in a {error "Just a test"} default {format 1}} msg] \ $msg $::errorInfo } {1 {Just a test} {Just a test while executing "error "Just a test"" ("a" arm line 1) invoked from within "case a in a {error "Just a test"} default {format 1}"}} test case-2.2 {error: not enough args} { list [catch {case} msg] $msg } {1 {wrong # args: should be "case string ?in? ?pattern body ...? ?default body?"}} test case-2.3 {error: pattern with no body} { list [catch {case a b} msg] $msg } {1 {extra case pattern with no body}} test case-2.4 {error: pattern with no body} { list [catch {case a in b {format 1} c} msg] $msg } {1 {extra case pattern with no body}} test case-2.5 {error in default command} { list [catch {case foo in a {error case1} default {error case2} \ b {error case 3}} msg] $msg $::errorInfo } {1 case2 {case2 while executing "error case2" ("default" arm line 1) invoked from within "case foo in a {error case1} default {error case2} b {error case 3}"}} test case-3.1 {single-argument form for pattern/command pairs} { case b in { a {format 1} b {format 2} default {format 6} } } {2} test case-3.2 {single-argument form for pattern/command pairs} { case b { a {format 1} b {format 2} default {format 6} } } {2} test case-3.3 {single-argument form for pattern/command pairs} { list [catch {case z in {a 2 b}} msg] $msg } {1 {extra case pattern with no body}} # cleanup ::tcltest::cleanupTests return |