Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Merge some trunk changes. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | core-9-0-b2-rc |
Files: | files | file ages | folders |
SHA3-256: |
c4ee2d267c48ddb898758c66a7ef8997 |
User & Date: | dgp 2024-04-24 15:48:34 |
Context
2024-04-24
| ||
17:02 | Merge more from trunk check-in: 13eb2298bc user: dgp tags: core-9-0-b2-rc | |
15:48 | Merge some trunk changes. check-in: c4ee2d267c user: dgp tags: core-9-0-b2-rc | |
2024-04-11
| ||
08:55 | Use Tcl_NewBooleanObj for booleans; we should say what we mean check-in: ba65f6c8c4 user: dkf tags: trunk, main | |
2024-04-10
| ||
15:06 | merge trunk check-in: c0e98b5545 user: dgp tags: core-9-0-b2-rc | |
Changes
Changes to generic/tclArithSeries.c.
︙ | ︙ | |||
875 876 877 878 879 880 881 | Tcl_Obj *objPtr, /* ArithSeries object for which an element * array is to be returned. */ Tcl_Size *objcPtr, /* Where to store the count of objects * referenced by objv. */ Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of * pointers to the list's objects. */ { | | | 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 | Tcl_Obj *objPtr, /* ArithSeries object for which an element * array is to be returned. */ Tcl_Size *objcPtr, /* Where to store the count of objects * referenced by objv. */ Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of * pointers to the list's objects. */ { if (TclHasInternalRep(objPtr, &arithSeriesType)) { ArithSeries *arithSeriesRepPtr; Tcl_Obj **objv; int i, objc; arithSeriesRepPtr = ArithSeriesGetInternalRep(objPtr); objc = arithSeriesRepPtr->len; |
︙ | ︙ |
Changes to generic/tclClock.c.
︙ | ︙ | |||
1135 1136 1137 1138 1139 1140 1141 | dataPtr->defFlags |= CLF_VALIDATE; } else { dataPtr->defFlags &= ~CLF_VALIDATE; } } if (i+1 >= objc) { Tcl_SetObjResult(interp, | | | 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 | dataPtr->defFlags |= CLF_VALIDATE; } else { dataPtr->defFlags &= ~CLF_VALIDATE; } } if (i+1 >= objc) { Tcl_SetObjResult(interp, Tcl_NewBooleanObj(dataPtr->defFlags & CLF_VALIDATE)); } break; case CLOCK_CLEAR_CACHE: ClockConfigureClear(dataPtr); break; case CLOCK_INIT_COMPLETE: { |
︙ | ︙ | |||
3452 3453 3454 3455 3456 3457 3458 | int idx; if (Tcl_GetIndexFromObj(interp, baseObj, nowOpts, "seconds", TCL_EXACT, &idx) == TCL_OK ) { goto baseNow; } | | | | 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 | int idx; if (Tcl_GetIndexFromObj(interp, baseObj, nowOpts, "seconds", TCL_EXACT, &idx) == TCL_OK ) { goto baseNow; } if (TclHasInternalRep(baseObj, &tclBignumType)) { goto baseOverflow; } Tcl_AppendResult(interp, " or integer", NULL); i = baseIdx; goto badOption; } /* * Seconds could be an unsigned number that overflowed. Make sure * that it isn't. Additionally it may be too complex to calculate * julianday etc (forwards/backwards) by too large/small values, thus * just let accept a bit shorter values to avoid overflow. * Note the year is currently an integer, thus avoid to overflow it also. */ if (TclHasInternalRep(baseObj, &tclBignumType) || baseVal < TCL_MIN_SECONDS || baseVal > TCL_MAX_SECONDS ) { baseOverflow: Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); i = baseIdx; goto badOption; } |
︙ | ︙ | |||
4459 4460 4461 4462 4463 4464 4465 | continue; } /* get unit */ if (Tcl_GetIndexFromObj(interp, objv[i+1], units, "unit", 0, &unitIndex) != TCL_OK) { goto done; } | | | 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 | continue; } /* get unit */ if (Tcl_GetIndexFromObj(interp, objv[i+1], units, "unit", 0, &unitIndex) != TCL_OK) { goto done; } if (TclHasInternalRep(objv[i], &tclBignumType) || offs > (unitIndex < CLC_ADD_HOURS ? 0x7fffffff : TCL_MAX_SECONDS) || offs < (unitIndex < CLC_ADD_HOURS ? -0x7fffffff : TCL_MIN_SECONDS) ) { Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); goto done; } |
︙ | ︙ |
Changes to generic/tclCmdIL.c.
︙ | ︙ | |||
985 986 987 988 989 990 991 | && (strcmp(argName, localPtr->name) == 0)) { if (localPtr->defValuePtr != NULL) { valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL, localPtr->defValuePtr, TCL_LEAVE_ERR_MSG); if (valueObjPtr == NULL) { return TCL_ERROR; } | | | | 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 | && (strcmp(argName, localPtr->name) == 0)) { if (localPtr->defValuePtr != NULL) { valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL, localPtr->defValuePtr, TCL_LEAVE_ERR_MSG); if (valueObjPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); } else { Tcl_Obj *nullObjPtr; TclNewObj(nullObjPtr); valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL, nullObjPtr, TCL_LEAVE_ERR_MSG); if (valueObjPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); } return TCL_OK; } } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "procedure \"%s\" doesn't have an argument \"%s\"", |
︙ | ︙ |
Changes to generic/tclDictObj.c.
︙ | ︙ | |||
2105 2106 2107 2108 2109 2110 2111 | TclDictObjSmartRef( Tcl_Interp *interp, Tcl_Obj *dictPtr) { Tcl_Obj *result; Dict *dict; | | | 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 | TclDictObjSmartRef( Tcl_Interp *interp, Tcl_Obj *dictPtr) { Tcl_Obj *result; Dict *dict; if (!TclHasInternalRep(dictPtr, &tclDictType) && SetDictFromAny(interp, dictPtr) != TCL_OK) { return NULL; } DictGetInternalRep(dictPtr, dict); result = Tcl_NewObj(); |
︙ | ︙ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
8491 8492 8493 8494 8495 8496 8497 | WIDE_RESULT(wResult); } } overflowExpon: if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK) | | | 8491 8492 8493 8494 8495 8496 8497 8498 8499 8500 8501 8502 8503 8504 8505 | WIDE_RESULT(wResult); } } overflowExpon: if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK) || !TclHasInternalRep(value2Ptr, &tclIntType) || (Tcl_WideUInt)w2 >= (1<<28)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "exponent too large", -1)); return GENERAL_ARITHMETIC_ERROR; } Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); err = mp_init(&bigResult); |
︙ | ︙ |
Changes to generic/tclIOCmd.c.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | /* * tclIOCmd.c -- * * Contains the definitions of most of the Tcl commands relating to IO. * * Copyright © 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclTomMath.h" /* * Callback structure for accept callback in a TCP server. */ typedef struct { | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | /* * tclIOCmd.c -- * * Contains the definitions of most of the Tcl commands relating to IO. * * Copyright © 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclIO.h" #include "tclTomMath.h" /* * Callback structure for accept callback in a TCP server. */ typedef struct { |
︙ | ︙ | |||
1129 1130 1131 1132 1133 1134 1135 | /* * Open the file or create a process pipeline. */ if (!pipeline) { chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot); } else { | | | | | | 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 | /* * Open the file or create a process pipeline. */ if (!pipeline) { chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot); } else { int mode, modeFlags; Tcl_Size cmdObjc; const char **cmdArgv; if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) { return TCL_ERROR; } mode = TclGetOpenMode(interp, modeString, &modeFlags); if (mode == -1) { chan = NULL; } else { int flags = TCL_STDERR | TCL_ENFORCE_MODE; switch (mode & O_ACCMODE) { case O_RDONLY: flags |= TCL_STDOUT; break; case O_WRONLY: flags |= TCL_STDIN; break; case O_RDWR: flags |= (TCL_STDIN | TCL_STDOUT); break; default: Tcl_Panic("Tcl_OpenCmd: invalid mode value"); break; } chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags); if ((modeFlags & CHANNEL_RAW_MODE) && chan) { Tcl_SetChannelOption(interp, chan, "-translation", "binary"); } } Tcl_Free((void *)cmdArgv); } if (chan == NULL) { return TCL_ERROR; |
︙ | ︙ |
Changes to generic/tclIOUtil.c.
︙ | ︙ | |||
12 13 14 15 16 17 18 19 20 21 22 23 24 25 | * Copyright © 2001-2004 Vincent Darley. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef _WIN32 # include "tclWinInt.h" #endif #include "tclFileSystem.h" #ifdef TCL_TEMPLOAD_NO_UNLINK #ifndef NO_FSTATFS | > | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | * Copyright © 2001-2004 Vincent Darley. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclIO.h" #ifdef _WIN32 # include "tclWinInt.h" #endif #include "tclFileSystem.h" #ifdef TCL_TEMPLOAD_NO_UNLINK #ifndef NO_FSTATFS |
︙ | ︙ | |||
1414 1415 1416 1417 1418 1419 1420 | } /* *--------------------------------------------------------------------------- * * TclGetOpenMode -- * | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | > | < | | | < < | < < | < < | | < | | < | < | > > > > > > > > > > > > > > > | > > > | > > > | > > > > > > > > | > > > | > | > > > > | < > > > | < < > > > > > > | < | | | | < | | 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 | } /* *--------------------------------------------------------------------------- * * TclGetOpenMode -- * * Computes a POSIX mode mask for opening a file. * * Results: * The mode to pass to "open", or -1 if an error occurs. * * Side effects: * Sets *modeFlagsPtr to 1 to tell the caller to * seek to EOF after opening the file, or to 0 otherwise. * * Adds CHANNEL_RAW_MODE to *modeFlagsPtr to tell the caller * to configure the channel as a binary channel. * * If there is an error and interp is not NULL, sets * interpreter result to an error message. * * Special note: * Based on a prototype implementation contributed by Mark Diekhans. * *--------------------------------------------------------------------------- */ int TclGetOpenMode( Tcl_Interp *interp, /* Interpreter, possibly NULL, to use for * error reporting. */ const char *modeString, /* Mode string, e.g. "r+" or "RDONLY CREAT" */ int *modeFlagsPtr) { int mode, c, gotRW; Tcl_Size modeArgc, i; const char **modeArgv = NULL, *flag; /* * Check for the simpler fopen-like access modes like "r" which are * distinguished from the POSIX access modes by the presence of a * lower-case first letter. */ *modeFlagsPtr = 0; mode = O_RDONLY; /* * Guard against wide characters before using byte-oriented routines. */ if (!(modeString[0] & 0x80) && islower(UCHAR(modeString[0]))) { /* INTL: ISO only. */ switch (modeString[0]) { case 'r': break; case 'w': mode = O_WRONLY|O_CREAT|O_TRUNC; break; case 'a': /* * Add O_APPEND for proper automatic seek-to-end-on-write by the * OS. [Bug 680143] */ mode = O_WRONLY|O_CREAT|O_APPEND; *modeFlagsPtr |= 1; break; default: goto error; } i = 1; while (i<3 && modeString[i]) { if (modeString[i] == modeString[i-1]) { goto error; } switch (modeString[i++]) { case '+': /* * Remove O_APPEND so that the seek command works. [Bug * 1773127] */ mode = (mode & ~(O_ACCMODE|O_APPEND)) | O_RDWR; break; case 'b': *modeFlagsPtr |= CHANNEL_RAW_MODE; break; default: goto error; } } if (modeString[i] != 0) { goto error; } return mode; error: *modeFlagsPtr = 0; if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "illegal access mode \"%s\"", modeString)); Tcl_SetErrorCode(interp, "TCL", "OPENMODE", "INVALID", (char *)NULL); } return -1; } /* * The access modes are specified as a list of POSIX modes like O_CREAT. * * Tcl_SplitList must work correctly when interp is NULL. */ if (Tcl_SplitList(interp, modeString, &modeArgc, &modeArgv) != TCL_OK) { invAccessMode: if (interp != NULL) { Tcl_AddErrorInfo(interp, "\n while processing open access modes \""); Tcl_AddErrorInfo(interp, modeString); Tcl_AddErrorInfo(interp, "\""); Tcl_SetErrorCode(interp, "TCL", "OPENMODE", "INVALID", (char *)NULL); } if (modeArgv) { Tcl_Free((void *)modeArgv); } return -1; } gotRW = 0; for (i = 0; i < modeArgc; i++) { flag = modeArgv[i]; c = flag[0]; if ((c == 'R') && (strcmp(flag, "RDONLY") == 0)) { if (gotRW) { invRW: if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid access mode \"%s\": modes RDONLY, " "RDWR, and WRONLY cannot be combined", flag)); } goto invAccessMode; } mode = (mode & ~O_ACCMODE) | O_RDONLY; gotRW = 1; } else if ((c == 'W') && (strcmp(flag, "WRONLY") == 0)) { if (gotRW) { goto invRW; } mode = (mode & ~O_ACCMODE) | O_WRONLY; gotRW = 1; } else if ((c == 'R') && (strcmp(flag, "RDWR") == 0)) { if (gotRW) { goto invRW; } mode = (mode & ~O_ACCMODE) | O_RDWR; gotRW = 1; } else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) { if (mode & O_APPEND) { accessFlagRepeated: if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "access mode \"%s\" repeated", flag)); } goto invAccessMode; } mode |= O_APPEND; *modeFlagsPtr |= 1; } else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) { if (mode & O_CREAT) { goto accessFlagRepeated; } mode |= O_CREAT; } else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) { if (mode & O_EXCL) { goto accessFlagRepeated; } mode |= O_EXCL; } else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) { #ifdef O_NOCTTY if (mode & O_NOCTTY) { goto accessFlagRepeated; } mode |= O_NOCTTY; #else if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "access mode \"%s\" not supported by this system", flag)); } goto invAccessMode; #endif } else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) { #ifdef O_NONBLOCK if (mode & O_NONBLOCK) { goto accessFlagRepeated; } mode |= O_NONBLOCK; #else if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "access mode \"%s\" not supported by this system", flag)); } goto invAccessMode; #endif } else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) { if (mode & O_TRUNC) { goto accessFlagRepeated; } mode |= O_TRUNC; } else if ((c == 'B') && (strcmp(flag, "BINARY") == 0)) { if (*modeFlagsPtr & CHANNEL_RAW_MODE) { goto accessFlagRepeated; } *modeFlagsPtr |= CHANNEL_RAW_MODE; } else { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid access mode \"%s\": must be APPEND, BINARY, " "CREAT, EXCL, NOCTTY, NONBLOCK, RDONLY, RDWR, " "TRUNC, or WRONLY", flag)); } goto invAccessMode; } } Tcl_Free((void *)modeArgv); if (!gotRW) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "access mode must include either RDONLY, RDWR, or WRONLY", -1)); } return -1; } return mode; } |
︙ | ︙ | |||
2204 2205 2206 2207 2208 2209 2210 | * Return the correct error message. */ return NULL; } fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->openFileChannelProc != NULL) { | | | | | | 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 | * Return the correct error message. */ return NULL; } fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->openFileChannelProc != NULL) { int mode, modeFlags; /* * Parse the mode to determine whether to seek at the outset * and/or set the channel into binary mode. */ mode = TclGetOpenMode(interp, modeString, &modeFlags); if (mode == -1) { return NULL; } /* * Open the file. */ retVal = fsPtr->openFileChannelProc(interp, pathPtr, mode, permissions); if (retVal == NULL) { return NULL; } /* * Seek and/or set binary mode as determined above. */ if ((modeFlags & 1) && Tcl_Seek(retVal, (Tcl_WideInt) 0, SEEK_END) < (Tcl_WideInt) 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not seek to end of file while opening \"%s\": %s", TclGetString(pathPtr), Tcl_PosixError(interp))); } Tcl_CloseEx(NULL, retVal, 0); return NULL; } if (modeFlags & CHANNEL_RAW_MODE) { Tcl_SetChannelOption(interp, retVal, "-translation", "binary"); } return retVal; } /* * File doesn't belong to any filesystem that can open it. |
︙ | ︙ |
Changes to generic/tclInt.decls.
︙ | ︙ | |||
99 100 101 102 103 104 105 | Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr) } declare 39 { Tcl_ObjCmdProc *TclGetObjInterpProc(void) } declare 40 { | | | 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 | Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr) } declare 39 { Tcl_ObjCmdProc *TclGetObjInterpProc(void) } declare 40 { int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *modeFlagsPtr) } declare 41 { Tcl_Command TclGetOriginalCommand(Tcl_Command command) } declare 42 { const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) } |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
2706 2707 2708 2709 2710 2711 2712 | /* * Converts the Tcl_Obj to a list if it isn't one and stores the element * count and base address of this list's elements in objcPtr_ and objvPtr_. * Return TCL_OK on success or TCL_ERROR if the Tcl_Obj cannot be * converted to a list. */ #define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_) \ | | | | | | | | | | | | | | 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 | /* * Converts the Tcl_Obj to a list if it isn't one and stores the element * count and base address of this list's elements in objcPtr_ and objvPtr_. * Return TCL_OK on success or TCL_ERROR if the Tcl_Obj cannot be * converted to a list. */ #define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_) \ ((TclHasInternalRep((listObj_), &tclListType)) \ ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \ TCL_OK) \ : Tcl_ListObjGetElements( \ (interp_), (listObj_), (objcPtr_), (objvPtr_))) /* * Converts the Tcl_Obj to a list if it isn't one and stores the element * count in lenPtr_. Returns TCL_OK on success or TCL_ERROR if the * Tcl_Obj cannot be converted to a list. */ #define TclListObjLength(interp_, listObj_, lenPtr_) \ ((TclHasInternalRep((listObj_), &tclListType)) \ ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \ : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_))) #define TclListObjIsCanonical(listObj_) \ ((TclHasInternalRep((listObj_), &tclListType)) ? ListObjIsCanonical((listObj_)) : 0) /* * Modes for collecting (or not) in the implementations of TclNRForeachCmd, * TclNRLmapCmd and their compilations. */ #define TCL_EACH_KEEP_NONE 0 /* Discard iteration result like [foreach] */ #define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */ /* * Macros providing a faster path to booleans and integers: * Tcl_GetBooleanFromObj, Tcl_GetLongFromObj, Tcl_GetIntFromObj * and Tcl_GetIntForIndex. * * WARNING: these macros eval their args more than once. */ #if TCL_MAJOR_VERSION > 8 #define TclGetBooleanFromObj(interp, objPtr, intPtr) \ ((TclHasInternalRep((objPtr), &tclIntType) \ || TclHasInternalRep((objPtr), &tclBooleanType)) \ ? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr))) #else #define TclGetBooleanFromObj(interp, objPtr, intPtr) \ ((TclHasInternalRep((objPtr), &tclIntType)) \ ? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ : (TclHasInternalRep((objPtr), &tclBooleanType)) \ ? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr))) #endif #ifdef TCL_WIDE_INT_IS_LONG #define TclGetLongFromObj(interp, objPtr, longPtr) \ ((TclHasInternalRep((objPtr), &tclIntType)) \ ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) #else #define TclGetLongFromObj(interp, objPtr, longPtr) \ ((TclHasInternalRep((objPtr), &tclIntType) \ && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \ ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) #endif #define TclGetIntFromObj(interp, objPtr, intPtr) \ ((TclHasInternalRep((objPtr), &tclIntType) \ && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \ ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ (((TclHasInternalRep((objPtr), &tclIntType)) && ((objPtr)->internalRep.wideValue >= 0) \ && ((objPtr)->internalRep.wideValue <= endValue)) \ ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) /* * Macro used to save a function call for common uses of * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is: * * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, * Tcl_WideInt *wideIntPtr); */ #define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ ((TclHasInternalRep((objPtr), &tclIntType)) \ ? (*(wideIntPtr) = \ ((objPtr)->internalRep.wideValue), TCL_OK) : \ Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) /* * Flag values for TclTraceDictPath(). * |
︙ | ︙ | |||
3355 3356 3357 3358 3359 3360 3361 | Tcl_Obj *objPtr, Tcl_Channel *chanPtr, int *modePtr, int flags); MODULE_SCOPE CmdFrame * TclGetCmdFrameForProcedure(Proc *procPtr); MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp, Tcl_Obj *value, int *code); MODULE_SCOPE Proc * TclGetLambdaFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **nsObjPtrPtr); | < < < | 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 | Tcl_Obj *objPtr, Tcl_Channel *chanPtr, int *modePtr, int flags); MODULE_SCOPE CmdFrame * TclGetCmdFrameForProcedure(Proc *procPtr); MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp, Tcl_Obj *value, int *code); MODULE_SCOPE Proc * TclGetLambdaFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **nsObjPtrPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr, Tcl_Size *sizePtr); MODULE_SCOPE int TclGetLoadedLibraries(Tcl_Interp *interp, const char *targetName, |
︙ | ︙ | |||
4609 4610 4611 4612 4613 4614 4615 | * * MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); #define TclIsPureDict(objPtr) \ | | | 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 | * * MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); #define TclIsPureDict(objPtr) \ (((objPtr)->bytes==NULL) && TclHasInternalRep((objPtr), &tclDictType)) #define TclHasInternalRep(objPtr, type) \ ((objPtr)->typePtr == (type)) #define TclFetchInternalRep(objPtr, type) \ (TclHasInternalRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL) /* |
︙ | ︙ |
Changes to generic/tclIntDecls.h.
︙ | ︙ | |||
120 121 122 123 124 125 126 | Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 39 */ EXTERN Tcl_ObjCmdProc * TclGetObjInterpProc(void); /* 40 */ EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str, | | | 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 | Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 39 */ EXTERN Tcl_ObjCmdProc * TclGetObjInterpProc(void); /* 40 */ EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *modeFlagsPtr); /* 41 */ EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command); /* 42 */ EXTERN const char * TclpGetUserHome(const char *name, Tcl_DString *bufferPtr); /* 43 */ EXTERN Tcl_ObjCmdProc2 * TclGetObjInterpProc2(void); |
︙ | ︙ | |||
616 617 618 619 620 621 622 | void (*reserved33)(void); void (*reserved34)(void); void (*reserved35)(void); void (*reserved36)(void); void (*reserved37)(void); int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */ Tcl_ObjCmdProc * (*tclGetObjInterpProc) (void); /* 39 */ | | | 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 | void (*reserved33)(void); void (*reserved34)(void); void (*reserved35)(void); void (*reserved36)(void); void (*reserved37)(void); int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */ Tcl_ObjCmdProc * (*tclGetObjInterpProc) (void); /* 39 */ int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *modeFlagsPtr); /* 40 */ Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */ const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */ Tcl_ObjCmdProc2 * (*tclGetObjInterpProc2) (void); /* 43 */ void (*reserved44)(void); int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */ int (*tclInExit) (void); /* 46 */ void (*reserved47)(void); |
︙ | ︙ |
Changes to generic/tclMain.c.
︙ | ︙ | |||
356 357 358 359 360 361 362 | /* * Set the "tcl_interactive" variable. */ is.tty = isatty(0); Tcl_SetVar2Ex(interp, "tcl_interactive", NULL, | | | 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 | /* * Set the "tcl_interactive" variable. */ is.tty = isatty(0); Tcl_SetVar2Ex(interp, "tcl_interactive", NULL, Tcl_NewBooleanObj(!path && is.tty), TCL_GLOBAL_ONLY); /* * Invoke application-specific initialization. */ Tcl_Preserve(interp); if (appInitProc(interp) != TCL_OK) { |
︙ | ︙ |
Changes to generic/tclOOInfo.c.
︙ | ︙ | |||
207 208 209 210 211 212 213 | } FOREACH(mixinPtr, oPtr->mixins) { if (!mixinPtr) { continue; } if (TclOOIsReachable(o2clsPtr, mixinPtr)) { | | | | 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 | } FOREACH(mixinPtr, oPtr->mixins) { if (!mixinPtr) { continue; } if (TclOOIsReachable(o2clsPtr, mixinPtr)) { Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); return TCL_OK; } } Tcl_SetObjResult(interp, Tcl_NewBooleanObj( TclOOIsReachable(o2clsPtr, oPtr->selfCls))); return TCL_OK; } } /* * ---------------------------------------------------------------------- |
︙ | ︙ |
Changes to generic/tclObj.c.
︙ | ︙ | |||
2017 2018 2019 2020 2021 2022 2023 | TclParseNumber(interp, objPtr, (flags & TCL_NULL_OK) ? "boolean value or \"\"" : "boolean value", NULL, TCL_INDEX_NONE, NULL, 0); Tcl_DecrRefCount(objPtr); } return TCL_ERROR; } do { | | | | | 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 | TclParseNumber(interp, objPtr, (flags & TCL_NULL_OK) ? "boolean value or \"\"" : "boolean value", NULL, TCL_INDEX_NONE, NULL, 0); Tcl_DecrRefCount(objPtr); } return TCL_ERROR; } do { if (TclHasInternalRep(objPtr, &tclIntType) || TclHasInternalRep(objPtr, &tclBooleanType)) { result = (objPtr->internalRep.wideValue != 0); goto boolEnd; } if (TclHasInternalRep(objPtr, &tclDoubleType)) { /* * Caution: Don't be tempted to check directly for the "double" * Tcl_ObjType and then compare the internalrep to 0.0. This isn't * reliable because a "double" Tcl_ObjType can hold the NaN value. * Use the API Tcl_GetDoubleFromObj, which does the checking and * sets the proper error message for us. */ double d; if (Tcl_GetDoubleFromObj(interp, objPtr, &d) != TCL_OK) { return TCL_ERROR; } result = (d != 0.0); goto boolEnd; } if (TclHasInternalRep(objPtr, &tclBignumType)) { result = 1; boolEnd: if (charPtr != NULL) { flags &= (TCL_NULL_OK-2); if (flags) { if (flags == (int)sizeof(int)) { *(int *)charPtr = result; |
︙ | ︙ | |||
2106 2107 2108 2109 2110 2111 2112 | /* * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine * whether a boolean conversion is possible without generating the string * rep. */ if (objPtr->bytes == NULL) { | | | | | 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 | /* * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine * whether a boolean conversion is possible without generating the string * rep. */ if (objPtr->bytes == NULL) { if (TclHasInternalRep(objPtr, &tclIntType)) { if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) { return TCL_OK; } goto badBoolean; } if (TclHasInternalRep(objPtr, &tclBignumType)) { goto badBoolean; } if (TclHasInternalRep(objPtr, &tclDoubleType)) { goto badBoolean; } } if (ParseBoolean(objPtr) == TCL_OK) { return TCL_OK; } |
︙ | ︙ | |||
2419 2420 2421 2422 2423 2424 2425 | int Tcl_GetDoubleFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get a double. */ double *dblPtr) /* Place to store resulting double. */ { do { | | | | | 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 | int Tcl_GetDoubleFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get a double. */ double *dblPtr) /* Place to store resulting double. */ { do { if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (isnan(objPtr->internalRep.doubleValue)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "floating point value is Not a Number", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN", (void *)NULL); } return TCL_ERROR; } *dblPtr = (double) objPtr->internalRep.doubleValue; return TCL_OK; } if (TclHasInternalRep(objPtr, &tclIntType)) { *dblPtr = (double) objPtr->internalRep.wideValue; return TCL_OK; } if (TclHasInternalRep(objPtr, &tclBignumType)) { mp_int big; TclUnpackBignum(objPtr, big); *dblPtr = TclBignumToDouble(&big); return TCL_OK; } } while (SetDoubleFromAny(interp, objPtr) == TCL_OK); |
︙ | ︙ | |||
2650 2651 2652 2653 2654 2655 2656 | Tcl_GetLongFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get a long. */ long *longPtr) /* Place to store resulting long. */ { do { #ifdef TCL_WIDE_INT_IS_LONG | | | | | | 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 | Tcl_GetLongFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get a long. */ long *longPtr) /* Place to store resulting long. */ { do { #ifdef TCL_WIDE_INT_IS_LONG if (TclHasInternalRep(objPtr, &tclIntType)) { *longPtr = objPtr->internalRep.wideValue; return TCL_OK; } #else if (TclHasInternalRep(objPtr, &tclIntType)) { /* * We return any integer in the range LONG_MIN to ULONG_MAX * converted to a long, ignoring overflow. The rule preserves * existing semantics for conversion of integers on input, but * avoids inadvertent demotion of wide integers to 32-bit ones in * the internal rep. */ Tcl_WideInt w = objPtr->internalRep.wideValue; if (w >= (Tcl_WideInt)(LONG_MIN) && w <= (Tcl_WideInt)(ULONG_MAX)) { *longPtr = (long)w; return TCL_OK; } goto tooLarge; } #endif if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; } if (TclHasInternalRep(objPtr, &tclBignumType)) { /* * Must check for those bignum values that can fit in a long, even * when auto-narrowing is enabled. Only those values in the signed * long range get auto-narrowed to tclIntType, while all the * values in the unsigned long range will fit in a long. */ |
︙ | ︙ | |||
2911 2912 2913 2914 2915 2916 2917 | Tcl_GetWideIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* Object from which to get a wide int. */ Tcl_WideInt *wideIntPtr) /* Place to store resulting long. */ { do { | | | | | 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 | Tcl_GetWideIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* Object from which to get a wide int. */ Tcl_WideInt *wideIntPtr) /* Place to store resulting long. */ { do { if (TclHasInternalRep(objPtr, &tclIntType)) { *wideIntPtr = objPtr->internalRep.wideValue; return TCL_OK; } if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; } if (TclHasInternalRep(objPtr, &tclBignumType)) { /* * Must check for those bignum values that can fit in a * Tcl_WideInt, even when auto-narrowing is enabled. */ mp_int big; Tcl_WideUInt value = 0; |
︙ | ︙ | |||
2996 2997 2998 2999 3000 3001 3002 | Tcl_GetWideUIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* Object from which to get a wide int. */ Tcl_WideUInt *wideUIntPtr) /* Place to store resulting long. */ { do { | | | | | 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 | Tcl_GetWideUIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* Object from which to get a wide int. */ Tcl_WideUInt *wideUIntPtr) /* Place to store resulting long. */ { do { if (TclHasInternalRep(objPtr, &tclIntType)) { if (objPtr->internalRep.wideValue < 0) { wideUIntOutOfRange: if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected unsigned integer but got \"%s\"", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; } *wideUIntPtr = (Tcl_WideUInt)objPtr->internalRep.wideValue; return TCL_OK; } if (TclHasInternalRep(objPtr, &tclDoubleType)) { goto wideUIntOutOfRange; } if (TclHasInternalRep(objPtr, &tclBignumType)) { /* * Must check for those bignum values that can fit in a * Tcl_WideUInt, even when auto-narrowing is enabled. */ mp_int big; Tcl_WideUInt value = 0; |
︙ | ︙ | |||
3080 3081 3082 3083 3084 3085 3086 | int TclGetWideBitsFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* Object from which to get a wide int. */ Tcl_WideInt *wideIntPtr) /* Place to store resulting wide integer. */ { do { | | | | | 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 | int TclGetWideBitsFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* Object from which to get a wide int. */ Tcl_WideInt *wideIntPtr) /* Place to store resulting wide integer. */ { do { if (TclHasInternalRep(objPtr, &tclIntType)) { *wideIntPtr = objPtr->internalRep.wideValue; return TCL_OK; } if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; } if (TclHasInternalRep(objPtr, &tclBignumType)) { mp_int big; mp_err err; Tcl_WideUInt value = 0, scratch; size_t numBytes; unsigned char *bytes = (unsigned char *) &scratch; |
︙ | ︙ | |||
3376 3377 3378 3379 3380 3381 3382 | GetBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ int copy, /* Whether to copy the returned bignum value */ mp_int *bignumValue) /* Returned bignum value. */ { do { | | | 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 | GetBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ int copy, /* Whether to copy the returned bignum value */ mp_int *bignumValue) /* Returned bignum value. */ { do { if (TclHasInternalRep(objPtr, &tclBignumType)) { if (copy || Tcl_IsShared(objPtr)) { mp_int temp; TclUnpackBignum(objPtr, temp); if (mp_init_copy(bignumValue, &temp) != MP_OKAY) { return TCL_ERROR; } |
︙ | ︙ | |||
3401 3402 3403 3404 3405 3406 3407 | */ if (objPtr->bytes == NULL) { TclInitEmptyStringRep(objPtr); } } return TCL_OK; } | | | | 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 | */ if (objPtr->bytes == NULL) { TclInitEmptyStringRep(objPtr); } } return TCL_OK; } if (TclHasInternalRep(objPtr, &tclIntType)) { if (mp_init_i64(bignumValue, objPtr->internalRep.wideValue) != MP_OKAY) { return TCL_ERROR; } return TCL_OK; } if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; |
︙ | ︙ | |||
3611 3612 3613 3614 3615 3616 3617 | Tcl_GetNumberFromObj( Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr) { do { | | | | | 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 | Tcl_GetNumberFromObj( Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr) { do { if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (isnan(objPtr->internalRep.doubleValue)) { *typePtr = TCL_NUMBER_NAN; } else { *typePtr = TCL_NUMBER_DOUBLE; } *clientDataPtr = &objPtr->internalRep.doubleValue; return TCL_OK; } if (TclHasInternalRep(objPtr, &tclIntType)) { *typePtr = TCL_NUMBER_INT; *clientDataPtr = &objPtr->internalRep.wideValue; return TCL_OK; } if (TclHasInternalRep(objPtr, &tclBignumType)) { static Tcl_ThreadDataKey bignumKey; mp_int *bigPtr = (mp_int *)Tcl_GetThreadData(&bignumKey, sizeof(mp_int)); TclUnpackBignum(objPtr, *bigPtr); *typePtr = TCL_NUMBER_BIG; *clientDataPtr = bigPtr; |
︙ | ︙ | |||
4265 4266 4267 4268 4269 4270 4271 | * is not deleted. * * If any check fails, then force another conversion to the command type, * to discard the old rep and create a new one. */ resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; | | | 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 | * is not deleted. * * If any check fails, then force another conversion to the command type, * to discard the old rep and create a new one. */ resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; if (TclHasInternalRep(objPtr, &tclCmdNameType)) { Command *cmdPtr = resPtr->cmdPtr; if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch) && (interp == cmdPtr->nsPtr->interp) && !(cmdPtr->nsPtr->flags & NS_DYING)) { Namespace *refNsPtr = (Namespace *) TclGetCurrentNamespace(interp); |
︙ | ︙ | |||
4380 4381 4382 4383 4384 4385 4386 | Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a * CmdName object. */ Command *cmdPtr) /* Points to Command structure that the * CmdName object should refer to. */ { ResolvedCmdName *resPtr; | | | 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 | Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a * CmdName object. */ Command *cmdPtr) /* Points to Command structure that the * CmdName object should refer to. */ { ResolvedCmdName *resPtr; if (TclHasInternalRep(objPtr, &tclCmdNameType)) { resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; if (resPtr != NULL && resPtr->cmdPtr == cmdPtr) { return; } } SetCmdNameObj(interp, objPtr, cmdPtr, NULL); |
︙ | ︙ | |||
4527 4528 4529 4530 4531 4532 4533 | */ if (cmdPtr == NULL || !TclRoutineHasName(cmdPtr)) { return TCL_ERROR; } resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; | | | 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 | */ if (cmdPtr == NULL || !TclRoutineHasName(cmdPtr)) { return TCL_ERROR; } resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; if (TclHasInternalRep(objPtr, &tclCmdNameType) && (resPtr->refCount == 1)) { /* * Re-use existing ResolvedCmdName struct when possible. * Cleanup the old fields that need it. */ Command *oldCmdPtr = resPtr->cmdPtr; |
︙ | ︙ | |||
4588 4589 4590 4591 4592 4593 4594 | descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_SIZE_MODIFIER "d," " object pointer at %p", objv[1]->typePtr ? objv[1]->typePtr->name : "pure string", objv[1]->refCount, objv[1]); if (objv[1]->typePtr) { | | | 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 | descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_SIZE_MODIFIER "d," " object pointer at %p", objv[1]->typePtr ? objv[1]->typePtr->name : "pure string", objv[1]->refCount, objv[1]); if (objv[1]->typePtr) { if (TclHasInternalRep(objv[1], &tclDoubleType)) { Tcl_AppendPrintfToObj(descObj, ", internal representation %g", objv[1]->internalRep.doubleValue); } else { Tcl_AppendPrintfToObj(descObj, ", internal representation %p:%p", (void *) objv[1]->internalRep.twoPtrValue.ptr1, (void *) objv[1]->internalRep.twoPtrValue.ptr2); } |
︙ | ︙ |
Changes to generic/tclStringObj.c.
︙ | ︙ | |||
125 126 127 128 129 130 131 | GrowStringBuffer( Tcl_Obj *objPtr, Tcl_Size needed, /* Not including terminating nul */ int flag) /* If 0, try to overallocate */ { /* * Preconditions: | | | 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 | GrowStringBuffer( Tcl_Obj *objPtr, Tcl_Size needed, /* Not including terminating nul */ int flag) /* If 0, try to overallocate */ { /* * Preconditions: * TclHasInternalRep(objPtr, &tclStringType) * needed > stringPtr->allocated * flag || objPtr->bytes != NULL */ String *stringPtr = GET_STRING(objPtr); char *ptr; Tcl_Size capacity; |
︙ | ︙ | |||
163 164 165 166 167 168 169 | static void GrowUnicodeBuffer( Tcl_Obj *objPtr, Tcl_Size needed) { /* * Preconditions: | | | 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 | static void GrowUnicodeBuffer( Tcl_Obj *objPtr, Tcl_Size needed) { /* * Preconditions: * TclHasInternalRep(objPtr, &tclStringType) * needed > stringPtr->maxChars */ String *stringPtr = GET_STRING(objPtr); Tcl_Size maxChars; /* Note STRING_MAXCHARS already takes into account space for nul */ |
︙ | ︙ | |||
3189 3190 3191 3192 3193 3194 3195 | * Non-empty string rep. Not a pure bytearray, so we won't * create a pure bytearray. */ binary = 0; if (ov > objv+1 && ISCONTINUATION(TclGetString(objPtr))) { forceUniChar = 1; | | | 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 | * Non-empty string rep. Not a pure bytearray, so we won't * create a pure bytearray. */ binary = 0; if (ov > objv+1 && ISCONTINUATION(TclGetString(objPtr))) { forceUniChar = 1; } else if ((objPtr->typePtr) && TclHasInternalRep(objPtr, &tclStringType)) { /* Prevent shimmer of non-string types. */ allowUniChar = 0; } } } else { binary = 0; if (TclHasInternalRep(objPtr, &tclStringType)) { |
︙ | ︙ |
Changes to generic/tclTest.c.
︙ | ︙ | |||
7426 7427 7428 7429 7430 7431 7432 | int mode, /* POSIX open mode. */ int permissions) /* If the open involves creating a file, with * what modes to create it? */ { Tcl_Obj *tempPtr; Tcl_Channel chan; | | | 7426 7427 7428 7429 7430 7431 7432 7433 7434 7435 7436 7437 7438 7439 7440 | int mode, /* POSIX open mode. */ int permissions) /* If the open involves creating a file, with * what modes to create it? */ { Tcl_Obj *tempPtr; Tcl_Channel chan; if ((mode & O_ACCMODE) != O_RDONLY) { Tcl_AppendResult(interp, "read-only", (char *)NULL); return NULL; } tempPtr = SimpleRedirect(pathPtr); chan = Tcl_FSOpenFileChannel(interp, tempPtr, "r", permissions); Tcl_DecrRefCount(tempPtr); |
︙ | ︙ | |||
8313 8314 8315 8316 8317 8318 8319 | static int foo = 0; const char *media = NULL, *color = NULL; Tcl_Size count = objc; Tcl_Obj **remObjv, *result[5]; const Tcl_ArgvInfo argTable[] = { {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL}, {TCL_ARGV_STRING, "-colormode" , NULL, &color, "color mode", NULL}, | | | 8313 8314 8315 8316 8317 8318 8319 8320 8321 8322 8323 8324 8325 8326 8327 | static int foo = 0; const char *media = NULL, *color = NULL; Tcl_Size count = objc; Tcl_Obj **remObjv, *result[5]; const Tcl_ArgvInfo argTable[] = { {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL}, {TCL_ARGV_STRING, "-colormode" , NULL, &color, "color mode", NULL}, {TCL_ARGV_GENFUNC, "-media", (void *)ParseMedia, &media, "media page size", NULL}, TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END }; foo = 0; if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) { return TCL_ERROR; } |
︙ | ︙ |
Changes to generic/tclZlib.c.
︙ | ︙ | |||
2702 2703 2704 2705 2706 2707 2708 | } return Tcl_ZlibStreamClose(zstream); case zs_eof: /* $strm eof */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } | | | 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 | } return Tcl_ZlibStreamClose(zstream); case zs_eof: /* $strm eof */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_ZlibStreamEof(zstream))); return TCL_OK; case zs_checksum: /* $strm checksum */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) |
︙ | ︙ |
Changes to tests/ioCmd.test.
︙ | ︙ | |||
472 473 474 475 476 477 478 | } "1 unmatched open brace in list unmatched open brace in list while processing open access modes \"FOO {BAR BAZ\" invoked from within \"open \$path(test3) \"FOO \\{BAR BAZ\"\"" test iocmd-12.7 {POSIX open access modes: errors} { list [catch {open $path(test3) {FOO BAR BAZ}} msg] $msg | | | | | 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 | } "1 unmatched open brace in list unmatched open brace in list while processing open access modes \"FOO {BAR BAZ\" invoked from within \"open \$path(test3) \"FOO \\{BAR BAZ\"\"" test iocmd-12.7 {POSIX open access modes: errors} { list [catch {open $path(test3) {FOO BAR BAZ}} msg] $msg } {1 {invalid access mode "FOO": must be APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK, RDONLY, RDWR, TRUNC, or WRONLY}} test iocmd-12.8 {POSIX open access modes: errors} { list [catch {open $path(test3) {TRUNC CREAT}} msg] $msg } {1 {access mode must include either RDONLY, RDWR, or WRONLY}} close [open $path(test3) w] test iocmd-12.9 {POSIX open access modes: BINARY} { list [catch {open $path(test1) BINARY} msg] $msg } {1 {access mode must include either RDONLY, RDWR, or WRONLY}} test iocmd-12.10 {POSIX open access modes: BINARY} { set f [open $path(test1) {WRONLY BINARY TRUNC}] puts $f a puts $f b puts -nonewline $f c ;# contents are now 5 bytes: a\nb\nc close $f set f [open $path(test1) r] |
︙ | ︙ | |||
509 510 511 512 513 514 515 516 517 518 519 520 521 522 | close $f set f [open $path(test1) r] fconfigure $f -translation binary set result [read -nonewline $f] close $f set result } H test iocmd-13.1 {errors in open command} { list [catch {open} msg] $msg } {1 {wrong # args: should be "open fileName ?access? ?permissions?"}} test iocmd-13.2 {errors in open command} { list [catch {open a b c d} msg] $msg } {1 {wrong # args: should be "open fileName ?access? ?permissions?"}} | > > > > > > > > > | 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 | close $f set f [open $path(test1) r] fconfigure $f -translation binary set result [read -nonewline $f] close $f set result } H test iocmd-12.12 {POSIX open access modes: errors} { list [catch {open $path(test3) {RDWR WRONLY}} msg] $msg } {1 {invalid access mode "WRONLY": modes RDONLY, RDWR, and WRONLY cannot be combined}} test iocmd-12.13 {POSIX open access modes: errors} { list [catch {open $path(test3) {BINARY BINARY}} msg] $msg } {1 {access mode "BINARY" repeated}} test iocmd-12.14 {POSIX open access modes: errors} { list [catch {open $path(test3) {TRUNC}} msg] $msg } {1 {access mode must include either RDONLY, RDWR, or WRONLY}} test iocmd-13.1 {errors in open command} { list [catch {open} msg] $msg } {1 {wrong # args: should be "open fileName ?access? ?permissions?"}} test iocmd-13.2 {errors in open command} { list [catch {open a b c d} msg] $msg } {1 {wrong # args: should be "open fileName ?access? ?permissions?"}} |
︙ | ︙ |
Changes to unix/tclUnixChan.c.
︙ | ︙ | |||
1764 1765 1766 1767 1768 1769 1770 | { int fd, channelPermissions; TtyState *fsPtr; const char *native, *translation; char channelName[16 + TCL_INTEGER_SPACE]; const Tcl_ChannelType *channelTypePtr; | | | 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 | { int fd, channelPermissions; TtyState *fsPtr; const char *native, *translation; char channelName[16 + TCL_INTEGER_SPACE]; const Tcl_ChannelType *channelTypePtr; switch (mode & O_ACCMODE) { case O_RDONLY: channelPermissions = TCL_READABLE; break; case O_WRONLY: channelPermissions = TCL_WRITABLE; break; case O_RDWR: |
︙ | ︙ |
Changes to win/tclWinChan.c.
︙ | ︙ | |||
1015 1016 1017 1018 1019 1020 1021 | Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open \"%s\": filename is invalid on this platform", TclGetString(pathPtr))); } return NULL; } | | | 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 | Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open \"%s\": filename is invalid on this platform", TclGetString(pathPtr))); } return NULL; } switch (mode & O_ACCMODE) { case O_RDONLY: accessMode = GENERIC_READ; channelPermissions = TCL_READABLE; break; case O_WRONLY: accessMode = GENERIC_WRITE; channelPermissions = TCL_WRITABLE; |
︙ | ︙ |
Changes to win/tclWinPipe.c.
︙ | ︙ | |||
534 535 536 537 538 539 540 | Tcl_DString ds; const WCHAR *nativePath; /* * Map the access bits to the NT access mode. */ | | | 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 | Tcl_DString ds; const WCHAR *nativePath; /* * Map the access bits to the NT access mode. */ switch (mode & O_ACCMODE) { case O_RDONLY: accessMode = GENERIC_READ; break; case O_WRONLY: accessMode = GENERIC_WRITE; break; case O_RDWR: |
︙ | ︙ |
Changes to win/tclWinPort.h.
︙ | ︙ | |||
341 342 343 344 345 346 347 348 349 350 351 352 353 354 | #endif #ifndef W_OK # define W_OK 02 #endif #ifndef R_OK # define R_OK 04 #endif /* * Define macros to query file type bits, if they're not already * defined. */ #ifndef S_IFLNK | > > > | 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 | #endif #ifndef W_OK # define W_OK 02 #endif #ifndef R_OK # define R_OK 04 #endif #ifndef O_ACCMODE # define O_ACCMODE (O_RDONLY | O_WRONLY | O_RDWR) #endif /* * Define macros to query file type bits, if they're not already * defined. */ #ifndef S_IFLNK |
︙ | ︙ |