Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch core-8-4-branch Through [79f92d79b1] Excluding Merge-Ins

This is equivalent to a diff from 5b384d430a to 79f92d79b1

2007-06-10
21:11		* README: updated links. [Bug 1715081] check-in: 6ddf3a1aec user: hobbs tags: core-8-4-branch
2007-06-06
09:54		* unix/configure.in (Darwin): add plist for tclsh; link the * unix/Makefile.in (Darwin): Tcl an... check-in: 79f92d79b1 user: das tags: core-8-4-branch
2007-06-05
17:54		* tests/result.test (result-6.2): Add test for Bug 1649062 so that 8.4 and 8.5... check-in: 0c1b05bd40 user: dgp tags: core-8-4-branch
2003-03-06
23:24		* generic/TclUtf.c (Tcl_UniCharNcasecmp): Corrected failure to * tests/utf.te... check-in: 8003bbacd1 user: dgp tags: core-8-4-branch
2003-03-04
23:45		* README: Bumped version number of * generic/tcl.h: ... check-in: a5f8f0d439 user: dgp tags: trunk
2003-03-03
20:22		Mac OS Classic specific fixes: * generic/tclIOUtil.c (TclNewFSPathObj): on TCL_PLATFORM_MAC, skip... check-in: 5b384d430a user: das tags: trunk, core-8-4-2
20:04		mark Mar 3 date for 8.4.2 check-in: 41131d3163 user: hobbs tags: trunk

---

1 2 3 4 5 6 7	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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 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 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 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 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 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 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 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 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 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 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 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 2698 2699 2700 2701 2702 2703 2704 2705 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 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 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 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 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 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 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 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 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 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 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 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	2007-06-06 Daniel Steffen <das@users.sourceforge.net> * unix/configure.in (Darwin): add plist for tclsh; link the * unix/Makefile.in (Darwin): Tcl and tclsh plists into their * macosx/Tclsh-Info.plist.in (new): binaries in all cases. * unix/tcl.m4 (Darwin): fix CF checks in fat 32&64bit builds. * unix/configure: autoconf-2.13 2007-06-05 Don Porter <dgp@users.sourceforge.net> * tests/result.test (result-6.2): Add test for Bug 1649062 so that 8.4 and 8.5 both test the same outcome and we verify compatibility. 2007-05-30 Don Porter <dgp@users.sourceforge.net> * README: Bump version number to 8.4.16 * generic/tcl.h: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/README.binary: * win/configure.in: * unix/configure: autoconf-2.13 * win/configure: 2007-05-29 Jeff Hobbs <jeffh@ActiveState.com> * unix/tclUnixThrd.c (Tcl_JoinThread): fix for 64-bit handling of pthread_join exit return code storage. [Bug 1712723] 2007-05-24 Don Porter <dgp@users.sourceforge.net> *** 8.4.15 TAGGED FOR RELEASE *** * generic/tclIO.c: Backport memleak fix in TclFinalizeIOSubsystem. 2007-05-17 Don Porter <dgp@users.sourceforge.net> * tests/fCmd.test: Backport the notNetworkFilesystem constraint. 2007-05-15 Don Porter <dgp@users.sourceforge.net> * generic/tclNamesp.c: Plugged memory leak related to [namespace delete ::]. [Bug 1716782] * changes: updates for 8.4.15 release. * win/tclWinReg.c: Bump to registry 1.1.5 to account * library/reg/pkgIndex.tcl: for [1682211] bug fix. 2007-05-10 Don Porter <dgp@users.sourceforge.net> * generic/tclInt.h: TclFinalizeThreadAlloc() is always defined, so make sure it is also always declared. [Tcl Bug 1706140] * generic/tclCmdMZ.c (Trace*Proc): Update Tcl_VarTraceProcs so * generic/tclLink.c (LinkTraceProc): that they call * generic/tclUtil.c (TclPrecTraceProc): Tcl_InterpDeleted() for themselves, and do not rely on (frequently buggy) setting of the TCL_INTERP_DESTROYED flag by the trace core. * generic/tclVar.c: Update callers of CallVarTraces to not pass in the TCL_INTERP_DESTROYED flag. Also apply filters so that public routines only pass documented flag values down to lower level routines. * generic/tclVar.c (CallVarTraces): The setting of the TCL_INTERP_DESTROYED flag is now done entirely within the CallVarTraces routine, the only place it can be done right. 2007-04-30 Daniel Steffen <das@users.sourceforge.net> * unix/Makefile.in: add 'tclsh' dependency to install targets that rely on tclsh, fixes parallel 'make install' from empty build dir. 2007-04-29 Daniel Steffen <das@users.sourceforge.net> * unix/tclUnixFCmd.c: add workaround for crashing bug in fts_open() * unix/tclUnixInit.c: without FTS_NOSTAT on 64bit Darwin 8 or earlier. * unix/tclLoadDyld.c (TclpLoadMemory): fix (void*) arithmetic. * macosx/tclMacOSXNotify.c: fix warnings. * macosx/README: sync whitespace/formatting with HEAD. * macosx/tclMacOSXBundle.c: * macosx/tclMacOSXNotify.c: * unix/tclLoadDyld.c: * macosx/Makefile: fix/add copyright and license refs. * macosx/tclMacOSXBundle.c: * macosx/Tcl-Info.plist.in: * unix/Makefile.in (dist): copy license.terms to dist macosx dir. * unix/configure.in: install license.terms into Tcl.framework. * unix/configure: autoconf-2.13 2007-04-21 Kevin B. Kenny <kennyb@acm.org> * generic/tclClock.c: Restored Cygwin buildability [Bug 1387154] * generic/tclInt.decls: Yet another round of attempting * generic/tclInt.h: to get the correct type signature * unix/tclUnixPort.h: for TclpLocaltime and TclpGmtime. * unix/tclUnixTime.c: CONST TclpTime_t is a 'time_t *CONST' * win/tclWinTime.c: and not a 'CONST time_t*' [Bug 1677275] * generic/tclIntDecls.h: * generic/tclIntPlatDecls.h: Regenerated. 2007-03-24 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> * win/tclWinThrd.c: Thread exit handler marks the current thread as un-initialized. This allows exit handlers that are registered later to re-initialize this subsystem in case they need to use some sync primitives (cond variables) from this file again. 2007-03-19 Don Porter <dgp@users.sourceforge.net> * generic/tclEvent.c (Tcl_CreateThread): Replaced some calls to * generic/tclPkg.c (CheckVersion): Tcl_Alloc() with calls to * unix/tclUnixTime.c (SetTZIfNecessary): ckalloc(), which better * win/tclAppInit.c (setargv): supports memory debugging. 2007-03-17 Kevin Kenny <kennykb@acm.org> * win/tclWinReg.c (GetKeyNames): Size the buffer for enumerating key names correctly, so that Unicode names exceeding 127 chars can be retrieved without crashing. [Bug 1682211] * tests/registry.test (registry-4.9): Added test case for the above bug. 2007-03-13 Don Porter <dgp@users.sourceforge.net> * generic/tclExecute.c (INST_FOREACH_STEP4): Re-fetch pointers for * tests/foreach.test (foreach-10.1): the value list each iteration of the loop as defense against shimmers. [Bug 1671087] * generic/tclVar.c (TclArraySet): Re-fetch pointers for the list * tests/var.test (var-17.1): argument of [array set] each time through the loop as defense against possible shimmer issues. [Bug 1669489]. 2007-03-10 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclCmdIL.c (Tcl_LsortObjCmd): Handle tricky case with loss * tests/cmdIL.test (cmdIL-1.29):of list rep during sorting due to shimmering. [Bug 1675116] 2007-03-07 Daniel Steffen <das@users.sourceforge.net> * macosx/tclMacOSXNotify.c: add spinlock debugging and sanity checks. * unix/tcl.m4 (Darwin): s/CFLAGS/CPPFLAGS/ in macosx-version-min check. * unix/configure: autoconf-2.13 2007-03-01 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclCompCmds.c (TclCompileForeachCmd): Prevent an unexpected * tests/foreach.test (foreach-9.1): infinite loop when the variable list is empty and the foreach is compiled. [Bug 1671138] 2007-02-22 Andreas Kupries <andreask@activestate.com> * tests/pkg.test: Added tests for the case of an alpha package satisfying a require for the regular package, demonstrating a corner case specified in TIP#280. More notes in the comments to the test. 2007-02-20 Don Porter <dgp@users.sourceforge.net> * doc/tcltest.n: Typo fix. [Bug 1663539] 2007-02-19 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclIOUtil.c (Tcl_FSEvalFile): safe incr of objPtr ref. * unix/tcl.m4: use SHLIB_SUFFIX=".so" on HP-UX ia64 arch. * unix/configure: autoconf-2.13 2007-02-12 Andreas Kupries <andreask@activestate.com> * generic/tclEncoding.c (EscapeFromUtfProc): Applied patch supplied by Mo DeJong to fix [Bug 1516109]. Backport from Tcl 8.5. Mo's description: Clear the TCL_ENCODING_END flag when end bytes are written. This fix keep this method from writing escape bytes for an encoding like iso2022-jp multiple times when the escape byte overlap with the end of the IO buffer. * tests/io.test: Add test case for escape byte overlap case. 2007-02-04 Daniel Steffen <das@users.sourceforge.net> * unix/configure.in: add caching to -pipe check. * unix/configure: autoconf-2.13 2007-01-30 Jeff Hobbs <jeffh@ActiveState.com> * win/Makefile.in (install-private-headers): added target 2007-01-29 Don Porter <dgp@users.sourceforge.net> * doc/fcopy.n: Typo fix. [Bug 1630627] 2007-01-25 Daniel Steffen <das@users.sourceforge.net> * unix/tcl.m4: integrate CPPFLAGS into CFLAGS as late as possible * unix/configure.in: and move (rather than duplicate) -isysroot flags from CFLAGS to CPPFLAGS to avoid errors about multiple -isysroot flags from some older gcc builds. * unix/configure: autoconf-2.13 2007-01-22 Andreas Kupries <andreask@activestate.com> * compat/memcmp.c (memcmp): Fixed the VOID / CONST typo introduced by the last checkin. 2007-01-22 Donal K. Fellows <donal.k.fellows@man.ac.uk> * compat/memcmp.c (memcmp): Reworked so that arithmetic is never performed upon void pointers, since that is illegal. [Bug 1631017] 2006-01-19 Daniel Steffen <das@users.sourceforge.net> * macosx/tclMacOSXNotify.c: accommodate changes to prototypes of OSSpinLock(Un)Lock API. * tests/env.test: add extra system env vars that need to be preserved on some Mac OS X versions for testsuite to work. * unix/tcl.m4: ensure CPPFLAGS env var is used when set. [Bug 1586861] (Darwin): add -isysroot and -mmacosx-version-min flags to CPPFLAGS when present in CFLAGS to avoid discrepancies between what headers configure sees during preprocessing tests and compiling tests. * unix/configure: autoconf-2.13 2006-12-19 Daniel Steffen <das@users.sourceforge.net> * unix/tclUnixThrd.c (TclpInetNtoa): fix for 64 bit. * unix/tcl.m4 (Darwin): --enable-64bit: verify linking with 64bit -arch flag succeeds before enabling 64bit build. * unix/configure: autoconf-2.13 2006-12-14 Donal K. Fellows <donal.k.fellows@man.ac.uk> * doc/string.n: Fix example. [Bug 1615277] 2006-12-05 Andreas Kupries <andreask@activestate.com> * tests/pkg.test: Backport to 8.4 (Don Porter's work): * generic/tclPkg.c: When no requirements are supplied to a [package require $pkg] and [package unknown] is invoked to find a satisfying package, pass the requirement argument "0-" (which means all versions are acceptable). This permits a registered [package unknown] command to call [package vsatisfies $testVersion {*}$args] without any special handling of the empty $args case. This fixes/avoids a bug in [::tcl::tm::UnknownHandler] that was causing old TM versions to be provided in preference to newer TM versions. Thanks to Julian Noble for discovering the issue. 2006-12-04 Donal K. Fellows <donal.k.fellows@man.ac.uk> * doc/file.n: Fix confusing wording for [file pathtype]. [Bug 1606454] 2006-11-28 Andreas Kupries <andreask@activestate.com> * generic/tclBasic.c: TIP #280 implementation, conditional on the * generic/tclCmdAH.c: define TCL_TIP280. * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclCompCmds.c: * generic/tclCompExpr.c: * generic/tclCompile.c: * generic/tclCompile.h: * generic/tclExecute.c: * generic/tclIOUtil.c: * generic/tclInt.h: * generic/tclInterp.c: * generic/tclNamesp.c: * generic/tclObj.c: * generic/tclProc.c: * tests/compile.test: * tests/info.test: * tests/platform.test: * tests/safe.test: 2006-11-27 Kevin Kenny <kennykb@acm.org> * unix/tclUnixChan.c (TclUnixWaitForFile): * tests/event.test (event-14.*): Corrected a bug where TclUnixWaitForFile would present select() with the wrong mask on an LP64 machine if a fd number exceeds 32. Thanks to Jean-Luc Fontaine for reporting and diagnosing [Bug 1602208] 2006-11-26 Daniel Steffen <das@users.sourceforge.net> * unix/tcl.m4 (Linux): --enable-64bit support. [Patch 1597389] * unix/configure: autoconf-2.13 [Bug 1230558] 2006-11-07 Andreas Kupries <andreask@activestate.com> * unix/tclUnixFCmd.c (CopyFile): Added code to fall back to a hardwired default block size should the filesystem report a bogus value. [Bug 1586470] 2006-11-03 Miguel Sofer <msofer@users.sf.net> * generic/tclBasic.c (TEOVI): fix for possible leak of a Command in the presence of execution traces that delete it. * generic/tclBasic.c (TEOVI): * tests/trace.test (trace-21.11): fix for [Bug 1590232], execution traces may cause a second command resolution in the wrong namespace. 2006-11-01 Daniel Steffen <das@users.sourceforge.net> * generic/tclEnv.c (Darwin): mark _environ symbol as unexported. 2006-10-31 Pat Thoyts <patthoyts@users.sourceforge.net> * rules.vc: Fix [Bug 1582769] build with VC2003 and correct i386 arch 2006-10-23 Don Porter <dgp@users.sourceforge.net> * README: Bump version number to 8.4.15 * generic/tcl.h: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/README.binary: * win/configure.in: * unix/configure: autoconf-2.13 * win/configure: 2006-10-18 Pat Thoyts <patthoyts@users.sourceforge.net> *** 8.4.14 TAGGED FOR RELEASE *** * win/nmakehlp.c: Ensure builds with VC6 without Platform SDK. * win/rules.vc: Pickup MACHINE from environment. 2006-10-17 Don Porter <dgp@users.sourceforge.net> * generic/tclIOUtil.c: Cleaned up some code flagged by a * generic/tclInt.h: `make checkexports` test. * win/tclWin32Dll.c: * win/tclWinFile.c: 2006-10-16 Daniel Steffen <das@users.sourceforge.net> * changes: updates for 8.4.14 release. * macosx/Makefile: don't redo prebinding of non-prebound binaires. 2006-10-11 Andreas Kupries <andreask@activestate.com> * generic/tclPkg.c (Tcl_PkgRequireEx): Corrected crash when argument version==NULL passed in. Backport of the fix for the same problem in 8.5. 2006-10-10 Don Porter <dgp@users.sourceforge.net> * changes: changes updated for 8.4.14 release. 2006-10-06 Jeff Hobbs <jeffh@ActiveState.com> * tests/http.test: update tests to handle strictness change. 2006-10-06 Pat Thoyts <patthoyts@users.sourceforge.net> * win/rules.vc: avoid /RTCc flag with MSVC8. [Bug 1571954] 2006-10-05 Jeff Hobbs <jeffh@ActiveState.com> * library/http/http.tcl (http::geturl): only do geturl url rfc 3986 validity checking if $::http::strict is true (default false for 8.4). [Bug 1560506] * generic/tcl.h: note limitation on changing Tcl_UniChar size * generic/tclEncoding.c (UtfToUnicodeProc, UnicodeToUtfProc): * tests/encoding.test (encoding-16.1): fix alignment issues in unicode <> utf conversion procs. [Bug 1122671] 2006-10-05 Miguel Sofer <msofer@users.sf.net> * generic/tclVar.c (Tcl_LappendObjCmd): * tests/append.test(4.21-22): fix for longstanding [Bug 1570718], lappending nothing to non-list. Reported by lvirden 2006-10-02 Don Porter <dgp@users.sourceforge.net> * generic/tclFileName.c (TclGlob): Prevent doubling of directory separators by [glob]. [Bug 1569042] 2006-10-01 Pat Thoyts <patthoyts@users.sourceforge.net> * win/tclWinFile.c: Handle possible missing define. * win/tclWinFile.c: Backported fix for [Bug 1420432] (cannot set * tests/cmdAH.test: mtime for directories on windows). 2006-09-30 Miguel Sofer <msofer@users.sf.net> * generic/tclUtil.c (Tcl_SplitList): optimisation, [Patch 1344747] by dgp. 2006-09-26 Pat Thoyts <patthoyts@users.sourceforge.net> * win/makefile.vc: Updated MSVC build to properly deal with * win/nmakehlp.c: MSVC8 and AMD64 target. Backport from 8.5 * win/rules.vc: * generic/tcl.h: Fixed stat definition for MSVC8 AMD64. * win/tclWinSock.c: Casting type police. * win/tclWinTime.c: 2006-09-26 Don Porter <dgp@users.sourceforge.net> * generic/tcl.h: As 2006-09-22 commit from Donal K. Fellows demonstrates, "#define NULL 0" is just wrong, and as a quotable chat figure observed, "If NULL isn't defined, we're not using a C compiler." Improper fallback definition of NULL removed. 2006-09-25 Andreas Kupries <andreask@activestate.com> * generic/tclIO.c (Tcl_StackChannel): Fixed [SF Tcl Bug 1564642], aka coverity #51. Extended loop condition, added checking for NULL to prevent seg.fault. 2006-09-25 Andreas Kupries <andreask@activestate.com> * generic/tclBasic.c: Reverted exposure of patchlevel in registered core version when TIP#268 features are activated. Better compatibility with existing packages. Like Tk. 2006-09-24 Miguel Sofer <msofer@users.sf.net> * generic/tclParse.c (Tcl_ParseCommand): also return an error if start==NULL and numBytes<0. This is coverity's bug #20 * generic/tclStringObj.c (STRING_SIZE): fix allocation for 0-length strings. This is coverity's bugs #54-5 2006-09-22 Andreas Kupries <andreask@activestate.com> * generic/tclInt.h: Moved TIP#268's field 'packagePrefer' to the end of the structure, for better backward compatibility. 2006-09-22 Andreas Kupries <andreask@activestate.com> * generic/tclPkg.c (Tcl_PkgRequireEx): Changes handling of the return information from 'Tcl_PkgRequireProc'. Keep the interpreter result empty. Backport of fix for problem found while testing #268 under 8.5. More details in the comments. 2006-09-22 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclThreadTest.c (TclCreateThread): Use NULL instead of 0 as end-of-strings marker to Tcl_AppendResult; the difference matters on 64-bit machines. [Bug 1562528] 2006-09-21 Andreas Kupries <andreask@activestate.com> * generic/tcl.decls: Implemented TIP #268, conditionally. * generic/tclBasic.c: Define TCL_TIP268 to activate the new * generic/tclDecls.h: features. * generic/tclInt.h: * generic/tclPkg.c: * generic/tclStubInit.c: * generic/tclTest.c: * library/init.tcl * library/package.tcl: * tests/pkg.test: * tests/platform.test: * tests/safe.test: * doc/PkgRequire.3: 2006-09-15 Jeff Hobbs <jeffh@ActiveState.com> * library/http/http.tcl: Change " " -> "+" url encoding mapping * library/http/pkgIndex.tcl: to " " -> "%20" as per RFC 3986. * tests/http.test (http-5.1): bump http to 2.5.3 for 8.4.14 2006-09-12 Andreas Kupries <andreask@activestate.com> * unix/configure.in (HAVE_MTSAFE_GETHOST*): Modified to recognize HP-UX 11.00 and beyond as having mt-safe implementations of the gethost functions. * unix/configure: Regenerated, using autoconf 2.13 * unix/tclUnixCompat.c (PadBuffer): Fixed bug in calculation of the increment needed to align the pointer, and added documentation explaining why the macro is implemented as it is. 2006-09-11 Andreas Kupries <andreask@activestate.com> * tests/msgcat.test: Bumped version in auxiliary files as well. * doc/msgcat.n: 2006-09-11 Daniel Steffen <das@users.sourceforge.net> * unix/tclUnixCompat.c: make compatLock static and only declare it when it will actually be used; #ifdef parts of TSD that are not always needed; adjust #ifdefs to cover all possible cases; fix whitespace. 2006-09-10 Don Porter <dgp@users.sourceforge.net> * library/msgcat/msgcat.tcl: Bump to version msgcat 1.3.4 to account * library/msgcat/pkgIndex.tcl: for modifications. 2006-09-10 Daniel Steffen <das@users.sourceforge.net> * library/msgcat/msgcat.tcl (msgcat::Init): on Darwin, add fallback of * tests/msgcat.test: default msgcat locale to * unix/tclUnixInit.c (TclpSetVariables): current CFLocale identifier if available (via private ::tcl::mac::locale global, set at interp init when on Mac OS X 10.3 or later with CoreFoundation). * unix/tcl.m4: add caching to new SC_TCL_* macros for MT-safe wrappers * unix/configure: autoconf-2.13 2006-09-08 Andreas Kupries <andreask@activestate.com> * unix/tclUnixCompat.c: Fixed conditions for CopyArray/CopyString, and CopyHostent. Also fixed bad var names in TclpGetHostByName. 2006-09-08 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> * unix/tclUnixCompat.c: Added fallback to gethostbyname() and gethostbyaddr() if the implementation is known to be MT-safe (currently for Darwin 6 or later only). * unix/configure.in: Assume gethostbyname() and gethostbyaddr() are MT-safe starting with Darwin 6 (Mac OSX 10.2). * unix/configure: Regenerated with autoconf V2.13 2006-09-07 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> * unix/tclUnixFCmd.c: Removed some false tests added (and left by mistake) by fixing [Bug 999544] * unix/tclUnixCompat.c: Added fallback to MT-unsafe library calls if TCL_THREADS is not defined. Fixed alignment of arrays copied by CopyArrayi() to be on the sizeof(char *) boundary. 2006-09-07 Andreas Kupries <andreask@activestate.com> * unix/configure: Regenerated using autoconf 2.13. 2006-09-07 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> * unix/tclUnixChan.c Rewritten MT-safe wrappers to * unix/tclUnixCompat.c return ptrs to TSD storage * unix/tclUnixFCmd.c making them all look like their * unix/tclUnixPort.h MT-unsafe pendants API-wise. * unix/tclUnixSock.c 2006-09-06 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> * unix/tclUnixChan.c: Added TCL_THREADS ifdef'ed usage * unix/tclUnixFCmd.c: of MT-safe calls like: * unix/tclUnixSock.c: getpwuid, getpwnam, getgrgid, getgrnam, * unix/tclUnixPort.h: gethostbyname and gethostbyaddr. * unix/Makefile.in: See Tcl Bug: 999544 * unix/configure.in: * unix/tcl.m4: * unix/configure: Regenerated. * unix/tclUnixCompat.c: New file containing MT-safe implementation of some library calls. 2006-09-04 Don Porter <dgp@users.sourceforge.net> * tests/main.text (Tcl_Main-4.4): Test corrected to not be timing sensitive to the Bug 1481986 fix. [Bug 1550858] 2006-09-04 Jeff Hobbs <jeffh@ActiveState.com> * doc/package.n: correct package example 2006-08-30 Jeff Hobbs <jeffh@ActiveState.com> * win/tclWinChan.c: [Bug 819667] Improve logic for identifying COM ports. * win/tclWinFCmd.c: [Bug 1548263] Added test for NULL return * generic/tclIOUtil.c: from Tcl_FSGetNormalizedPath which was causing segv's * generic/tclFileName.c (TclDoGlob): match incr with existing decr. * unix/Makefile.in: add valgrindshell target and update default VALGRINDARGS. User can override, or add to it with VALGRIND_OPTS env var. * generic/tclBasic.c (Tcl_CreateInterp): init iPtr->threadId * generic/tclIOGT.c (ExecuteCallback): * generic/tclPkg.c (Tcl_PkgRequireEx): replace Tcl_GlobalEval(Obj) with more efficient Tcl_Eval(Obj)Ex 2006-08-22 Andreas Kupries <andreask@activestate.com> * unix/tclUnixNotfy.c (Tcl_WaitForEvent): Fixed broken if syntax committed 2006-08-21 by Daniel. The broken syntax is visible to all unix platforms, but not on OSX for machines which HAVE_COREFOUNDATION. 2006-08-21 Don Porter <dgp@users.sourceforge.net> * generic/tclIOUtil.c: Revisions to complete the thread finalization of the cwdPathPtr. [Bug 1536142] 2006-08-21 Daniel Steffen <das@users.sourceforge.net> * macosx/tclMacOSXNotify.c (Tcl_WaitForEvent): if the run loop is already running (e.g. if Tcl_WaitForEvent was called recursively), re-run it in a custom run loop mode containing only the source for the notifier thread, otherwise wakeups from other sources added to the common run loop modes might get lost; sync panic msg changes from HEAD. * unix/tclUnixNotfy.c (Tcl_WaitForEvent): on 64-bit Darwin, pthread_cond_timedwait() appears to have a bug that causes it to wait forever when passed an absolute time which has already been exceeded by the system time; as a workaround, when given a very brief timeout, just do a poll on that platform. [Bug 1457797] * unix/tclUnixPort.h (Darwin): override potentially faulty configure detection of termios availability in all cases, since termios is known to be present on all Mac OS X releases since 10.0. [Bug 497147] 2006-08-18 Daniel Steffen <das@users.sourceforge.net> * unix/tcl.m4 (Darwin): add support for --enable-64bit on x86_64, for universal builds including x86_64, for 64-bit CoreFoundation on Leopard and for use of -mmacosx-version-min instead of MACOSX_DEPLOYMENT_TARGET. * unix/configure: autoconf-2.13 * generic/tcl.h: add fixes for building on Leopard and support * unix/tclUnixPort.h: for 64-bit CoreFoundation on Leopard. * unix/tclUnixPort.h: on Darwin x86_64, disable use of vfork as it causes execve to fail intermittently. (rdar://4685553) * macosx/README: updates for x86_64 support and Xcode 2.4. * unix/tclUnixChan.c (TclUnixWaitForFile): with timeout < 0, if select() returns early (e.g. due to a signal), call it again instead of returning a timeout result. Fixes intermittent event-13.8 failures. 2006-08-09 Don Porter <dgp@users.sourceforge.net> * generic/tclEncoding.c: Replace buffer copy in for loop with call to memcpy(). Thanks to afredd. [Patch 1530262] 2006-08-03 Daniel Steffen <das@users.sourceforge.net> * unix/tclUnixPipe.c (TclpCreateProcess): for USE_VFORK: ensure standard channels are initialized before vfork() so that the child doesn't potentially corrupt global state in the parent's address space. 2006-07-30 Kevin Kenny <kennykb@acm.org> * tests/clock.test: Allowed UTC as a synonym for GMT in two tests that indirectly invoke 'strftime' with the result of 'gmtime' to fix a bogus test failure on FreeBSD systems. [Bug 1513489] 2006-07-30 Joe English <jenglish@users.sourceforge.net> * doc/AppInit.3: Fix typo [Bug 1496886] 2006-07-20 Daniel Steffen <das@users.sourceforge.net> * macosx/tclMacOSXNotify.c (Tcl_InitNotifier, Tcl_WaitForEvent): create notifier thread lazily upon first call to Tcl_WaitForEvent() rather than in Tcl_InitNotifier(). Allows calling exeve() in processes where the event loop has not yet been run (Darwin's execve() fails in processes with more than one thread), in particular allows embedders to call fork() followed by execve(), previously the pthread_atfork() child handler's call to Tcl_InitNotifier() would immediately recreate the notifier thread in the child after a fork. * macosx/tclMacOSXNotify.c (Tcl_InitNotifier): add support for * unix/tclUnixFCmd.c (DoRenameFile, CopyFileAtts): weakly importing * unix/tclUnixInit.c (TclpSetInitialEncodings): symbols not available on OSX 10.2 or 10.3, enables binaires built on later OSX versions to run on earlier ones. * macosx/README: document how to enable weak-linking; cleanup. * unix/tclUnixPort.h: add support for weak-linking; conditionalize AvailabilityMacros.h inclusion; only disable realpath on 10.2 or earlier when threads are enabled. * unix/tclLoadDyld.c (TclpLoadMemoryGetBuffer): change runtime Darwin * unix/tclUnixInit.c (TclpInitPlatform): release check to use global initialized once * unix/tclUnixFCmd.c (DoRenameFile, TclpObjNormalizePath): add runtime Darwin release check to determine if realpath is threadsafe. * unix/configure.in: add check on Darwin for compiler support of weak * unix/tcl.m4: import and for AvailabilityMacros.h header; move Darwin specific checks & defines that are only relevant to the tcl build out of tcl.m4; restrict framework option to Darwin; cleanup quoting. * unix/configure: autoconf-2.13 * unix/tclLoadDyld.c (TclpLoadMemory): * unix/tclUnixPipe.c (TclpCreateProcess): fix signed-with-unsigned comparison and other warnings from gcc4 -Wextra. 2006-07-13 Andreas Kupries <andreask@activestate.com> * unix/tclUnixPort.h: Added the inclusion of <AvailabilityMacros.h>. The missing header caused the upcoming #if conditions to wrongly exclude realpath, causing file normalize to ignore symbolic links in the path. 2006-07-11 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> * generic/tclAsync.c: Made Tcl_AsyncDelete() more tolerant when called after all thread TSD has been garbage-collected. 2006-07-10 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclIO.c (Tcl_CreateChannel): allow Tcl std channel inheritance to be #defined out (default remains in). 2006-06-15 Don Porter <dgp@users.sourceforge.net> * changes: changes to start prep for an 8.4.14 release. 2006-06-14 Daniel Steffen <das@users.sourceforge.net> * unix/tclUnixPort.h (Darwin): support for MAC_OS_X_VERSION_MAX_ALLOWED define from AvailabilityMacros.h: override configure detection and only use API available in the indicated OS version or earlier. 2006-06-14 Pat Thoyts <patthoyts@users.sourceforge.net> * generic/regerror.c: Enable building Tcl with Microsoft's latest * generic/tcl.h: compiler offering (VS2005). We have to handle * generic/tclDate.c: a number of oddities as they have deprecated * tests/env.test: most of the standard C library and now * win/makefile.vc: generate manifest files to be linked into the * win/nmakehlp.c: binaries. [Bug 1424909] * win/rules.vc: * win/tclWinTime.c: 2006-06-13 Donal K. Fellows <donal.k.fellows@man.ac.uk> * unix/tclLoadDl.c (TclpDlopen): Workaround for a compiler bug in Sun Forte 6. [Bug 1503729] 2006-06-06 Don Porter <dgp@users.sourceforge.net> * doc/GetStdChan.3: Added recommendation that each call to Tcl_SetStdChannel() be accompanied by a call to Tcl_RegisterChannel(). 2006-05-31 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclNamesp.c (NamespaceInscopeCmd): revert [Bug 1400572] fix of 2006-01-09 for [namespace inscope] as it seems to mess with itcl scope decoding. Leaving namespace-29.6 test failure until final cause it determined. 2006-05-29 Jeff Hobbs <jeffh@ActiveState.com> * generic/tcl.h (Tcl_DecrRefCount): use if/else construct to allow placement in unbraced outer if/else conditions. (jcw) 2006-05-27 Daniel Steffen <das@users.sourceforge.net> * macosx/tclMacOSXNotify.c: implemented pthread_atfork() handler that * unix/tcl.m4 (Darwin): recreates CoreFoundation state and notifier thread in the child after a fork(). Note that pthread_atfork() is available starting with Tiger only. Because vfork() is used by the core on Darwin, [exec]/[open] are not affected by this fix, only extensions or embedders that call fork() directly (such as TclX). However, this only makes fork() safe from corefoundation tcl with --disable-threads; as on all platforms, forked children may deadlock in threaded tcl due to the potential for stale locked mutexes in the child. [Patch 923072] * unix/configure: autoconf-2.59 2006-05-24 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> * unix/tcl.m4 (SC_CONFIG_SYSTEM): Fixed quoting of command script to awk; it was a rarely used branch, but it was wrong. [Bug 1494160] 2006-05-13 Don Porter <dgp@users.sourceforge.net> * generic/tclFileName.c (TclDoGlob): Disabled the partial normalization done by the recursive glob routine, since changing the precise string of the pathname broke [glob] on some Tcl_Filesystems. [Bug 943995] * generic/tclProc.c (ProcCompileProc): When a bump of the compile epoch forces the re-compile of a proc body, take care not to overwrite any Proc struct that may be referred to on the active call stack. This fixes [Bug 1482718]. Note that the fix will not be effective for code that calls the private routine TclProcCompileProc() directly. 2006-05-05 Don Porter <dgp@users.sourceforge.net> * generic/tclMain.c (Tcl_Main): Corrected flaw that required * tests/main.test: (Tcl_Main-4.5): processing of one interactive command before passing control to the loop routine registered with Tcl_SetMainLoop() [Bug 1481986] 2006-05-04 Don Porter <dgp@users.sourceforge.net> * README: Bump version number to 8.4.14 * generic/tcl.h: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/README.binary: * win/configure.in: * unix/configure: autoconf-2.13 * win/configure: * generic/tclExecute.c (ExprSrandFunc): Restore acceptance of wide * tests/expr-old.test: integer values by srand() [Bug 1480509] 2006-04-12 Don Porter <dgp@users.sourceforge.net> *** 8.4.13 TAGGED FOR RELEASE *** * changes: updates for another RC. 2006-04-11 Don Porter <dgp@users.sourceforge.net> * generic/tclCmdMZ.c: Stop some interference between enter traces * tests/trace.test: and enterstep traces. [Bug 1458266] 2006-04-10 Don Porter <dgp@users.sourceforge.net> * changes: updates for another RC. 2006-04-06 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclRegexp.c (FinalizeRegexp): full reset data to indicate readiness for reinitialization. 2006-04-06 Don Porter <dgp@users.sourceforge.net> * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): It seems there * tests/indexObj.test: are extensions that rely on the prior behavior * doc/GetIndex.3: that the empty string cannot succeed as a unique prefix matcher, so I'm restoring Donal Fellows's solution. Added mention of this detail to the documentation. [Bug 1464039] 2006-04-06 Daniel Steffen <das@users.sourceforge.net> * unix/tcl.m4: removed TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING define on Darwin. [Bug 1457515] * unix/configure: autoconf-2.13 2006-04-05 Don Porter <dgp@users.sourceforge.net> * library/reg/pkgIndex.tcl: Long overlooked bump to registry * win/tclWinReg.c: package version 1.1.4 (should have been done for the Tcl 8.4.8 release!) * library/dde/pkgIndex.tcl: Long overlooked bump to dde package * win/tclWinDde.c: version 1.2.4 (should have been done for the Tcl 8.4.8 release!) 2006-04-05 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): Allow empty strings to be matched by the Tcl_GetIndexFromObj machinery, in the same manner as any other key. [Bug 1464039] 2006-04-04 Don Porter <dgp@users.sourceforge.net> * generic/tclPkg.c: Revised Bug 1162286 fix from 2005-11-08 to be * tests/pkg.test: even more forgiving of package version mismatch errors in [package ifneeded] commands, not even logging any warning messages. This further reduces the ***POTENTIAL INCOMPATIBILITY*** noted for that change. 2006-04-03 Andreas Kupries <andreask@activestate.com> * generic/tclIO.c (ReadChars): Added check, panic and commentary to a piece of code which relies on BUFFER_PADDING to create enough space at the beginning of each buffer for the insertion of partial multibyte data at the beginning of a buffer. Commentary explains why this code is OK, and the panic is as a precaution if someone twiddled the BUFFER_PADDING into uselessness. * generic/tclIO.c (ReadChars): Temporarily suppress the use of TCL_ENCODING_END set when EOF was reached while the buffer we are converting is not truly the last buffer in the queue. Together with the Utf bug below it was possible to completely wreck the buffer data structures, eventually crashing Tcl. [Bug 1462248] * generic/tclEncoding.c (UtfToUtfProc): Stop accessing memory beyond the end of the input buffer when TCL_ENCODING_END is set and the last bytes of the buffer start a multi-byte sequence. This bug contributed to [Bug 1462248]. 2006-03-28 Jeff Hobbs <jeffh@ActiveState.com> * win/configure, win/tcl.m4: define MACHINE for gcc builds as well. Needed by Tk for manifest generation. * win/tclWinConsole.c: revert 2005-11-03 [Patch 1256872] change to add win32 unicode console support as it broke the ability to modify the encoding to the console. 2006-03-28 Daniel Steffen <das@users.sourceforge.net> * unix/tclUnixFCmd.c (TclpObjNormalizePath): deal with *BSD/Darwin realpath() converting relative paths into absolute paths. [Bug 1064247] 2006-03-28 Vince Darley <vincentdarley@sourceforge.net> * generic/tclIOUtil.c: fix to nativeFilesystemRecord comparisons (lesser part of [Bug 1064247]) 2006-03-27 Pat Thoyts <patthoyts@users.sourceforge.net> * win/tclWinTest.c: Fixes for [Bug 1456373] (mingw-gcc issue) 2006-03-23 Don Porter <dgp@users.sourceforge.net> * tests/expr.test: Nan self-inquality test silenced. [Bug 761471] 2006-03-22 Don Porter <dgp@users.sourceforge.net> * changes: updates for another RC. 2006-03-18 Vince Darley <vincentdarley@sourceforge.net> * generic/tclTest.c: * win/tclWinFile.c: * win/tclWinTest.c: * tests/fCmd.test: * tests/winFCmd.test: * tests/tcltest.test: Backport of [file writable] fixes for Windows from HEAD. [Bug 1193497] 2006-03-16 Andreas Kupries <andreask@activestate.com> * doc/open.n: Documented the changed behaviour of 'a'ppend mode. * tests/io.test (io-43.1 io-44.[1234]): Rewritten to be self-contained with regard to setup and cleanup. [Bug 681793] * generic/tclIOUtil.c (TclGetOpenMode): Added the flag O_APPEND to the list of POSIX modes used when opening a file for 'a'ppend. This enables the proper automatic seek-to-end-on-write by the OS. See [Bug 680143] for longer discussion. * tests/ioCmd.test (iocmd-13.7.*): Extended the testsuite to check the new handling of 'a'. 2006-03-15 Andreas Kupries <andreask@activestate.com> * tests/socket.test: Extended the timeout in socket-11.11 from 10 to 40 seconds to allow for really slow machines. Also extended actual/expected results with value of variable 'done' to make it clearer when a test fails due to a timeout. [Bug 792159] 2006-03-14 Andreas Kupries <andreask@activestate.com> * generic/tclPipe.c (TclCreatePipeline): Modified the processing of pipebars to fail if the last bar is followed only by redirections. [Bug 768659] 2006-03-14 Andreas Kupries <andreask@activestate.com> * doc/fconfigure.n: Clarified that -translation is binary is reported as lf when queried, because it is identical to lf, except for the special additional behaviour when setting it. [Bug 666770] 2006-03-14 Andreas Kupries <andreask@activestate.com> * win/tclWinPipe.c (Tcl_WaitPid): Backport of fix made to the head by David Gravereaux in 2004. See ChangeLog entry 2004-01-19. [Bug 1381436] Fixed a thread-safety problem with the process list. The delayed cut operation after the wait was going stale by being outside the list lock. It now cuts within the lock and does a locked splice for when it needs to instead. [Bug 859820] 2006-03-13 Don Porter <dgp@users.sourceforge.net> * generic/tclEncoding.c: Report error when an escape encoding is missing one of its sub-encodings [Bug 506653] * unix/configure.in: Revert change from 2005-07-26 that sometimes * unix/configure: added $prefix/share to the tcl_pkgPath. See [Patch 1231015]. autoconf-2.13. 2006-03-10 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> -- Summary of changes fixing [Bug 1437595] -- * generic/tclEvent.c: Cosmetic touches and identation * generic/tclInt.h: Added TclpFinalizeSockets() call. * generic/tclIO.c: Calls TclpFinalizeSockets() as part of the TclFinalizeIOSubsystem(). * unix/tclUnixSock: Added no-op TclpFinalizeSockets(). * mac/tclMacSock.c: * win/tclWinPipe.c * win/tclWinSock.c: Finalization of the sockets/pipes is now solely done in TclpFinalizeSockets() and TclpFinalizePipes() and not over the thread-exit handler, because the order of actions the Tcl generic core will impose may result in cores/hangs if the thread exit handler tears down corresponding subsystem(s) too early. 2006-03-10 Vince Darley <vincentdarley@sourceforge.net> * win/tclWin32Dll.c: * win/tclWinInt.h: * win/tclWinFile.c: backported some fixes from HEAD relating to 'file readable' and 'file writable', but main 'file writable' bug still outstanding. 2006-03-07 Don Porter <dgp@users.sourceforge.net> * README: Bump version number to 8.4.13 and update * changes: changes to start prep for an 8.4.13 release. * generic/tcl.h: * tools/tcl.wse.in: * unix/configure{.in}: * unix/tcl.spec: * win/README.binary: * win/configure{.in}: * tests/parse.test: Missing constraint 2006-03-06 Don Porter <dgp@users.sourceforge.net> * generic/tclBasic.c: Revised handling of TCL_EVAL_* flags to * tests/parse.test: simplify TclEvalObjvInternal and to correct the auto-loading of alias targets (parse-8.12). [Bug 1444291] 2006-03-02 Jeff Hobbs <jeffh@ActiveState.com> * win/Makefile.in: convert _NATIVE paths to use / to avoid ".\" path-as-escape issue. * unix/tcl.m4, win/tcl.m4: []-quote ac_defun functions. 2006-03-02 Pat Thoyts <patthoyts@users.sourceforge.net> * unix/tcl.m4: Fix for [Tk Bug 1334613] to sort out shared library * unix/configure: issues on NetBSD. Regenerated configure script. 2006-02-28 Don Porter <dgp@users.sourceforge.net> * generic/tclBasic.c: Corrections to be sure that TCL_EVAL_GLOBAL * tests/parse.test: evaluations act the same as [uplevel #0] * tests/trace.test: evaluations, even when execution traces or invocations of [::unknown] are present. [Bug 1439836] 2006-02-16 Don Porter <dgp@users.sourceforge.net> * generic/tclIndexObj.c: Disallow the "ambiguous" error message * tests/indexObj.test: when TCL_EXACT matching is requested. 2006-02-15 Don Porter <dgp@users.sourceforge.net> * generic/tclIO.c: Made several routines tolerant of * generic/tclIOUtil.c: interp == NULL arguments. [Bug 1380662] 2006-02-09 Don Porter <dgp@users.sourceforge.net> * tests/main.test (Tcl_Main-6.7): Improved robustness of command auto-completion test. [Bug 1422736] 2006-01-25 Donal K. Fellows <donal.k.fellows@man.ac.uk> * unix/tclUnixInit.c (TclpInitPlatform): Improved conditions on when to update the FP rounding mode on FreeBSD, taken from FreeBSD port. 2006-01-23 Miguel Sofer <msofer@users.sf.net> * generic/tclStringObj.c (Tcl_GetRange): * tests/stringTest (string-12.21):fixed incorrect handling of internal rep in Tcl_GetRange. Thanks to twylite and Peter Spjuth. [Bug 1410553] 2006-01-16 Reinhard Max <max@suse.de> * generic/tclPipe.c (FileForRedirect): Prevent nameString from being freed without having been initialized. * tests/exec.test: Added a test for the above. 2006-01-12 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> * generic/tclIOUtil.c (Tcl_FSGetInternalRep): fixed potential overwriting of already freed memory which caused all kinds of (rare but reproducible) coredumps all over the place. 2006-01-11 Don Porter <dgp@users.sourceforge.net> * tests/error.test (error-7.0): Test the timing of write traces on ::errorInfo. [Bug 1397843] 2006-01-10 Daniel Steffen <das@users.sourceforge.net> * unix/configure: add caching, use AC_CACHE_CHECK instead of * unix/configure.in: AC_CACHE_VAL where possible, consistent message * unix/tcl.m4: quoting, sync relevant tclconfig/tcl.m4 and HEAD changes and gratuitous formatting differences, fix SC_CONFIG_MANPAGES with default argument, Darwin improvements to SC_LOAD_*CONFIG. 2006-01-09 Don Porter <dgp@users.sourceforge.net> * generic/tclNamesp.c (NamespaceInscopeCmd): [namespace inscope] * tests/namespace.test: commands were not reported by [info level]. [Bug 1400572] 2005-12-20 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclThreadAlloc.c (Tcl_GetMemoryInfo): Format values as longs and not ints, so they are less likely to wrap on 64-bit machines. 2005-12-19 Donal K. Fellows <donal.k.fellows@man.ac.uk> * doc/Tcl.n: Clarify what is going on in variable substitution following thread on comp.lang.tcl. 2005-12-14 Daniel Steffen <das@users.sourceforge.net> * generic/tclIOUtil.c: workaround gcc warning "comparison is always * generic/tclTest.c: false due to limited range of data type". * unix/configure.in: run check for fts API on all platforms, since Linux glibc2 and *BSDs also have this and using fts is more efficient than recursive opendir/readdir (sync with HEAD). * unix/configure: regen. 2005-12-12 Jeff Hobbs <jeffh@ActiveState.com> * unix/tcl.m4, unix/configure: Fix sh quoting error reported in bash-3.1+ [Bug 1377619] (schafer) 2005-12-12 Reinhard Max <max@suse.de> * generic/tclExecute.c (ExprAbsFunc): fixed the abs(MIN_INT) case so that it doesn't break on compilers that don't assume integers to wrap around (e.g. gcc-4.1.0). 2005-12-09 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> * tests/lsearch.test (lsearch-10.8..10): If the -start is off the end, * generic/tclCmdIL.c (Tcl_LsearchObjCmd): searching should find nothing at all. [Bug 1374778] 2005-12-05 Daniel Steffen <das@users.sourceforge.net> *** 8.4.12 TAGGED FOR RELEASE *** * unix/tclUnixPort.h (Darwin): fix incorrect __DARWIN_UNIX03 configure overrides that were originally copied from Darwin CVS (rdar://3693001). 2005-12-05 Don Porter <dgp@users.sourceforge.net> * unix/configure.in: Revised fix for [Bug 1034337] from Daniel * unix/tclUnixFCmd.c: Steffen. Uses fts_*() routines. * unix/configure: autoconf-2.13 * changes: Update changes for 8.4.12 release 2005-12-04 Daniel Steffen <das@users.sourceforge.net> * README: refer to macosx/README instead of mac/README. * mac/README: add note that mac classic port is no longer supported. 2005-12-03 Jeff Hobbs <jeffh@ActiveState.com> * README: correct 2 urls 2005-12-01 Don Porter <dgp@users.sourceforge.net> * changes: Update changes for 8.4.12 release 2005-12-01 Daniel Steffen <das@users.sourceforge.net> * unix/tcl.m4 (Darwin): fixed error when MACOSX_DEPLOYMENT_TARGET unset * unix/configure: regen. 2005-11-29 Jeff Hobbs <jeffh@ActiveState.com> * win/tcl.m4: Add build support for Windows-x64 builds. * win/configure: --enable-64bit now accepts =amd64|ia64 for * win/Makefile.in: Windows 64-bit build variants (default: amd64) * win/makefile.vc: [Bug 1369597] 2005-11-29 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclObj.c (Tcl_GetWideIntFromObj): Add more efficient conversion to wides from normal ints. [Bug 1310081] * generic/tclCmdIL.c (Tcl_LsearchObjCmd): Allow [lsearch -regexp] to process REs that contain backreferences. This expensive mode of operation is only used if the RE would otherwise cause a compilation failure. [Bug 1366683] 2005-11-28 Donal K. Fellows <donal.k.fellows@man.ac.uk> * win/tclWinSock.c (CreateSocket): Applied [Patch 1353853] to prevent reads of uninitialized variables during cleanup. 2005-11-27 Daniel Steffen <das@users.sourceforge.net> * unix/tcl.m4 (Darwin): add 64bit support, check for Tiger copyfile(), add CFLAGS to SHLIB_LD to support passing -isysroot in env(CFLAGS) to configure (flag can't be present twice, so can't be in both CFLAGS and LDFLAGS during configure), don't use -prebind when deploying on 10.4, define TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING (rdar://3171542). (SC_ENABLE_LANGINFO, SC_TIME_HANDLER): add/fix caching, fix obsolete autoconf macros. Sync with tk/unix/tcl.m4, sync whitespace with HEAD. * unix/configure.in: fix obsolete autoconf macros, sync gratuitous formatting/ordering differences with tk/unix/configure.in. * unix/Makefile.in: add CFLAGS to tclsh/tcltest link to make executable linking the same as during configure (needed to avoid loosing any linker relevant flags in CFLAGS, in particular flags that can't be in LDFLAGS). Avoid concurrent linking of tclsh and compiling of tclTestInit.o or xtTestInit.o during parallel make. (checkstubs, checkdoc, checkexports): dependency and Darwin fixes * unix/tclLoadDyld.c (TclpDlopen): [Bug 1204237] use NSADDIMAGE_OPTION_WITH_SEARCHING on second NSAddImage only. (TclGuessPackageName): should not be MODULE_SCOPE. (TclpLoadMemory): ppc64 and endian (i386) fixes, add support for loading universal (fat) bundles from memory. * unix/tclUnixPort.h: * unix/tclUnixFCmd.c: add support for new Tiger copyfile() API to enable copying of xattrs & ACLs by [file copy]. * generic/tcl.h: add Darwin specifc configure overrides for TCL_WIDE defines to support fat compiles of ppc and ppc64 at the same time, (replaces Darwin CVS fix by emoy, rdar://3693001). add/correct location of version numbers in macosx files. * generic/tclInt.h: clarify fat compile comment. * unix/tclUnixPort.h: add Darwin specifc configure overrides to support fat compiles, where configure runs only once for multiple architectures (replaces Darwin CVS fix by emoy, rdar://3693001). * macosx/tclMacOSXBundle.c: * macosx/tclMacOSXNotify.c: * unix/tclUnixNotfy.c: fix #include order to support compile time * unix/tclUnixPort.h: override of HAVE_COREFOUNDATION in tclUnixPort.h when building for ppc64 * macosx/Tcl.pbproj/default.pbxuser (new file): * macosx/Tcl.pbproj/jingham.pbxuser: * macosx/Tcl.pbproj/project.pbxproj: sync with HEAD. * macosx/README: clarification/cleanup, sync with HEAD, document universal (fat) builds via CFLAGS (i.e. all of ppc ppc64 i386 at once). * macosx/Makefile: add support for reusing configure cache, build target fixes, remove GENERIC_FLAGS override now handled by tcl.m4. * generic/tclIOUtil.c: * generic/tclRegexp.c: * generic/tclVar.c: declare globals used only in own file as static (sync with HEAD). * generic/rege_dfa.c (getvacant): * generic/regexec.c (cfind): * generic/tclCompExpr.c (CompileSubExpr): * unix/tclUnixChan.c (TclUnixWaitForFile): initialise variables to silence gcc 4 warnings. * generic/regguts.h: only #define NDEBUG if not already #defined. * macosx/tclMacOSXNotify.c: sync whitespace & comments with HEAD * unix/configure: regen. 2005-11-20 Joe English <jenglish@users.sourceforge.net> * generic/tclStubLib.c: Don't set tclStubsPtr to 0 when Tcl_PkgRequireEx() fails [Fix for [Bug 1091431] "Tcl_InitStubs failure crashes wish"] 2005-11-18 Miguel Sofer <msofer@users.sf.net> * tests/trace.test (trace-34.5): [Bug 1047286], added a second test illustrating the role of "ns in callStack" in the ns's visibility during deletion traces. * generic/tclBasic.c (Tcl_DeleteCommandFromToken): * generic/tclCmdMZ.c (TraceCommandProc): * generic/tclInt.h (NS_KILLED): * generic/tclNamesp.c (Tcl_DeleteNamespace * tests/namespace.test (namespace-7.3-6): * tests/trace.test (trace-20.13-16): fix [Bugs 1355942/1355342]. 2005-11-18 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclIO.c (TclFinalizeIOSubsystem): preserve statePtr until we netrieve next statePtr from it. 2005-11-18 Don Porter <dgp@users.sourceforge.net> * generic/tclPkg.c: Revised Bug 1162286 fix from 2005-11-08 to be * tests/pkg.test: more forgiving of package version mismatch errors in [package ifneeded] commands. This reduces the ***POTENTIAL INCOMPATIBILITY*** noted for that change. 2005-11-18 Andreas Kupries <andreask@activestate.com> * generic/tclIO.c (TclFinalizeIOSubsystem): Applied Pat Thoyts' patch for [Bug 1359094]. This moves the retrieval of the next channel state to the end of the loop, as the called closeproc may close other channels, i.e., modify the list we are iterating, invalidating any pointer retrieved earlier. 2005-11-18 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> * library/http/http.tcl (http::geturl): Improved syntactic validation of URLs, and better error messages in some cases. [Bug 1358369] 2005-11-16 Don Porter <dgp@users.sourceforge.net> * README: Bump version number to 8.4.12 * generic/tcl.h: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/README.binary: * win/configure.in: * unix/configure: autoconf-2.13 * win/configure: 2005-11-15 Don Porter <dgp@users.sourceforge.net> * changes: Update changes for 8.4.12 release 2005-11-15 Kevin B. Kenny <kennykb@acm.org> * tests/cmdAH.test: Backported the fix for [Bug 926016] because of * win/tclWinFile.c: a repeated bug report in 8.4 [Bug 1353840]. Windows [file mtime] will now return seconds from the Posix epoch correctly (except for FAT32 file systems after a DST change without a reboot - for which there is no help). A side effect is that file times will appear different in Tcl from the way they do in Windows Explorer or a 'dir' listing, because the Microsoft tools get the DST state wrong in the listings. 2005-11-09 Kevin B. Kenny <kennykb@acm.org> * generic/tclTimer.c: Changed [after] so that it behaves correctly * tests/timer.test: with negative arguments. [Bug 1350293] 2005-11-08 Jeff Hobbs <jeffh@ActiveState.com> * unix/tclUnixFCmd.c (MAX_READDIR_UNLINK_THRESHOLD): reduce to 130 based on errors seen on OS X 10.3 with lots of links in a dir. [Bug 1034337 followup] 2005-11-08 Don Porter <dgp@users.sourceforge.net> * tests/expr.test: Portable tests expr-46.13-18 [Bug 1341368] * generic/tclPkg.c: Corrected inconsistencies in the value returned * tests/pkg.test: by Tcl_PkgRequire(Ex) so that the returned values will always agree with what is stored in the package database. This way repeated calls to Tcl_PkgRequire(Ex) have the same results. Thanks to Hemang Lavana. [Bug 1162286] ***POTENTIAL INCOMPATIBILITY***: Incompatible with those existing packages that are accustomed to the [package] command forgiving their bugs. * tests/namespace.test (25.7,8): Backport test of knownBug. 2005-11-08 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclCmdMZ.c (TclTraceVariableObjCmd, TraceVarProc): Applied Miguel's fix for [Bug 1348775]. It is not quite as elegant as the one applied to the HEAD, but it is easier to use it rather than fully backporting. 2005-11-07 Miguel Sofer <msofer@users.sf.net> * tests/trace.test (trace-13.2-4): added tests to detect leak, see [Bug 1348775]. 2005-11-04 Don Porter <dgp@users.sourceforge.net> * unix/tcl.m4: Added code to enable [load] on LynxOS. Thanks to heidibr@users.sf.net for the patch. [Bug 1163896] * unix/configure: autoconf-2.13. 2005-11-04 Pat Thoyts <patthoyts@users.sourceforge.net> * win/tclWinPipe.c: Applied [Patch 1267871] by Matt Newman which * win/tclWinPort.h: provides extended error code support. * tests/exec.test: Wrote some tests for this feature. 2005-11-04 Kevin Kenny <kennykb@acm.org> * generic/tclGetDate.y: Added abbreviations for the Korean timezone. * generic/tclDate.c: Regenerated. * compat/strftime.c: Fixed a problem where the name of the time zone was double-converted from system encoding to UTF-8. Thanks to the anonymous submitter of [Bug 1317477] for the report and the patch. 2005-11-04 Miguel Sofer <msofer@users.sf.net> * generic/tclInt.h: * generic/tclNamesp.c: * generic/tclVar.c: fix for [Bugs 1338280/1337229]. Thanks Don. * tests/trace.test: fix duplicate test numbers 2005-11-03 Don Porter <dgp@users.sourceforge.net> * generic/tclUnixInit.c (TclpSetInitialEncodings): Modified so that multiple calls can continue to atttempt to properly set the system encoding. Needed for Tclkit to properly support non-default encodings. Thanks to Yaroslav Schekin. [Bug 1201171] 2005-11-03 Pat Thoyts <patthoyts@users.sourceforge.net> * win/tclWin32Dll.c: Backported Anton Kovalenko's [Patch 1256872] * win/tclWinConsole.c: to give unicode console support on * win/tclWinInt.h: suitable systems (eg: NT/XP) 2005-11-01 Don Porter <dgp@users.sourceforge.net> * generic/tclCmdMZ.c (TclCheckExecutionTraces): Corrected mistaken assumption that all command traces are set at the script level. Report/fix from Jacques H. de Villiers. [Bug 1337941] * tests/expr-old.test (expr-32.52): Use int(.) to restrict result of left shift to the C long range. 2005-10-29 Mo DeJong <mdejong@users.sourceforge.net> * tests/expr.test: Fix problems in new round() tests that lead to correct result only on 32 bit long systems. [Bug 1341368] 2005-10-29 Miguel Sofer <msofer@users.sf.net> * generic/tclCmdMZ.c (TraceVarProc): [Bug 1337229], partial fix. Ensure that a second call with TCL_TRACE_DESTROYED does not lead to a second call to Tcl_EventuallyFree(). It is still true that that second call should not happen, so the bug is not completely fixed. * tests/trace.test (test-18.3-4): added tests for [Bugs 1337229 and 1338280]. 2005-10-27 Mo DeJong <mdejong@users.sourceforge.net> * generic/tclExecute.c (ExprRoundFunc): Fix typo where number before rounding is compared with smallest integer instead of number after rounding. This fix does not change the results of any tests. * tests/expr.test: Add round() tests for cases near the min and max int values. * tests/util.test: Remove pointless warning code about testobj command 2005-10-23 Miguel Sofer <msofer@users.sf.net> * generic/tclBasic.c: * generic/tclBinary.c: * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclExecute.c: * generic/tclLink.c: * generic/tclMain.c: * generic/tclProc.c: * generic/tclScan.c: * generic/tclTest.c: * generic/tclVar.c: * mac/tclMacInit.c: * unix/tclUnixInit.c: * win/tclWinInit.c: Ensure that the core never calls TclPtrSetVar, Tcl_SetVar2Ex, Tcl_ObjSetVar2 or Tcl_SetObjErrorCode with a 0-ref new value. It is not possible to handle error returns correctly in that case [Bug 1334947], one has the choice of leaking the object in some cases, or else risk crashing in some others. 2005-10-22 Miguel Sofer <msofer@users.sf.net> * generic/tclExecute.c (INST_CONCAT): disable the optimisation for wide integers. [Bug 1251791] 2005-10-14 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> * generic/tclIO.c (Tcl_ClearChannelHandlers): removed change dated 2005-10-04 below. Look into [Bug 1323992] for detailed discussion. 2005-10-13 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclCmdAH.c (Tcl_FormatObjCmd): Stop [format] from seeing the difference between ints and wides. [Bug 1284178] 2005-10-13 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> * generic/tclIO.c (Tcl_ClearChannelHandlers): temporary ifdef TCL_THREADS changes done to de-activate pending event processing when channel is being closed/cutted. 2005-10-10 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclInt.h: ensure MODULE_SCOPE decl 2005-10-07 Jeff Hobbs <jeffh@ActiveState.com> * unix/tclUnixFCmd.c (TraverseUnixTree): Adjust 2004-11-11 change to * tests/fCmd.test (fCmd-20.2): account for NFS special files with a readdir rewind threshold. [Bug 1034337] 2005-10-05 Andreas Kupries <andreask@activestate.com> * generic/tclPipe.c (TclCreatePipeline): Fixed [Bug 1109294]. Applied the patch provided by David Gravereaux. * doc/CrtChannel.3: Fixed [Bug 1104682], by application of David Welton's patch for it, and added a note about wideSeekProc. 2005-10-05 Jeff Hobbs <jeffh@ActiveState.com> * tests/env.test (env-6.1): * win/tclWinPort.h: define USE_PUTENV_FOR_UNSET 1 * generic/tclEnv.c (TclSetEnv, TclUnsetEnv): add USE_PUTENV_FOR_UNSET to existing USE_PUTENV define to account for various systems that have putenv(), but can't unset env vars with it. Note difference between Windows and Linux for actually unsetting the env var (use of '='). Correct the resizing of the environ array. We assume that we are in full ownership, but that's not correct. [Bug 979640] 2005-10-04 Jeff Hobbs <jeffh@ActiveState.com> * win/tclWinSerial.c (SerialSetOptionProc): free argv [Bug 1067708] * tests/http.test: Do not URI encode -._~ according to * library/http/http.tcl (init): RFC3986. [Bug 1182373] (aho) * generic/tclIOUtil.c (TclFSNormalizeAbsolutePath): make static * generic/tclEncoding.c (TclFindEncodings): make static * unix/tclLoadShl.c (TclpDlopen): use DYNAMIC_PATH on second shl_load only. [Bug 1204237] 2005-10-04 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> * generic/tclIO.c (Tcl_ClearChannelHandlers): now deletes any outstanding timer for the channel. Also, prevents events still in the event queue from triggering on the current channel. * generic/tclTimer.c (Tcl_DeleteTimerHandler): bail out early if passed NULL argument. 2005-09-30 Don Porter <dgp@users.sourceforge.net> * generic/tclMain.c: Separate encoding conversion of command line arguments from list formatting. [Bug 1306162] 2005-09-27 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclBinary.c (FormatNumber): Factorize out copying of double values to a helper to work around ugly broken compiler problems. [Bug 1116542] 2005-09-15 Miguel Sofer <msofer@users.sf.net> * doc/ParseCmd.3: copy/paste fix [Bug 1292427] 2005-09-15 Donal K. Fellows <donal.k.fellows@man.ac.uk> * unix/tcl.m4 (SC_TCL_EARLY_FLAGS): Added extra hack to allow Tcl to transparently open large files on RHEL 3. [Bug 1287638] * unix/configure: autoconf-2.13 2005-09-07 Don Porter <dgp@users.sourceforge.net> * generic/tclUtf.c (Tcl_UniCharToUtf): Corrected handling of negative * tests/utf.test (utf-1.5): Tcl_UniChar input value. Incorrect handling was producing byte sequences outside of Tcl's legal internal encoding. [Bug 1283976] 2005-08-29 Kevin Kenny <kennykb@acm.org> * generic/tclBasic.c (ExprMathFunc): Restored "round away from zero" * tests/expr.test (expr-46.*): behaviour to the "round" function. Added test cases for the behavior, including the awkward case of a number whose fractional part is 1/2-1/2ulp. [Bug 1275043] 2005-08-25 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclListObj.c (UpdateStringOfList): Stop uncontrolled and unsafe crashes from happening when working with very large string representations. [Bug 1267380] 2005-08-17 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclFCmd.c (TclFileMakeDirsCmd): fix to race condition in file mkdir (backport from head 2005-06-13) [Bug 1217375] 2005-08-16 Kevin Kenny <kennykb@acm.org> * generic/tclEvent.c (Tcl_Finalize): Pushed Tcl_FinalizeLoad and Tcl_ResetFilesystem down after Tcl_FinalizeThreadAlloc because unloading DLLs can't happen while they still own TSD keys. (This is a backport of changes made in the HEAD on 2005-08-10.) 2005-08-05 Donal K. Fellows <donal.k.fellows@man.ac.uk> * unix/tclUnixInit.c (localeTable): Solaris uses a non-standard name for the cp1251 charset. Thanks to Victor Wagner for reporting this. [Bug 1252475] 2005-08-05 Kevin Kenny <kennykb@users.sourceforge.net> * generic/tclExecute.c (TclExecuteByteCode): Fixed a corner case * tests/expr.test (expr-38.1): where applying abs to MIN_INT failed to promote the result to a wide integer. [Bug 1241572] 2005-08-04 Don Porter <dgp@users.sourceforge.net> * generic/tclObj.c: Simplified routines that manage the typeTable. 2005-08-03 Don Porter <dgp@users.sourceforge.net> * generic/tclCompExpr.c: Untangled some dependencies in the * generic/tclEvent.c: order of finalization routines. * generic/tclInt.h: [Bug 1251399] * generic/tclObj.c: 2005-07-30 Daniel Steffen <das@users.sourceforge.net> * unix/configure, unix/tcl.m4: revert 2005-07-28 change. * unix/tclLoadDyld.c (TclpDlopen, TclpLoadMemory): workarounds for bugs/changes in behaviour in Mac OS X 10.4 Tiger, sync formatting changes from HEAD. 2005-07-29 Donal K. Fellows <dkf@users.sf.net> * generic/tclCmdIL.c (InfoGlobalsCmd): Even in high-speed mode, still have to take care with non-existant variables. [Bug 1247135] 2005-07-28 Mo DeJong <mdejong@users.sourceforge.net> * win/README: Update link to msys_mingw8.zip. Remove old Cygwin + Mingw info, people should just build with the msys + mingw configuration. 2005-07-28 Jeff Hobbs <jeffh@ActiveState.com> * unix/configure, unix/tcl.m4: defined TCL_LOAD_FROM_MEMORY on Darwin only for SHARED_BUILD 2005-07-28 Donal K. Fellows <dkf@users.sf.net> * generic/tclPipe.c (TclCreatePipeline): Arrange for POSIX systems to * unix/tclUnixPipe.c (TclpOpenFile): use the O_APPEND flag for * tests/exec.test (exec-19.1): files opened in a pipeline like ">>this". Note that Windows cannot support such access; there is no equivalent flag on the handle that can be set at the kernel-call level. The test is unix-specific in every way. [Bug 1245953] 2005-07-26 Mo DeJong <mdejong@users.sourceforge.net> * unix/configure: Regen. * unix/configure.in: Check for a $prefix/share directory and add it the the package if found. This will check for Tcl packages in /usr/local/share when Tcl is configured with the default dist install. [Patch 1231015] 2005-07-26 Don Porter <dgp@users.sourceforge.net> * doc/tclvars.n: Improved $errorCode documentation. [RFE 776921] * generic/tclBasic.c (Tcl_CallWhenDeleted): Converted to use per-thread counter, rather than a process global one that required mutex protection. [RFE 1077194] * generic/tclNamesp.c (TclTeardownNamespace): Re-ordering so that * tests/trace.test (trace-34.4): command delete traces fire while the command still exists. [Bug 1047286] 2005-07-24 Mo DeJong <mdejong@users.sourceforge.net> * unix/tcl.m4 (SC_PROG_TCLSH, SC_BUILD_TCLSH): * win/tcl.m4 (SC_PROG_TCLSH, SC_BUILD_TCLSH): Split confused search for tclsh on PATH and build and install locations into two macros. SC_PROG_TCLSH searches just the PATH. SC_BUILD_TCLSH determines the name of the tclsh executable in the Tcl build directory. [Bug 1160114], [Patch 1244153] 2005-07-22 Don Porter <dgp@users.sourceforge.net> * library/auto.tcl: Updates to the Tcl script library to make * library/history.tcl: use of Tcl 8.4 feautures. Thanks to * library/init.tcl: Patrick Fradin for prompting on this. * library/package.tcl: [Patch 1237755] * library/safe.tcl: * library/word.tcl: 2005-07-07 Jeff Hobbs <jeffh@ActiveState.com> * unix/tcl.m4, unix/configure: Backported [Bug 1095909], removing * unix/tclUnixPort.h: any use of readdir_r as it is not * unix/tclUnixThrd.c: necessary and just confuses things. 2005-07-05 Don Porter <dgp@users.sourceforge.net> * generic/tclCmdAH.c: New "encoding" Tcl_ObjType (not registered) * generic/tclEncoding.c: that permits longer lifetimes of the * generic/tclInt.h: Tcl_Encoding values kept as intreps of Tcl_Obj's. Reduces the need for repeated reading of encoding definition files from the filesystem. [Bug 1077262] * generic/tclNamesp.c: Allow for [namespace import] of a command * tests/namespace.test: over a previous [namespace import] of itself without throwing an error. [RFE 1230597] 2005-07-01 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> * unix/tclUnixNotfy.c: protect against spurious wake-ups while waiting on the condition variable when tearing down the notifier thread. [Bug 1222872] 2005-06-27 Don Porter <dgp@users.sourceforge.net> *** 8.4.11 TAGGED FOR RELEASE *** * library/auto.tcl: Reverted to Revision 1.12.2.3 (Tcl 8.4.9). Restores the (buggy) behavior of [auto_reset] that fails to clear away auto-loaded commands from non-global namespaces. Fixing this bug exposed an unknown number of buggy files out there (including at least portions of the Tk script library) that cannot tolerate double [source]-ing. The burden of fixing these exposed bugs will not be forced on package/extension/application authors until Tcl 8.5. 2005-06-24 Kevin Kenny <kennykb@acm.org> * generic/tclEvent.c (Tcl_Finalize): * generic/tclInt.h: * generic/tclPreserve.c (TclFinalizePreserve): Changed the finalization logic so that Tcl_Preserve finalizes after exit handlers run; a lot of code called from Tk's exit handlers presumes tha Tcl_Preserve will still work even from an exit handler. Also, made the assertion check that no exit handlers are created in Tcl_Finalize conditional on TCL_MEM_DEBUG to avoid spurious panics in the "stable" release. 2005-06-24 Don Porter <dgp@users.sourceforge.net> * library/auto.tcl: Make file safe to re-[source] without destroying registered auto_mkindex_parser hooks. 2005-06-23 Daniel Steffen <das@users.sourceforge.net> * tools/tcltk-man2html.tcl: fixed useversion glob pattern to accept multi-digit patchlevels. 2005-06-23 Kevin Kenny <kennykb@acm.org> * win/tclWinChan.c: More rewriting of __asm__ blocks that * win/tclWinFCmd.c: implement SEH in GCC, because mingw's gcc 3.4.2 is not as forgiving of violations committed by the old code and caused panics. [Bug 1225957] 2005-06-23 Daniel Steffen <das@users.sourceforge.net> * unix/Makefile.in (install-private-headers): rewrite tclPort.h when installing private headers to remove ../unix relative #include path to tclUnixPort.h (which is incorrect at the installed location). 2005-06-22 Kevin Kenny <kennykb@acm.org> * generic/tclInt.h: Changed the finalization * generic/tclEvent.c (Tcl_Finalize): logic to defer the * generic/tclIO.c (TclFinalizeIOSubsystem): shutdown of the pipe * unix/tclUnixPipe.c (TclFinalizePipes): management until after * win/tclWinPipe.c (TclFinalizePipes): all channels have been closed, in order to avoid a situation where the Windows PipeCloseProc2 would re-establish the exit handler after exit handlers had already run, corrupting the heap. [Bug 1225727] Corrected a read of uninitialized memory in PipeCloseProc2, which (at least on certain configurations) caused a great number of tests to either fail or hang. [Bug 1225044] 2005-06-22 Andreas Kupries <andreask@activestate.com> * generic/tclInt.h: Followup to change made on 2005-06-18 by Daniel Steffen. There are compilers (*) who error out on the redefinition of WORDS_BIGENDIAN. We have to undef the previous definition (on the command line) first to make this acceptable. (*): AIX native. 2005-06-22 Don Porter <dgp@users.sourceforge.net> * win/tclWinFile.c: Potential buffer overflow. [Bug 1225571] Thanks to Pat Thoyts for discovery and fix. * tests/safe.test: Backport performance improvement from reduced $::auto_path. 2005-06-21 Pat Thoyts <patthoyts@users.sourceforge.net> * tests/winDde.test: Added some waits to the dde server script to let event processing run after we create the dde server and before we exit the server process. This avoids 'server did not respond' errors. 2005-06-21 Kevin Kenny <kennykb@acm.org> * generic/tclFileName.c: Corrected a problem where a directory name containing a colon can crash the process on Windows [Bug 1194458] * tests/fileName.test: Added test for [file split] and [file join] with a name containing a colon. * win/tclWinPipe.c: Reverted davygrvy's changes of 2005-04-19; they cause multiple failures in io.test. [Bug 1225044, still open] 2005-06-21 Don Porter <dgp@users.sourceforge.net> * generic/tclBasic.c: Made the walk of the active trace list aware * generic/tclCmdMZ.c: of the direction of trace scanning, so the * generic/tclInt.h: proper correction can be made. [Bug 1224585] * tests/trace.test (trace-34.2,3): * generic/tclBasic.c (Tcl_DeleteTrace): Added missing walk of the * tests/trace.test (trace-34.1): list of active traces to cleanup references to traces being deleted. [Bug 1201035] 2005-06-20 Don Porter <dgp@users.sourceforge.net> * doc/FileSystem.3: added missing Tcl_GlobTypeData documentation [Bug 935853] 2005-06-18 Daniel Steffen <das@users.sourceforge.net> * generic/tclInt.h: ensure WORDS_BIGENDIAN is defined correctly with fat compiles on Darwin (i.e. ppc and i386 at the same time), the configure AC_C_BIGENDIAN check is not sufficient in this case because a single run of the compiler builds for two architectures with different endianness. * unix/tcl.m4 (Darwin): add -headerpad_max_install_names to LDFLAGS to ensure we can always relocate binaries with install_name_tool. * unix/configure: autoconf-2.13 2005-06-18 Don Porter <dgp@users.sourceforge.net> * changes: Update changes for 8.4.11 release * README: Bump version number to 8.4.11 * generic/tcl.h: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/README.binary: * win/configure.in: * unix/configure: autoconf * win/configure: 2005-06-18 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclCmdAH.c (Tcl_FormatObjCmd): Fix for [Bug 1154163]; only * tests/format.test: insert 'l' modifier when it is needed. 2005-06-07 Donal K. Fellows <donal.k.fellows@man.ac.uk> * unix/tclUnixNotfy.c (Tcl_FinalizeNotifier): Add dummy variable so threaded build compiles. 2005-06-06 Kevin B. Kenny <kennykb@acm.org> * win/tclWin32Dll.c: Corrected another buglet in the assembly code for stack probing on Win32/gcc. [Bug 1213678] 2005-06-03 Daniel Steffen <das@users.sourceforge.net> *** 8.4.10 TAGGED FOR RELEASE *** * unix/tclLoadDyld.c: fixed header conflict when building this file with USE_TCL_STUBS. * macosx/Makefile: fixed 'embedded' target. 2005-06-02 Jeff Hobbs <jeffh@ActiveState.com> * unix/Makefile.in (html): add BUILD_HTML_FLAGS optional var * tools/tcltk-man2html.tcl: add a --useversion to prevent confusion when multiple Tcl source dirs exist. * changes: updated for 8.4.10 release (porter) 2005-05-31 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> * unix/tclUnixNotfy.c: the notifier thread is now created as joinable thread and it is properly joined in Tcl_FinalizeNotifier. This is an attempt to fix [Bug 1082283] 2005-05-29 Jeff Hobbs <jeffh@ActiveState.com> * win/tclWinThrd.c (TclpFinalizeThreadData): move tlsKey defn to top of file and clarify name (was 'key'). [Bug 1204064] 2005-05-27 Jeff Hobbs <jeffh@ActiveState.com> * README: Bumped patchlevel to 8.4.10 * generic/tcl.h: * tools/tcl.wse.in: * unix/tcl.spec, unix/configure, unix/configure.in: * win/configure, win/configure.in: 2005-05-26 Daniel Steffen <das@users.sourceforge.net> * macosx/Makefile: moved & corrected EMBEDDED_BUILD check. * unix/configure.in: corrected framework finalization to softlink stub library to Versions/8.x subdir instead of Versions/Current. * unix/configure: autoconf-2.13 2005-05-25 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclCmdMZ.c (Tcl_TimeObjCmd): add necessary cast * unix/configure, unix/configure.in: ensure false Tcl.framework is only created with --enable-framework 2005-05-24 Daniel Steffen <das@users.sourceforge.net> * tests/env.test: added DYLD_FRAMEWORK_PATH to the list of env vars that need to be handled specially. * macosx/Makefile: * macosx/README: * macosx/Tcl-Info.plist.in (new file): * unix/Makefile.in: * unix/configure.in: * unix/tcl.m4: * unix/tclUnixInit.c: moved all Darwin framework build support from macosx/Makefile into the standard unix configure/make buildsystem, the macosx/Makefile is no longer required to build Tcl.framework (but its functionality is still available for backwards compatibility). * unix/configure: autoconf-2.13 * generic/tclIOUtil.c (TclLoadFile): * generic/tclInt.h: * unix/tcl.m4: * unix/tclLoadDyld.c: added support for [load]ing .bundle binaries in addition to .dylib's: .bundle's can be [unload]ed (unlike .dylib's), and can be [load]ed from memory, e.g. directly from VFS without needing to be written out to a temporary location first. [Bug 1202209] * unix/configure: autoconf-2.13 * generic/tclCmdMZ.c (Tcl_TimeObjCmd): change [time] called with a count > 1 to return a string with a float value instead of a rounded off integer. [Bug 1202178] 2005-05-20 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> * generic/tclParseExpr.c: removed unreferenced stack variable "errMsg" probably included by fixing [Bug 1201589] (see below). 2005-05-20 Don Porter <dgp@users.sourceforge.net> * generic/tclParseExpr.c: Corrected parser to recognize all boolean literals accepted by Tcl_GetBoolean, including prefixes like "y" and "f", and to allow "eq" and "ne" as function names in the proper context. [Bug 1201589] 2005-05-19 Daniel Steffen <das@users.sourceforge.net> * macosx/tclMacOSXNotify.c (Tcl_InitNotifier): fixed crashing CFRelease of runLoopSource in Tcl_InitNotifier (reported by Zoran): CFRunLoopAddSource doesn't CFRetain, so can only CFRelease the runLoopSource in Tcl_FinalizeNotifier. 2005-05-14 Daniel Steffen <das@users.sourceforge.net> * macosx/tclMacOSXBundle.c: * unix/tclUnixInit.c: * unix/tcl.m4 (Darwin): made use of CoreFoundation API configurable and added test of CoreFoundation availablility to allow building on ppc64, replaced HAVE_CFBUNDLE by HAVE_COREFOUNDATION; test for availability of Tiger or later OSSpinLockLock API. * unix/tclUnixNotfy.c: * unix/Makefile.in: * macosx/tclMacOSXNotify.c (new file): when CoreFoundation is available, use new CFRunLoop based notifier: allows easy integration with other event loops on Mac OS X, in particular the TkAqua Carbon event loop is now integrated via a standard tcl event source (instead of TkAqua upon loading having to finalize the exsting notifier and replace it with its custom version). [Patch 1202052] * tests/unixNotfy.test: don't run unthreaded tests on Darwin since notifier may be using threads even in unthreaded core. * unix/tclUnixPort.h: * unix/tcl.m4 (Darwin): test for thread-unsafe realpath durning configure, as Darwin 7 and later realpath is threadsafe. * macosx/tclMacOSXBundle.c: * unix/tclLoadDyld.c: * unix/tclUnixInit.c: fixed gcc 4.0 warnings. * unix/configure: autoconf-2.13 2005-05-10 Jeff Hobbs <jeffh@ActiveState.com> * tests/string.test: string-10.[21-30] * generic/tclCmdMZ.c (Tcl_StringObjCmd): add extra checks to prevent possible UMR in unichar cmp function for string map. 2005-05-06 Jeff Hobbs <jeffh@ActiveState.com> * unix/tcl.m4, unix/configure: correct Solaris 10 (5.10) check and add support for x86_64 Solaris cc builds. 2005-04-29 Donal K. Fellows <donal.k.fellows@man.ac.uk> * doc/FileSystem.3: Backport of doc fix. [Bug 1172401] 2005-04-27 Don Porter <dgp@users.sourceforge.net> * library/init.tcl: Corrected flaw in interactive command * tests/main.test: auto-completion. [Bug 1191409] * tests/unixInit.test (7.1): Alternative fix for the 2005-04-22 commit. 2005-04-25 Daniel Steffen <das@users.sourceforge.net> * compat/string.h: fixed memchr() protoype for __APPLE__ so that we build on Mac OS X 10.1 again. * generic/tclNotify.c (TclFinalizeNotifier): fixed notifier not being finalized in unthreaded core (was testing for notifier initialization in current thread by checking thread id != 0 but thread id is always 0 in untreaded core). * unix/tclUnixNotfy.c (Tcl_WaitForEvent): sync with HEAD: only declare and use timeout var in unthreaded core. * unix/Makefile.in: added @PLAT_SRCS@ to SRCS and split out NOTIFY_SRCS from UNIX_SRCS for parity with UNIX_OBJS & NOTIFY_OBJS. * unix/configure.in: only run check for broken strstr implementation if AC_REPLACE_FUNCS(strstr) hasn't already determined that strstr is unavailable, otherwise compat/strstr.o will be used twice (resulting in duplicate symbol link errors on Mac OS X 10.1) * unix/tcl.m4 (Darwin): added configure checks for recently added linker flags -single_module and -search_paths_first to allow building with older tools (and on Mac OS X 10.1), use -single_module in SHLIB_LD and not just T{CL,K}_SHLIB_LD_EXTRAS, added unexporting from Tk of symbols from libtclstub to avoid duplicate symbol warnings, added PLAT_SRCS definition for Mac OS X. (SC_MISSING_POSIX_HEADERS): added caching of dirent.h check. (SC_TCL_64BIT_FLAGS): fixed 'checking for off64_t' message output. * unix/configure: autoconf-2.13 2005-04-22 Don Porter <dgp@users.sourceforge.net> * generic/tclCmdMZ.c: Corrected intrep-dependence of * tests/string.test: [string is boolean] [Bug 1187123] 2005-04-22 Daniel Steffen <das@users.sourceforge.net> * tests/unixInit.test (7.1): fixed failure when running tests with -tmpdir arg not set to working dir. 2005-04-20 Don Porter <dgp@users.sourceforge.net> * generic/tclGet.c (Tcl_GetInt): Corrected error that did not * generic/tclObj.c (Tcl_GetIntFromObj): permit 0x80000000 to be recognized as an integer on TCL_WIDE_INT_IS_LONG systems [Bug 1090869] 2005-04-19 Jeff Hobbs <jeffh@ActiveState.com> * tests/winPipe.test (winpipe-6.2): remove -blocking 1 as this one can truly block. 2005-04-19 David Gravereaux <davygrvy@pobox.com> * win/tclWinPipe.c: The pipe channel driver now respects the -blocking option when closing. The windows pipe driver now has the same behavior as the UNIX side. This change is to avoid a hung shell when exiting due to open pipes that refuse to close in a graceful manner. * doc/open.n: Added a note about -blocking 0 and lack of exit status as it had never been documented. [Bug 947693] ***POTENTIAL INCOMPATIBILITY*** Scripts that use async pipes on windows, must (like the UNIX side) set -blocking to 1 before calling [close] to receive the exit status. * tests/winPipe.test (winpipe-6.1/2): added 'fconfigure $f -blocking 1' so the exit status can be acquired. 2005-04-13 David Gravereaux <davygrvy@pobox.com> * generic/tclIO.c (Tcl_SetChannelBufferSize): Lowest size limit * tests/io.test: changed from ten bytes to one byte. Need for * tests/iogt.test: this change was proven by Ross Cartlidge <rossc@cisco.com> where [read stdin 1] was grabbing 10 bytes followed by starting a child process that was intended to continue reading from stdin. Even with -buffersize set to one, nine chars were getting lost by the buffersize over reading for the native read() caused by [read]. 2005-04-12 Kevin B. Kenny <kennykb@acm.org> * compat/strstr.c: Added default definition of NULL to accommodate building on systems with badly broken headers. [Bug 1175161] 2005-04-09 Daniel Steffen <das@users.sourceforge.net> * macosx/README: updated requirements for OS & developer tool versions + other small fixes/cleanup. * unix/tcl.m4 (Darwin): added -single_module linker flag to TCL_SHLIB_LD_EXTRAS and TK_SHLIB_LD_EXTRAS. * unix/configure: autoconf-2.13 2005-04-05 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> Set of changes correcting huge memory waste (not a leak) when a thread exits. This has been introduced in 8.4.7 within an attempt to correctly cleanup after ourselves when Tcl library is being unloaded with the Tcl_Finalize() call. This fixes the [Bug 1178445]. * generic/tclInt.h: added prototypes for TclpFreeAllocCache() and TclFreeAllocCache() * generic/tclThreadAlloc.c: modified TclFinalizeThreadAlloc() to explicitly call TclpFreeAllocCache with the NULL-ptr as argument signalling cleanup of private tsd key used only by the threading allocator. * unix/tclUnixThrd.c: fixed TclpFreeAllocCache() to recognize when being called with NULL argument. This is a signal for it to clean up the tsd key associated with the threading allocator. * win/tclWinThrd.c: renamed TclWinFreeAllocCache to TclpFreeAllocCache and fixed to recognize when being called with NULL argument. This is a signal for it to clean up the tsd key associated with the threading allocator. 2005-04-05 Don Porter <dgp@users.sourceforge.net> * generic/tclExecute.c (ExprSrandFunc): Replaced incursions into the * generic/tclUtil.c (TclGetIntForIndex): intreps of numeric types with simpler calls of Tcl_GetIntFromObj and Tcl_GetLongFromObj, now that those routines are better behaved wrt shimmering. [Patch 1177129] 2005-03-29 Jeff Hobbs <jeffh@ActiveState.com> * win/tcl.m4, win/configure: do not require cygpath in macros to allow msys alone as an alternative. * win/tclWinTime.c (TclpGetDate): use time_t for 'time' [Bug 1163422] 2005-03-18 Don Porter <dgp@users.sourceforge.net> * generic/tclCompCmds.c (TclCompileIncrCmd): Corrected checks for immediate operand usage to permit leading space and sign characters. Restores more efficient bytecode for [incr x -1] that got lost in the CONST string reforms of Tcl 8.4. [Bug 1165671] * generic/tclBasic.c (Tcl_EvalEx,TclEvalTokensStandard): * generic/tclCmdMZ.c (Tcl_SubstObj): * tests/basic.test (basic-46.4): Restored recursion limit * tests/parse.test (parse-19.*): testing in nested command substitutions within direct script evaluation (Tcl_EvalEx) that got lost in the parser reforms of Tcl 8.1. Added tests for correct behavior. [Bug 1115904] 2005-03-15 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclFileName.c: * win/tclWinFile.c: * tests/winFCMd.test: fix to 'file pathtype' and 'file norm' failures on reserved filenames like 'COM1:', etc. 2005-03-15 Kevin B. Kenny <kennykb@acm.org> * generic/tclClock.c: * generic/tclDate.c: * generic/tclGetDate.y: * generic/tclInt.decls: * unix/tclUnixTime.c: * win/tclWinTime.c: Replaced 'unsigned long' variable holding times with 'Tcl_WideInt', to cope with systems on which a time_t is wider than a long (Win64) [Bug 1163422] * generic/tclIntDecls.h: Regen 2005-03-15 Pat Thoyts <patthoyts@users.sourceforge.net> * unix/tcl.m4: Make it work on OpenBSD again. Imported patch from the OpenBSD ports tree. 2005-03-10 Don Porter <dgp@users.sourceforge.net> * generic/tclCmdMZ.c (TclCheckInterpTraces): Corrected mistaken cast of ClientData to (TraceCommandInfo *) when not warranted. Thanks to Yuri Victorovich for the report. [Bug 1153871] 2005-03-08 Jeff Hobbs <jeffh@ActiveState.com> * win/makefile.vc: clarify necessary defined vars that can come from MSVC or the Platform SDK. 2005-02-24 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: Better use of [glob -types] to avoid * tests/tcltest.test: failed attempts to [source] a directory, and similar matters. Thanks to "mpettigr". [Bug 1119798] * library/tcltest/pkgIndex.tcl: Bump to tcltest 2.2.8 2005-02-23 Donal K. Fellows <donal.k.fellows@man.ac.uk> * doc/CrtChannel.3 (THREADACTIONPROC): Formatting fix. [Bug 1149605] 2005-02-17 Jeff Hobbs <jeffh@ActiveState.com> * win/tclWinFCmd.c (TraverseWinTree): use wcslen on wchar, not Tcl_UniCharLen. 2005-02-16 Miguel Sofer <msofer@users.sf.net> * doc/variable.n: fix for [Bug 1124160], variables are detected by [info vars] but not by [info locals]. 2005-02-10 Jeff Hobbs <jeffh@ActiveState.com> * unix/Makefile.in: remove SHLIB_LD_FLAGS (only for AIX, inlined * unix/tcl.m4: into SHLIB_LD). Combine AIX-* and AIX-5 * unix/configure: branches in SC_CONFIG_CFLAGS. Correct gcc builds for AIX-4+ and HP-UX-11. 2005-02-10 Miguel Sofer <msofer@users.sf.net> * generic/tclBasic.c (Tcl_EvalObjEx): * tests/basic.test (basic-26.2): preserve the arguments passed to TEOV in the pure-list branch, in case the list shimmers away. Fix for [Bug 1119369], reported by Peter MacDonald. 2005-02-10 Donal K. Fellows <donal.k.fellows@man.ac.uk> * doc/binary.n: Made the documentation of sign bit masking and [binary scan] consistent. [Bug 1117017] 2005-02-01 Don Porter <dgp@users.sourceforge.net> * generic/tclExecute.c (TclCompEvalObj): Removed stray statement left behind in prior code reorganization. 2005-01-28 Jeff Hobbs <jeffh@ActiveState.com> * unix/configure, unix/tcl.m4: add solaris 64-bit gcc build support. [Bug 1021871] 2005-01-27 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclBasic.c (Tcl_ExprBoolean, Tcl_ExprDouble) (Tcl_ExprLong): Fix to recognize Tcl_WideInt type. [Bug 1109484] 2005-01-27 Andreas Kupries <andreask@activestate.com> TIP#218 IMPLEMENTATION * generic/tclDecls.h: Regenerated from tcl.decls. * generic/tclStubInit.c: * doc/CrtChannel.3: Documentation of extended API, * generic/tcl.decls: extended testsuite, and * generic/tcl.h: implementation. Removal of old * generic/tclIO.c: driver-specific TclpCut/Splice * generic/tclInt.h: functions. Replaced with generic * tests/io.test: thread-action calls through the * unix/tclUnixChan.c: new hooks. Update of all builtin * unix/tclUnixPipe.c: channel drivers to version 4. * unix/tclUnixSock.c: Windows drivers extended to * win/tclWinChan.c: manage thread state in a thread * win/tclWinConsole.c: action handler. * win/tclWinPipe.c: * win/tclWinSerial.c: * win/tclWinSock.c: * mac/tclMacChan.c: 2005-01-25 Don Porter <dgp@users.sourceforge.net> * library/auto.tcl: Updated [auto_reset] to clear auto-loaded procs in namespaces other than :: [Bug 1101670]. 2005-01-25 Daniel Steffen <das@users.sourceforge.net> * unix/tcl.m4 (Darwin): fixed bug with static build linking to dynamic library in /usr/lib etc instead of linking to static library earlier in search path. [Bug 956908] Removed obsolete references to Rhapsody. * unix/configure: autoconf-2.13 2005-01-19 Mo DeJong <mdejong@users.sourceforge.net> * win/tclWinChan.c (FileCloseProc): Invoke TclpCutFileChannel() to remove a FileInfo from the thread local list before deallocating it. This should have been done via an earlier call to Tcl_CutChannel, but I was running into a crash in the next call to Tcl_CutChannel during the IO finalization stage. 2005-01-17 Vince Darley <vincentdarley@users.sourceforge.net> * tests/winFCmd.test: made test independent of current drive. [Bug 1066528] 2005-01-10 Donal K. Fellows <donal.k.fellows@man.ac.uk> * unix/tclUnixFCmd.c (CopyFile): Convert u_int to unsigned to make clashes with types in standard C headers less of a problem. [Bug 1098829] 2005-01-06 Donal K. Fellows <donal.k.fellows@man.ac.uk> * library/http/http.tcl (http::mapReply): Significant performance enhancement by using [string map] instead of [regsub]/[subst], and update version requirement to Tcl8.4. [Bug 1020491] 2005-01-05 Donal K. Fellows <donal.k.fellows@man.ac.uk> * unix/tclUnixInit.c (localeTable): Add encoding mappings for some Chinese locales. [Bug 1084595] * doc/lsearch.n: Convert to other form of emacs mode control comment to prevent problems with old versions of man. [Bug 1085127] 2004-12-29 Jeff Hobbs <jeffh@ActiveState.com> * win/tcl.m4, win/configure: update MSVC CFLAGS_OPT to -O2, remove -Gs (included in -O2) and -GD (outdated). Use "link -lib" instead of "lib" binary and remove -YX for MSVC7 portability. Add -fomit-frame-pointer for gcc OPT compiles. [Bug 1092952, 1091967] 2004-12-13 Kevin B. Kenny <kennykb@acm.org> * doc/clock.n: Clarify that the [clock scan] command does not accept the full range of ISO8601 point-in-time formats. [Bug 1075433] 2004-12-09 Donal K. Fellows <donal.k.fellows@man.ac.uk> * doc/Async.3: Reword for better grammar, better nroff and get the flag name right. (Reported by David Welton.) 2004-12-06 Jeff Hobbs <jeffh@ActiveState.com> *** 8.4.9 TAGGED FOR RELEASE *** * unix/tclUnixNotfy.c (NotifierThreadProc): init numFdBits [Bug 1079286] 2004-12-02 Jeff Hobbs <jeffh@ActiveState.com> * changes: updated for 8.4.9 release 2004-12-02 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclIOUtil.c: fix and new tests for [Bug 1074671] to * tests/fileSystem.test: ensure tilde paths are not returned specially by 'glob'. 2004-12-01 Don Porter <dgp@users.sourceforge.net> * library/auto.tcl (tcl_findLibrary): Disabled use of [file normalize] that caused trouble with freewrap. [Bug 1072136] 2004-11-26 Don Porter <dgp@users.sourceforge.net> * tests/reg.test (reg-32.*): Added missing testregexp constraints. * library/auto.tcl (tcl_findLibrary): Made sure the uniquifying operations on the search path does not also normalize. [Bug 1072136] 2004-11-26 Donal K. Fellows <donal.k.fellows@man.ac.uk> * doc/dde.n: Resynchonized the documentation with itself and fixed some formatting errors. 2004-11-25 Zoran Vasiljevic <vasiljevic@users.sf.net> * doc/Notify.3: * doc/Thread.3: Added doc fixes and hints from [Bug 1068077]. 2004-11-25 Reinhard Max <max@suse.de> * tests/tcltest.test: The order in which [glob] returns the file names * tests/fCmd.test: is undefined, so tests should not depend on it. 2004-11-24 Don Porter <dgp@users.sourceforge.net> * unix/tcl.m4 (SC_ENABLE_THREADS): Corrected failure to determine the number of arguments for readdir_r on SunOS systems. [Bug 1071701] * unix/configure: autoconf-2.13 2004-11-24 Jeff Hobbs <jeffh@ActiveState.com> * README: Bumped patchlevel to 8.4.9 * generic/tcl.h: * tools/tcl.wse.in: * unix/tcl.spec, unix/configure, unix/configure.in: * win/configure, win/configure.in: 2004-11-24 Kevin B. Kenny <kennykb@acm.org> * unix/tcl.m4 (SC_ENABLE_THREADS): Corrected bad check for 3-argument readdir_r(). [Bug 1001325] * unix/configure: Regenerated. * unix/tclUnixNotfy.c: Corrected all uses of 'select' to manage their masks using the FD_CLR, FD_ISSET, FD_SET, and FD_ZERO macros rather than bit-whacking that failed under Solaris-Sparc-64. [Bug 1071807] 2004-11-23 Don Porter <dgp@users.sourceforge.net> * generic/tclCmdIL.c (InfoVarsCmd): Corrected segfault in new * tests/info.test (info-19.6): trivial matching branch [Bug 1072654] 2004-11-23 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclPathObj.c: fix and new test for [Bug 1043129] in * tests/fileSystem.test: the treatment of backslashes in file join on Windows. 2004-11-22 Mo DeJong <mdejong@users.sourceforge.net> * unix/configure: Regen. * unix/tcl.m4 (SC_TCL_64BIT_FLAGS): Define HAVE_TYPE_OFF64_T only when off64_t, open64(), and lseek64() are defined. IRIX 5.3 is known to not include an open64 function. [Bug 1030465] 2004-11-22 Mo DeJong <mdejong@users.sourceforge.net> * unix/configure: Regen. * unix/tcl.m4 (SC_ENABLE_THREADS): Check for a 2 argument version of readdir_r that is known to exists under IRIX 5.3. * unix/tclUnixThrd.c (TclpReaddir): Use either 2 arg or 3 arg version of readdir_r. [Bug 1001325] 2004-11-19 Reinhard Max <max@suse.de> *** 8.4.8 TAGGED FOR RELEASE *** * unix/installManPage: Classic sed doesn't support | in REs. 2004-11-19 Daniel Steffen <das@users.sourceforge.net> * macosx/Makefile: * unix/configure.in: * unix/tclUnixInit.c (MacOSXGetLibraryPath): changed detection of tcl framework build when determining tclLibPath from overloaded TCL_LIBRARY to configuration define TCL_FRAMEWORK. [Bug 1068088] * unix/configure: autoconf-2.13 * tests/unixInit.test (7.1): fixed failure when running tests with -tmpdir arg not set to working dir. 2004-11-18 Don Porter <dgp@users.sourceforge.net> * changes: Final updates for Tcl 8.4.8 release. 2004-11-18 Reinhard Max <max@suse.de> * unix/tcl.m4 (SC_CONFIG_MANPAGES): Applied an improved version of * unix/configure.in: [Patch 996085], that introduces * unix/Makefile.in: --enable-man-suffix. * unix/installManPage: added * unix/mkLinks.tcl: removed * unix/mkLinks: removed 2004-11-16 Jeff Hobbs <jeffh@ActiveState.com> * unix/tclUnixChan.c (TtySetOptionProc): fixed crash configuring -ttycontrol on a channel. [Bug 1067708] 2004-11-16 Andreas Kupries <andreask@activestate.com> * win/makefile.vc: Fixed bug in installation of http 2.5. * win/makefile.bc: Was installed into directory http2.4. * win/Makefile.in: This has been corrected. * unix/Makefile.in: * tools/tcl.wse.in: * tools/tclmin.wse: 2004-11-16 Don Porter <dgp@users.sourceforge.net> * library/auto.tcl: Updated [tcl_findLibrary] search path to include the $::auto_path. [RFE 695441] 2004-11-16 Donal K. Fellows <donal.k.fellows@man.ac.uk> * doc/tclvars.n: Mention global variables set by tclsh and wish so they are easier to find. [Patch 1065732] 2004-11-15 Don Porter <dgp@users.sourceforge.net> * generic/tclCmdMZ.c (Tcl_TraceObjCmd): Fixed Bug 1065378 which failed * tests/trace.test (trace-33.1): to permit a variable trace created with [trace variable] to be destroyed with [trace remove]. Thanks to Keith Vetter for the report. 2004-11-12 Don Porter <dgp@users.sourceforge.net> * library/init.tcl: Made [unknown] robust in the case that either of the variables ::errorInfo or ::errorCode gets unset. [Bug 1063707] 2004-11-12 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclEncoding.c (TableFromUtfProc): correct crash condition when TCL_UTF_MAX == 6. [Bug 1004065] 2004-11-12 Daniel Steffen <das@users.sourceforge.net> * doc/clock.n: * doc/registry.n: * doc/upvar.n: fixed *roff errors uncovered by running 'make html'. * tools/tcltk-man2html.tcl: added faked support for bullet point lists, i.e. *nroff ".IP \(bu" syntax. Synced other changes from HEAD. 2004-11-11 Daniel Steffen <das@users.sourceforge.net> * tests/fCmd.test: * unix/tclUnixFCmd.c (TraverseUnixTree): added option to rewind() the readdir() loop whenever the source hierarchy has been modified by traverseProc (e.g. by deleting files); this is required to ensure complete traversal of the source hierarchy on certain filesystems like HFS+. Added test for failing recursive delete on Mac OS X that was due to this. [Bug 1034337] * generic/tclListObj.c (Tcl_ListObjReplace): use memmove() instead of manual copy loop to shift list elements. Decreases time spent in Tcl_ListObjReplace() from 5.2% to 1.7% of overall runtime of tclbench on a ppc 7455 (i.e. 200% speed increase). [Patch 1064243] * generic/tclHash.c: hoisted some constant pointer dereferences out of loops to eliminate redundant loads that the gcc optimizer didn't deal with. Decreases time spend in Tcl_FindHashEntry() by 10% over a full run of the tcl testuite on a ppc 7455. [Patch 1064243] * tests/fileName.test: * tests/fileSystem.test: * tests/io.test: * tests/tcltest.test: fixed bugs causing failures when running tests with -tmpdir arg not set to working dir. * macosx/Makefile: corrected path to html help inside framework. Prevent parallel make from building several targets at the same time. 2004-11-09 Donal K. Fellows <donal.k.fellows@man.ac.uk> * doc/catch.n: Clarify documentation on return codes. [Bug 1062647] 2004-11-02 Don Porter <dgp@users.sourceforge.net> * changes: Updates for Tcl 8.4.8 release. 2004-11-02 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: Corrected some misleading * tests/tcltest.test (tcltest-26.1,2): displays of ::errorInfo and ::errorCode information when the -setup, -body, and/or -cleanup scripts return an unexpected return code. Thanks to Robert Seeger for the fix. [RFE 1017151] 2004-11-02 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclExecute.c (TclExecuteByteCode): NaN-equality fix from Miguel Sofer. [Bug 761471] * doc/CrtChannel.3 (Tcl_GetChannelMode): Add synopsis. [Bug 1058446] 2004-10-31 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclCmdIL.c (InfoGlobalsCmd): * tests/info.test (info-8.4): Strip leading global-namespace specifiers from the pattern argument. [Bug 1057461] 2004-10-30 Miguel Sofer <msofer@users.sf.net> * generic/tclCmdAH.c (Tcl_CatchObjCmd): removed erroneous comment [Bug 1029518] 2004-10-29 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: Correct reaction to errors in the obsolete processCmdLineArgsHook. [Bug 1055673] * library/tcltest/pkgIndex.tcl: Bump to tcltest 2.2.7 2004-10-28 Andreas Kupries <andreask@activestate.com> * generic/tclAlloc.c: Fixed [Bug 1030548], a threaded debug * generic/tclThreadAlloc.c: build on Windows now works again. Had to * win/tclWinThrd.c: touch Unix as well. Basic patch by Kevin, * unix/tclUnixThrd.c: with modifications by myself. 2004-10-28 Don Porter <dgp@users.sourceforge.net> * README: Bumped patch level to 8.4.8 to prepare for * generic/tcl.h: next patch release. * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/README.binary: * win/configure.in: * unix/configure: autoconf (2.13) * win/configure: 2004-10-28 Kevin B. Kenny <kennykb@acm.org> * generic/tclInt.decls: * unix/tclUnixTime.c (TclpGmtime, TclpLocaltime): * win/tclWinTime.c (TclpGmtime, TclpLocaltime): Changed type signatures of TclpGmtime and TclpLocaltime to accept CONST TclpTime_t throughout, to avoid any possible confusion in pedantic compilers. [Bug 1001319] * generic/tclIntDecls.h: * generic/tclIntPlatDecls.h: Regenerated. 2004-10-27 Don Porter <dgp@users.sourceforge.net> * generic/tclCmdAH.c (Tcl_FormatObjCmd): Restored missing line from yesterday's 868489 backport that caused failed alloc's on LP64 systems. * tests/appendComp.test: Backport test suite fixes of errors * tests/autoMkindex.test: revealed by -singleproc 1 -debug 1 * tests/exec.test: options to make test. * tests/execute.test: * tests/interp.test: * tests/io.test: * tests/namespace.test: * tests/regexpComp.test: * tests/stringComp.test: * tests/unixInit.test: * tests/winPipe.test: 2004-10-26 Kevin B. Kenny <kennykb@acm.org> * generic/tclCmdAH.c (Tcl_FormatObjCmd): Backport a missing bit of the [Bug 868489] fix. * generic/tclObj.c (SetBooleanFromAny): Backport fix for [Bug 1026125] * tests/format.test (format-19.1): Additional regression test for [Bug 868489]. 2004-10-26 Donal K. Fellows <donal.k.fellows@man.ac.uk> * doc/*.n: Backporting of documentation updates. 2004-10-26 Don Porter <dgp@users.sourceforge.net> * tests/subst.test (subst-12.3-5): More tests for [Bug 1036649] * tests/compile.test (compile-12.4): Backport test for [Bug 1001997] * tests/timer.test (timer-10.1): Backport test for [Bug 1016167] * tests/tcltest.test (tcltest-12.3,4): Backport setup corrections. * tests/error.test (error-6.3,4,7,9): Backport of some tests. * tests/basic.test (basic-49.*): * tests/namespace.test (namespace-8.7): * tests/init.test (init-2.8): Updated to not rely on http package. * generic/tclThreadTest.c (ThreadEventProc): Corrected subtle bug where the returned (char *) from Tcl_GetStringResult(interp) continued to be used without copying or refcounting, while activity on the interp continued. 2004-10-14 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclUtil.c (TclMatchIsTrivial): Detect degenerate cases of glob matching that let us avoid scanning through hash tables. * generic/tclCmdIL.c (InfoCommandsCmd, InfoGlobalsCmd, InfoProcsCmd): (InfoVarsCmd): Use this to speed up some [info] subcommands. 2004-10-08 Jeff Hobbs <jeffh@ActiveState.com> * win/tclWinFile.c (NativeIsExec): correct result of 'file executable' to not be case sensitive. [Bug 954263] 2004-10-05 Don Porter <dgp@users.sourceforge.net> * generic/tclNamesp.c (Tcl_PopCallFrame): Removed Bug 1038021 workaround. That bug is now fixed. 2004-09-30 Don Porter <dgp@users.sourceforge.net> * generic/tclNamespace.c (TclTeardownNamespace): Tcl_Obj-ified the * tests/namespace.test (namespace-8.5,6): save/restore of ::errorInfo and ::errorCode during global namespace teardown. Revised the comment to clarify why this is done, and added tests that will fail if this is not done. * generic/tclResult.c (TclTransferResult): Added safety checks so that unexpected undefined ::errorInfo or ::errorCode will not lead to a segfault. * generic/tclVar.c (CallVarTraces): Save/restore the flag values * tests/var.test (var-16.1): that define part of the interpreter state during variable traces. [Bug 1038021] 2004-09-30 Miguel Sofer <msofer@users.sf.net> * tests/subst.test (12.2): test correction. 2004-09-29 Miguel Sofer <msofer@users.sf.net> * generic/tclBasic.c (Tcl_EvalEx): * tests/subst.test (12.1-2): fix for buffer overflow in [subst], [Bug 1036649] 2004-09-23 Mo DeJong <mdejong@users.sourceforge.net> * unix/dltest/Makefile.in (clean): Fixup make clean rule so that it does not delete all files when SHLIB_SUFFIX is set to the empty string in a static build. [Bug 1016726] 2004-09-18 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclExecute.c (TEBC-INST_LSHIFT,INST_RSHIFT): Ensure that large shifts end up shifting correctly. [Bug 868467] 2004-09-15 Daniel Steffen <das@users.sourceforge.net> * tests/load.test (load-2.3): adopted fix for failure on darwin from HEAD. 2004-09-14 Don Porter <dgp@users.sourceforge.net> * generic/tclObj.c (Tcl_GetIntFromObj): Corrected flaw in returning the int value of a wideInteger. [Bug 1027690] 2004-09-10 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclObj.c (SetIntOrWideFromAny): Rewritten integral value parsing code so that values do not flip so easily between numeric representations. Thanks to KBK for this! [Bug 868489] * generic/tclIO.c (Tcl_Seek): Make sure wide seeks do not fail to set ::errorCode on error. [Bug 1025359] 2004-09-10 Andreas Kupries <andreask@activestate.com> * generic/tcl.h: Micro formatting fixes. * generic/tclIOGT.c: Channel version fixed, must be 3, to have wideseekProc. Thanks to David Graveraux <davygrvy@pobox.com>. 2004-09-11 Don Porter <dgp@users.sourceforge.net> * generic/tclNamespace.c (TclGetNamespaceForQualName): Resolved longstanding inconsistency in the treatment of the TCL_NAMESPACE_ONLY flag revealed by testing the 2004-09-09 commits against Itcl. TCL_NAMESPACE_ONLY now acts as specified in the pre-function comment, forcing resolution in the passed in context namespace. It has been incorrectly forcing resolution in the interp's current namespace. 2004-09-10 Miguel Sofer <msofer@users.sf.net> * generic/tclExecute.c (INST_CONCAT1): added a peephole optimisation for concatting an empty string. This enables replacing the idiom 'K $x [set x {}]' by '$x[set x {}]' for fastest execution. 2004-09-09 Don Porter <dgp@users.sourceforge.net> * generic/tclNamesp.c (Tcl_ForgetImport): Corrected faulty logic that * tests/namespace.test: relied exclusively on string matching and failed in the presence of [rename]s. [Bug 560297] Also corrected faulty prevention of [namespace import] cycles. [Bug 1017299] 2004-09-08 Kevin B. Kenny <kennykb@acm.org> * compat/strftime.c (_conv): Corrected a problem where hour 0 would format as a blank format group with %k. * tests/clock.test (clock-41.1): Added regression test case for %k at the zero hour. 2004-09-07 Kevin B. Kenny <kennykb@acm.org> * generic/tclTimer.c: Removed a premature optimisation that attempted to store the assoc data in the client data; the optimisation caused a bug that [after] would overwrite its imports. [Bug 1016167] 2004-09-02 Donal K. Fellows <donal.k.fellows@man.ac.uk> * doc/lsearch.n: Clarified meaning of -dictionary. [Bug 759545] 2004-09-01 Jeff Hobbs <jeffh@ActiveState.com> * win/tclWinReg.c (BroadcastValue): WIN64 cast corrections * win/tclWinDde.c (DdeClientWindowProc): (DdeServicesOnAck, DdeEnumWindowsCallback): WIN64 corrections * win/tclWin32Dll.c (TclWinCPUID): need _asm for WIN64 (Itanium), until we have it, just return unknown. [Bug 1020445] 2004-08-30 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclCmdMZ.c (Tcl_StringObjCmd): Stop [string map] from crashing when its map and input string are the same object. 2004-08-27 Daniel Steffen <das@users.sourceforge.net> * tests/env.test: macosx fixes. 2004-08-19 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclScan.c (Tcl_ScanObjCmd, ValidateFormat): Ensure that the %ld conversion works correctly on 64-bit platforms. [Bug 1011860] 2004-08-16 Miguel Sofer <msofer@users.sf.net> * doc/SetVar.3: * generic/tclTest.c (TestseterrorcodeCmd): * generic/tclVar.c (TclPtrSetVar): * tests/result.test (result-4.*, result-5.*): [Bug 1008314] detected and fixed by dgp. 2004-08-13 Don Porter <dgp@users.sourceforge.net> * library/msgcat/msgcat.tcl: Added checks to prevent [mclocale] * tests/msgcat.test: from registering filesystem paths to possibly malicious code to be evaluated by a later [mcload]. * library/msgcat/pkgIndex.tcl: Bump to msgcat 1.3.3 2004-08-10 Zoran Vasiljevic <vasiljevic@users.sf.net> * unix/tclUnixThrd.c (TclpThreadCreate): changed handling of the returned thread ID since broken on 64-bit systems (Cray). Thanks to Rob Ratcliff for reporting the bug. 2004-07-30 Don Porter <dgp@users.sourceforge.net> * generic/tclEvent.c (Tcl_Finalize): Re-organized Tcl_Finalize so that Tcl_ExitProc's that call Tcl_Finalize recursively do not cause deadlock. [Patch 999084, fixes Tk Bug 714956] 2004-07-30 Daniel Steffen <das@users.sourceforge.net> * unix/configure: * unix/tcl.m4 (SC_CONFIG_CFLAGS): Darwin: instead of setting PLAT_OBJS to explict object files in tcl.m4, refer to MAC_OSX_OBJS makefile var. * unix/Makefile.in: added MAC_OSX_OBJS variable. 2004-07-28 Don Porter <dgp@users.sourceforge.net> * generic/tclMain.c (Tcl_Main, StdinProc): Append newline only to * tests/basic.test (basic-46.1): incomplete scripts as part of multi-line script construction. Do not add an extra trailing newline to the complete script. [Bug 833150] 2004-07-26 Jeff Hobbs <jeffh@ActiveState.com> *** 8.4.7 TAGGED FOR RELEASE *** * tests/io.test (io-61.1): create file in binary mode for x-plat. 2004-07-25 Pat Thoyts <patthoyts@users.sourceforge.net> * generic/tclThreadAlloc.c: Moved the tclInt.h include to provide Tcl_Panic which is now required for non-threaded build. 2004-07-22 Don Porter <dgp@users.sourceforge.net> * tests/eofchar.data (removed): Test io-61.1 now generates its own * tests/io.test: file of test data as needed. 2004-07-21 Don Porter <dgp@users.sourceforge.net> * win/tclWinDde.c: Bump to dde 1.2.3 to cover changes * library/dde/pkgIndex.tcl: committed on 2004-06-14. * changes: Updated for Tcl 8.4.7 release. 2004-07-20 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclEvent.c: Correct threaded obj allocator to * generic/tclInt.h: fully cleanup on exit and allow for * generic/tclThreadAlloc.c: reinitialization. [Bug 736426] * unix/tclUnixThrd.c: (mistachkin, kenny) * win/tclWinThrd.c: 2004-07-20 Daniel Steffen <das@users.sourceforge.net> * unix/tcl.m4: fixed Darwin autoconf breakage caused by recent CFLAGS reordering. * unix/configure: regen * unix/tclConfig.sh.in: replaced EXTRA_CFLAGS with CFLAGS. * unix/dltest/Makefile.in: replaced EXTRA_CFLAGS with DEFS. * macosx/tclMacOSXBundle.c: dynamically acquire address for CFBundleOpenBundleResourceMap symbol, since it is only present in full CoreFoundation on Mac OS X and not in CFLite on pure Darwin. 2004-07-19 Jeff Hobbs <jeffh@ActiveState.com> * unix/Makefile.in, unix/tcl.m4: move (C|LD)FLAGS after their * unix/configure.in, unix/configure: _DEFAULT to allow for env setting to override m4 switches. Consolidate header checks to limit redundancy in configure. (CFLAGS_WARNING): Remove -Wconversion, add -fno-strict-aliasing for gcc builds (need to suppress 3.x type puning warnings). (SC_ENABLE_THREADS): Set m4 to force threaded build when built against a threaded Tcl core. Reorder configure.in for better 64-bit build configuration, replacing EXTRA_CFLAGS with CFLAGS. [Bug 874058] 2004-07-19 Zoran Vasiljevic <vasiljevic@users.sf.net> * win/tclwinThrd.c: redefined MASTER_LOCK to call TclpMasterLock. Fixes [Bug 987967] 2004-07-16 Andreas Kupries <andreask@activestate.com> * generic/tclIOCmd.c (Tcl_FcopyObjCmd): Corrected a typo in the generation of error messages and simplified by reusing data in a variable instead of retrieving the string again. Fixes [Bug 835289] * doc/OpenFileChnl.3: Added description of the behaviour of Tcl_ReadChars when its 'charsToRead' argument is set to -1. Fixes [Bug 934511] * doc/CrtCommand.3: Added note that the arguments given to the command proc of a Tcl_CreateCommand are in utf8 since Tcl 8.1. Closing [Patch 414778] * doc/ChnlStack.3: Removed the declaration that the interp argument to Tcl_(un)StackChannel can be NULL. This fixes [Bug 881220], reported by Marco Maggi <marcomaggi@users.sourceforge.net>. * tests/socket.test: Accepted two new testcases by Stuart Casoff <stwo@users.sourceforge.net> checking that -server and -async don't go together [Bug 796534] * unix/tclUnixNotfy.c (NotifierThreadProc): Accepted Joe Mistachkin's patch for [Bug 990500], properly closing the notifier thread when its exits. 2004-07-15 Andreas Kupries <andreask@activestate.com> * unix/tclUnixThrd.c (TclpFinalizeMutex): Accepted Joe Mistachkin's patch for [Bug 990453], closing leakage of mutexes. They were not destroyed properly upon finalization. 2004-07-15 Zoran Vasiljevic <vasiljevic@users.sf.net> * generic/tclEvent.c (NewThreadProc): Backout of changes to fix [Bug 770053]. See SF bugreport for more info. * generic/tclNotify.c (TclFinalizeNotifier): Added conditional notifier finalization based on the fact that an TclInitNotifier has been called for the current thread. This fixes [Bug 770053] again. Hopefully this time w/o unwanted side-effects. 2004-07-14 Andreas Kupries <andreask@activestate.com> * generic/tclIO.h (CHANNEL_INCLOSE): New flag. Set in Tcl_Close * generic/tclIO.c (Tcl_UnregisterChannel): while the close callbacks * generic/tclIO.c (Tcl_Close): are run. Checked in Tcl_Close and Tcl_Unregister to prevent recursive call of [close] in the close-callbacks. This is a possible error made by implementors of virtual filesystems based on 'tclvfs', thinking that they have to close the channel in the close handler for the filesystem. 2004-07-14 Andreas Kupries <andreask@activestate.com> * generic/tclIO.c: * generic/tclIO.h: Not reverting, but #ifdef'ing the changes from May 19, 2004 out of the core. This removes the ***POTENTIAL INCOMPATIBILITY*** for channel drivers it introduced. This has become possible due to Expect gaining a BlockModeProc and now handling blockingg and non-blocking modes correctly. Thus [Bug 943274] is still fixed if a recent enough version of Expect is used. * doc/CrtChannel.3: Added warning about usage of a channel without a BlockModeProc. 2004-07-15 Andreas Kupries <andreask@pliers.activestate.com> * generic/tclIOCmd.c (Tcl_PutsObjCmd): Added length check to the old depreceated newline syntax, to ensure that only "nonewline" is accepted. [Bug 985869] (mistachkin) 2004-07-13 Jeff Hobbs <jeffh@ActiveState.com> * README, generic/tcl.h, tools/tcl.wse.in: bumped to * unix/configure, unix/configure.in, unix/tcl.spec: patchlevel * win/README.binary, win/configure, win/configure.in: 8.4.7 2004-07-13 Zoran Vasiljevic <vasiljevic@users.sf.net> * generic/tclEvent.c (NewThreadProc): Fixed broken build on Windows caused by missing TCL_THREAD_CREATE_RETURN. This is backported from HEAD. Thnx to Kevin Kenny for spotting this. 2004-07-03 Miguel Sofer <msofer@users.sf.net> * generic/tclExecute.c (ExprRoundFunc): * tests/expr-old.test (39.1): added support for wide integers to round(); [Bug 908375], reported by Hemang Lavana. 2004-07-02 Jeff Hobbs <jeffh@ActiveState.com> * generic/regcomp.c (stid): correct minor pointer size error * generic/tclPipe.c (TclCreatePipeline): Add 2>@1 as a special * tests/exec.test: case redir of stderr to the result output. 2004-07-02 Vince Darley <vincentdarley@users.sourceforge.net> * tests/fileSystem.test: new tests backported * win/tclWin32Dll.c: compilation fix for VC++5.2 2004-06-29 Donal K. Fellows <donal.k.fellows@man.ac.uk> * library/safe.tcl: Make sure that the temporary variable is local to the namespace and not inadvertently global. [Bug 981733] 2004-06-22 Zoran Vasiljevic <vasiljevic@users.sf.net> * generic/tclEvent.c: * generic/tclInt.h: * unix/tclUnixNotfy.c: * unix/tclUnixThrd.c: * win/tclWinThrd.c: See bug report for more information about what it does. [Bug 770053] * tests/unixNotfy.test: rewritten to use tcltest::threadReap to gracefully wait for the test thread to exit. Otherwise we got a race condition with main thread exiting before the test thread. This exposed the long-standing Tcl lib issue with resource garbage-collection on application exit. 2004-06-21 Mo DeJong <mdejong@users.sourceforge.net> * win/tclWin32Dll.c (DllMain, _except_dllmain_detach_handler) (TclpCheckStackSpace, _except_checkstackspace_handler, TclWinCPUID) (_except_TclWinCPUID_detach_handler): * win/tclWinChan.c (Tcl_MakeFileChannel) (_except_makefilechannel_handler): * win/tclWinFCmd.c (DoRenameFile, _except_dorenamefile_handler) (DoCopyFile, _except_docopyfile_handler): Rework pushing of exception handler function pointer so that compiling with gcc -O3 works. Remove empty function call to avoid compiler warning. Mark the DllMain function as noinline to avoid compiler error from duplicated asm labels in generated code. 2004-06-14 Pat Thoyts <patthoyts@users.sourceforge.net> * tests/winDde.test: Fixed -async test * win/tclWinDde.c: Backported the fix from 8.5 to avoid hanging in the presence of applications that do not process Window messages. 2004-06-10 Andreas Kupries <andreask@activestate.com> * generic/tclDecls.h: Regenerated on a unix box. The Win/DOS * generic/tclIntDecls.h: EOLs from the last regen screwed up * generic/tclIntPlatDecls.h: compilation with an older gcc. * generic/tclPlatDecls.h: * generic/tclStubInit.c: 2004-06-10 Zoran Vasiljevic <vasiljevic@users.sf.net> * generic/tclIOUtil.c: partially corrected [Bug 932314]. Also, corrected return values of Tcl_FSChdir() to reflect those of the underlying platform-specific call. Originally, return codes were mixed with those of Tcl. 2004-06-08 Miguel Sofer <msofer@users.sf.net> * generic/tclCompile.c: handle warning [Bug 969066] 2004-06-05 Kevin B. Kenny <kennykb@acm.org> * generic/tcl.h: Corrected Tcl_WideInt declarations so that the mingw build works again. * generic/tclDecls.h: Changes to the tests for * generic/tclInt.decls: clock frequency in Tcl_WinTime * generic/tclIntDecls.h: so that any clock frequency is * generic/tclIntPlatDecls.h: accepted provided that all * generic/tclPlatDecls.h: CPU's in the system share a * generic/tclStubInit.c: common chip, and hence, * tests/platform.test (platform-1.3): presumably, a common clock. * win/tclWin32Dll.c (TclWinCPUID): This change necessitated a * win/tclWinTest.c (TestwincpuidCmd) small burst of assembly code * win/tclWinTime.c (Tcl_GetTime): to read CPU ID information, which was added as TclWinCPUID in the internal Stubs. To test this code in the common case of a single-processor machine, a 'testwincpuid' command was added to tclWinTest.c, and a test case in platform.test. Thanks to Jeff Godfrey and Richard Suchenwirth for reporting this bug. [Bug 976722] 2004-05-27 Kevin B. Kenny <kennykb@acm.org> * tests/clock.test: Added a single test for the presence of %G in [clock format], and conditioned out the clock-10.x series if they're all going to fail because of a broken strftime() call. [Bug 961714] 2004-05-27 Reinhard Max <max@suse.de> * generic/tclEncoding.c: * tests/encoding.test: added support and tests for translating embedded null characters between real nullbytes and the internal representation on input/output. [Bug 949905] 2004-05-26 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: Correction to debug prints and testing * library/tcltest/pkgIndex.tcl: if TCLTEST_OPTIONS value. Corrected * tests/tcltest.test: double increment of numTestFiles in -singleproc 1 configurations. Updated tcltest-19.1 to tcltest 2.1 behavior. Corrected tcltest-25.3 to not falsely report a failure in tcltest.test. Bumped to tcltest 2.2.6. [Bugs 960560, 960926] 2004-05-25 Jeff Hobbs <jeffh@ActiveState.com> * doc/http.n (http::config): add -urlencoding option (default utf-8) * library/http/http.tcl: that specifies encoding conversion of * library/http/pkgIndex.tcl: args for http::formatQuery. Previously * tests/http.test: undefined, RFC 2718 says it should be utf-8. 'http::config -urlencoding {}' returns previous behavior, which will throw errors processing non-latin-1 chars. Bumped http package to 2.5.0. 2004-05-25 Kevin Kenny <kennykb@acm.org> * tests/winFCmd.test: Correct test for the presence of a CD-ROM so that it doesn't misdetect some other sort of filesystem with a write-protected root as being a CD-ROM drive. [Bug 918267] 2004-05-24 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclExecute.c (VerifyExprObjType): use GET_WIDE_OR_INT to properly have tclIntType used for smaller values. This corrects TclX bug 896727 and any other 3rd party extension that created math functions but was not yet WIDE_INT aware in them. 2004-05-24 Miguel Sofer <msofer@users.sf.net> * doc/set.n: accurate description of name resolution process, referring to namespace.n for details [Bug 959180] 2004-05-22 Miguel Sofer <msofer@users.sf.net> * generic/tclVar.c (TclObjUnsetVar2): backported fix [Bug 735335] and new (in tcl8.4) exteriorisations of [Bug 736729] due to the use of tclNsVarNameType obj types. The consequences of [Bug 736729] should be the same as in tcl8.3 and previous versions. The use of tclNsVarNameType objs is still disabled, pending a decision by the release manager. 2004-05-19 Donal K. Fellows <donal.k.fellows@man.ac.uk> * win/tclWinFile.c (TclpMatchInDirectory): fix for an issue where there was a sneak path from Tcl_DStringFree to SetErrorCode(0). The result was that the error code could be reset between a call to FindFirstFile and the check of its status return, leading to a bizarre error return of {POSIX unknown {No error}}. (Found in unplanned test - no incident logged at SourceForge.) 2004-05-19 Andreas Kupries <andreask@activestate.com> * generic/tclIO.c: Fixed [SF Tcl Bug 943274]. This is the same problem * generic/tclIO.h: as [SF Tcl Bug 462317], see ChangeLog entry 2001-09-26. The fix done at that time is incomplete. It is possible to get around it if the actual read operation is defered and not executed in the event handler itself. Instead of tracking if we are in an read caused by a synthesized fileevent we now track if the OS has delivered a true event = actual data and bypass the driver if a read finds that there is no actual data waiting. The flag is cleared by a short or full read. [[this bug amended 2004-07-14]] 2004-05-18 Kevin B. Kenny <kennykb@acm.org> * compat/strftime.c (_fmt, ISO8601Week): * doc/clock.n: * tests/clock.test: Major rework to the handling of ISO8601 week numbers. Now passes all the %G and %V test cases on Windows, Linux and Solaris [Bugs 500285, 500389, and 852944] 2004-05-17 Kevin B. Kenny <kennykb.@acm.org> * generic/tclInt.decls: Restored TclpTime_t kludge to all places * generic/tclIntPlatDecls.h: where it appeared before the changes of * unix/tclUnixPort.h 14 May, because use of native time_t in * unix/tclUnixTime.h its place requires the 8.5 header * win/tclWinTime.h: reforms. [Bug 955146] 2004-05-17 Donal K. Fellows <donal.k.fellows@man.ac.uk> * doc/OpenFileChnl.3: Documented type of 'offset' argument to Tcl_Seek was wrong. [Bug 953374] 2004-05-14 Kevin B. Kenny <kennykb@acm.org> * generic/tclInt.decls: Promoted TclpLocaltime and TclpGmtime * generic/tclIntDecls.h: from Unix-specific stubs to the generic * generic/tclIntPlatDecls.h: internal Stubs table. Reran 'genstubs' * generic/tclStubInit.c: * unix/tclUnixPort.h: * generic/tclClock.c: Changed a buggy 'GMT' timezone specification to the correct 'GMT0'. [Bug 922848] * unix/tclUnixThrd.c: Moved TclpGmtime and TclpLocaltime to unix/tclUnixTime.c where they belong. * unix/tclUnixTime.c (TclpGmtime, TclpLocaltime, TclpGetTimeZone, (ThreadSafeGMTime[removed], ThreadSafeLocalTime[removed], (SetTZIfNecessary, CleanupMemory): Restructured to make sure that the same mutex protects all calls to localtime, gmtime, and tzset. Added a check in front of those calls to make sure that the TZ env var hasn't changed since the last call to tzset, and repeat tzset if necessary. [Bug 940278] Removed a buggy test of the Daylight Saving Time information in 'gettimeofday' in favor of applying 'localtime' to a known value. [Bug 922848] * tests/clock.test (clock-3.14): Added test to make sure that changes to $env(TZ) take effect immediately. * win/tclWinTime.c (TclpLocaltime, TclpGmtime): Added porting layer for 'localtime' and 'gmtime' calls. 2004-05-10 David Gravereaux <davygrvy@pobox.com> * win/tclWinPipe.c (BuildCommandLine): Append a space when the path got primed. (TclpCreateProcess): When under NT, with no console, and executing a DOS application, the path priming does not need an ending space as BuildCommandLine() will append one for us. 2004-05-07 Miguel Sofer <msofer@users.sf.net> * doc/unset.n: added upvar.n to the "see also" list 2004-05-05 David Gravereaux <davygrvy@pobox.com> * generic/tclEvent.c: TclSetLibraryPath's use of caching the stringrep of the pathPtr object to TclGetLibraryPath called from another thread was ineffective if the original's stringrep had been invalidated as what happens when it gets muted to a list. * generic/tclEncoding.c: Added FreeEncoding(systemEncoding) in TclFinalizeEncodingSubsystem because its ref count was incremented in TclInitEncodingSubsystem. * win/tclWin32Dll.c: Structured Exception Handling added around Tcl_Finalize called from DllMain's DLL_PROCESS_DETACH. We can't be 100% assured that Tcl is being unloaded by the OS in a stable condition and we need to protect the exit handlers should the stack be in a hosed state. AT&T style assembly for SEH under MinGW included, too. [Patch 858493] Also added DisableThreadLibraryCalls() for the DLL_PROCESS_ATTACH case. We're not interested in knowing about DLL_THREAD_ATTACH, so disable the notices. * generic/tclInt.h: * generic/tclThread.c: * generic/tclEvent.c: * unix/tclUnixThrd.c: * win/tclWinThrd.c: Provisions made so masterLock, initLock, allocLock and joinLock mutexes can be recovered during Tcl_Finalize. * win/tclWinSock.c: (SocketThreadExitHandler): Don't call TerminateThread when WaitForSingleObject returns a timeout. Tcl_Finalize called from DllMain will pause all threads. Trust that the thread will get the close notice at a later time if it does ever wake up before being cleaned up by the system anyway. (SocketEventProc): connect errors should fire both the readable and writable handlers because this is how it works on UNIX. [Bug 794839] * win/coffbase.txt: Added the tls extension to the list of preferred load addresses. 2004-05-05 Don Porter <dgp@users.sourceforge.net> * tests/unixInit.test (unixInit-2.10): Test correction for Mac OSX. Be sure to consistently compare normalized path names. Thanks to Steven Abner (tauvan). [Bug 948177] 2004-05-05 Donal K. Fellows <donal.k.fellows@man.ac.uk> * doc/CrtObjCmd.3: Remove reference to Tcl_RenameCommand; there is no such API. [Bug 848440] 2004-05-04 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclIOUtil.c (Tcl_FSChdir): Work-around crash condition * tests/winFCmd.test (winFCmd-16.12): triggered when $HOME is volumerelative (ie 'C:'). * tests/fileName.test (filename-12.9): use C:/ instead of the first item in file volumes - that's usually A:/, which for most will have nothing in it. 2004-05-04 Don Porter <dgp@users.sourceforge.net> * tests/tcltest.test: Test corrections for Mac OSX. Thanks to Steven Abner (tauvan). [Bug 947440] 2004-05-03 Andreas Kupries <andreask@activestate.com> Applied [SF Tcl Patch 868853], fixing a mem leak in TtySetOptionProc. Report and Patch provided by Stuart Cassoff <stwo@users.sf.net>. 2004-05-03 Kevin Kenny <kennykb@acm.org> * win/tclWin32Dll.c (TclpCheckStackSpace): * tests/stack.test (stack-3.1): Fix for undetected stack overflow in TclReExec on Windows. [Bug 947070] 2004-05-03 Don Porter <dgp@users.sourceforge.net> * library/init.tcl: Corrected unique prefix matching of interactive command completion in [unknown]. [Bug 946952] 2004-05-02 Miguel Sofer <msofer@users.sf.net> * generic/tclProc.c (TclObjInvokeProc): * tests/proc.test (proc-3.6): fix for bad quoting of multi-word proc names in error messages [Bug 942757] 2004-04-23 Andreas Kupries <andreask@activestate.com> * generic/tclIO.c (Tcl_SetChannelOption): Fixed [Bug 930851]. When changing the eofchar we have to zap the related flags to prevent them from prematurely aborting the next read. 2004-04-07 Jeff Hobbs <jeffh@ActiveState.com> * win/configure: * win/configure.in: define TCL_LIB_FLAG, TCL_BUILD_LIB_SPEC, TCL_LIB_SPEC and TCL_PACKAGE_PATH in tclConfig.sh. 2004-04-06 Don Porter <dgp@users.sourceforge.net> * tests/unixInit.test (unixInit-3.1): Default encoding on Darwin systems is utf-8. Thanks to Steven Abner (tauvan). [Bug 928808] 2004-04-06 Donal K. Fellows <donal.k.fellows@man.ac.uk> * tests/cmdAH.test (cmdAH-18.2): Added constraint because access(...,X_OK) is defined to be permitted to be meaningless when running as root, and OSX exhibits this. [Bug 929892] 2004-04-02 Don Porter <dgp@users.sourceforge.net> * tests/tcltest.test: Corrected constraint typos: "nonRoot" -> "notRoot". Thanks to Steven Abner (tauvan). [Bug 928353] 2004-03-31 Don Porter <dgp@users.sourceforge.net> * doc/msgcat.n: Clarified message catalog file encodings. [Bug 811457] * library/msgcat/msgcat.tcl ([mcset], [ConvertLocale], [Init]): Corrected [mcset] to be able to successfully set a translation to the empty string. [mcset $loc $src {}] was incorrectly set the $loc translation of $src back to $src. Also changed [ConvertLocale] to minimally require a non-empty "language" part in the locale value. If not, an error raised prompts [Init] to keep looking for a valid locale value, or ultimately fall back on the "C" locale. [Bug 811461] * library/msgcat/pkgIndex.tcl: Bump to msgcat 1.3.2. 2004-03-31 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclObj.c (HashObjKey): Make sure this hashes the whole string rep of the object, instead of missing the last character. 2004-03-29 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclInt.h: * generic/tclEncoding.c (TclFindEncodings, Tcl_FindExecutable): * mac/tclMacInit.c (TclpInitLibraryPath): Correct handling of UTF * unix/tclUnixInit.c (TclpInitLibraryPath): data that is actually * win/tclWinFile.c (TclpFindExecutable): "clean", allowing the * win/tclWinInit.c (TclpInitLibraryPath): loading of Tcl from paths that contain multi-byte chars on Windows [Bug 920667] 2004-03-28 Miguel Sofer <msofer@users.sf.net> * generic/tclCompile.c (TclCompileScript): corrected possible segfault when a compilation returns TCL_OUTLINE_COMPILE after having grown the compile environment. [Bug 925121] 2004-03-21 Jeff Hobbs <jeffh@ActiveState.com> * win/tclWinInt.h: define VER_PLATFORM_WIN32_CE if not already set. * win/tclWinInit.c (TclpSetInitialEncodings): recognize WIN32_CE as a unicode (WCHAR) platform. 2004-03-15 Miguel Sofer <msofer@users.sf.net> * generic/tclCompile.c (TclCompileScript): * tests/compile.test (compile-3.5): corrected wrong test and behaviour in the earlier fix for [Bug 705406]; Don Porter reported this as [Bug 735055], and provided the solution. Fixed in HEAD on 2003-05-09, but backport to 8-4-branch was wrongly omitted; re-reported as [Bug 916795] by Roy Terry, diagnosed by dgp. 2004-03-08 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclFileName.c: Fix to 'glob -path' near the root * tests/fileName.test: of the filesystem. [Bug 910525] 2004-03-01 Don Porter <dgp@users.sourceforge.net> *** 8.4.6 TAGGED FOR RELEASE *** * unix/tcl.m4 (SC_CONFIG_CFLAGS): Allow 64-bit enabling on IRIX64-6.5* systems. [Bug 218561] * unix/configure: autoconf-2.13 * generic/tclCmdMZ.c (TclCheckInterpTraces): The TIP 62 * generic/tclTest.c (TestcmdtraceCmd): implementation introduced a * tests/basic.test (basic-39.10): bug by testing the CallFrame level instead of the iPtr->numLevels level when deciding what traces created by Tcl_Create(Obj)Trace to call. Added test to expose the error, and made fix. [Request 462580] 2004-02-26 Daniel Steffen <das@users.sourceforge.net> * macosx/Makefile: fixed copyright year in Tcl.framework Info.plist 2004-02-25 Don Porter <dgp@users.sourceforge.net> * tests/basic.test: Made several tests more robust to the * tests/cmdMZ.test: list-quoting of path names that might * tests/exec.test: contain Tcl-special chars like { or [. * tests/io.test: Should help us sort out Tcl Bug 554068. * tests/pid.test: * tests/socket.test: * tests/source.test: * tests/unixInit.test: 2004-02-25 Donal K. Fellows <donal.k.fellows@man.ac.uk> * unix/tclUnixChan.c (TcpGetOptionProc): Stop memory leak with very long hostnames. [Bug 888777] 2004-02-25 David Gravereaux <davygrvy@pobox.com> * tests/winPipe.test: * win/tclWinPipe.c: backport of BuildCommandLine changes to mirror msvcrt's parse_cmdline() rules of quoting. 2004-02-19 Mo DeJong <mdejong@users.sourceforge.net> * win/tclWinInit.c (AppendEnvironment): Use the tail component of the passed in lib path instead of just blindly using lib+4. That worked when lib was "lib/..." but fails for other values. Thanks go to Patrick Samson for pointing this out. 2004-02-17 Don Porter <dgp@users.sourceforge.net> * doc/tcltest.n: * library/tcltest/tcltest.tcl: Changed -verbose default value to {body error} so that detailed information on unexpected errors in tests is provided by default, even after the fix for [Bug 725253] 2004-02-17 Jeff Hobbs <jeffh@ActiveState.com> (reverted due to test failures on Solaris, but not Win/Lin :/) * generic/tclIOUtil.c: backport of rewrite of generic file normalization code to cope with links followed by '..'. [Bug 849514], and parts of [859251] * tests/unixInit.test: unixInit-7.1 * unix/tclUnixInit.c (TclpInitPlatform): ensure the std fds exist to prevent crash condition [Bug 772288] 2004-02-16 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclCmdMZ.c (TclTraceExecutionObjCmd) (TclTraceCommandObjCmd): fix possible mem leak in trace info. 2004-02-12 Jeff Hobbs <jeffh@ActiveState.com> * README: update patchlevel to 8.4.6 * generic/tcl.h: * tools/tcl.wse.in: * unix/configure, unix/configure.in, unix/tcl.spec: * win/README.binary, win/configure, win/configure.in: * unix/tcl.m4: update HP-11 build libs setup 2004-02-06 Don Porter <dgp@users.sourceforge.net> * doc/clock.n: Removed reference to non-existent [file ctime]. 2004-02-04 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: Corrected references to non-existent $name variable in [cleanupTests]. [Bug 833637] 2004-02-03 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: Corrected parsing of single command line argument (option with missing value) [Bug 833910] * library/tcltest/pkgIndex.tcl: Bump to version 2.2.5. 2004-02-02 David Gravereaux <davygrvy@pobox.com> * generic/tclIO.c (Tcl_Ungets): fixes improper filling of the channel buffer. [Bug 405995] 2004-01-13 Don Porter <dgp@users.sourceforge.net> * generic/tclFileName.c (Tcl_GlobObjCmd): Latest changes to management of the interp result by Tcl_GetIndexFromObj() exposed improper interp result management in the [glob] command procedure. Corrected by adopting the Tcl_SetObjResult(Tcl_NewStringObj) pattern. This stopped a segfault in test filename-11.36. 2004-01-13 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct, Tcl_WrongNumArgs): Create fresh objects instead of using the one currently in the interpreter, which isn't guaranteed to be fresh and unshared. The cost for the core will be minimal because of the object cache, and this fixes. [Bug 875395] 2004-01-09 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclIOUtil.c: fix to infinite loop in TclFinalizeFilesystem. [Bug 873311] 2003-12-17 Daniel Steffen <das@users.sourceforge.net> * generic/tclBinary.c (DeleteScanNumberCache): fixed crashing bug when numeric scan-value cache contains NULL value. 2003-12-17 Zoran Vasiljevic <zv@archiware.com> * generic/tclIOUtil.c: fixed 2 memory (object) leaks. This fixes [Bug 839519] 2003-12-12 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclCmdAH.c: fix to normalization of non-existent user name ('file normalize ~nobody') [Bug 858937] 2003-12-09 Donal K. Fellows <donal.k.fellows@man.ac.uk> * unix/tclUnixPort.h: #ifdef'd out declarations of errno which * tools/man2tcl.c: are known to cause problems with recent glibc. [Bug 852369] 2003-12-03 Don Porter <dgp@users.sourceforge.net> * generic/tcl.h: Bumped patch level to 8.4.5.1 to distinguish * unix/configure.in: CVS snapshots from 8.4.5 release. * unix/tcl.spec: * win/configure.in: * unix/configure: autoconf (2.13) * win/configure: 2003-12-02 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclBinary.c (DeleteScanNumberCache, ScanNumber): Made the numeric scan-value cache have proper references to the objects within it so strange patterns of writes won't cause references to freed objects. Thanks to Paul Obermeier for the report. [Bug 851747] 2003-12-01 Miguel Sofer <msofer@users.sf.net> * doc/lset.n: fix typo [Bug 852224] 2003-11-21 Don Porter <dgp@users.sourceforge.net> *** 8.4.5 TAGGED FOR RELEASE *** * tests/windFCmd.test (winFCmd-16.10): Corrected failure to initialize variable $dd that caused test suite failure. 2003-11-20 Miguel Sofer <msofer@users.sf.net> * generic/tclVar.c: fix flag bit collision between LOOKUP_FOR_UPVAR and TCL_PARSE_PART1 (deprecated) [Bug 835020] 2003-11-20 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclIOUtil.c: * tests/winFCmd.test: fix to [Bug 845778] - Infinite recursion on [cd] (Windows only bug). 2003-11-18 Jeff Hobbs <jeffh@ActiveState.com> * changes: updated for 8.4.5 release 2003-11-17 Don Porter <dgp@users.sourceforge.net> * generic/regcomp.c: Backported regexp bug fixes and tests. Thanks * generic/tclTest.c: to Pavel Goran and Vince Darley. * tests/reg.test: [Bugs 230589, 504785, 505048, 703709, 840258] 2003-11-12 Jeff Hobbs <jeffh@ActiveState.com> * tests/cmdMZ.test (cmdMZ-1.4): change to nonPortable as more systems are using permissions caching, and this isn't really a Tcl controlled issue. 2003-11-11 Jeff Hobbs <jeffh@ActiveState.com> * unix/configure: * unix/tcl.m4: improve AIX --enable-64bit handling 2003-11-10 Don Porter <dgp@users.sourceforge.net> * tests/unixInit.test (unixInit-2.10): re-enabled. * unix/tclUnixInit.c (TclpInitLibraryPath): Alternative fix * win/tclWinInit.c (TclpInitLibraryPath): for [Bug 832657] that should not run afoul of startup constraints. * library/dde/pkgIndex.tcl: Added safeguards so that registry * library/reg/pkgIndex.tcl: and dde packages are not offered * win/tclWinDde.c: on non-Windows platforms. Bumped to * win/tclWinReg.c: registry 1.1.3 and dde 1.2.2. 2003-11-06 Jeff Hobbs <jeffh@ActiveState.com> * tests/unixInit.test (unixInit-2.10): mark as knownBug * generic/tclEncoding.c (TclFindEncodings): revert patch from 2003-11-05. It wasn't valid in the sensitive startup init phase and broke Windows from working at all. 2003-11-07 Daniel Steffen <das@users.sourceforge.net> * macosx/Makefile: optimized builds define NDEBUG to turn off ThreadAlloc range checking. 2003-11-05 Don Porter <dgp@users.sourceforge.net> * generic/tclEncoding.c (TclFindEncodings): Normalize the path of the executable before passing to TclpInitLibraryPath() to avoid buggy handling of paths containing "..". [Bug 832657] * tests/unixInit.test (unixInit-2.10): New test for fixed bug. 2003-11-04 Daniel Steffen <das@users.sourceforge.net> * macosx/Makefile: added 'test' target. 2003-10-31 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclTest.c: fix test suite memory leak (backport error) * unix/tclUnixFile.c: ensure translated path (required for correct error messages) is freed in both code paths. 2003-10-23 Andreas Kupries <andreask@activestate.com> * unix/tclUnixChan.c (Tcl_MakeFileChannel): Applied [Patch 813606] fixing [Bug 813087]. Detection of sockets was off for Mac OS X which implements pipes as local sockets. The new code ensures that only IP sockets are detected as such. 2003-10-22 Andreas Kupries <andreask@activestate.com> * win/tclWinSock.c (TcpWatchProc): Watch for FD_CLOSE too when asked for writable events by the generic layer. (SocketEventProc): Generate a writable event too when a close is detected. Together the changes fix [Bug 599468]. 2003-10-22 Andreas Kupries <andreask@activestate.com> * generic/tclIOUtil.c (FsListMounts, FsAddMountsToGlobResult): New functions. See below for context. (Tcl_FSMatchInDirectory): Modified to call on the new functions (above) to handle the mountpoints in the glob'bed directory correctly. Part of the patch by Vincent Darley to solve the [Bug 800106] for the 8.4.x series. * generic/tcl.h (TCL_GLOB_TYPE_MOUNT): New definition. Part of the patch by Vincent Darley to solve [Bug 800106] for the 8.4.x series. 2003-10-22 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tclCmdAH.c (Tcl_FileObjCmd): Changed FILE_ prefix for option enumeration to FCMD_ to prevent collision with symbols defined by Cygwin/Mingw32 on NT. [Bug 822528] 2003-10-21 Daniel Steffen <das@users.sourceforge.net> * tools/tcltk-man2html.tcl: fixed incorrect html generated for .IP/.TP lists, now use <DL><DT>...<DD>...<P><DT>...<DD>...</DL> instead of illegal <DL><P><DT>...<DD>...<P><DT>...<DD>...</DL>. Added skipping of directives directly after .TP to avoid them being used as item descriptions, e.g. .TP\n.VS in clock.n. 2003-10-21 Andreas Kupries <andreask@activestate.com> * win/tclWinPipe.c (BuildCommandLine): Applied the patch coming with [Bug 805605] to the code, fixing the incorrect use of ispace noted by Ronald Dauster <ronaldd@users.sourceforge.net>. 2003-10-14 David Gravereaux <davygrvy@pobox.com> * win/tclAppInit.c (sigHandler): Punt gracefully if exitToken has already been destroyed. 2003-10-13 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclCmdMZ.c: * tests/regexp.test: fix to [Bug 823524] in regsub; added three new tests. 2003-10-12 Jeff Hobbs <jeffh@ActiveState.com> * unix/tclUnixTest.c (TestalarmCmd): don't bother checking return value of alarm. [Bug 664755] (english) 2003-10-08 Don Porter <dgp@users.sourceforge.net> * generic/tclBasic.c: Save and restore the iPtr->flag bits that control the state of errorCode and errorInfo management when calling "leave" execution traces, so that all error information of the traced command is still available whether traced or not. Thanks to Yahalom Emet. [Bug 760947] 2003-10-08 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tclTest.c (TestNumUtfCharsCmd): Command to allow finer access to Tcl_NumUtfChars for testing. * generic/tclUtf.c (Tcl_NumUtfChars): Corrected string length determining when the length parameter is negative; the terminator is a zero byte, not (necessarily) a \u0000 character. [Bug 769812] 2003-10-07 Don Porter <dgp@users.sourceforge.net> * tests/exec.test: Corrected temporary file management * tests/fileSystem.test: issues uncovered by -debug 1 test * tests/io.test: operations. Also backported some * tests/ioCmd.test: other fixes from the HEAD. * tests/pid.test: [Bugs 675605, 675655, 675659] * tests/socket.test: * tests/source.test: * tests/fCmd.test: Run tests with the [temporaryDirectory] as the current directory, so that tests can depend on ability to write files. [Bug 575837] * doc/OpenFileChnl.3: Updated Tcl_Tell and Tcl_Seek documentation to reflect that they now return Tcl_WideInt (TIP 72) [Bug 787537] * tests/io.test: Corrected several tests that failed when paths * tests/ioCmd.test: included regexp-special chars. [Bug 775394] 2003-10-06 Don Porter <dgp@users.sourceforge.net> * tests/regexp.test: Matched [makeFile] with [removeFile]. * tests/regexpComp.test: [Bug 675652] * tests/fCmd.test (fCmd-8.2): Test only that tilde-substitution happens, not for any particular result. [Bug 685991] * unix/tcl.m4 (SC_PATH_TCLCONFIG): Corrected search path so that alpha and beta releases of Tcl are not favored. [Bug 608698] * tests/reg.test: Corrected duplicate test names. * tests/resource.test: [Bugs 710370, 710358] * tests/cmdMZ.test: Updated [package require tcltest] lines to * tests/fileSystem.test: indiciate that these test files * tests/notify.test: use features of tcltest 2. [Bug 706114] * tests/parseExpr.test: * tests/unixNotfy.test: 2003-10-06 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclFileName.c: * generic/tclIOUtil.c: backport of volumerelative file normalization and 'file join' inconsistency fixes [Bug 767834, 813273]. 2003-10-04 Chengye Mao <chengye.geo@yahoo.com> * win/tclWinPipe.c: fixed a bug in BuildCommandLine. This bug built a command line with a missing space between tclpipe.dll and the following arguments. It caused error in Windows 98 when exec command.com (e.g. dir) [Bug 789040] 2003-10-03 Don Porter <dgp@users.sourceforge.net> * generic/tclBasic.c: Fixed error in ref count management of command * generic/tclCmdMZ.c: and execution traces that caused access to freed memory in trace-32.1. [Bug 811483] 2003-10-03 Vince Darley <vincentdarley@users.sourceforge.net> * tests/fileName.test: * tests/winFCmd.test: * doc/FileSystem.3: backported various test and documentation changes from HEAD. Backport of actual code fixes to follow. 2003-10-02 Don Porter <dgp@users.sourceforge.net> * README: Bumped patch level to 8.4.5 to prepare * generic/tcl.h: for next patch release. * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/README.binary: * win/configure.in: * unix/configure: autoconf (2.13) * win/configure: * library/http/http.tcl: Bumped to http 2.4.5 * library/http/pkgIndex.tcl: 2003-10-01 Daniel Steffen <das@users.sourceforge.net> * macosx/Makefile: fixed redo prebinding bug when DESTDIR="". * mac/tclMacResource.c: fixed possible NULL dereference (bdesgraupes). 2003-09-29 Don Porter <dgp@users.sourceforge.net> * generic/tclBasic.c (CallCommandTraces): Added safety bit * tests/trace.test: masking to prevent any of the bit values TCL_TRACE_*_EXEC from leaking into the flags field of any Command struct. This does not fix [Bug 811483] but helps to contain some of its worst symptoms. Also backported the corrections to test trace-28.4 from Vince Darley. 2003-09-29 Donal K. Fellows <fellowsd@cs.man.ac.uk> * library/http/http.tcl (geturl): Correctly check the type of boolean-valued options. [Bug 811170] * unix/tcl.m4 (SC_ENABLE_FRAMEWORK): Added note to make it clearer that this is an OSX feature, not a general Unix feature. [Bug 619440] 2003-09-28 David Gravereaux <davygrvy@pobox.com> * win/tclWinPipe.c: The windows port of expect can call TclWinAddProcess before any of the other pipe functions. Added a missing PipeInit() call to make sure the initialization happens. 2003-09-25 Daniel Steffen <das@users.sourceforge.net> * macosx/Makefile: ensure SYMROOT exists if OBJROOT is overridden on command line. Replaced explict use of /usr/bin by ${BINDIR}. 2003-09-23 Don Porter <dgp@users.sourceforge.net> * generic/tclCmdMZ.c: Fixed [Bug 807243] where * tests/trace.test (trace-31,32.*): the introspection results of both [trace info command] and [trace info execution] were getting co-mingled. Thanks to Mark Saye for the report. * library/init.tcl (auto_load, auto_import): Expanded Eric Melski's 2000-01-28 fix for [Bug 218871] to all potentially troubled uses of [info commands] on input data, where glob-special characters could cause problems. 2003-09-19 Miguel Sofer <msofer@users.sf.net> * generic/tclExecute.c: adding (DE)CACHE_STACK_INFO() pairs to protect all calls that may cause traces on ::errorInfo or ::errorCode to corrupt the stack [Bug 804681] 2003-09-10 Don Porter <dgp@users.sourceforge.net> * library/opt/optparse.tcl: Overlooked dependence of opt 0.4.4 * library/opt/pkgIndex.tcl: on Tcl 8.2. Bumped to opt 0.4.4.1. 2003-09-01 Zoran Vasiljevic <zoran@archiware.com> * generic/tclIOUtil.c: backported fix from HEAD [Bug 788780] 2003-08-27 Don Porter <dgp@users.sourceforge.net> * generic/tclUtil.c: Corrected [Bug 411825] and other bugs in TclNeedSpace() where non-breaking space (\u00A0) and backslash-escaped spaces were handled incorrectly. * tests/util.test: Added new tests util-8.[2-6]. 2003-08-06 Jeff Hobbs <jeffh@ActiveState.com> * win/tclWinInit.c: recognize amd64 and ia32_on_win64 cpus and Windows CE platform. 2003-08-06 Don Porter <dgp@users.sourceforge.net> * library/msgcat/msgcat.tcl: Added escape so that non-Windows * library/msgcat/pkgIndex.tcl: platforms do not try to use the registry package. This can save a costly and pointless package search. Bumped to 1.3.1. Thanks to Dave Bodenstab. [Bug 781609] 2003-08-05 Miguel Sofer <msofer@users.sf.net> * generic/tclExecute.c (INST_INVOKE, INST_EVAL, INST_PUSH_RESULT): added a Tcl_ResetResult(interp) at each point where the interp's result is pushed onto the stack, to avoid keeping an extra reference that may cause costly Tcl_Obj duplication. Detected by Franco Violi, analyzed by Peter Spjuth and Donal Fellows. [Bug 781585] 2003-07-24 Reinhard Max <max@suse.de> * library/package.tcl: Fixed a typo that broke pkg_mkIndex -verbose. * tests/pkgMkIndex.test: Added a test for [pkg_mkIndex -verbose]. 2003-07-23 Daniel Steffen <das@users.sourceforge.net> * unix/Makefile.in: changes to html-tcl & html-tk targets for compatibility with non-gnu makes. * unix/Makefile.in: added macosx/README to dist target. 2003-07-23 Pat Thoyts <patthoyts@users.sourceforge.net> * win/tclWinReg.c (OpenSubKey): Backported fix for [Bug 775976] which causes the registry set command to fail when built with VC7. * library/reg/pkgIndex.tcl: Incremented the version to 1.1.2. 2003-07-21 Jeff Hobbs <jeffh@ActiveState.com> *** 8.4.4 TAGGED FOR RELEASE *** * changes: updated for 8.4.4 release 2003-07-18 Daniel Steffen <das@users.sourceforge.net> * macosx/Makefile: added option to allow installing manpages in addition to default html help. 2003-07-18 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/Utf.3: Tightened up documentation of Tcl_UtfNext and Tcl_UtfPrev to better match the behaviour. [Bug 769895] 2003-07-18 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclIOUtil.c: correct MT-safety issues with filesystem records. [Bug 753315] (vasiljevic) * library/http/pkgIndex.tcl: merged to v2.4.4 from head * library/http/http.tcl: add support for user:pass info in URL. * tests/http.test: [Bug 759888] (shiobara) 2003-07-18 Don Porter <dgp@users.sourceforge.net> * generic/tclBasic.c: Corrected several instances of unsafe * generic/tclCompile.c: truncation of UTF-8 strings that might break * generic/tclProc.c: apart a multi-byte character. [Bug 760872] * library/init.tcl: * tests/init.test: * doc/tcltest.n: Restored the [Eval] proc to replace * library/tcltest/tcltest.tcl: the [::puts] command when either the -output or -error option for [test] is in use, in order to capture data written to the output or error channels for comparison against what is expected. This is easier to document and agrees better with most user expectations than the previous attempt to replace [puts] only in the caller's namespace. Documentation made more precise on the subject. [Bug 706359] * doc/AddErrInfo.3: Improved consistency of documentation by using * doc/CrtTrace.3: "null" everywhere to refer to the character * doc/Encoding.3: '\0', and using "NULL" everywhere to refer to * doc/Eval.3: the value of a pointer that points to nowhere. * doc/GetIndex.3: Also dropped references to ASCII that are no * doc/Hash.3: longer true, and standardized on the * doc/LinkVar.3: hyphenated spelling of "null-terminated". * doc/Macintosh.3: * doc/OpenFileChnl.3: * doc/SetVar.3: * doc/StringObj.3: * doc/Utf.3: * doc/CrtSlave.3 (Tcl_MakeSafe): Removed warning about possible deprecation (no TIP on that). 2003-07-17 Daniel Steffen <das@users.sourceforge.net> * macosx/Makefile: added var to allow overriding of tclsh used during html help building (Landon Fuller). 2003-07-16 Mumit Khan <khan@nanotech.wisc.edu> * generic/tclIOUtil.c (SetFsPathFromAny): Add Cygwin specific code to convert POSIX filename to native format. * generic/tclFileName.c (Tcl_TranslateFileName): And remove from here. (TclDoGlob): Adjust for cygwin and append / for dirs instead of \ * win/tclWinFile.c (TclpObjChdir): Use chdir on Cygwin. [Patch 679315] 2003-07-16 Jeff Hobbs <jeffh@ActiveState.com> * library/safe.tcl (FileInAccessPath): normalize paths before comparison. [Bug 759607] (myers) * unix/tclUnixNotfy.c (NotifierThreadProc): correct size of found and word vars from int to long. [Bug 767578] (hgo) 2003-07-16 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/CrtSlave.3 (Tcl_MakeSafe): Updated documentation to strongly discourage use. IMHO code outside the core that uses this function is a bug... [Bug 655300] 2003-07-16 Jeff Hobbs <jeffh@ActiveState.com> * generic/tcl.h: Add recognition of -DTCL_UTF_MAX=6 on the * generic/regcustom.h: make line to support UCS-4 mode. No config arg at this time, as it is not the recommended build mode. * generic/tclPreserve.c: In Result and Preserve'd routines, do not * generic/tclUtil.c: assume that ckfree == free, as that is not * generic/tclResult.c: always true. [Bug 756791] (fuller) 2003-07-16 Mo DeJong <mdejong@users.sourceforge.net> * win/Makefile.in: Don't define TCL_DBGX symbol for every compile. Instead, define TCL_PIPE_DLL only when compiling tclWinPipe.c. This will break other build systems, so they will need to remove the TCL_DBGX define and replace it with a define for TCL_PIPE_DLL. * win/makefile.vc: Ditto. * win/tclWinPipe.c (TclpCreateProcess): Remove PREFIX_IDENT and DEBUG_IDENT from top of file. Use TCL_PIPE_DLL passed in from build env instead of trying to construct the dll name from already defined symbols. This approach is more flexible and better in the long run. 2003-07-16 Don Porter <dgp@users.sourceforge.net> * generic/tclFileName.c (Tcl_GlobObjCmd): [Bug 771840] * generic/tclIOUtil.c (Tcl_FSConvertToPathType):[Bug 771947] * unix/tclUnixFCmd.c (GetModeFromPermString): [Bug 771949] Silence compiler warnings about unreached lines. * library/tcltest/tcltest.tcl (ProcessFlags): Corrected broken call * library/tcltest/pkgIndex.tcl: to [lrange]. Bumped to version 2.2.4. [Bug 772333] 2003-07-15 Mo DeJong <mdejong@users.sourceforge.net> * unix/dltest/pkga.c (Pkga_EqObjCmd): Fix typo that was causing a crash in load.test. 2003-07-15 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/array.n: Added some examples from David Welton [Patch 763312] 2003-07-15 Don Porter <dgp@users.sourceforge.net> * doc/http.n: Updated SYNOPSIS to match actual syntax of commands. [Bug 756112] * unix/dltest/pkga.c: Updated to not use Tcl_UtfNcmp and counted strings instead of strcmp (not defined in any #include'd header) and presumed NULL-terminated strings. * README: Bumped patch level to 8.4.4 in anticipation * generic/tcl.h: of another patch release. * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/README.binary: * win/configure.in: * unix/configure: autoconf (2.13) * win/configure: * generic/tclCompCmds.c (TclCompileIfCmd): Prior fix of Bug 711371 on 2003-04-07 introduced a buffer overflow. Corrected. [Bug 771613] 2003-07-15 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tclCmdIL.c (SortCompare): Cleared up confusing error message. [Bug 771539] 2003-07-15 Daniel Steffen <das@users.sourceforge.net> * macosx/Makefile: Rewrote buildsystem for Mac OS X framework build to be purely make driven; in order to become independent of Apple's closed-source IDE and build tool. The changes are intended to be transparent to the Makefile user, all existing make targets and cmd line variable overrides should continue to work. Changed build to only include tcl specific html help in Tcl.framework, the tk specific html help is now included in Tk.framework. * macosx/Tcl.pbproj/project.pbxproj: * macosx/Tcl.pbproj/jingham.pbxuser: Changed to purely call through to the make driven buildsystem; Tcl.framework is no longer assembled by ProjectBuilder. Set default SYMROOT in target options to simplify setting up PB (manually setting common build folder for tcl & tk no longer needed). * tools/tcltk-man2html.tcl: Added options to allow building only the tcl or tk html help files; the default behaviour with none of the new options is to build both, as before. * unix/Makefile.in: Added targets for building only the tcl or tk help. * macosx/README (new): Tcl specific excerpts of tk/macosx/README. * generic/tcl.h: Updated reminder comment about editing macosx/Tcl.pbproj/project.pbxproj when version number changes. 2003-07-11 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tests/binary.test (binary-46.*): Tests to help enforce the current behaviour. * doc/binary.n: Documented that [binary format a] and [binary scan a] do encoding conversion by dropping high bytes, unlike the rest of the core. [Bug 735364] 2003-07-11 Don Porter <dgp@users.sourceforge.net> * library/package.tcl: Corrected [pkg_mkIndex] bug reported on comp.lang.tcl. The indexer was searching for newly indexed packages instead of newly provided packages. 2003-07-04 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/expr.n: Tighten up the wording of some operations. [Bug 758488] * tests/cmdAH.test: Made tests of [file mtime] work better on FAT filesystems. [Patch 760768] Also a little general cleanup. 2003-06-25 Mo DeJong <mdejong@users.sourceforge.net> * unix/configure: Regen. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Add -ieee when compiling with cc and add -mieee when compiling with gcc under OSF1-V5 "Tru64" systems. [Bug 748957] 2003-06-24 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/encoding.n: Corrected the docs to say that [source] uses the system encoding, which it always did anyway (since 8.1) [Bug 742100] 2003-06-23 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclFCmd.c: fix to bad error message when trying to do 'file copy foo ""'. [Bug 756951] * tests/fCmd.test: added two new tests for the bug. * doc/FileSystem.3: documentation fix [Bug 720634] 2003-06-18 Miguel Sofer <msofer@users.sf.net> * generic/tclNamesp.c (Tcl_Export): removed erroneous comments [Bug 756744] 2003-06-17 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclCmdMZ.c: * tests/regexp.test: fixing of bugs related to regexp and regsub matching of empty strings. Addition of a number of new tests. 2003-06-10 Miguel Sofer <msofer@users.sf.net> * generic/tclBasic.c: * generic/tclExecute.c: let TclEvalObjvInternal call TclInterpReady instead of relying on its callers to do so; fix for the part of [Bug 495830] that is new in 8.4. * tests/interp.test: Added tests 18.9 (knownbug) and 18.10 2003-06-09 Don Porter <dgp@users.sourceforge.net> * tests/string.test (string-4.15): Added test for [string first] bug reported in Tcl 8.3, where test for all-single-byte-encoded strings was not reliable. 2003-06-04 Joe Mistachkin <joe@mistachkin.com> * tools/man2help.tcl: Added duplicate help section checking and * tools/index.tcl: corrected a comment typo for the getTopics proc in index.tcl. [Bug 748700] 2003-05-23 Don Porter <dgp@users.sourceforge.net> * generic/tclObj.c (tclCmdNameType): Converted internal rep management of the cmdName Tcl_ObjType the opposite way, to always use the twoPtrValue instead of always using the otherValuePtr. Previous fix on 2003-05-12 broke several extensions that wanted to poke around with the twoPtrValue.ptr2 value of a cmdName Tcl_Obj, like TclBlend and e4graph. [Bug 726018] Thanks to George Petasis for the bug report and Jacob Levy for testing assistance. 2003-05-22 Daniel Steffen <das@users.sourceforge.net> *** 8.4.3 TAGGED FOR RELEASE *** * macosx/tclMacOSXBundle.c: fixed a problem that caused only the first call to Tcl_MacOSXOpenVersionedBundleResources() for a given bundle identifier to succeed. This caused the tcl runtime library not to be found in all interps created after the inital one. 2003-05-20 Jeff Hobbs <jeffh@ActiveState.com> * changes: updated for 8.4.3 * unix/Makefile.in: do not run autoconf during 'make dist' as the configure is now a CVS-maintained file and should be up-to-date. 2003-05-19 Daniel Steffen <das@users.sourceforge.net> * macosx/Tcl.pbproj/project.pbxproj: changed tclConfig.sh location in versioned framework subdirectories to be identical to location in framework toplevel; fixed stub library symbolic links to be Tcl version specific. 2003-05-16 Daniel Steffen <das@users.sourceforge.net> * macosx/Tcl.pbproj/project.pbxproj: updated copyright year. 2003-05-15 Jeff Hobbs <jeffh@ActiveState.com> * win/tclWinFile.c (TclpMatchInDirectory): revert glob code to r1.44 as 2003-04-14 optimizations broke Windows98 glob'ing. * README: bumped version to 8.4.3 * generic/tcl.h: * macosx/Tcl.pbproj/project.pbxproj: * tools/tcl.wse.in: * unix/configure: * unix/configure.in: * unix/tcl.spec: * win/README.binary: * win/configure: * win/configure.in: * doc/socket.n: nroff font handling correction. * library/encoding/gb2312-raw.enc (new): This is the original gb2312.enc renamed to allow for it to still be used. This is needed by Tk (unix) because X fonts with gb2312* charsets really do want the original gb2312 encoding. [Bug 557030] 2003-05-14 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tclCmdAH.c (Tcl_FormatObjCmd): Values which can't be anything but wide shouldn't be demoted to long. [consequence of HEAD fixes for Bug 699060] 2003-05-14 Jeff Hobbs <jeffh@ActiveState.com> * library/encoding/gb2312.enc: copy euc-cn.enc over original gb2312.enc. gb2312.enc appeared to not work as expected, and most uses of gb2312 really mean euc-cn (which may be the cause of the problem). [Bug 557030] * generic/tclEnv.c (TclUnsetEnv): Another putenv() copy behavior problem repaired when compiling on windows and using microsoft's runtime. [Bug 736421] (gravereaux) 2003-05-13 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclIOUtil.c: add decl for FsThrExitProc to suppress warnings 2003-05-13 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tclEvent.c (Tcl_Finalize): Removed unused variable to reduce compiler warnings. [Bug 664745] 2003-05-13 Joe Mistachkin <joe@mistachkin.com> * generic/tcl.decls: Changed Tcl_JoinThread parameter name from "id" * generic/tclDecls.h: to "threadId". [Bug 732477] * unix/tclUnixThrd.c: * win/tclWinThrd.c: * mac/tclMacThrd.c: 2003-05-13 Daniel Steffen <das@users.sourceforge.net> * generic/tcl.decls: * macosx/tclMacOSXBundle.c: added extended version of the Tcl_MacOSXOpenBundleResources() API taking an extra version number argument: Tcl_MacOSXOpenVersionedBundleResources(). This is needed to be able to access bundle resources in versioned frameworks such as Tcl and Tk, otherwise if multiple versions were installed, only the latest version's resources could be accessed. [Bug 736774] * unix/tclUnixInit.c (Tcl_MacOSXGetLibraryPath): use new versioned bundle resource API to get tcl runtime library for TCL_VERSION. [Bug 736774] * generic/tclPlatDecls.h: * generic/tclStubInit.c: regen. * unix/tclUnixPort.h: worked around the issue of realpath() not being thread-safe on Mac OS X by defining NO_REALPATH for threaded builds on Mac OS X. [Bug 711232] 2003-05-12 Don Porter <dgp@users.sourceforge.net> * generic/tclInterp.c: (AliasObjCmd): Added refCounting of the words * tests/interp.test (interp-33.1): of the target of an interp alias during its execution. Also added test. [Bug 730244]. * generic/tclBasic.c (TclInvokeObjectCommand): objv[argc] is no longer set to NULL (Tcl_CreateObjCommand docs already say that it should not be accessed). * generic/tclObj.c (tclCmdNameType): Corrected variable use of the otherValuePtr or the twoPtrValue.ptr1 fields to store a (ResolvedCmdName *) as the internal rep. [Bug 726018]. * doc/Eval.3: Corrected prototype for Tcl_GlobalEvalObj [Bug 727622]. 2003-05-12 Miguel Sofer <msofer@users.sf.net> * generic/tclVar.c (TclObjLookupVar): [Bug 735335] temporary fix, disabling usage of tclNsVarNameType. * tests/var.test (var-15.1): test for [Bug 735335] 2003-05-10 Zoran Vasiljevic <zoran@archiware.com> * unix/tclUnixThrd.c: corrected [Bug 723502] 2003-05-10 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclIOUtil.c: ensure cd is thread-safe. [Bug 710642] (vasiljevic) * win/tclWinSerial.c (SerialCloseProc): correct mem leak on closing a Windows serial port [Bug 718002] (schroedter) * generic/tclCmdMZ.c (Tcl_StringObjCmd): prevent string repeat crash when overflow sizes were given (throws error). [Bug 714106] 2003-05-09 Joe Mistachkin <joe@mistachkin.com> * generic/tclThreadAlloc.c (TclFreeAllocCache): Fixed memory leak caused by treating cachePtr as a TLS index [Bug 731754]. * win/tclAppInit.c (Tcl_AppInit): Fixed memory leaks caused by not freeing the memory allocated by setargv and the async handler created by Tcl_AppInit. An exit handler has been created that takes care of both leaks. In addition, Tcl_AppInit now uses ckalloc instead of Tcl_Alloc to allow for easier leak tracking and to be more consistent with the rest of the Tcl core [Bugs 733156, 733221]. * tools/encoding/txt2enc.c (main): Fixed memory leak caused by failing to free the memory used by the toUnicode array of strings [Bug 733221] 2003-05-05 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: The -returnCodes option to [test] failed to recognize the symbolic name "ok" for return code 0. 2003-05-05 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tclBasic.c (Tcl_HideCommand): Fixed error message grammar and spelling. 2003-04-29 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclFileName.c: fix to bug reported privately by Jeff where, for example, 'glob -path {[tcl]} *' gets confused by the leading special character (which is escaped internally), and instead lists files in '/'. Bug only occurs on Windows where '\' is also a directory separator. (Bug has been around at least since Tcl 8.3.) * tests/fileName.test: added test for the above bug. 2003-04-25 Don Porter <dgp@users.sourceforge.net> * generic/tclBasic.c: Tcl_EvalObjv() failed to honor the TCL_EVAL_GLOBAL flag when resolving command names. Tcl_EvalEx passed a string rep including leading whitespace and comments to TclEvalObjvInternal(). 2003-04-25 Andreas Kupries <andreask@activestate.com> * win/tclWinThrd.c: Applied [Patch 727271]. This patch changes the code to catch any errors returned by the windows functions handling TLS ASAP instead of waiting to get some mysterious crash later on due to bogus pointers. Patch provided by Joe Mistachkin. This is a stop-gap measure to deal with the low number of ?TLS slots provided by some of the variants of Windows (60-80). 2003-04-21 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: When the return code of a test does not meet expectations, report that as the reason for test failure, and do not attempt to check the test result for correctness. [Bug 725253] 2003-04-18 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclExecute.c (ExprCallMathFunc): remove incorrect extraneous cast from Tcl_WideAsDouble. 2003-04-18 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/open.n: Moved serial port options from [fconfigure] * doc/fconfigure.n: to [open] as it is up to the creator of a channel to describe the channel's special config options. [Bug 679010] 2003-04-16 Don Porter <dgp@users.sourceforge.net> * generic/tcl.h Made changes so that the "wideInt" Tcl_ObjType * generic/tclObj.c is defined on all platforms, even those where * generic/tclPort.h TCL_WIDE_INT_IS_LONG is defined. Also made the Tcl_Value struct have a wideValue field on all platforms. This is a ***POTENTIAL INCOMPATIBILITY*** for TCL_WIDE_INT_IS_LONG platforms because that struct changes size. This is the same TIP 72 incompatibility that was seen on other platforms at the 8.4.0 release, when this change should have happened as well. [Bug 713562] * generic/tclInt.h: New internal macros TclGetWide() and TclGetLongFromWide() to deal with both forms of the "wideInt" Tcl_ObjType, so that conditional TCL_WIDE_INT_IS_LONG code is confined to the header file. * generic/tclCmdAH.c: Replaced most coding that was conditional * generic/tclCmdIL.c: on TCL_WIDE_INT_IS_LONG with code that * generic/tclExecute.c: works across platforms, sometimes using * generic/tclTest.c: the new macros above to do it. * generic/tclUtil.c: * generic/tclVar.c: 2003-04-17 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/socket.n: Added a paragraph to remind people to specify their encodings when using sockets. [Bug 630621] 2003-04-16 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/CrtMathFnc.3: Functions also have to deal with wide ints, but this was not documented. [Bug 709720] 2003-04-15 Kevin Kenny <kennykb@acm.org> * win/tclWinTime.c: Corrected use of types to make compilation compatible with VC++5. 2003-04-14 Kevin Kenny <kennykb@acm.org> * win/tclWinFile.c: added conditionals to restore compilation on VC++6, which was broken by recent changes. 2003-04-14 Vince Darley <vincentdarley@users.sourceforge.net> Merged various bug fixes from current cvs head: * tests/cmdAH.test: better fix to test suite problem if /home is a symlink [Bug 703264] * generic/tclIOUtil.c: fix bad error message with 'cd ""' [Bug 704917] * win/tclWinFile.c: * win/tclWin32Dll.c: * win/tclWinInt.h: allow Tcl to differentiate between reparse points which are symlinks and mounted volumes, and correctly handle the latter. This involves some elaborate code to find the actual drive letter (if possible) corresponding to a mounted volume. [Bug 697862] * tests/fileSystem.test: add constraints to stop tests running in ordinary tcl interpreter. [Bug 705675] * generic/tclIOUtil.c: Some re-arrangement of code to bring it closer to CVS HEAD. No functional changes. * tests/fCmd.test: * win/tclWinFile.c: added some filesystem optimisation to the 'glob' implementation, and some new tests. * tests/winFile.test: * tests/ioUtil.test: * tests/unixFCmd.test: renumbered tests with duplicate numbers. [Bug 710361] 2003-04-12 Kevin Kenny <kennykb@acm.org> * tests/clock.test: Renumbered test cases to avoid duplicates [Bug 710310]. * tests/winTime.test: * win/tclWinTest.c (TestwinclockCmd, TestwinsleepCmd): * win/tclWinTime.c (Tcl_WinTime, UpdateTimeEachSecond, (ResetCounterSamples, AccumulateSample, SAMPLES, TimeInfo): Made substantial changes to the phase-locked loop (replaced an IIR filter with an FIR one) in a quest for improved loop stability (Bug not logged at SF, but cited in private communication from Jeff Hobbs). 2003-04-11 Don Porter <dgp@users.sourceforge.net> * generic/tclCmdMZ.c (Tcl_StringObjCmd,STR_IS_INT): Corrected inconsistent results of [string is integer] observed on systems where sizeof(long) != sizeof(int). [Bug 718878] * tests/string.test: Added tests for Bug 718878. * doc/string.n: Clarified that [string is integer] accepts 32-bit integers. 2003-04-11 Andreas Kupries <andreask@activestate.com> * generic/tclIO.c (UpdateInterest): When dropping interest in TCL_READABLE now dropping interest in TCL_EXCEPTION too. This fixes a bug where Expect detects eof on a file prematurely on Solaris 2.6 and higher. A much more complete explanation is in the code itself (40 lines of comments for a one-line change :) 2003-04-10 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/binary.n: Fixed typo in [binary format w] desc. [Bug 718543] 2003-04-08 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tclCmdAH.c (Tcl_ErrorObjCmd): Strings are only empty if they have zero length, not if their first byte is zero, so fix test guarding Tcl_AddObjErrorInfo to take this into account. [Bug reported by Don Porter; no bug-id.] 2003-04-07 Don Porter <dgp@users.sourceforge.net> * generic/tclCompCmds.c (TclCompileIfCmd): Corrected string limits of arguments interpolated in error messages. [Bug 711371] * generic/tclCmdMZ.c (TraceExecutionProc): Added missing Tcl_DiscardResult() call to avoid memory leak. 2003-04-07 Donal K. Fellows <zzcgudf@ernie.mvc.mcc.ac.uk> * generic/tclObj.c (tclWideIntType, TclInitObjSubsystem): (SetBooleanFromAny): Make sure that tclWideIntType is defined and somewhat sensible everywhere. [Bug 713562] 2003-04-02 Mo DeJong <mdejong@users.sourceforge.net> * win/configure: Regen. * win/configure.in: Set stub lib flag based on new LIBFLAGSUFFIX variable. * win/tcl.m4 (SC_CONFIG_CFLAGS): Set new LIBFLAGSUFFIX that works like LIBSUFFIX, it is used when creating library names. The previous implementation would generate -ltclstub85 instead of -ltclstub85s when configured with --disable-shared. 2003-04-01 Don Porter <dgp@users.sourceforge.net> * tests/README: Direct [source] of *.test files is no longer recommended. The tests/*.test files should only be evaluated under the control of the [runAllTests] command in tests/all.tcl. 2003-03-27 Miguel Sofer <msofer@users.sf.net> * tests/encoding.test: * tests/proc-old.test: * tests/set-old.test: Altered test numers to eliminate duplicates, [Bugs 710313, 710320, 710352] 2003-03-27 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tests/parseOld.test: Altered test numers to eliminate duplicates. * tests/parse.test: [Bugs 710365, 710369] * tests/expr-old.test: * tests/expr.test: * tests/utf.test: Altered test numers to eliminate duplicates. * tests/trace.test: [Bugs 710322, 710327, 710349, 710363] * tests/lsearch.test: * tests/list.test: * tests/info.test: * tests/incr-old.test: * tests/if-old.test: * tests/format.test: * tests/foreach.test: 2003-03-26 Don Porter <dgp@users.sourceforge.net> * doc/tcltest.n: * library/tcltest/tcltest.tcl: Added reporting during [configure -debug 1] operations to warn about multiple uses of the same test name. [FR 576693] Replaced [regexp] and [regsub] with [string map] where possible. Thanks to David Welton. [Bugs 667456,667558] * library/tcltest/pkgIndex.tcl: Bumped to tcltest 2.2.3 * tests/msgcat.test (msgcat-2.2.1): changed test name to avoid duplication. [Bug 710356] * unix/dltest/pkg?.c: Changed all Tcl_InitStubs calls to pass argument exact = 0, so that rebuilds are not required when Tcl bumps to a new version. [Bug 701926] 2003-03-24 Miguel Sofer <msofer@users.sf.net> * generic/tclVar.c: * tests/var.test: fixing ObjMakeUpvar's lookup algorithm for the created local variable, [Bugs 631741] (Chris Darroch) and [696893] (David Hilker). 2003-03-22 Kevin Kenny <kennykb@acm.org> * library/dde/pkgIndex.tcl: * library/reg/pkgIndex.tcl: Fixed a bug where [package require dde] or [package require registry] attempted to load the release version of the DLL into a debug build. [Bug 708218] Thanks to Joe Mistachkin for the patch. * win/makefile.vc: Added quoting around the script name in the 'test' target; Joe Mistachkin insists that he has a configuration that fails to launch tcltest without it, and it appears harmless otherwise. 2003-03-20 Don Porter <dgp@users.sourceforge.net> * generic/tclInt.h (tclOriginalNotifier): * generic/tclStubInit.c (tclOriginalNotifier): * mac/tclMacNotify.c (Tcl_SetTimer,Tcl_WaitForEvent): * unix/tclUnixNotfy.c (Tcl_SetTimer,Tcl_WaitForEvent, (Tcl_CreateFileHandler,Tcl_DeleteFileHandler): * win/tclWinNotify.c (Tcl_SetTimer,Tcl_WaitForEvent): Some linkers apparently use a different representation for a pointer to a function within the same compilation unit and a pointer to a function in a different compilation unit. This causes checks like those in the original notifier procedures to fall into infinite loops. The fix is to store pointers to the original notifier procedures in a struct defined in the same compilation unit as the stubs tables, and compare against those values. [Bug 707174] * generic/tclInt.h: Removed definition of ParseValue struct that is no longer used. 2003-03-19 Miguel Sofer <msofer@users.sf.net> * generic/tclCompile.c: * tests/compile.test: bad command count on TCL_OUT_LINE_COMPILE [Bug 705406] (Don Porter). 2003-03-19 Don Porter <dgp@users.sourceforge.net> * doc/Eval.3 (Tcl_EvalObjEx): Corrected CONST and * doc/ParseCmd.3 (Tcl_EvalTokensStandard): return type errors in documentation. [Bug 683994] 2003-03-18 Kevin Kenny <kennykb@users.sourceforge.net> * tests/registry.test: Changed the conditionals to avoid an abort if [testlocale] is missing, as when running the test in tclsh rather than tcltest. [Bug 705677] 2003-03-18 Daniel Steffen <das@users.sourceforge.net> * tools/tcltk-man2html.tcl: added support for building 'make html' from inside distribution directories named with 8.x.x version numbers. tcltk-man2html now uses the latest tcl8.x.x resp. tk8.x.x directories found inside its --srcdir argument. 2003-03-18 Vince Darley <vincentdarley@users.sourceforge.net> * tests/cmdAH.test: fix test suite problem if /home is a symlink * generic/tclIOUtil.c: fix bad error message with 'cd ""' * win/tclWinFile.c: allow Tcl to differentiate between reparse points which are symlinks and mounted drives. These changes fix [Bugs 703264, 704917, 697862] respectively. 2003-03-17 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/lsearch.n: Altered documentation of -ascii options so * doc/lsort.n: they don't specify that they operate on ASCII strings, which they never did anyway. [Bug 703807] 2003-03-14 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tclCmdAH.c (Tcl_FileObjCmd): Remove assumption that file times and longs are the same size. [Bug 698146] (Tcl_FormatObjCmd): Stop surprising type conversions from happening when working with integer and wide values. [Bug 699060] * generic/tclCmdAH.c (Tcl_FormatObjCmd): Only add the modifier that indicates we've got a wide int when we're formatting in an integer style. Stops some libc's from going mad. [Bug 702622] Also tidied whitespace. 2003-03-13 Kevin Kenny <kennykb@users.sourceforge.net> * win/makefile.vc: Backed the version to 8.4 on the 8.4 branch. (I just loathe sticky tags). 2003-03-12 Don Porter <dgp@users.sourceforge.net> * generic/tcl.h: Removed TCL_PREFIX_IDENT and TCL_DEBUG_IDENT * win/tclWinPipe.c: from tcl.h -- they are not part of Tcl's public interface. Put them in win/tclWinPipe.c where they are used. * generic/tclCmdMZ.c (Tcl_SubstObj): Corrected and added test for * tests/subst.test (subst-2.4): Tcl_SubstObj's incorrect halting of substitution at the first \x00 byte. [Bug 685106] * generic/tclInterp.c (Tcl_InterpObjCmd): Corrected and added * tests/interp.test (interp-2.13): test for option parsing beyond objc for [interp create --]. Thanks to Marco Maggi. [Bug 702383] 2003-03-11 Kevin Kenny <kennykb@users.sourceforge.net> * win/makefile.vc: Added two missing uses of $(DBGX) so that tclpip8x.dll loads without panicking on Win9x. 2003-03-08 Don Porter <dgp@users.sourceforge.net> * doc/tcltest.n: Added missing "-body" to example. Thanks to Helmut Giese. [Bug 700011] 2003-03-06 Don Porter <dgp@users.sourceforge.net> * generic/TclUtf.c (Tcl_UniCharNcasecmp): Corrected failure to * tests/utf.test (utf-25.*): properly compare Unicode strings of different case in a case insensitive manner. [Bug 699042] 2003-03-03 Jeff Hobbs <jeffh@ActiveState.com> *** 8.4.2 TAGGED FOR RELEASE *** 2003-03-03 Daniel Steffen <das@users.sourceforge.net> Mac OS Classic specific fixes:
︙
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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334	4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 5028 5029 5030 5031 5032 5033 5034 5035 5036 5037 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104 5105 5106 5107 5108 5109 5110 5111 5112 5113 5114 5115 5116 5117 5118 5119 5120 5121 5122 5123 5124 5125 5126 5127 5128 5129 5130 5131 5132 5133 5134 5135 5136 5137 5138 5139 5140 5141 5142 5143 5144 5145 5146 5147 5148 5149 5150 5151 5152 5153 5154 5155 5156 5157 5158 5159 5160 5161 5162 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 5211 5212 5213 5214 5215 5216 5217 5218 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248 5249 5250 5251 5252 5253 5254 5255 5256 5257 5258 5259 5260 5261 5262 5263 5264 5265 5266 5267 5268 5269 5270 5271 5272 5273 5274 5275 5276 5277 5278 5279 5280 5281 5282 5283 5284 5285 5286 5287 5288 5289 5290 5291 5292 5293 5294 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 5338 5339 5340 5341 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 5359 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 5426 5427 5428 5429 5430 5431 5432 5433 5434 5435 5436 5437 5438 5439 5440 5441 5442 5443 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 5456 5457 5458 5459 5460 5461 5462 5463 5464 5465 5466 5467 5468 5469 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 5483 5484 5485 5486 5487 5488 5489 5490 5491 5492 5493 5494 5495 5496 5497 5498 5499 5500 5501 5502 5503 5504 5505 5506 5507 5508 5509 5510 5511 5512 5513 5514 5515 5516 5517 5518 5519 5520 5521 5522 5523 5524 5525 5526 5527 5528 5529 5530 5531 5532 5533 5534 5535 5536 5537 5538 5539 5540 5541 5542 5543 5544 5545 5546 5547 5548 5549 5550 5551 5552 5553 5554 5555 5556 5557 5558 5559 5560 5561 5562 5563 5564 5565 5566 5567 5568 5569 5570 5571 5572 5573 5574 5575 5576 5577 5578 5579 5580 5581 5582 5583 5584 5585 5586 5587 5588 5589 5590 5591 5592 5593 5594 5595 5596 5597 5598 5599 5600 5601 5602 5603 5604 5605 5606 5607 5608 5609 5610 5611 5612 5613 5614 5615 5616 5617 5618 5619 5620 5621 5622 5623 5624 5625 5626 5627 5628 5629 5630 5631 5632 5633 5634 5635 5636 5637 5638 5639 5640 5641 5642 5643 5644 5645 5646 5647 5648 5649 5650 5651 5652 5653 5654 5655 5656 5657 5658 5659 5660 5661 5662 5663 5664 5665 5666 5667 5668 5669 5670 5671 5672 5673 5674 5675 5676 5677 5678 5679 5680 5681 5682 5683 5684 5685 5686 5687 5688 5689 5690 5691 5692 5693 5694 5695 5696 5697 5698 5699 5700 5701 5702 5703 5704 5705 5706 5707 5708 5709 5710 5711 5712 5713 5714 5715 5716 5717 5718 5719 5720 5721 5722 5723 5724 5725 5726 5727 5728 5729 5730 5731 5732 5733 5734 5735 5736 5737 5738 5739 5740 5741 5742 5743 5744 5745 5746 5747 5748 5749 5750 5751 5752 5753 5754 5755 5756 5757 5758 5759 5760 5761 5762 5763 5764 5765 5766 5767 5768 5769 5770 5771 5772 5773 5774 5775 5776 5777 5778 5779 5780 5781 5782 5783 5784 5785 5786 5787 5788 5789 5790 5791 5792 5793 5794 5795 5796 5797 5798 5799 5800 5801 5802 5803 5804 5805 5806 5807 5808 5809 5810 5811 5812 5813 5814 5815 5816 5817 5818 5819 5820 5821 5822 5823 5824 5825 5826 5827 5828 5829 5830 5831 5832 5833 5834 5835 5836 5837 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 5859 5860 5861 5862 5863 5864 5865 5866 5867 5868 5869 5870 5871 5872 5873 5874 5875 5876 5877 5878 5879 5880 5881 5882 5883 5884 5885 5886 5887 5888 5889 5890 5891 5892 5893 5894 5895 5896 5897 5898 5899 5900 5901 5902 5903 5904 5905 5906 5907 5908 5909 5910 5911 5912 5913 5914 5915 5916 5917 5918 5919 5920 5921 5922 5923 5924 5925 5926 5927 5928 5929 5930 5931 5932 5933 5934 5935 5936 5937 5938 5939 5940 5941 5942 5943 5944 5945 5946 5947 5948 5949 5950 5951 5952 5953 5954 5955 5956 5957 5958 5959 5960 5961 5962 5963 5964 5965 5966 5967 5968 5969 5970 5971 5972 5973 5974 5975 5976 5977 5978 5979 5980 5981 5982 5983 5984 5985 5986 5987 5988 5989 5990 5991 5992 5993 5994 5995 5996 5997 5998 5999 6000 6001 6002	- - + + - + - - - + + + - + - + - + - + - - + + - - - + + - + - + - + - - - + + + - - - + + + - - - + + + - + - + - - - - - + + + + + - + - - - + + + - - + + - - - - + + + + - + - - - - + + + + - + - + - - + - - + + - + - + - - + + - - + + - - + - + - - - + + - + - + - + - + - - - - - - - + + + + + + + + - - + + - - - - - + + + + - + - - + - - + + - - - - + + + + - + - + - + - - + + - + - - - - + + + - - + - - + - + - - - - - - + + + + + - - + + - - + + - - + + - - - - - - + + + + + + - + - - + - - - + + - - + - - - + + + - - - - - + + + + - - - + + - + - - + + - + - - + - - - - - - - + + + + + + + - - - + + + - + - - - - - - - - + + + + + + + + - - - - - + + + + + - - - - - - - - - - - + + + + + + + + + + + - - + - - - + + + - - - - + + + + - - + + - - - - - - - - - - + + + + + + + + + + - - + + - + - - + - - - + + - - - + + - - + - - + + - - - + + + - - + - - - - + + + + - - - - + + + + - + - - - + + - + - - - + + - - - - + + + - - + - - - - + + + - - - + + - - - - + + + - - - + + + - - - - - - - - - - + + + + + + + + + + - - - + + + - - - - - + + + + - - - + + - - + - - + + - - - + + - - + - - + - + - - - - - + + + + - - - + + - - - - - - + + + + + - + - - - - - - - + + + + + + - - - + + - - + + - - - + + + - - - - - + + + + + - - - + + - - - - - - - - - - - - + + + + + + + + + + + - - + + - + - - - + + - - + - + - - + - - - + + - + - - + - - + - - - + + - + - - + - + - - + - + - - + - - - + + + - - - + + - + - - - + + + - + - - + + - - - + + + - - - + + + - - - + + - - - - - + + + + + - - - + + + - - - - + + + + - - - + + + - - - - + + + - - - - - + + + + + - - - - + + + - - + + - + - - + + - - - - - + + + + + - - - - - + + + + - - + + - - - + + + - - - - + + + + - - - + + + - - - + + - - + + - - - + + + - - - + + + - - + + - - - - - - + + + + + + - - - - - - + + + + + + - - - + + + - - - - + + + - - - + + + - - + + - - + + - - - + + + - - - + + - - - - - + + + + - - - + + + - - - - - - + + + + + - - + + - + - - + + - - - + + + - - - - - + + + + + - - - + + + - - - + + + - + - - - + + - - + + - - + + - - + + - + - - + + - - - - + + + + - - - + + - + - + - - + + - - + + - - - + + - - + + - - + + - - - + + - + - + - - + + - - + + - - - - + + + + - - + + - - + + - + - + - - - + + + - - + + - - - + + +	* mac/tclMacPort.h: define S_ISLNK macro to fix stat'ing of links. * mac/tclMacUtil.c (FSpLocationFromPathAlias): fix to enable stat'ing of broken links. 2003-03-03 Kevin Kenny <kennykb@users.sourceforge.net> * win/Makefile.vc: corrected bug introduced by 'g' for debug builds. 2003-03-03 Don Porter <dgp@users.sourceforge.net> 2003-03-03 Don Porter <dgp@users.sourceforge.net> * library/dde/pkgIndex.tcl: dde bumped to version 1.2.1 for * win/tclWinDde.c: bundled release with Tcl 8.4.2 * library/reg/pkgIndex.tcl: registry bumped to version 1.1.1 for * win/tclWinReg.c: bundled release with Tcl 8.4.2 * library/opt/pkgIndex.tcl: updated package index to version 0.4.4 2003-02-28 Jeff Hobbs <jeffh@ActiveState.com> * win/configure: * win/configure.in: check for 'g' for debug build type, not 'd'. * win/rules.vc (DBGX): correct to use 'g' for nmake win makefile to match the cygwin makefile for debug builds. [Bug #635107] to match the cygwin makefile for debug builds. [Bug 635107] 2003-02-28 Vince Darley <vincentdarley@users.sourceforge.net> * doc/file.n: subcommand is 'file volumes' not 'file volume' 2003-02-27 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclIOUtil.c (MakeFsPathFromRelative): removed dead code check of typePtr (darley). * tests/winTime.test: added note about PCI hardware dependency issues with high performance clock. 2003-02-27 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tests/lsearch.test (lsearch-10.7): * generic/tclCmdIL.c (Tcl_LsearchObjCmd): Stopped -start option from causing an option when used with an empty list. [Bug #694232] * tests/lsearch.test (lsearch-10.7): * generic/tclCmdIL.c (Tcl_LsearchObjCmd): Stopped -start option from causing an option when used with an empty list. [Bug 694232] 2003-02-26 Chengye Mao <chengye.geo@yahoo.com> * win/tclWinInit.c: fixed a bug in TclpSetVariables by initializing dwUserNameLen with the sizeof(szUserName) before calling GetUserName. Don't know if this bug has been recorded: it caused crash in starting Tcl or wish in Windows. 2003-02-26 Jeff Hobbs <jeffh@ActiveState.com> 2003-02-26 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclCmdMZ.c (TraceCommandProc): Fix mem leak when deleting a command that had trace on it. [Bug #693564] (sofer) deleting a command that had trace on it. [Bug 693564] (sofer) 2003-02-25 Don Porter <dgp@users.sourceforge.net> 2003-02-25 Don Porter <dgp@users.sourceforge.net> * doc/pkgMkIndex.n: Modified [pkg_mkIndex] to use -nocase matching * library/package.tcl: of -load patterns, to better accomodate common user errors due to confusion between [package names] names and [info loaded] names. 2003-02-25 Andreas Kupries <andreask@pliers.activestate.com> 2003-02-25 Andreas Kupries <andreask@activestate.com> * tests/pid.test: See below [Bug #678412]. * tests/io.test: Made more robust against spaces in paths * tests/pid.test: See below [Bug 678412]. * tests/io.test: Made more robust against spaces in paths [Bug 678400] [Bug #678400]. 2003-02-25 Miguel Sofer <msofer@users.sf.net> * tests/execute.test: cleaning up testobj's at the end, to avoid leak warning by valgrind. * tests/execute.test: cleaning up testobj's at the end, to avoid leak warning by valgrind. 2003-02-22 Zoran Vasiljevic <zoran@archiwrae.com> * generic/tclEvent.c (Tcl_FinalizeThread): Fix [Bug #571002] * generic/tclEvent.c (Tcl_FinalizeThread): Fix [Bug 571002] 2003-02-21 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tests/binary.test (binary-44.[34]): * tests/binary.test (binary-44.[34]): * generic/tclBinary.c (ScanNumber): Fixed problem with unwanted sign-bit propagation when scanning wide ints. [Bug #690774] sign-bit propagation when scanning wide ints. [Bug 690774] 2003-02-21 Daniel Steffen <das@users.sourceforge.net> * mac/tclMacChan.c (TclpCutFileChannel, TclpSpliceFileChannel): Implemented missing cut and splice procs for file channels. 2003-02-21 Don Porter <dgp@users.sourceforge.net> * library/package.tcl (tclPkgUnknown): Minor performance tweaks to reduce the number of [file] invocations. Meant to improve startup times, at least a little bit. [Patch 687906] * library/package.tcl (tclPkgUnknown): Minor performance tweaks to reduce the number of [file] invocations. Meant to improve startup times, at least a little bit. [Patch 687906] 2003-02-20 Daniel Steffen <das@users.sourceforge.net> * unix/tcl.m4: * unix/tclUnixPipe.c: (macosx) use vfork() instead of fork() to create new processes, as recommended by Apple (vfork can be up to 100 times faster thank fork on macosx). * unix/tclUnixPipe.c: (macosx) use vfork() instead of fork() to create new processes, as recommended by Apple (vfork can be up to 100 times faster thank fork on macosx). * unix/configure: regen. 2003-02-20 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclEncoding.c (LoadTableEncoding): * library/encoding/cp932.enc: Correct jis round-trip encoding * library/encoding/euc-jp.enc: by adding 'R' type to .enc files. * library/encoding/iso2022-jp.enc: [Patch #689341] (koboyasi, taguchi) * library/encoding/cp932.enc: Correct jis round-trip encoding * library/encoding/euc-jp.enc: by adding 'R' type to .enc files. * library/encoding/iso2022-jp.enc: [Patch 689341] (koboyasi, taguchi) * library/encoding/jis0208.enc: * library/encoding/shiftjis.enc: * tests/encoding.test: * unix/tclUnixChan.c (Tcl_MakeTcpClientChannel): add MakeTcpClientChannelMode that takes actual mode flags to avoid hang on OS X (may be OS X bug, but patch works x-plat). [Bug #689835] (steffen) [Bug 689835] (steffen) 2003-02-20 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/regsub.n: Typo fix [Bug #688943] * doc/regsub.n: Typo fix [Bug 688943] 2003-02-19 Jeff Hobbs <jeffh@ActiveState.com> * unix/tclUnixThrd.c (TclpReaddir): * unix/tclUnixPort.h: update to Bug 689100 patch to ensure that there is a defined value of MAXNAMLEN (aka NAME_MAX in POSIX) and that we have some buffer allocated. 2003-02-19 Daniel Steffen <das@users.sourceforge.net> * generic/tclStringObj.c: restored Tcl_SetObjLength() side-effect of always invalidating unicode rep (if the obj has a string rep). Added hasUnicode flag to String struct, allows decoupling of validity of unicode rep from buffer size allocated to it (improves memory allocation efficiency). [Bugs #686782, #671138, #635200] * generic/tclStringObj.c: restored Tcl_SetObjLength() side-effect of always invalidating unicode rep (if the obj has a string rep). Added hasUnicode flag to String struct, allows decoupling of validity of unicode rep from buffer size allocated to it (improves memory allocation efficiency). [Bugs 686782, 671138, 635200] * macosx/Tcl.pbproj/project.pbxproj: * macosx/Makefile: reworked embedded build to no longer require relinking but to use install_name_tool instead to change the install_names for embedded frameworks. [Bug #644510] install_names for embedded frameworks. [Bug 644510] * macosx/Tcl.pbproj/project.pbxproj: preserve mod dates when running 'make install' to build framework (avoids bogus rebuilds of dependent frameworks because tcl headers appear changed). * macosx/Tcl.pbproj/project.pbxproj: preserve mod dates when running 'make install' to build framework (avoids bogus rebuilds of dependent frameworks because tcl headers appear changed). * tests/ioCmd.test (iocmd-1.8): fix failure when system encoding is utf-8: use iso8859-1 encoding explicitly. * tests/ioCmd.test (iocmd-1.8): fix failure when system encoding is utf-8: use iso8859-1 encoding explicitly. 2003-02-18 Miguel Sofer <msofer@users.sf.net> * generic/tclCompile.c (TclCompileExprWords): remove unused variable "range" [Bug 664743] * generic/tclExecute.c (ExprSrandFunc): remove unused variable "result" [Bug 664743] * generic/tclCompile.c (TclCompileExprWords): remove unused variable "range" [Bug 664743] * generic/tclExecute.c (ExprSrandFunc): remove unused variable "result" [Bug 664743] * generic/tclStringObj.c (UpdateStringOfString): remove unused variable "length" [Bug 664751] * tests/execute.test (execute-7.30): fix for [Bug 664775] * tests/execute.test (execute-7.30): fix for [Bug 664775] 2003-02-18 Andreas Kupries <andreask@activestate.com> * unix/tcl.m4: [Bug #651811] Added definition of _XOPEN_SOURCE and linkage of 'xnet' library to HP 11 branch. This kills a lot of socket-related failures in the testsuite when Tcl was compiled in 64 bit mode (both PA-RISC 2.0W, and IA 64). * unix/tcl.m4: [Bug 651811] Added definition of _XOPEN_SOURCE and linkage of 'xnet' library to HP 11 branch. This kills a lot of socket-related failures in the testsuite when Tcl was compiled in 64 bit mode (both PA-RISC 2.0W, and IA 64). * unix/configure: Regenerated. 2003-02-18 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclIO.c (HaveVersion): correctly decl static * unix/tclUnixThrd.c (TclpReaddir): reduce size of name string in tsd to NAME_MAX instead of PATH_MAX. [Bug #689100] (waters) tsd to NAME_MAX instead of PATH_MAX. [Bug 689100] (waters) 2003-02-18 Mo DeJong <mdejong@users.sourceforge.net> * unix/configure: Regen. * unix/tcl.m4 (SC_ENABLE_THREADS): Make sure * unix/tcl.m4 (SC_ENABLE_THREADS): Make sure -lpthread gets passed on -lpthread gets passed on the link line when checking for the pthread_attr_setstacksize symbol. the link line when checking for the pthread_attr_setstacksize symbol. 2003-02-18 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclTest.c: cleanup of new 'simplefs' test code, and better documentation. * generic/tclTest.c: cleanup of new 'simplefs' test code, and better documentation. 2003-02-17 Miguel Sofer <msofer@users.sf.net> * generic/tclBasic.c (TclRenameCommand): fixing error in previous commit. commit. 2003-02-17 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclExecute.c (TclExecuteByteCode INST_STR_MATCH): * generic/tclCmdMZ.c (Tcl_StringObjCmd STR_MATCH): * generic/tclUtf.c (TclUniCharMatch): * generic/tclInt.decls: add private TclUniCharMatch function that * generic/tclInt.decls: add private TclUniCharMatch function that * generic/tclIntDecls.h: does string match on counted unicode * generic/tclStubInit.c: strings. Tcl_UniCharCaseMatch has the * tests/string.test: failing that it can't handle strings or * tests/stringComp.test: patterns with embedded NULLs. Added * tests/string.test: failing that it can't handle strings or * tests/stringComp.test: patterns with embedded NULLs. Added tests that actually try strings/pats with NULLs. TclUniCharMatch should be TIPed and made public in the next minor version rev. 2003-02-17 Miguel Sofer <msofer@users.sf.net> * generic/tclBasic.c (TclRenameCommand): 'oldFullName' object was not being freed on all function exits, causing a memory leak * generic/tclBasic.c (TclRenameCommand): 'oldFullName' object was not being freed on all function exits, causing a memory leak. [Bug 684756] [Bug 684756] 2003-02-17 Mo DeJong <mdejong@users.sourceforge.net> * generic/tclIO.c (Tcl_GetsObj): Minor change * generic/tclIO.c (Tcl_GetsObj): Minor change so that eol is only so that eol is only assigned at the top of the TCL_TRANSLATE_AUTO case block. The other cases assign eol so this does not change any functionality. assigned at the top of the TCL_TRANSLATE_AUTO case block. The other cases assign eol so this does not change any functionality. 2003-02-17 Kevin Kenny <kennykb@users.sourceforge.net> * tests/notify.test: Removed Windows line terminators. [Bug 687913]. 2003-02-15 Miguel Sofer <msofer@users.sf.net> * generic/tclBasic.c (Tcl_EvalEx): * generic/tclCompExpr.c (CompileSubExpr): * generic/tclCompile.c (TclCompileScript): * generic/tclParse.c (Tcl_ParseCommand, ParseTokens): * generic/tclParseExpr.c (ParsePrimaryExpr): * tests/basic.test (47.1): * tests/main.test (3.4): * tests/misc.test (1.2): * tests/parse.test (6.18): * tests/parseExpr.test (15.35): * tests/subst.test (8.6): Don Porter's fix for bad parsing of nested scripts [Bug 681841]. 2003-02-15 Kevin Kenny <kennykb@users.sourceforge.net> * tests/notify.test (new-file): * tests/notify.test (new-file): * generic/tclTest.c (TclTest_Init, EventtestObjCmd, EventtestProc, EventTestDeleteProc): (EventTestDeleteProc): * generic/tclNotify.c (Tcl_DeleteEvents): Fixed Tcl_DeleteEvents not to get a pointer smash when deleting the last event in the queue. Added test code in 'tcltest' and a new file of test cases 'notify.test' to exercise this functionality; several of the new test cases fail for the original code and pass for the corrected code. [Bug 673714] * unix/tclUnixTest.c (TestfilehandlerCmd): Corrected a couple of typos in error messages. [Bug 596027] 2003-02-14 Jeff Hobbs <jeffh@ActiveState.com> * README: Bumped to version 8.4.2. * generic/tcl.h: * tools/tcl.wse.in: * unix/configure: * unix/configure.in: * unix/tcl.m4: * unix/tcl.spec: * win/README.binary: * win/configure: * win/configure.in: * macosx/Tcl.pbproj/project.pbxproj: * generic/tclStringObj.c (Tcl_GetCharLength): perf tweak * unix/tcl.m4: correct HP-UX ia64 --enable-64bit build flags 2003-02-14 Kevin Kenny <kennykb@users.sourceforge.net> * win/tclWinTime.c: Added code to test and compensate for forward leaps of the performance counter. See the MSDN Knowledge Base article Q274323 for the hardware problem that makes this necessary on certain machines. * tests/winTime.test: Revised winTime-2.1 - it had a tolerance of thousands of seconds, rather than milliseconds. (What's six orders of magnitude among friends? * win/tclWinTime.c: Added code to test and compensate for forward leaps of the performance counter. See the MSDN Knowledge Base article Q274323 for the hardware problem that makes this necessary on certain machines. * tests/winTime.test: Revised winTime-2.1 - it had a tolerance of thousands of seconds, rather than milliseconds. (What's six orders of magnitude among friends? Both the above changes are triggered by a problem reported at http://aspn.activestate.com/ASPN/Mail/Message/ActiveTcl/1536811 although the developers find it difficult to believe that it accounts for the observed behavior and suspect a fault in the although the developers find it difficult to believe that it accounts for the observed behavior and suspect a fault in the RTC chip. RTC chip. 2003-02-13 Kevin Kenny <kennykb@users.sourceforge.net> * win/tclWinInit.c: Added conversion from the system encoding to tcl_platform(user), so that it works with non-ASCII7 user names. [Bug 685926] * win/tclWinInit.c: Added conversion from the system encoding to tcl_platform(user), so that it works with non-ASCII7 user names. [Bug 685926] * doc/tclsh.1: Added language to describe the handling of the end-of-file character \u001a embedded in a script file. end-of-file character \u001a embedded in a script file. [Bug 685485] [Bug 685485] 2003-02-11 Vince Darley <vincentdarley@users.sourceforge.net> * tests/fileName.test: * unix/tclUnixFile.c: fix for [Bug 685445] when using 'glob -l' on broken symbolic links. Added two new tests for this bug. * unix/tclUnixFile.c: fix for [Bug 685445] when using 'glob -l' on broken symbolic links. Added two new tests for this bug. 2003-02-11 Kevin Kenny <kennykb@users.sourceforge.net> * tests/http.test: Corrected a problem where http-4.14 would fail when run in an environment with a proxy server. Replaced references to scriptics.com by tcl.tk. * tests/http.test: Corrected a problem where http-4.14 would fail when run in an environment with a proxy server. Replaced references to scriptics.com by tcl.tk. 2003-02-11 Jeff Hobbs <jeffh@ActiveState.com> * tests/lsearch.test: * generic/tclCmdIL.c (Tcl_LsearchObjCmd): protect against the case that lsearch -regepx list and pattern objects are equal. * tests/stringObj.test: * generic/tclStringObj.c (Tcl_GetCharLength): correct ascii char opt of 2002-11-11 to not stop early on \x00. [Bug #684699] opt of 2002-11-11 to not stop early on \x00. [Bug 684699] * tests.parse.test: remove excess EOF whitespace * generic/tclParse.c (CommandComplete): more paranoid check to break on (p >= end) instead of just (p == end). 2003-02-11 Miguel Sofer <msofer@users.sf.net> * generic/tclParse.c (CommandComplete): * generic/tclParse.c (CommandComplete): * tests/parse.test: fix for [Bug 684744], by Don Porter. 2003-02-11 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclIOUtil.c (Tcl_FSJoinPath, Tcl_FSGetNormalizedPath): * generic/tclIOUtil.c (Tcl_FSJoinPath, Tcl_FSGetNormalizedPath): (UpdateStringOfFsPath): revert the cwdLen == 0 check and instead follow a different code path in Tcl_FSJoinPath. (Tcl_FSConvertToPathType, Tcl_FSGetNormalizedPath): (Tcl_FSGetFileSystemForPath): Update string rep of path objects before freeing the internal object. (darley) * tests/fileSystem.test: added test 8.3 * generic/tclIOUtil.c (Tcl_FSGetNormalizedPath): (UpdateStringOfFsPath): handle the cwdLen == 0 case * generic/tclIOUtil.c (Tcl_FSGetNormalizedPath): (UpdateStringOfFsPath): handle the cwdLen == 0 case * unix/tclUnixFile.c (TclpMatchInDirectory): simplify the hidden file match check. 2003-02-10 Mo DeJong <mdejong@users.sourceforge.net> * win/configure: * win/configure.in: Generate error when attempting * win/configure.in: Generate error when attempting to build under to build under Cygwin. The Cygwin port of Tcl/Tk does not build and people are filing bug reports under the mistaken impression that someone is actually maintaining the Cygwin port. A post to Cygwin. The Cygwin port of Tcl/Tk does not build and people are filing bug reports under the mistaken impression that someone is actually maintaining the Cygwin port. A post to comp.lang.tcl asking someone to comp.lang.tcl asking someone to volunteer as an area maintainer has generated no results. volunteer as an area maintainer has generated no results. Closing Closing bugs 680840, 630199, and 634772 and marking as "Won't fix". [Bugs 680840, 630199, 634772] and marking as "Won't fix". 2003-02-10 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/append.n: Return value was not documented. [Bug 683188] 2003-02-10 Vince Darley <vincentdarley@users.sourceforge.net> * doc/FileSystem.3: * generic/tclIOUtil.c: * generic/tclInt.h: * tests/fileSystem.test: * unix/tclUnixFCmd.c: * unix/tclUnixFile.c: * win/tclWinFile.c: further filesystem optimization, applying [Patch 682500]. In particular, these code examples are [Patch 682500]. In particular, these code examples are faster now: faster now: foreach f $flist { if {[file exists $f]} {file stat $f arr;...}} foreach f [glob -dir $dir *] { # action and/or recursion on $f } cd $dir foreach f [glob *] { # action and/or recursion on $f } cd .. foreach f $flist { if {[file exists $f]} {file stat $f arr;...}} foreach f [glob -dir $dir *] { # action and/or recursion on $f } cd $dir foreach f [glob *] { # action and/or recursion on $f } cd .. * generic/tclTest.c: Fix for [Bug 683181] where test suite left files in 'tmp'. * generic/tclTest.c: Fix for [Bug 683181] where test suite left files in 'tmp'. 2003-02-08 Jeff Hobbs <jeffh@ActiveState.com> * library/safe.tcl: code cleanup of eval and string comp use. 2003-02-07 Vince Darley <vincentdarley@users.sourceforge.net> * win/tclWinFCmd.c: cleanup long lines * win/tclWinFile.c: sped up pure 'glob' by a factor of 2.5 ('foreach f [glob *] { file exists $f }' is still slow) * win/tclWinFile.c: sped up pure 'glob' by a factor of 2.5 ('foreach f [glob *] { file exists $f }' is still slow) * tests/fileSystem.text: * tests/fileName.test: added new tests to ensure correct behaviour in optimized filesystem code. * tests/fileName.test: added new tests to ensure correct behaviour in optimized filesystem code. 2003-02-07 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclTest.c: * tests/fileSystem.text: fixed test 7.2 to avoid a possible crash, and not change the pwd. * tests/http.text: added comment to test 4.15, that it may fail if you use a proxy server. * tests/fileSystem.text: fixed test 7.2 to avoid a possible crash, and not change the pwd. * tests/http.text: added comment to test 4.15, that it may fail if you use a proxy server. 2003-02-06 Mo DeJong <mdejong@users.sourceforge.net> * generic/tclCompCmds.c (TclCompileIncrCmd): * tests/incr.test: Don't include the text * tests/incr.test: Don't include the text "(increment expression)" in "(increment expression)" in the errorInfo generated by the compiled version of the the errorInfo generated by the compiled version of the incr command incr command since it does not match the message generated by the non-compiled version of incr. It is also not possible to match since it does not match the message generated by the non-compiled version of incr. It is also not possible to match this error output this error output under Jacl, which does not support a compiler. under Jacl, which does not support a compiler. 2003-02-06 Mo DeJong <mdejong@users.sourceforge.net> * generic/tclExecute.c (TclExecuteByteCode): When an error is encountered reading the increment value during a compiled call to incr, add a "(reading increment)" * generic/tclExecute.c (TclExecuteByteCode): When an error is encountered reading the increment value during a compiled call to incr, add a "(reading increment)" error string to the errorInfo error string to the errorInfo variable. This makes the errorInfo variable set by the compiled incr command match the value set by the non-compiled version. * tests/incr-old.test: Change errorInfo result for the compiled incr command case to match the modified variable. This makes the errorInfo variable set by the compiled incr command match the value set by the non-compiled version. * tests/incr-old.test: Change errorInfo result for the compiled incr command case to match the modified implementation. implementation. * tests/incr.test: Add tests to make sure the compiled and non-compiled errorInfo messages are the same. * tests/incr.test: Add tests to make sure the compiled and non-compiled errorInfo messages are the same. 2003-02-06 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: Filename arguments to [outputChannel] * library/tcltest/tcltest.tcl: Filename arguments to [outputChannel] and [errorChannel] (also -outfile and -errfile) were [open]ed but never [closed]. Also, [cleanupTests] could remove output or error files. [Bug 676978]. never [closed]. Also, [cleanupTests] could remove output or error files. [Bug 676978]. * library/tcltest/pkgIndex.tcl: Bumped to version 2.2.2. 2003-02-05 Mo DeJong <mdejong@users.sourceforge.net> * tests/interp.test: * tests/set-old.test: Run test cases that depend * tests/set-old.test: Run test cases that depend on hash order through on hash order through lsort so that the tests also pass under Jacl. Does not change test lsort so that the tests also pass under Jacl. Does not change test results under Tcl. 2003-02-04 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclIOUtil.c: * generic/tclEvent.c: * generic/tclInt.h: * mac/tclMacFCmd.c: * unix/tclUnixFCmd.c: * win/tclWin32Dll.c: * win/tclWinFCmd.c: * win/tclWinInit.c: * win/tclWinInt.h: * tests/fileSystem.test: fix to finalization/unloading/encoding issues to make filesystem much less dependent on encodings for its cleanup, and therefore allow it to be finalized later in the exit process. This fixes fileSystem.test-7.1. Also fixed one more bug in setting of modification dates of files which have undergone cross-platform copies. [Patch 676271] * tests/fileSystem.test: fix to finalization/unloading/encoding issues to make filesystem much less dependent on encodings for its cleanup, and therefore allow it to be finalized later in the exit process. This fixes fileSystem.test-7.1. Also fixed one more bug in setting of modification dates of files which have undergone cross-platform copies. [Patch 676271] * tests/basic.test: * tests/exec.test: * tests/fileName.test: * tests/io.test: fixed some test failures when tests are run from a directory containing spaces. * tests/io.test: fixed some test failures when tests are run from a directory containing spaces. * tests/fileSystem.test: * generic/tclTest.c: added regression test for the modification date setting of cross-platform file copies. 2003-02-03 Kevin Kenny <kennykb@users.sourceforge.net> * generic/tclBasic.c: Changed [trace add command] so that 'rename' callbacks get fully qualified names of the command. [Bug 651271]. ***POTENTIAL INCOMPATIBILITY*** * tests/trace.test: Modified the test cases for [trace add command] to expect fully qualified names on the 'rename' callbacks. Added a case for renaming a proc within a namespace. * doc/trace.n: Added language about use of fully qualified names in trace callbacks. callbacks get fully qualified names of the command. [Bug 651271]. ***POTENTIAL INCOMPATIBILITY*** * tests/trace.test: Modified the test cases for [trace add command] to expect fully qualified names on the 'rename' callbacks. Added a case for renaming a proc within a namespace. * doc/trace.n: Added language about use of fully qualified names in trace callbacks. 2003-02-01 Kevin Kenny <kennykb@users.sourceforge.net> * generic/tclCompCmds.c: Removed an unused variable that caused compiler warnings on SGI. [Bug 664379] * generic/tclLoad.c: Changed the code so that if Tcl_StaticPackage is called to report the same package as being loaded in two interps, it shows up in [info loaded {}] in both of them (previously, it didn't appear in the static package list in the second. * generic/tclLoad.c: Changed the code so that if Tcl_StaticPackage is called to report the same package as being loaded in two interps, it shows up in [info loaded {}] in both of them (previously, it didn't appear in the static package list in the second. * tests/load.test Added regression test for the above bug. [Bug 670042] * generic/tclClock.c: Fixed a bug that incorrectly allowed [clock clicks {}] and [clock clicks -] to be accepted as if they were [clock clicks -milliseconds]. * tests/clock.test: Added regression tests for the above bug. [Bug 675356] * tests/unixNotfy.test: Added cleanup of working files * tests/load.test Added regression test for the above bug. [Bug 670042] * generic/tclClock.c: Fixed a bug that incorrectly allowed [clock clicks {}] and [clock clicks -] to be accepted as if they were [clock clicks -milliseconds]. * tests/clock.test: Added regression tests for the above bug. [Bug 675356] * tests/unixNotfy.test: Added cleanup of working files [Bug 675609] [Bug 675609] * doc/Tcl.n: Added headings to the eleven paragraphs, to improve formatting in the tools that attempt to extract tables of contents from the manual pages. [Bug 627455] * generic/tclClock.c: Expanded mutex protection around the setting of env(TZ) and the thread-unsafe call to tzset(). [Bug 656660] * generic/tclClock.c: Expanded mutex protection around the setting of env(TZ) and the thread-unsafe call to tzset(). [Bug 656660] 2003-01-31 Don Porter <dgp@users.sourceforge.net> * tests/tcltest.test: Cleaned up management of file/directory creation/deletion to improve "-debug 1" output. [Bug 675614] The utility [slave] command failed to properly [list]-quote a constructed [open] command, causing failure when the pathname contained whitespace. [Bug 678415] creation/deletion to improve "-debug 1" output. [Bug 675614] The utility [slave] command failed to properly [list]-quote a constructed [open] command, causing failure when the pathname contained whitespace. [Bug 678415] * tests/main.test: Stopped main.test from deleting existing file. Test suite should not delete files that already exist. [Bug 675660] 2003-01-28 Don Porter <dgp@users.sourceforge.net> * tests/main.test: Constrain tests that do not work on Windows. [Bug 674387] * tests/main.test: Constrain tests that do not work on Windows. [Bug 674387] 2003-01-28 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclIOUtil.c: fix to setting modification date in TclCrossFilesystemCopy. Also added 'panic' in Tcl_FSGetFileSystemForPath under illegal calling circumstances which lead to hard-to-track-down bugs. * generic/tclTest.c: added test suite code to allow exercising a vfs-crash-on-exit bug in Tcl's finalization caused by the encodings being cleaned up before unloading occurs. * tests/fileSystem.test: added new 'knownBug' test 7.1 to demonstrate the crash on exit. * generic/tclIOUtil.c: fix to setting modification date in TclCrossFilesystemCopy. Also added 'panic' in Tcl_FSGetFileSystemForPath under illegal calling circumstances which lead to hard-to-track-down bugs. * generic/tclTest.c: added test suite code to allow exercising a vfs-crash-on-exit bug in Tcl's finalization caused by the encodings being cleaned up before unloading occurs. * tests/fileSystem.test: added new 'knownBug' test 7.1 to demonstrate the crash on exit. 2003-01-28 Mo DeJong <mdejong@users.sourceforge.net> * generic/tcl.h: Add TCL_PREFIX_IDENT and TCL_DEBUG_IDENT, used only by TclpCreateProcess. * generic/tcl.h: Add TCL_PREFIX_IDENT and TCL_DEBUG_IDENT, used only by TclpCreateProcess. * unix/Makefile.in: Define TCL_DBGX. * win/Makefile.in: Define TCL_DBGX. * win/tclWinPipe.c (TclpCreateProcess): * win/tclWinPipe.c (TclpCreateProcess): Check that the Tcl pipe dll Check that the Tcl pipe dll actually exists in the Tcl bin directory and panic if it actually exists in the Tcl bin directory and panic if it is not is not found. Incorporate TCL_DBGX into the Tcl pipe dll name. This fixes a really mysterious error that would show up when found. Incorporate TCL_DBGX into the Tcl pipe dll name. This fixes a really mysterious error that would show up when exec'ing a 16 bit exec'ing a 16 bit application under Win95 or Win98 when Tcl was compiled with symbols. The error seemed to indicate that the executable application under Win95 or Win98 when Tcl was compiled with symbols. The error seemed to indicate that the executable could not be found, could not be found, but it was actually the Tcl pipe dll that could not be found. but it was actually the Tcl pipe dll that could not be found. 2003-01-26 Mo DeJong <mdejong@users.sourceforge.net> * win/README: Update msys+mingw URL to release 6. This version bundles gcc 3. * win/README: Update msys+mingw URL to release 6. This version bundles gcc 3. 2003-01-26 Mo DeJong <mdejong@users.sourceforge.net> * win/configure: Regen. * win/configure.in: Add test that checks to see if the compiler can cast to a union type. * win/tclWinTime.c: Squelch compiler warning * win/configure.in: Add test that checks to see if the compiler can cast to a union type. * win/tclWinTime.c: Squelch compiler warning about union initializer about union initializer by casting to union type when compiling with gcc. by casting to union type when compiling with gcc. 2003-01-25 Mo DeJong <mdejong@users.sourceforge.net> * generic/tclIO.c (Tcl_CutChannel, Tcl_SpliceChannel): Invoke TclpCutFileChannel and TclpSpliceFileChannel. * generic/tclInt.h: Declare TclpCutFileChannel and TclpSpliceFileChannel. * generic/tclIO.c (Tcl_CutChannel, Tcl_SpliceChannel): Invoke TclpCutFileChannel and TclpSpliceFileChannel. * generic/tclInt.h: Declare TclpCutFileChannel and TclpSpliceFileChannel. * unix/tclUnixChan.c (FileCloseProc, TclpOpenFileChannel, Tcl_MakeFileChannel, TclpCutFileChannel, TclpSpliceFileChannel): Implement thread load data cut and splice for file channels. This avoids an invalid memory ref when compiled with -DDEPRECATED. (Tcl_MakeFileChannel, TclpCutFileChannel, (TclpSpliceFileChannel): Implement thread load data cut and splice for file channels. This avoids an invalid memory ref when compiled with -DDEPRECATED. * win/tclWinChan.c (FileCloseProc, TclpCutFileChannel, TclpSpliceFileChannel): Implement thread load data (TclpSpliceFileChannel): Implement thread load data cut and splice for cut and splice for file channels. This avoids an invalid memory ref that was showing up in the thread extension. file channels. This avoids an invalid memory ref that was showing up in the thread extension. 2003-01-25 Mo DeJong <mdejong@users.sourceforge.net> * win/tclWin32Dll.c (TclpCheckStackSpace, squelch_warnings): * win/tclWinChan.c (Tcl_MakeFileChannel, squelch_warnings): * win/tclWinFCmd.c (DoRenameFile, DoCopyFile, squelch_warnings): Re-implement inline ASM SEH handlers for gcc. Re-implement inline ASM SEH handlers for gcc. The esp and ebp The esp and ebp registers are now saved on the stack instead of in global variables so that the code is thread safe. Add additional checks registers are now saved on the stack instead of in global variables so that the code is thread safe. Add additional checks when TCL_MEM_DEBUG when TCL_MEM_DEBUG is defined to be sure the values were recovered from the stack properly. Remove squelch_warnings functions and add a dummy call in the handler methods to squelch is defined to be sure the values were recovered from the stack properly. Remove squelch_warnings functions and add a dummy call in the handler methods to squelch compiler warnings. compiler warnings. 2003-01-25 Mo DeJong <mdejong@users.sourceforge.net> * win/configure: * win/configure.in: Define HAVE_ALLOCA_GCC_INLINE * win/configure.in: Define HAVE_ALLOCA_GCC_INLINE when we detect that when we detect that no alloca function is found in malloc.h and we are compiling with GCC. Remove HAVE_NO_ALLOC_DECL define. * win/tclWin32Dll.c (TclpCheckStackSpace): no alloca function is found in malloc.h and we are compiling with GCC. Remove HAVE_NO_ALLOC_DECL define. * win/tclWin32Dll.c (TclpCheckStackSpace): Don't define alloca as a Don't define alloca as a cdecl function. Doing this caused a tricky runtime bug because the _alloca function expects the size argument cdecl function. Doing this caused a tricky runtime bug because the _alloca function expects the size argument to be passed in a register to be passed in a register and not on the stack. To fix this problem, we use inline ASM when compiling with gcc to invoke _alloca with the size argument loaded into a register. and not on the stack. To fix this problem, we use inline ASM when compiling with gcc to invoke _alloca with the size argument loaded into a register. 2003-01-24 Jeff Hobbs <jeffh@ActiveState.com> * win/tclWinDde.c (Dde_Init): clarified use of tsdPtr. (DdeServerProc): better refcount handling of returnPackagePtr. * generic/tclEvent.c (Tcl_Finalize): revert finalize change on 2002-12-04 to correct the issue with extensions that have TSD needing to finalize that before they are unloaded. This issue needs further clarification. 2002-12-04 to correct the issue with extensions that have TSD needing to finalize that before they are unloaded. This issue needs further clarification. * tests/unixFCmd.test: only do groups check on unix 2003-01-24 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclStringObj.c: proper fixes for Tcl_SetObjLength and Tcl_AttemptSetObjectLength dealing with string objects with both pure-unicode and normal internal representations. Previous fix didn't handle all cases correctly. * generic/tclIO.c: Add 'Tcl_GetString()' to ensure the object has a valid 'objPtr->bytes' field before manipulating it directly. This fixes [Bug 635200] and [Bug 671138], but may reduce performance of Unicode string handling in some cases. A further patch will be applied to address this, once the code is known to be correct. * generic/tclStringObj.c: proper fixes for Tcl_SetObjLength and Tcl_AttemptSetObjectLength dealing with string objects with both pure-unicode and normal internal representations. Previous fix didn't handle all cases correctly. * generic/tclIO.c: Add 'Tcl_GetString()' to ensure the object has a valid 'objPtr->bytes' field before manipulating it directly. This fixes [Bug 635200] and [Bug 671138], but may reduce performance of Unicode string handling in some cases. A further patch will be applied to address this, once the code is known to be correct. 2003-01-24 Mo DeJong <mdejong@users.sourceforge.net> * win/configure: Regen. * win/configure.in: Add test to see if alloca is undefined in malloc.h. * win/tclWin32Dll.c (TclpCheckStackSpace): Rework * win/configure.in: Add test to see if alloca is undefined in malloc.h. * win/tclWin32Dll.c (TclpCheckStackSpace): Rework the SEH exception the SEH exception handler logic to avoid using the stack since alloca will modify the stack. This was causing a nasty bug that would set the exception handler to 0 because it tried to pop the previous exception handler off the top of handler logic to avoid using the stack since alloca will modify the stack. This was causing a nasty bug that would set the exception handler to 0 because it tried to pop the previous exception handler off the top of the stack. the stack. 2003-01-23 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/lset.n: Fixed fault in return values from lset in documentation examples [SF Bug #658463] and tidied up a bit at the * doc/lset.n: Fixed fault in return values from lset in documentation examples [Bug 658463] and tidied up a bit at the same time. same time. 2003-01-21 Joe English <jenglish@users.sourceforge.net> * doc/namespace.n (namespace inscope): Clarified documentation [SF Patch #670110] [Patch 670110] 2003-01-21 Mo DeJong <mdejong@users.sourceforge.net> * win/configure: Regen. * win/tcl.m4 (SC_CONFIG_CFLAGS): Set SHLIB_SUFFIX so that TCL_SHLIB_SUFFIX will be set to a useful * win/tcl.m4 (SC_CONFIG_CFLAGS): Set SHLIB_SUFFIX so that TCL_SHLIB_SUFFIX will be set to a useful value in the generated value in the generated tclConfig.sh. Set SHLIB_LD_LIBS to "" or '${LIBS}' based on the --enable-shared flag. This matches the tclConfig.sh. Set SHLIB_LD_LIBS to "" or '${LIBS}' based on the --enable-shared flag. This matches the UNIX implementation. UNIX implementation. 2003-01-18 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclCkalloc.c: change %ud to %u as appropriate. 2003-01-17 Mo DeJong <mdejong@users.sourceforge.net> * win/tclWinDde.c (DdeServerProc): Deallocate * win/tclWinDde.c (DdeServerProc): Deallocate the Tcl_Obj returned by the Tcl_Obj returned by ExecuteRemoteObject if it was not saved in a connection object. ExecuteRemoteObject if it was not saved in a connection object. 2003-01-17 Mo DeJong <mdejong@users.sourceforge.net> * generic/tcl.h: Revert earlier change that * generic/tcl.h: Revert earlier change that defined TCL_WIDE_INT_TYPE defined TCL_WIDE_INT_TYPE as long long and TCL_LL_MODIFIER as L when compiling with mingw. This change ended up causing some test case failures when compiling with mingw. * generic/tclObj.c (UpdateStringOfWideInt): as long long and TCL_LL_MODIFIER as L when compiling with mingw. This change ended up causing some test case failures when compiling with mingw. * generic/tclObj.c (UpdateStringOfWideInt): Describe the warning Describe the warning generated by mingw and why it needs to be ignored so that someone is not tempted to "fix" this problem again generated by mingw and why it needs to be ignored so that someone is not tempted to "fix" this problem again in the future. in the future. 2003-01-16 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclStringObj.c: Tcl_SetObjLength fix for when the object has a unicode string rep. Fixes [Bug 635200] * tests/stringObj.test: removed 'knownBug' constraint from test 14.1 now that this bug is fixed. * generic/tclStringObj.c: Tcl_SetObjLength fix for when the object has a unicode string rep. Fixes [Bug 635200] * tests/stringObj.test: removed 'knownBug' constraint from test 14.1 now that this bug is fixed. * generic/tclInt.h: * generic/tclBasic.c: * generic/tclCmdMZ.z: * tests/trace.test: execution and command tracing bug fixes and cleanup. In particular fixed [Bug 655645], [Bug 615043], cleanup. In particular fixed [Bugs 655645, 615043, 571385] [Bug 571385] - fixed some subtle cleanup problems with tracing. This required replacing Tcl_Preserve/Tcl_Release with a more robust refCount approach. Solves at least one known crash caused by memory corruption. - fixed some confusion in the code between new style traces (Tcl 8.4) and the very limited 'Tcl_CreateTrace' which existed - fixed some subtle cleanup problems with tracing. This required replacing Tcl_Preserve/Tcl_Release with a more robust refCount approach. Solves at least one known crash caused by memory corruption. - fixed some confusion in the code between new style traces (Tcl 8.4) and the very limited 'Tcl_CreateTrace' which existed before. before. - made behaviour consistent with documentation (several tests even contradicted the documentation before). - made behaviour consistent with documentation (several tests even contradicted the documentation before). - fixed some minor error message details - added a number of new tests 2003-01-16 Jeff Hobbs <jeffh@ActiveState.com> * win/tclWinSerial.c (SerialOutputProc): add casts for bytesWritten to allow strict compilation (no warnings). * win/tclWinSerial.c (SerialOutputProc): add casts for bytesWritten to allow strict compilation (no warnings). * tests/winDde.test: * win/tclWinDde.c (Tcl_DdeObjCmd): Prevent crash when empty service name is passed to 'dde eval' and goto errorNoResult in request and poke error cases to free up any allocated data. * win/tclWinDde.c (Tcl_DdeObjCmd): Prevent crash when empty service name is passed to 'dde eval' and goto errorNoResult in request and poke error cases to free up any allocated data. 2003-01-16 Mo DeJong <mdejong@users.sourceforge.net> * win/tclWin32Dll.c (squelch_warnings): Squelch compiler warnings from SEH ASM code. * win/tclWinChan.c (squelch_warnings): Squelch compiler warnings from SEH ASM code. * win/tclWinDde.c: Add casts to avoid compiler * win/tclWin32Dll.c (squelch_warnings): Squelch compiler warnings from SEH ASM code. * win/tclWinChan.c (squelch_warnings): Squelch compiler warnings from SEH ASM code. * win/tclWinDde.c: Add casts to avoid compiler warnings. Pass pointer warnings. Pass pointer to DWORD instead of int to avoid compiler warnings. * win/tclWinFCmd.c (squelch_warnings): Add casts to DWORD instead of int to avoid compiler warnings. * win/tclWinFCmd.c (squelch_warnings): Add casts and fixup decls to and fixup decls to avoid compiler warnings. Squelch compiler warnings from SEH ASM code. * win/tclWinFile.c: Add casts and fixup decls to avoid compiler warnings. Remove unused variable. * win/tclWinNotify.c: Declare as DWORD instead of int to avoid compiler warning. * win/tclWinReg.c: Add casts to avoid compiler warning. Fix assignment in if expression bug. * win/tclWinSerial.c: Add casts to avoid compiler warnings. Remove unused variable. * win/tclWinSock.c: Add casts and fixup decls to avoid compiler warnings. avoid compiler warnings. Squelch compiler warnings from SEH ASM code. * win/tclWinFile.c: Add casts and fixup decls to avoid compiler warnings. Remove unused variable. * win/tclWinNotify.c: Declare as DWORD instead of int to avoid compiler warning. * win/tclWinReg.c: Add casts to avoid compiler warning. Fix assignment in if expression bug. * win/tclWinSerial.c: Add casts to avoid compiler warnings. Remove unused variable. * win/tclWinSock.c: Add casts and fixup decls to avoid compiler warnings. 2003-01-14 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclClock.c (FormatClock): corrected typo that incorrectly conditionally defined savedTZEnv and savedTimeZone. * generic/tclClock.c (FormatClock): corrected typo that incorrectly conditionally defined savedTZEnv and savedTimeZone. 2003-01-13 Mo DeJong <mdejong@users.sourceforge.net> Fix mingw build problems and compiler warnings. * generic/tcl.h: Add if defined(__MINGW32__) * generic/tcl.h: Add if defined(__MINGW32__) check to code that sets check to code that sets the TCL_WIDE_INT_TYPE and TCL_LL_MODIFIER. * generic/tclClock.c (FormatClock): Don't the TCL_WIDE_INT_TYPE and TCL_LL_MODIFIER. * generic/tclClock.c (FormatClock): Don't define savedTimeZone and define savedTimeZone and savedTZEnv if we are not going to use them. savedTZEnv if we are not going to use them. * generic/tclEnv.c: Add cast to avoid warning. * win/tclWinChan.c: Use DWORD instead of int * win/tclWinChan.c: Use DWORD instead of int to avoid compiler warning to avoid compiler warning. * win/tclWinThrd.c: Only define allocLock, * win/tclWinThrd.c: Only define allocLock, allocLockPtr, and dataKey allocLockPtr, and dataKey when TCL_THREADS is defined. This avoid a compiler warning about unused variables. when TCL_THREADS is defined. This avoid a compiler warning about unused variables. 2003-01-12 Mo DeJong <mdejong@users.sourceforge.net> * win/README: Update msys + mingw URL, the * win/README: Update msys + mingw URL, the new release includes the new release includes the released 1.0.8 version of msys which includes a number released 1.0.8 version of msys which includes a number of bug fixes. of bug fixes. 2003-01-12 Mo DeJong <mdejong@users.sourceforge.net> * win/configure: Regen. * win/tcl.m4 (SC_CONFIG_CFLAGS): Pull in * win/tcl.m4 (SC_CONFIG_CFLAGS): Pull in addition of shell32.lib to addition of shell32.lib to LIBS_GUI that was added to the Tk tcl.m4 but never made it back into the Tcl version. LIBS_GUI that was added to the Tk tcl.m4 but never made it back into the Tcl version. 2003-01-12 Mo DeJong <mdejong@users.sourceforge.net> * generic/tcl.h: Skip Tcl's define of CHAR, * generic/tcl.h: Skip Tcl's define of CHAR, SHORT, and LONG when SHORT, and LONG when HAVE_WINNT_IGNORE_VOID is defined. This avoids a bunch of compiler HAVE_WINNT_IGNORE_VOID is defined. This avoids a bunch of compiler warnings when building with Cygwin or Mingw. * win/configure: Regen. * win/configure.in: Define HAVE_WINNT_IGNORE_VOID * win/configure.in: Define HAVE_WINNT_IGNORE_VOID when we detect a when we detect a winnt.h that still defines CHAR, SHORT, and LONG when VOID has already winnt.h that still defines CHAR, SHORT, and LONG when VOID has already been defined. * win/tcl.m4 (SC_LOAD_TCLCONFIG): Subst the * win/tcl.m4 (SC_LOAD_TCLCONFIG): Subst the TCL_DEFS loaded from TCL_DEFS loaded from tclConfig.sh so that Tcl defines can make it into the Tk Makefile. tclConfig.sh so that Tcl defines can make it into the Tk Makefile. 2003-01-12 Mo DeJong <mdejong@users.sourceforge.net> * win/configure: Regen. * win/configure.in: Check for typedefs like LPFN_ACCEPT in winsock2.h and define HAVE_NO_LPFN_DECLS if not found. * win/tclWinSock.c: Define LPFN_* typedefs if * win/configure.in: Check for typedefs like LPFN_ACCEPT in winsock2.h and define HAVE_NO_LPFN_DECLS if not found. * win/tclWinSock.c: Define LPFN_* typedefs if HAVE_NO_LPFN_DECLS is HAVE_NO_LPFN_DECLS is defined. This fixes the build under Mingw and Cygwin, it was broken by the changes made on 2002-11-26. defined. This fixes the build under Mingw and Cygwin, it was broken by the changes made on 2002-11-26. 2003-01-10 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclIOUtil.c: * generic/tclIOUtil.c: * win/tclWinInt.h: * win/tclWinInit.c: fix to new WinTcl crash on exit with vfs, introduced on 2002-12-06. Encodings must be cleaned up after the filesystem. introduced on 2002-12-06. Encodings must be cleaned up after the filesystem. * win/makefile.vc: fix to minor VC++ 5.2 syntax problem 2003-01-09 Don Porter <dgp@users.sourceforge.net> * generic/tclCompCmds.c (TclCompilerReturnCmd): Corrected off-by-one problem with recent commit. [Bug 633204] * generic/tclCompCmds.c (TclCompilerReturnCmd): Corrected off-by-one problem with recent commit. [Bug 633204] 2003-01-09 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclFileName.c: remove unused variable 'macSpecialCase' [Bug 664749] * generic/tclFileName.c: remove unused variable 'macSpecialCase' [Bug 664749] * generic/tclIOUtil.c: * generic/tclInt.h: * unix/tclUnixFile.c: * mac/tclMacFile.c: * win/tclWinFile.c: * win/tclWinInt.h: * win/tclWin32Dll.c: * tests/cmdAH.test: fix to non-ascii chars in paths when setting mtime and atime through 'file (a|m)time $path $time' * win/tclWin32Dll.c: * tests/cmdAH.test: fix to non-ascii chars in paths when setting mtime and atime through 'file (a|m)time $path $time'. [Bug 634151] [Bug 634151] 2003-01-08 Don Porter <dgp@users.sourceforge.net> * generic/tclExecute.c (TclExprFloatError): Use the IS_NAN macro for greater clarity of code. * generic/tclExecute.c (TclExprFloatError): Use the IS_NAN macro for greater clarity of code. 2003-01-07 Don Porter <dgp@users.sourceforge.net> * generic/tclCompCmds.c (TclCompileReturnCmd): * tests/compile.test: Corrects failure of bytecompiled [catch {return}] to have result TCL_RETURN (not TCL_OK) [Bug 633204]. This patch is a workaround for 8.4.X. A new opcode INST_RETURN is a better long term solution for 8.5 and later. * generic/tclCompCmds.c (TclCompileReturnCmd): * tests/compile.test: Corrects failure of bytecompiled [catch {return}] to have result TCL_RETURN (not TCL_OK) [Bug 633204]. This patch is a workaround for 8.4.X. A new opcode INST_RETURN is a better long term solution for 8.5 and later. 2003-01-04 David Gravereaux <davygrvy@pobox.com> * win/makefile.vc: * win/rules.vc: Fixed INSTALLDIR macro problem that blanked itself by accident causing the install target to put the tree at the root of the drive built on. Whoops.. * win/rules.vc: Fixed INSTALLDIR macro problem that blanked itself by accident causing the install target to put the tree at the root of the drive built on. Whoops.. Renamed the 'linkexten' option to be 'staticpkg'. Added 'thrdalloc' to allow the switching _on_ of the thread allocator. Under testing, I found it not to be benificial under windows for the purpose of the application I was using it for. It was more important for this app Renamed the 'linkexten' option to be 'staticpkg'. Added 'thrdalloc' to allow the switching _on_ of the thread allocator. Under testing, I found it not to be benificial under windows for the purpose of the application I was using it for. It was more important for this app that resources for tcl threads be returned to the system rather than saved/moved to the global recycler. Be extra clean or extra fast for the default threaded build? Let's move to clean and allow it to be switched on for users who find it benificial for their use of saved/moved to the global recycler. Be extra clean or extra fast for the default threaded build? Let's move to clean and allow it to be switched on for users who find it benificial for their use of threads. threads. 2002-12-18 David Gravereaux <davygrvy@pobox.com> * win/makefile.vc: some uses of xcopy swapped to the @$(CPY) macro. Reported by Joe Mistachkin <joe@mistachkin.com>. 2002-12-17 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclNotify.c (TclFinalizeNotifier, Tcl_SetServiceMode): (Tcl_ThreadAlert): Check that the stub functions are non-NULL before calling them. They could be set to NULL by Tcl_SetNotifier. * generic/tclNotify.c (TclFinalizeNotifier, Tcl_SetServiceMode): (Tcl_ThreadAlert): Check that the stub functions are non-NULL before calling them. They could be set to NULL by Tcl_SetNotifier. 2002-12-16 David Gravereaux <davygrvy@pobox.com> * generic/tclPipe.c (TclCleanupChildren): * tests/winPipe.test: * win/tclWinPipe.c (Tcl_WaitPid): * win/tclWinTest.c: Gave Tcl_WaitPid the ability to return a Win32 exception code translated into a posix style SIG*. This allows [close] to report "CHILDKILLED" without the meaning getting lost in a truncated exit code. In TclCleanupChildren(), TclpGetPid() had to get moved to before Tcl_WaitPid() as the * win/tclWinTest.c: Gave Tcl_WaitPid the ability to return a Win32 exception code translated into a posix style SIG*. This allows [close] to report "CHILDKILLED" without the meaning getting lost in a truncated exit code. In TclCleanupChildren(), TclpGetPid() had to get moved to before Tcl_WaitPid() as the the handle is removed from the the handle is removed from the list taking away the ability to get the process id after the wait is done. This shouldn't effect the unix implimentaion unless waitpid is called with a pid of zero, meaning "any". I don't think it is.. list taking away the ability to get the process id after the wait is done. This shouldn't effect the unix implimentaion unless waitpid is called with a pid of zero, meaning "any". I don't think it is.. 2002-12-13 Don Porter <dgp@users.sourceforge.net> * unix/configure.in: Updated configure of CVS snapshots to reflect * win/configure.in: the 8.4.1.1 patchlevel. * unix/configure: autoconf * win/configure autoconf 2002-12-11 Don Porter <dgp@users.sourceforge.net> * generic/tclProc.c (ProcessProcResultCode): Fix failure to propagate negative return codes up the call stack. [Bug 647307] * generic/tclProc.c (ProcessProcResultCode): Fix failure to propagate negative return codes up the call stack. [Bug 647307] * tests/proc.test (proc-6.1): Test for Bug 647307 * generic/tclParseExpr.c (TclParseInteger): Return 1 for the string "0x" (recognize leading "0" as an integer). [Bug 648441]. string "0x" (recognize leading "0" as an integer). [Bug 648441]. * tests/parseExpr.test (parseExpr-19.1): Test for Bug 648441. 2002-12-09 Jeff Hobbs <jeffh@ActiveState.com> * win/tclWinThrd.c (TclpMasterUnlock): * generic/tclThread.c (TclFinalizeThreadData): TclpMasterUnlock must exist and be called unconditional of TCL_THREADS. [Bug #651139] * generic/tclThread.c (TclFinalizeThreadData): TclpMasterUnlock must exist and be called unconditional of TCL_THREADS. [Bug 651139] 2002-12-08 David Gravereaux <davygrvy@pobox.com> * win/tclWinSock.c (SocketThreadExitHandler, InitSockets): Check that the tsdPtr is valid before dereferencing as we call it from the exit handler, too [Bug 650353]. Another WSAStartup() loaded version comparison byte swap issue fixed. Although 0x0101 byte swapped is still 0x0101, properly claiming which is major/minor * win/tclWinSock.c (SocketThreadExitHandler, InitSockets): Check that the tsdPtr is valid before dereferencing as we call it from the exit handler, too [Bug 650353]. Another WSAStartup() loaded version comparison byte swap issue fixed. Although 0x0101 byte swapped is still 0x0101, properly claiming which is major/minor is more correct. is more correct. 2002-12-06 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclStubInit.c: regen * generic/tclIntPlatDecls.h: regen * generic/tclInt.decls: added TclWinResetInterface * win/tclWin32Dll.c (TclWinResetInterfaces): * win/tclWinInit.c (TclpSetInitialEncodings, WinEncodingsCleanup): add exit handler that resets the encoding information to a state where we can reuse Tcl. Following these changes, it is possible to reuse Tcl (following Tcl_FindExecutable or Tcl_CreateInterp) following a Tcl_Finalize. add exit handler that resets the encoding information to a state where we can reuse Tcl. Following these changes, it is possible to reuse Tcl (following Tcl_FindExecutable or Tcl_CreateInterp) following a Tcl_Finalize. * generic/tclIOUtil.c (TclFinalizeFilesystem): reset statics to their original values on finalize to allow reuse of the library. * generic/tclIOUtil.c (TclFinalizeFilesystem): reset statics to their original values on finalize to allow reuse of the library. 2002-12-04 David Gravereaux <davygrvy@pobox.com> * win/tclWinPipe.c: reverted back to -r1.27 due to numerous test failures that need to be resolved first. The idea was good, but the details aren't. failures that need to be resolved first. The idea was good, but the details aren't. 2002-12-04 David Gravereaux <davygrvy@pobox.com> * win/tclWinPipe.c (Tcl_WaitPid): When a process exits with an exception, pass this notice on to the caller with a SIG* code rather than truncating the exit code and missing the meaning. This allows TclCleanupChildren() to report "CHILDKILLED". * win/tclWinPipe.c (Tcl_WaitPid): When a process exits with an exception, pass this notice on to the caller with a SIG* code rather than truncating the exit code and missing the meaning. This allows TclCleanupChildren() to report "CHILDKILLED". This has a different behavior than unix in that closing the read pipe to a process sends the SIGPIPE signal which is returned as a SIGPIPE exit status. On windows, we send the This has a different behavior than unix in that closing the read pipe to a process sends the SIGPIPE signal which is returned as a SIGPIPE exit status. On windows, we send the process a CTRL_BREAK_EVENT and process a CTRL_BREAK_EVENT and get back a CONTROL_C_EXIT which is documented to mean a SIGINT which seems wrong as a system, but is the correct exit status. get back a CONTROL_C_EXIT which is documented to mean a SIGINT which seems wrong as a system, but is the correct exit status. 2002-12-04 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclIOUtil.c: fix to redirected 'load' in virtual filesystem for some Unix systems. * generic/tclIOUtil.c: fix to redirected 'load' in virtual filesystem for some Unix systems. * generic/tclEvent.c: the filesystem must be cleaned up before the encoding subsystem because it needs access to encodings. Fixes crash on exit observed in embedded applications. * generic/tclEvent.c: the filesystem must be cleaned up before the encoding subsystem because it needs access to encodings. Fixes crash on exit observed in embedded applications. * generic/tclTestObj.c: patch omitted from previous change of 2002-11-13 * generic/tclTestObj.c: patch omitted from previous change of 2002-11-13 2002-12-03 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclStubLib.c (Tcl_InitStubs): prevent the cached check of tclStubsPtr to allow for repeated load/unload of the Tcl dll by hosting apps. [Bug 615304] 2002-12-03 David Gravereaux <davygrvy@pobox.com> * win/tclAppInit.c (sigHandler): Protect from trying to close a NULL handle. * win/tclAppInit.c (sigHandler): Protect from trying to close a NULL handle. * win/tclWinPipe.c (PipeClose2Proc, TclpCreateProcess): Send a real Win32 signal (CTRL_C_EVENT) when the read channel is brought down to alert the child to close on its side. Start the process with CREATE_NEW_PROCESS_GROUP to allow the ability to send these signals. The following test case now brings down the child without the use of an external [kill] command. * win/tclWinPipe.c (PipeClose2Proc, TclpCreateProcess): Send a real Win32 signal (CTRL_C_EVENT) when the read channel is brought down to alert the child to close on its side. Start the process with CREATE_NEW_PROCESS_GROUP to allow the ability to send these signals. The following test case now brings down the child without the use of an external [kill] command. % set p [open "|[info name]" w+] file8d5380 % pid $p 2876 % close $p <- now doesn't block in Tcl_WaitPid() % % set p [open "|[info name]" w+] file8d5380 % pid $p 2876 % close $p <- now doesn't block in Tcl_WaitPid() % * win/tclWinPipe.c (PipeClose2Proc): Changed CTRL_C_EVENT to CTRL_BREAK_EVENT as it can't be ignored by the child and proved to work on [open "|netstat 1" w+] where CTRL_C_EVENT * win/tclWinPipe.c (PipeClose2Proc): Changed CTRL_C_EVENT to CTRL_BREAK_EVENT as it can't be ignored by the child and proved to work on [open "|netstat 1" w+] where CTRL_C_EVENT didn't. didn't. 2002-11-27 David Gravereaux <davygrvy@pobox.com> * win/tclWinPort.h: Don't turn off winsock prototypes! TclX didn't like it. Even though the core doesn't use the prototypes, do offer them. * win/tclWinPort.h: Don't turn off winsock prototypes! TclX didn't like it. Even though the core doesn't use the prototypes, do offer them. * win/tclWinSock.c: Removed shutdown() from the function table as it wasn't referenced anywhere and cleaned-up some casting that that wasn't needed. * win/tclWinSock.c: Removed shutdown() from the function table as it wasn't referenced anywhere and cleaned-up some casting that that wasn't needed. * win/tclWinSock.c: WSAStartup() loaded version comparison error which resulted in 2.0 looking less than 1.1. * win/tclWinSock.c: WSAStartup() loaded version comparison error which resulted in 2.0 looking less than 1.1. * win/tclWinChan.c (Tcl_MakeFileChannel): return of DuplicateHandle() incorrectly used [Bug 618852]. * win/tclWinChan.c (Tcl_MakeFileChannel): return of DuplicateHandle() incorrectly used [Bug 618852]. 2002-11-26 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclEncoding.c (TclFinalizeEncodingSubsystem): properly cleanup all encodings by using Tcl_FirstHashEntry in the while loop. * unix/Makefile.in (valgrind): add simple valgrind target * tests/exec.test: unset path var to allow singleproc testing * generic/tclInterp.c (AliasCreate): preserve/release interps to prevent possible FMR error in bad alias cases. 2002-11-26 David Gravereaux <davygrvy@pobox.com> * win/tclWinPort.h: * win/tclWinSock.c: This patch does two things: 1) Cleans-up the winsock typedefs by using the typedefs provided by winsock2.h. This has no effect on how winsock is initialized; just makes the source code easier to read. 1) Cleans-up the winsock typedefs by using the typedefs provided by winsock2.h. This has no effect on how winsock is initialized; just makes the source code easier to read. [Patch 561305, 561301] [Patch 561305 561301] 2) Revamps how the socket message handler thread is brought up and down to allow for cleaner exits without the use of 2) Revamps how the socket message handler thread is brought up and down to allow for cleaner exits without the use of TerminateThread(). TerminateThread(). TerminateThread is evil. No attempt has been made to resolve [Bug 593810] which may need a new channel driver version for adding a registering function within the transfered thread to init the handler thread. IOW, initialization of the TSD structure is getting bypassed TerminateThread is evil. No attempt has been made to resolve [Bug 593810] which may need a new channel driver version for adding a registering function within the transfered thread to init the handler thread. IOW, initialization of the TSD structure is getting bypassed through the thread extension's [thread::transfer] command. 2002-11-26 David Gravereaux <davygrvy@pobox.com> * win/tclWinConsole.c: * win/tclWinPipe.c: * win/tclWinSerial.c: * win/tclWinSock.c: * win/tclWinThrd.c: * win/tclWinTime.c: General cleanup of all worker threads used by the channel drivers. Eliminates the normal case where the worker thread is terminated ('cept the winsock one). Instead, * win/tclWinTime.c: General cleanup of all worker threads used by the channel drivers. Eliminates the normal case where the worker thread is terminated ('cept the winsock one). Instead, use kernel events to use kernel events to signal a clean exit. Only when the worker thread is blocked on an I/O call is the thread terminated. Essentially, this makes all other channel worker threads behave like the PipeReaderThread() function for it's cleaner exit behavior. This appears to fix [Bug 597924] but needs 3rd party confirmation to close the issue. signal a clean exit. Only when the worker thread is blocked on an I/O call is the thread terminated. Essentially, this makes all other channel worker threads behave like the PipeReaderThread() function for it's cleaner exit behavior. This appears to fix [Bug 597924] but needs 3rd party confirmation to close the issue. 2002-11-26 Mo DeJong <mdejong@users.sourceforge.net> * win/README: Update msys build env URL. This release #4 build both tcl and tk without problems. * win/README: Update msys build env URL. This release #4 build both tcl and tk without problems. 2002-11-22 Jeff Hobbs <jeffh@ActiveState.com> * library/init.tcl: code cleanup to reduce use of * library/init.tcl: code cleanup to reduce use of * library/opt/optparse.tcl: string compare * tests/interp.test: interp-14.4 * generic/tclInterp.c (TclPreventAliasLoop): prevent seg fault when creating an alias command over the interp name. [Bug #641195] * generic/tclInterp.c (TclPreventAliasLoop): prevent seg fault when creating an alias command over the interp name. [Bug 641195] 2002-11-18 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclUtil.c (SetEndOffsetFromAny): handle integer offset after the "end-" prefix. * generic/get.test: * generic/string.test: * generic/tclObj.c (SetIntFromAny, SetWideIntFromAny): * generic/tclGet.c (TclGetLong, Tcl_GetInt): simplify sign handling before calling strtoul(l). [Bug #634856] * generic/tclObj.c (SetIntFromAny, SetWideIntFromAny): * generic/tclGet.c (TclGetLong, Tcl_GetInt): simplify sign handling before calling strtoul(l). [Bug 634856] 2002-11-18 David Gravereaux <davygrvy@pobox.com> * win/tclWinThrd.c (Tcl_CreateThread/TclpThreadExit): Fixed improper compiler macros that missed the VC++ compiler. This resulted in VC++ builds using CreateThread()/ExitThread() in place of the proper _beginthreadex()/_endthreadex(). This was a large error and am surprised I missed seeing it earlier. * win/tclWinThrd.c (Tcl_CreateThread/TclpThreadExit): Fixed improper compiler macros that missed the VC++ compiler. This resulted in VC++ builds using CreateThread()/ExitThread() in place of the proper _beginthreadex()/_endthreadex(). This was a large error and am surprised I missed seeing it earlier. 2002-11-13 Jeff Hobbs <jeffh@ActiveState.com> * generic/regexpComp.test: added tests 22.* * generic/tclCompCmds.c (TclCompileRegexpCmd): add left and right anchoring (^ and $) recognition and check starting or ending .* to extend the number of REs that can be compiled to string match or string equal. 2002-11-13 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclCmdMZ.c: * tests/trace.test: applied patch from Hemang Levana to fix [Bug #615043] in execution traces with 'return -code error'. * tests/trace.test: applied patch from Hemang Levana to fix [Bug 615043] in execution traces with 'return -code error'. * generic/tclTestObj.c: * tests/stringObj.test: added 'knownBug' test for [Bug 635200] * generic/tclStringObj.c: corrected typos in comments * generic/tclFileName.c: * tests/fileName.test: applied patch for bug reported against tclvfs concerning handling of Windows serial ports like 'com1', 'lpt3' by the virtual filesystem code. * tests/fileName.test: applied patch for bug reported against tclvfs concerning handling of Windows serial ports like 'com1', 'lpt3' by the virtual filesystem code. * doc/RegExp.3: clarification of the 'extendMatch' return * doc/RegExp.3: clarification of the 'extendMatch' return values. values. 2002-11-11 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclUtil.c (Tcl_Backslash): use TclUtfToUniChar. (Tcl_StringCaseMatch): use TclUtfToUniChar and add further optimizations for the one-byte/char case. * generic/tclUtf.c: make use of TclUtfToUniChar macro throughout the functions, and add extra optimization to Tcl_NumUtfChars for * generic/tclUtf.c: make use of TclUtfToUniChar macro throughout the functions, and add extra optimization to Tcl_NumUtfChars for one-byte/char case. * generic/tclVar.c (DisposeTraceResult, CallVarTraces): add proper static declarations. * generic/tclStringObj.c (Tcl_GetCharLength): optimize for the ascii char case. * generic/tclStringObj.c (Tcl_GetCharLength): optimize for the ascii char case. (Tcl_GetUniChar): remove unnecessary use of Tcl_UtfToUniChar. (FillUnicodeRep): Use TclUtfToUniChar. * generic/tclHash.c (HashStringKey): move string++ lower to save an instruction. * generic/tclHash.c (HashStringKey): move string++ lower to save an instruction. * generic/tclExecute.c (TclExecuteByteCode): improve INST_STR_CMP to use memcmp in the one-byte/char case, also use direct index for * generic/tclExecute.c (TclExecuteByteCode): improve INST_STR_CMP to use memcmp in the one-byte/char case, also use direct index for INST_STR_INDEX in that case. * generic/tclEncoding.c (UtfToUtfProc, UtfToUnicodeProc): * generic/tclEncoding.c (UtfToUtfProc, UtfToUnicodeProc): (TableFromUtfProc, EscapeFromUtfProc): Use TclUtfToUniChar. (UnicodeToUtfProc, TableToUtfProc): add 1-byte char optimizations for Tcl_UniCharToUtf call. These improve encoded channel conversion speeds by up to 20%. for Tcl_UniCharToUtf call. These improve encoded channel conversion speeds by up to 20%. * tests/split.test: added 1-char string split tests * generic/tclCmdMZ.c (Tcl_SplitObjCmd): Use TclUtfToUniChar. Also added a special case for single-ascii-char splits. (Tcl_StringObjCmd): Use TclUtfToUniChar. For STR_RANGE, support getting ranges of ByteArrays (reverts * generic/tclCmdMZ.c (Tcl_SplitObjCmd): Use TclUtfToUniChar. Also added a special case for single-ascii-char splits. (Tcl_StringObjCmd): Use TclUtfToUniChar. For STR_RANGE, support getting ranges of ByteArrays (reverts change from 2000-05-26). change from 2000-05-26). (TraceExecutionProc) add proper static declaration. * generic/tclInt.h: add macro version of Tcl_UtfToUniChar (TclUtfToUniChar) that does the one-byte utf-char check without calling Tcl_UtfToUniChar, for use by the core. This brings notable speedups for primarily ascii string handling. calling Tcl_UtfToUniChar, for use by the core. This brings notable speedups for primarily ascii string handling. * generic/tcl.h (TCL_PATCH_LEVEL): bump to 8.4.1.1 for patchlevel only. This interim number will only be reflected by only. This interim number will only be reflected by [info patchlevel] [info patchlevel]. 2002-11-11 Kevin Kenny <kennykb@acm.org> * doc/Tcl.n: Corrected indentation of the new language. Oops. * doc/Tcl.n: Corrected indentation of the new language. Oops. 2002-11-10 Kevin Kenny <kennykb@acm.org> * doc/Tcl.n: Added language to the Endekalogue to make it clear that substitutions always take place from left to right. [Bug * doc/Tcl.n: Added language to the Endekalogue to make it clear that substitutions always take place from left to right. [Bug 635644] #635644] 2002-11-06 Mo DeJong <mdejong@users.sourceforge.net> * changes: Note TclInExit TclInThreadExit changes. * generic/tclEvent.c (TclInExit, TclInThreadExit): Split out functionality of TclInExit to make it clear which one should be called in each situation. Split out functionality of TclInExit to make it clear which one should be called in each situation. * generic/tclInt.decls: Declare TclInThreadExit. * generic/tclIntDecls.h: Regen. * generic/tclStubInit.c: Regen. * mac/tclMacChan.c (StdIOClose): * unix/tclUnixChan.c (FileCloseProc): * win/tclWinChan.c (FileCloseProc): * win/tclWinConsole.c (ConsoleCloseProc): * win/tclWinPipe.c (TclpCloseFile): * win/tclWinSerial.c (SerialCloseProc): Invoke the new TclInThreadExit method instead of TclInExit. * win/tclWinSerial.c (SerialCloseProc): Invoke the new TclInThreadExit method instead of TclInExit. 2002-11-06 Mo DeJong <mdejong@users.sourceforge.net> * unix/configure: Regen. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Generate a fatal configure error if no ar program can be found on the * unix/tcl.m4 (SC_CONFIG_CFLAGS): Generate a fatal configure error if no ar program can be found on the path. [Bug 582039] path. [Bug #582039] * win/configure: Regen. * win/configure.in: Check that AR, RANLIB, and RC are found on the path when building with gcc. * win/configure.in: Check that AR, RANLIB, and RC are found on the path when building with gcc. 2002-11-03 David Gravereaux <davygrvy@pobox.com> * win/tclAppInit.c: Calls Registry_Init() and Dde_Init() when STATIC_BUILD and TCL_USE_STATIC_PACKAGES macros are set. * win/makefile.vc: * win/rules.vc: linkexten option now sets the TCL_USE_STATIC_PACKAGES * win/rules.vc: linkexten option now sets the TCL_USE_STATIC_PACKAGES macro which also adds the registry and dde object files to the link of the shell. [Patch 479697] Also factored some additional macros that will be helpful for extension authors. Version grepping of tcl.h that will be helpful for extension authors. Version grepping of tcl.h will need to be added to complete this. * win/buildall.vc.bat: Added more descriptive commentary. 2002-11-01 David Gravereaux <davygrvy@pobox.com> * win/tclWinReg.c: Changed the Tcl_PkgProvide() line to declare the registry extension at version 1.1 from 1.0. * win/tclWinReg.c: Changed the Tcl_PkgProvide() line to declare the registry extension at version 1.1 from 1.0. 2002-10-31 Andreas Kupries <andreask@activestate.com> * library/word.tcl: Changed $tcl_platform to $::tcl_platform to avoid possible scope trouble. * library/word.tcl: Changed $tcl_platform to $::tcl_platform to avoid possible scope trouble. 2002-10-29 Vince Darley <vincentdarley@users.sourceforge.net> * win/tclWinInt.h: * win/tclWin32Dll.c: added comments about certain NULL function pointers which will be filled in when Tcl_FindExecutable is called, so that users don't report invalid bugs on this topic. (No code changes at all). pointers which will be filled in when Tcl_FindExecutable is called, so that users don't report invalid bugs on this topic. (No code changes at all). 2002-10-29 Daniel Steffen <das@users.sourceforge.net> * unix/tclLoadDyld.c (TclpFindSymbol): pass all dyld error messages upstream [Bug #627546]. * unix/tclLoadDyld.c (TclpFindSymbol): pass all dyld error messages upstream [Bug 627546]. 2002-10-28 Andreas Kupries <andreask@activestate.com> * library/dde/pkgIndex.tcl: * library/reg/pkgIndex.tcl: Changed the hardwired debug suffix (d) to the correct suffix (g). * library/reg/pkgIndex.tcl: Changed the hardwired debug suffix (d) to the correct suffix (g). 2002-10-28 Don Porter <dgp@users.sourceforge.net> * library/auto.tcl: Converted the Mac-specific [package unknown] * library/init.tcl: behavior to use a chaining mechanism to extend * library/package.tcl: the default [tclPkgUnknown]. [Bug 627660] * library/package.tcl: the default [tclPkgUnknown]. [Bug 627660] * library/tclIndex: [Patch 624509] (steffen) 2002-10-26 David Gravereaux <davygrvy@pobox.com> * win/makefile.vc: xcopy on NT 4.0 doesn't support the /Y switch (overwrite). Added logic to handle this. [Bug 618019] (overwrite). Added logic to handle this. [Bug 618019] 2002-10-23 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tclInt.h: Removed definitions of obsolete HistoryEvent and HistoryRev structures (the history mechanism has been written in Tcl for some time now.) * generic/tclInt.h: Removed definitions of obsolete HistoryEvent and HistoryRev structures (the history mechanism has been written in Tcl for some time now). 2002-10-22 Jeff Hobbs <jeffh@ActiveState.com> *** 8.4.1 TAGGED FOR RELEASE *** * changes: updated for 8.4.1 release * win/Makefile.in: removed @MEM_DEBUG_FLAGS@ subst. * win/configure: regen * win/configure.in: removed SC_ENABLE_MEMDEBUG call * win/tcl.m4: replaced SC_ENABLE_MEMDEBUG with a more intelligent SC_ENABLE_SYMBOLS that takes yes|no|mem|compile|all as options now. 2002-10-22 Daniel Steffen <das@users.sourceforge.net> * library/auto.tcl (tcl_findLibrary): * library/package.tcl (tclPkgUnknown): on macosx, search inside the Resources/Scripts subdirectory of any potential package directory * macosx/Tcl.pbproj/project.pbxproj: add standard Frameworks dirs to TCL_PACKAGE_PATH make argument. * macosx/Tcl.pbproj/project.pbxproj: add standard Frameworks dirs to TCL_PACKAGE_PATH make argument. * unix/tclUnixInit.c (TclpSetVariables): on macosx, add embedded framework dirs to tcl_pkgPath: @executable_path/../Frameworks and @executable_path/../PrivateFrameworks (if they exist), as well as the dirs in DYLD_FRAMEWORK_PATH (if set). [Patch #624509] use standard MAXPATHLEN instead of literal 1024 @executable_path/../PrivateFrameworks (if they exist), as well as the dirs in DYLD_FRAMEWORK_PATH (if set). [Patch 624509] use standard MAXPATHLEN instead of literal 1024 2002-10-22 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/StringObj.3, doc/Object.3: Documented that Tcl_Obj's standard string form is a modified UTF-8; apparently, this was not mentioned anywhere in the main docs, and lead to [Bug 624919].
︙
1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 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 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682	6011 6012 6013 6014 6015 6016 6017 6018 6019 6020 6021 6022 6023 6024 6025 6026 6027 6028 6029 6030 6031 6032 6033 6034 6035 6036 6037 6038 6039 6040 6041 6042 6043 6044 6045 6046 6047 6048 6049 6050 6051 6052 6053 6054 6055 6056 6057 6058 6059 6060 6061 6062 6063 6064 6065 6066 6067 6068 6069 6070 6071 6072 6073 6074 6075 6076 6077 6078 6079 6080 6081 6082 6083 6084 6085 6086 6087 6088 6089 6090 6091 6092 6093 6094 6095 6096 6097 6098 6099 6100 6101 6102 6103 6104 6105 6106 6107 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 6118 6119 6120 6121 6122 6123 6124 6125 6126 6127 6128 6129 6130 6131 6132 6133 6134 6135 6136 6137 6138 6139 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 6157 6158 6159 6160 6161 6162 6163 6164 6165 6166 6167 6168 6169 6170 6171 6172 6173 6174 6175 6176 6177 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 6215 6216 6217 6218 6219 6220 6221 6222 6223 6224 6225 6226 6227 6228 6229 6230 6231 6232 6233 6234 6235 6236 6237 6238 6239 6240 6241 6242 6243 6244 6245 6246 6247 6248 6249 6250 6251 6252 6253 6254 6255 6256 6257 6258 6259 6260 6261 6262 6263 6264 6265 6266 6267 6268 6269 6270 6271 6272 6273 6274 6275 6276 6277 6278 6279 6280 6281 6282 6283 6284 6285 6286 6287 6288 6289 6290 6291 6292 6293 6294 6295 6296 6297 6298 6299 6300 6301 6302 6303 6304 6305 6306 6307 6308 6309 6310 6311 6312 6313 6314 6315 6316 6317 6318 6319 6320 6321 6322 6323 6324 6325 6326 6327 6328 6329 6330 6331 6332 6333 6334 6335 6336 6337 6338 6339 6340 6341 6342 6343 6344	- - - + + + - + - - + + - - + + - - + + - + - + - + - - - + + + - - - - + + + - - - - - - + + + + + - - + + - + - + - - + + - - - - - + + + + + - - + + - - + + - - - + + + - - + + - - + + - - - + + + - - + + - - + + - - + + - - - + + + - - - - - + + + + + - - - + + - - + + - - - + + + - - - - - - + + + + + + - - + + - - + - - + + - - - - + + + + - - + + - - + - - + + - - - + + + - - + + - - - + + - +	* library/reg/pkgIndex.tcl: * win/configure: * win/configure.in: * win/Makefile.in: * win/makefile.vc: * win/makefile.bc: Updated to reg1.1 * doc/registry.n: Added support for broadcasting changes to * tests/registry.test: the registry Environment. Noted proper code * win/tclWinReg.c: in the docs. [Patch #625453] * doc/registry.n: Added support for broadcasting changes to the * tests/registry.test: registry Environment. Noted proper code in ths * win/tclWinReg.c: docs. [Patch 625453] * unix/Makefile.in (dist): add any mac/tcl*.sea.hqx files 2002-10-17 Don Porter <dgp@users.sourceforge.net> * generic/tclVar.c: Fixed code that check for proper # of args to * tests/var.test: [array names]. Added test. [Bug 624755] * tests/var.test: [array names]. Added test. [Bug 624755] 2002-10-16 Jeff Hobbs <jeffh@ActiveState.com> * win/configure: add workaround for cygwin windres * win/tcl.m4 (SC_CONFIG_CFLAGS): problem. [Patch #624010] (howell) * win/configure: add workaround for cygwin windres * win/tcl.m4 (SC_CONFIG_CFLAGS): problem. [Patch 624010] (howell) 2002-10-15 Jeff Hobbs <jeffh@ActiveState.com> * README: added archives.tcl.tk note * unix/configure: * unix/tcl.m4: Correct AIX-5 ppc build flags. Correct HP 11 64-bit gcc building. [Patch #601051] (martin) * unix/tcl.m4: Correct AIX-5 ppc build flags. Correct HP 11 64-bit gcc building. [Patch 601051] (martin) 2002-10-15 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclCmdMZ.c: * tests/trace.test: applied patch from Hemang Levana to fix [Bug #615043] in execution traces with idle tasks firing. * tests/trace.test: applied patch from Hemang Levana to fix [Bug 615043] in execution traces with idle tasks firing. 2002-10-14 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclEnv.c (Tcl_PutEnv): correct possible mem leak. [Patch #623269] (brouwers) [Patch 623269] (brouwers) 2002-10-11 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tcl.h: Need a different strategy through the maze of #defines to let people building with Cygwin build correctly. Also made some comments less misleading... 2002-10-10 Jeff Hobbs <jeffh@ActiveState.com> * README: fixed minor nits [Bug #607776] (virden) * README: fixed minor nits [Bug 607776] (virden) * win/configure: * win/tcl.m4: enable USE_THREAD_ALLOC (new threaded allocator) by default in cygwin configure on Windows. 2002-10-10 Don Porter <dgp@users.sourceforge.net> * doc/Tcl.n: Clarified that namespace separators are legal in the variable names during $-subtitution. [Bug 615139] * doc/regexp.n: Typo correction. Thanks Ronnie Brunner. [Bug 606826] 2002-10-10 Vince Darley <vincentdarley@users.sourceforge.net> * unix/tclLoadAout.c * unix/tclLoadDl.c * unix/tclLoadDld.c * unix/tclLoadDyld.c * unix/tclLoadNext.c * unix/tclLoadOSF.c * unix/tclLoadShl.c * win/tclWinLoad.c: allow either full paths or simply dll names to be specified when loading files (the latter will be looked up by the OS on your PATH/LD_LIBRARY_PATH as appropriate). * win/tclWinLoad.c: allow either full paths or simply dll names to be specified when loading files (the latter will be looked up by the OS on your PATH/LD_LIBRARY_PATH as appropriate). Fixes [Bug 611108] Fixes [Bug 611108] 2002-10-09 Jeff Hobbs <jeffh@ActiveState.com> * unix/README: doc'ed --enable-symbols options. * unix/Makefile.in: removed @MEM_DEBUG_FLAGS@ subst. * unix/configure: regen * unix/configure.in: removed SC_ENABLE_MEMDEBUG call * unix/tcl.m4: replaced SC_ENABLE_MEMDEBUG with a more intelligent SC_ENABLE_SYMBOLS that takes yes|no|mem|compile|all as options now. 2002-10-09 Kevin B. Kenny <kennykb@acm.org> * win/tclWinTime.c: Added code to set an exit handler that terminates the thread that calibrates the performance counter, so that the thread won't outlive unloading the Tcl DLL. [Tcl bug * win/tclWinTime.c: Added code to set an exit handler that terminates the thread that calibrates the performance counter, so that the thread won't outlive unloading the Tcl DLL. [Bug 620735]. 620735]. 2002-10-09 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/binary.n: More clarification of [binary scan]'s behaviour. 2002-10-09 Daniel Steffen <das@users.sourceforge.net> * generic/tclIntDecls.h: fixed botched regen. 2002-10-09 Daniel Steffen <das@users.sourceforge.net> * generic/tclInt.decls: made TclSetPreInitScript() declaration generic as it is used on mac & aqua as well. * generic/tclIntDecls.h: * generic/tclStubInit.c: regen. * generic/tclCompile.h: added prototype for TclCompileVariableCmd. * mac/tclMacPort.h: removed incorrect <fcntl.h> definitions and obsolete <stat.h> definitions. * mac/tclMacChan.c: removed obsolete GetOpenMode() and replaced associated constants with the <fcntl.h> analogues (they existing defs were inconsistent with <fcntl.h> which was causing havoc when * mac/tclMacPort.h: removed incorrect <fcntl.h> definitions and obsolete <stat.h> definitions. * mac/tclMacChan.c: removed obsolete GetOpenMode() and replaced associated constants with the <fcntl.h> analogues (they existing defs were inconsistent with <fcntl.h> which was causing havoc when Tcl_GetOpenMode was used instead of private GetOpenMode). * mac/tclMacFCmd.c: removed GenerateUniqueName(), use equivalent (and identically named) routine from MoreFiles instead. * mac/tclMacFCmd.c: removed GenerateUniqueName(), use equivalent (and identically named) routine from MoreFiles instead. * mac/tclMacLoad.c: CONSTification, fixes to Vince's last changes. * mac/tclMacFile.c: * mac/tclMacFile.c: * mac/tclMacTest.c: * mac/tclMacUnix.c: CONSTification. * mac/tclMacOSA.c: CONSTification, sprintf fixes, UH 3.4.x changes; fix for missing autoname token from TclOSACompileCmd. (bdesgraupes) * mac/AppleScript.html(AppleScript delete): doc fix. (bdesgraupes) * mac/tcltkMacBuildSupport.sea.hqx: updated MoreFiles to 1.5.3, * mac/tcltkMacBuildSupport.sea.hqx: updated MoreFiles to 1.5.3, updated build instructions for 8.4. * mac/tclMacProjects.sea.hqx: rebuilt archive. 2002-10-09 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/Alloc.3: Added a note to mention that attempting to allocate a zero-length block can return NULL. [Tk bug 619544] * doc/Alloc.3: Added a note to mention that attempting to allocate a zero-length block can return NULL. [Tk Bug 619544] 2002-10-04 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/binary.n: Doc improvements [Patch 616480] * tests/fCmd.test, tests/winFCmd.test: * tools/eolFix.tcl, tools/genStubs.tcl: [file exist] -> [file exists] Thanks to David Welton. 2002-10-03 Don Porter <dgp@users.sourceforge.net> * doc/tcltest.n: fixed typo [Bug 618018]. Thanks to "JJM". 2002-10-03 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tools/man2help2.tcl: * tests/http.test, tests/httpd, tests/httpold.test: * tests/env.test, tests/binary.test, tests/autoMkindex.test: * library/init.tcl, library/http/http.tcl: [info exist] should really be [info exists]. [Bug 602566] * tools/man2help2.tcl: * tests/http.test, tests/httpd, tests/httpold.test: * tests/env.test, tests/binary.test, tests/autoMkindex.test: * library/init.tcl, library/http/http.tcl: [info exist] should really be [info exists]. [Bug 602566] * doc/lsearch.n: Better specification of what happens when -sorted is mixed with other options. [Bug 617816] * doc/lsearch.n: Better specification of what happens when -sorted is mixed with other options. [Bug 617816] 2002-10-01 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclProc.c (TclCreateProc): mask out VAR_UNDEFINED for precompiled locals to support 8.3 precompiled code. (Tcl_ProcObjCmd): correct 2002-09-26 fix to look for tclProcBodyType. 2002-10-01 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/socket.n: Mentioned that ports may be specified as serivce names as well as integers. [Bug 616843] * doc/socket.n: Mentioned that ports may be specified as serivce names as well as integers. [Bug 616843] 2002-09-30 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclCompCmds.c (TclCompileRegexpCmd): correct the checking for bad re's that didn't terminate the re string. Resultant compiles were correct, but much slower than necessary. * generic/tclCompCmds.c (TclCompileRegexpCmd): correct the checking for bad re's that didn't terminate the re string. Resultant compiles were correct, but much slower than necessary. 2002-09-29 David Gravereaux <davygrvy@pobox.com> * win/tclAppInit.c: Added proper exiting conditions using Win32 console signals. This handles the existing lack of a Ctrl+C exit to call exit handlers when built for thread support. Also, properly console signals. This handles the existing lack of a Ctrl+C exit to call exit handlers when built for thread support. Also, properly handles exits from other conditions such as CTRL_CLOSE_EVENT, CTRL_LOGOFF_EVENT, and CTRL_SHUTDOWN_EVENT signals. In all cases, exit handlers will be called. [Bug 219355] CTRL_LOGOFF_EVENT, and CTRL_SHUTDOWN_EVENT signals. In all cases, exit handlers will be called. [Bug 219355] * win/makefile.vc: Added missing tclThreadAlloc.c to the build rules and defines USE_THREAD_ALLOC when TCL_THREADS is defined to get the new behavior by default. * win/makefile.vc: Added missing tclThreadAlloc.c to the build rules and defines USE_THREAD_ALLOC when TCL_THREADS is defined to get the new behavior by default. 2002-09-27 Don Porter <dgp@users.sourceforge.net> * README: Bumped to version 8.4.1 to avoid confusion * generic/tcl.h: of CVS snapshots with the actual 8.4.0 * tools/tcl.wse.in: release. * unix/configure.in: * unix/tcl.spec: * win/configure.in: * unix/configure: autoconf * win/configure: 2002-09-26 Jeff Hobbs <jeffh@ActiveState.com> * unix/configure: regen. * unix/tcl.m4: improve AIX-4/5 64bit compilation support. * generic/tclProc.c (Tcl_ProcObjCmd): correct overeager optimization of noop proc to handle the precompiled case. (sofer) * generic/tclProc.c (Tcl_ProcObjCmd): correct overeager optimization of noop proc to handle the precompiled case. (sofer) * unix/ldAix (nmopts): add -X32_64 to make it work for 32 or 64bit mode compilation. * library/encoding/koi8-u.enc: removed extraneous spaces that confused encoding reader. [Bug #615115] * library/encoding/koi8-u.enc: removed extraneous spaces that confused encoding reader. [Bug 615115] * unix/Makefile.in: generate source dists with -src designator and do not generate .Z anymore (just .gz and .zip). * unix/Makefile.in: generate source dists with -src designator and do not generate .Z anymore (just .gz and .zip). 2002-09-18 Mumit Khan <khan@nanotech.wisc.edu> Added basic Cygwin support. * win/tcl.m4 (SC_PATH_TCLCONFIG): Support one-tree build. (SC_PATH_TKCONFIG): Likewise. (SC_PROG_TCLSH): Likewise. (SC_CONFIG_CFLAGS): Assume real Cygwin port and remove -mno-cygwin flags. Add -mwin32 to extra_cflags and extra_ldflags. Remove ``-e _WinMain@16'' from LDFLAGS_WINDOW. (SC_CONFIG_CFLAGS): Assume real Cygwin port and remove -mno-cygwin flags. Add -mwin32 to extra_cflags and extra_ldflags. Remove ``-e _WinMain@16'' from LDFLAGS_WINDOW. * win/configure.in: Allow Cygwin build. (SEH test): Define to be 1 instead of empty value. (EXCEPTION_DISPOSITION): Add test. * win/configure: Regenerate. * generic/tcl.h: Don't explicitly define __WIN32__ for Cygwin, let the user decide whether to use Windows or POSIX personality. (TCL_WIDE_INT_TYPE, TCL_LL_MODIFIER, struct Tcl_StatBuf): Define for Cygwin. * generic/tclEnv.c (Tcl_CygwinPutenv): putenv replacement for * generic/tcl.h: Don't explicitly define __WIN32__ for Cygwin, let the user decide whether to use Windows or POSIX personality. (TCL_WIDE_INT_TYPE, TCL_LL_MODIFIER, struct Tcl_StatBuf): Define for Cygwin. * generic/tclEnv.c (Tcl_CygwinPutenv): putenv replacement for Cygwin. Cygwin. * generic/tclFileName.c (Tcl_TranslateFileName): Convert POSIX to native format. * generic/tclFileName.c (Tcl_TranslateFileName): Convert POSIX to native format. (TclDoGlob): Likewise. * generic/tclPlatDecls.h (TCHAR): Define for Cygwin. * win/tclWinPort.h (putenv, TclpSysAlloc, TclpSysFree, TclpSysRealloc): Define for Cygwin. * win/tclWinPort.h (putenv, TclpSysAlloc, TclpSysFree) (TclpSysRealloc): Define for Cygwin. 2002-09-26 Daniel Steffen <das@users.sourceforge.net> * macosx/Makefile: preserve environment value of INSTALL_ROOT. When embedding only use deployment build. Force relink before embedded build to ensure new linker flags are picked up. * macosx/Makefile: preserve environment value of INSTALL_ROOT. When embedding only use deployment build. Force relink before embedded build to ensure new linker flags are picked up. * macosx/Tcl.pbproj/project.pbxproj: add symbolic links to debug lib, stub libs and tclConfig.sh in framework toplevel. Configure target dependency fix. Fix to 'clean' action. Added private tcl headers to framework. Install tclsh symbolic link. Html doc build works when no installed tclsh available. Made html doc structure in framework more like in Apple frameworks. * macosx/Tcl.pbproj/project.pbxproj: add symbolic links to debug lib, stub libs and tclConfig.sh in framework toplevel. Configure target dependency fix. Fix to 'clean' action. Added private tcl headers to framework. Install tclsh symbolic link. Html doc build works when no installed tclsh available. Made html doc structure in framework more like in Apple frameworks. 2002-09-24 Donal K. Fellows <fellowsd@cs.man.ac.uk> * unix/tcl.m4 (SC_TCL_64BIT_FLAGS): Yet more robust 64-bit value detection to close [Bug 613117] on more systems. * generic/tclCompile.c (TclPrintSource): More CONSTifying. * generic/tclExecute.c (EvalStatsCmd): Object-ify to reduce warnings. Thanks to 'CoderX2' on the chat for bringing this to my * generic/tclExecute.c (EvalStatsCmd): Object-ify to reduce warnings. Thanks to 'CoderX2' on the chat for bringing this to my attention... attention... * unix/tcl.m4: Forgot to define TCL_WIDE_INT_IS_LONG at the appropriate moment. I believe this is the cause of [Bug 613117] appropriate moment. I believe this is the cause of [Bug 613117] * doc/lset.n: Changed 'list' to 'varName' for consistency with lappend documentation. Thanks to Glenn Jackman [Bug 611719] * doc/lset.n: Changed 'list' to 'varName' for consistency with lappend documentation. Thanks to Glenn Jackman [Bug 611719] 2002-09-22 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: Corrected [puts -nonewline] within test bodies. Thanks to Harald Kirsch. [Bug 612786, Patch 612788] Also corrected reporting of body return code. Thanks to David Taback [Bug 611922] * library/tcltest/tcltest.tcl: Corrected [puts -nonewline] within test bodies. Thanks to Harald Kirsch. [Bug 612786, Patch 612788] Also corrected reporting of body return code. Thanks to David Taback [Bug 611922] * library/tcltest/pkgIndex.tcl: Bump to version 2.2.1. * tests/tcltest.test: added tests for these bugs. 2002-09-15 Mo DeJong <mdejong@users.sourceforge.net> * unix/configure: Regen. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Add PEEK_XCLOSEIM define under Linux. This is used by Tk to double * unix/tcl.m4 (SC_CONFIG_CFLAGS): Add PEEK_XCLOSEIM define under Linux. This is used by Tk to double check that an X input context is check that an X input context is cleaned up before it is closed. cleaned up before it is closed. 2002-09-12 David Gravereaux <davygrvy@pobox.com> * win/coffbase.txt: Added BLT to the virtual base address listings table should BLT's build tools decide to use it. * win/coffbase.txt: Added BLT to the virtual base address listings table should BLT's build tools decide to use it. 2002-09-12 Daniel Steffen <das@users.sourceforge.net> * generic/tcl.h: * mac/tclMacApplication.r: * mac/tclMacLibrary.r: * mac/tclMacResource.r: unified use of the two equivalent resource compiler header inclusion defines RC_INVOKED and RESOURCE_INCLUDED, now use RC_INVOKED throughout. * mac/tclMacResource.r: unified use of the two equivalent resource compiler header inclusion defines RC_INVOKED and RESOURCE_INCLUDED, now use RC_INVOKED throughout. 2002-09-10 Mo DeJong <mdejong@users.sourceforge.net> * unix/README: Add note about building extensions with the same compiler Tcl was built with. * unix/README: Add note about building extensions with the same compiler Tcl was built with. [Tk Bug 592096] [Tk Bug 592096] 2002-09-10 Daniel Steffen <das@users.sourceforge.net> * macosx/Tcl.pbproj/project.pbxproj: disabled building html documentation during embedded build. 2002-09-10 Daniel Steffen <das@users.sourceforge.net> * unix/Makefile.in: added DYLIB_INSTALL_DIR variable for macosx and set it to default value ${LIB_RUNTIME_DIR} * unix/Makefile.in: added DYLIB_INSTALL_DIR variable for macosx and set it to default value ${LIB_RUNTIME_DIR} * unix/tcl.m4 (Darwin): use DYLIB_INSTALL_DIR instead of LIB_RUNTIME_DIR in the -install_name argument to ld. * unix/configure: regen. * macosx/Tcl.pbproj/project.pbxproj: * macosx/Makefile: added support for building Tcl as an embedded framework, i.e. using an dyld install_name containing @executable_path/../Frameworks via the new DYLIB_INSTALL_DIR unix/Makefile variable. 2002-09-10 Jeff Hobbs <jeffh@ActiveState.com> *** 8.4.0 TAGGED FOR RELEASE *** 2002-09-06 Don Porter <dgp@users.sourceforge.net> * doc/file.n: Format correction, and clarified [file normalize]
︙
1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 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 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 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 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 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 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 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 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627	6352 6353 6354 6355 6356 6357 6358 6359 6360 6361 6362 6363 6364 6365 6366 6367 6368 6369 6370 6371 6372 6373 6374 6375 6376 6377 6378 6379 6380 6381 6382 6383 6384 6385 6386 6387 6388 6389 6390 6391 6392 6393 6394 6395 6396 6397 6398 6399 6400 6401 6402 6403 6404 6405 6406 6407 6408 6409 6410 6411 6412 6413 6414 6415 6416 6417 6418 6419 6420 6421 6422 6423 6424 6425 6426 6427 6428 6429 6430 6431 6432 6433 6434 6435 6436 6437 6438 6439 6440 6441 6442 6443 6444 6445 6446 6447 6448 6449 6450 6451 6452 6453 6454 6455 6456 6457 6458 6459 6460 6461 6462 6463 6464 6465 6466 6467 6468 6469 6470 6471 6472 6473 6474 6475 6476 6477 6478 6479 6480 6481 6482 6483 6484 6485 6486 6487 6488 6489 6490 6491 6492 6493 6494 6495 6496 6497 6498 6499 6500 6501 6502 6503 6504 6505 6506 6507 6508 6509 6510 6511 6512 6513 6514 6515 6516 6517 6518 6519 6520 6521 6522 6523 6524 6525 6526 6527 6528 6529 6530 6531 6532 6533 6534 6535 6536 6537 6538 6539 6540 6541 6542 6543 6544 6545 6546 6547 6548 6549 6550 6551 6552 6553 6554 6555 6556 6557 6558 6559 6560 6561 6562 6563 6564 6565 6566 6567 6568 6569 6570 6571 6572 6573 6574 6575 6576 6577 6578 6579 6580 6581 6582 6583 6584 6585 6586 6587 6588 6589 6590 6591 6592 6593 6594 6595 6596 6597 6598 6599 6600 6601 6602 6603 6604 6605 6606 6607 6608 6609 6610 6611 6612 6613 6614 6615 6616 6617 6618 6619 6620 6621 6622 6623 6624 6625 6626 6627 6628 6629 6630 6631 6632 6633 6634 6635 6636 6637 6638 6639 6640 6641 6642 6643 6644 6645 6646 6647 6648 6649 6650 6651 6652 6653 6654 6655 6656 6657 6658 6659 6660 6661 6662 6663 6664 6665 6666 6667 6668 6669 6670 6671 6672 6673 6674 6675 6676 6677 6678 6679 6680 6681 6682 6683 6684 6685 6686 6687 6688 6689 6690 6691 6692 6693 6694 6695 6696 6697 6698 6699 6700 6701 6702 6703 6704 6705 6706 6707 6708 6709 6710 6711 6712 6713 6714 6715 6716 6717 6718 6719 6720 6721 6722 6723 6724 6725 6726 6727 6728 6729 6730 6731 6732 6733 6734 6735 6736 6737 6738 6739 6740 6741 6742 6743 6744 6745 6746 6747 6748 6749 6750 6751 6752 6753 6754 6755 6756 6757 6758 6759 6760 6761 6762 6763 6764 6765 6766 6767 6768 6769 6770 6771 6772 6773 6774 6775 6776 6777 6778 6779 6780 6781 6782 6783 6784 6785 6786 6787 6788 6789 6790 6791 6792 6793 6794 6795 6796 6797 6798 6799 6800 6801 6802 6803 6804 6805 6806 6807 6808 6809 6810 6811 6812 6813 6814 6815 6816 6817 6818 6819 6820 6821 6822 6823 6824 6825 6826 6827 6828 6829 6830 6831 6832 6833 6834 6835 6836 6837 6838 6839 6840 6841 6842 6843 6844 6845 6846 6847 6848 6849 6850 6851 6852 6853 6854 6855 6856 6857 6858 6859 6860 6861 6862 6863 6864 6865 6866 6867 6868 6869 6870 6871 6872 6873 6874 6875 6876 6877 6878 6879 6880 6881 6882 6883 6884 6885 6886 6887 6888 6889 6890 6891 6892 6893 6894 6895 6896 6897 6898 6899 6900 6901 6902 6903 6904 6905 6906 6907 6908 6909 6910 6911 6912 6913 6914 6915 6916 6917 6918 6919 6920 6921 6922 6923 6924 6925 6926 6927 6928 6929 6930 6931 6932 6933 6934 6935 6936 6937 6938 6939 6940 6941 6942 6943 6944 6945 6946 6947 6948 6949 6950 6951 6952 6953 6954 6955 6956 6957 6958 6959 6960 6961 6962 6963 6964 6965 6966 6967 6968 6969 6970 6971 6972 6973 6974 6975 6976 6977 6978 6979 6980 6981 6982 6983 6984 6985 6986 6987 6988 6989 6990 6991 6992 6993 6994 6995 6996 6997 6998 6999 7000 7001 7002 7003 7004 7005 7006 7007 7008 7009 7010 7011 7012 7013 7014 7015 7016 7017 7018 7019 7020 7021 7022 7023 7024 7025 7026 7027 7028 7029 7030 7031 7032 7033 7034 7035 7036 7037 7038 7039 7040 7041 7042 7043 7044 7045 7046 7047 7048 7049 7050 7051 7052 7053 7054 7055 7056 7057 7058 7059 7060 7061 7062 7063 7064 7065 7066 7067 7068 7069 7070 7071 7072 7073 7074 7075 7076 7077 7078 7079 7080 7081 7082 7083 7084 7085 7086 7087 7088 7089 7090 7091 7092 7093 7094 7095 7096 7097 7098 7099 7100 7101 7102 7103 7104 7105 7106 7107 7108 7109 7110 7111 7112 7113 7114 7115 7116 7117 7118 7119 7120 7121 7122 7123 7124 7125 7126 7127 7128 7129 7130 7131 7132 7133 7134 7135 7136 7137 7138 7139 7140 7141 7142 7143 7144 7145 7146 7147 7148 7149 7150 7151 7152 7153 7154 7155 7156 7157 7158 7159 7160 7161 7162 7163 7164 7165 7166 7167 7168 7169 7170 7171 7172 7173 7174 7175 7176 7177 7178 7179 7180 7181 7182 7183 7184 7185 7186 7187 7188 7189 7190 7191 7192 7193 7194 7195 7196 7197 7198 7199 7200 7201 7202 7203 7204 7205 7206 7207 7208 7209 7210 7211 7212 7213 7214 7215 7216 7217 7218 7219 7220 7221 7222 7223 7224 7225 7226 7227 7228 7229 7230 7231 7232 7233 7234 7235 7236 7237 7238 7239 7240 7241 7242 7243 7244 7245 7246 7247 7248 7249 7250 7251 7252 7253 7254 7255 7256 7257 7258 7259 7260 7261 7262 7263 7264 7265 7266 7267	- - + + - - + + - + - + - - + + - - + + - + - - + + - - - + + + - + - - - - - + + + + + - - - - - + + + + - - - - + + + + - - - + + + - - - + + + - - - - - - - - - + + + + + + + + + - - + + - - + + - + - - - - - - + + + + + - - - - + + + - - - + + + - - - + + + - - + + - - + + - - + + - + - - + + - + - - + + - - - - - + + + - - + + - - - + + + - + - + - - + + - + - - - + + + - - - + + - - + + - + - + - - + - + - - + + - - - - + + + - + - + - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - + - - - - - + + + + - - + + - - + + - - - + + + - + - - - - + + + + - - - + + - - - - + + + + - - - - - - + + + + + - - - - + + + + - - - - - - - - - + + + + + + + + + - - + + - + - - - - + + + + - - - - + + + + - + - - - + + - - - + + - - + - + - - - + + - - + - - - - - + + + + - - - + + + - + - - - + + - + - + + - - + + - - + + - - - - + + + + - - + + - - + + - - + + - - - + + - - - + + + - - - + + + - - - - - - - - + + + + + + + + - - + + - - + + - - + - - + + - + - + - + - + - - + + - - + + - + - - + + - + - - - - + + + + - - + + - - - - + + + - - + + - - - + + + - - - - + + + + - - - + + + - + - - + + - - + + - - - + + + - + - - + + - + - - - - - + + + + - + - - - - - - + + + + + + - - - - - + + + + - - - + + + - - + + - - + + - - - - + + + + - + - - - - + + + + - - - - - + + + + + - - - + + + - - - - + + + + - + - - + + - +	2002-09-05 Don Porter <dgp@users.sourceforge.net> * doc/tcltest.n: Clarified phrasing. * generic/tclBasic.c (TclRenameCommand,CallCommandTraces): * tests/trace.test (trace-27.1): Corrected memory leak when a rename trace deleted the command being traced. Test added. Thanks to Hemang Lavana for the fix. [Bug 604609] trace deleted the command being traced. Test added. Thanks to Hemang Lavana for the fix. [Bug 604609] * generic/tclVar.c (TclDeleteVars): Corrected logic for setting the TCL_INTERP_DESTROYED flag when calling variable traces. [Tk Bug 605121] 2002-09-04 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclVar.c (DeleteArray): leak plug [Bug 604239]. Thanks to dkf and dgp for the long and difficult discussion in the chat. * generic/tclVar.c (DeleteArray): leak plug [Bug 604239]. Thanks to dkf and dgp for the long and difficult discussion in the chat. 2002-09-03 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclVar.c (Tcl_UpVar2): code cleanup to not use goto * unix/configure: remove -pthread from LIBS on FreeBSD in thread * unix/tcl.m4: enabled build. [Bug #602849] * unix/tcl.m4: enabled build. [Bug 602849] 2002-09-03 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclInterp.c (AliasCreate): a Tcl_Obj was leaked on error return from TclPreventAliasLoop. 2002-09-03 Daniel Steffen <das@users.sourceforge.net> * macosx/Tcl.pbproj/project.pbxproj: Bumped version number to 8.4.0 and updated copyright info. * macosx/Tcl.pbproj/project.pbxproj: Bumped version number to 8.4.0 and updated copyright info. 2002-09-03 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclVar.c (Tcl_UpVar2): a Tcl_Obj was being leaked on error return from TclGetFrame. * generic/tclVar.c (Tcl_UpVar2): a Tcl_Obj was being leaked on error return from TclGetFrame. 2002-09-03 Don Porter <dgp@users.sourceforge.net> * changes: Updated changes for 8.4.0 release. 2002-09-02 Jeff Hobbs <jeffh@ActiveState.com> * unix/tclUnixFile.c (TclpObjLink): removed unnecessary/unfreed extra native char*. * unix/tclUnixChan.c (Tcl_MakeTcpClientChannel): make sure to init flags field of TcpState ptr to 0. * unix/configure: * unix/tcl.m4: added 64-bit gcc compilation support on HP-11. [Patch #601051] (martin) [Patch 601051] (martin) * README: Bumped version number to 8.4.0 * generic/tcl.h: * tools/tcl.wse.in: * unix/configure: * unix/configure.in: * unix/tcl.spec: * win/README.binary: * win/configure: * win/configure.in: * generic/tclInterp.c (SlaveCreate): make sure that the memory and checkmem commands are initialized in non-safe slave interpreters when TCL_MEM_DEBUG is used. [Bug #583445] checkmem commands are initialized in non-safe slave interpreters when TCL_MEM_DEBUG is used. [Bug 583445] * win/tclWinConsole.c (ConsoleCloseProc): only wait on writable pipe if there was something to write. This may prevent infinite wait on exit. * win/tclWinConsole.c (ConsoleCloseProc): only wait on writable pipe if there was something to write. This may prevent infinite wait on exit. * tests/exec.test: marked exec-18.1 unixOnly until the Windows incompatability (in the test, not the core) can be resolved. * tests/http.test (http-3.11): added close $fp that was causing an error on Windows because the file was not closed before deleting. * unix/tclUnixInit.c (Tcl_MacOSXGetLibraryPath): made this static function only appear when HAVE_CFBUNDLE is defined. 2002-08-31 Daniel Steffen <das@users.sourceforge.net> * unix/tcl.m4: added TK_SHLIB_LD_EXTRAS analogue of existing TCL_SHLIB_LD_EXTRAS for linker settings only used when linking Tk. * unix/configure: regen 2002-08-31 Daniel Steffen <das@users.sourceforge.net> *** macosx-8-4-branch merged into the mainline [tcl patch #602770] *** *** macosx-8-4-branch merged into the mainline [Patch 602770] *** * generic/tcl.decls: added new macosx specific entry to stubs table. * tools/genStubs.tcl: added generation of platform guards for macosx. This is a little more complex than it seems, because MacOS X IS "unix" plus a little bit, for the purposes of Tcl. BUT unfortunately, Tk uses "unix" to mean X11. So added platform keys for macosx (the little added to "unix"), "aqua" and "x11" to * tools/genStubs.tcl: added generation of platform guards for macosx. This is a little more complex than it seems, because MacOS X IS "unix" plus a little bit, for the purposes of Tcl. BUT unfortunately, Tk uses "unix" to mean X11. So added platform keys for macosx (the little added to "unix"), "aqua" and "x11" to distinguish these for Tk. distinguish these for Tk. * generic/tcl.h: added a #ifnded RESOURCE_INCLUDED so that tcl.h can be passed to the resource compiler. * generic/tcl.h: added a #ifnded RESOURCE_INCLUDED so that tcl.h can be passed to the resource compiler. * generic/tcl.h: * generic/tclNotify.c: added a few Notifier procs, to be able to modify more bits of the Tcl notifier dynamically. Required to get Mac OS X Tk to live on top of the Tcl Unix threaded notifier. Changes the size of the Tcl_NotifierProcs structure, but doesn't move any elements around. modify more bits of the Tcl notifier dynamically. Required to get Mac OS X Tk to live on top of the Tcl Unix threaded notifier. Changes the size of the Tcl_NotifierProcs structure, but doesn't move any elements around. * unix/tclUnixNotfy.c: moved the call to Tcl_ConditionNotify till AFTER we are done mucking with the pointer swap. Fixes cases where the thread waiting on the condition wakes & accesses the waitingListPtr before it gets reset, causing a hang. AFTER we are done mucking with the pointer swap. Fixes cases where the thread waiting on the condition wakes & accesses the waitingListPtr before it gets reset, causing a hang. * library/auto.tcl (tcl_findLibrary): added checking the directories in the tcl_pkgPath for library files on macosx to enable support of the standard Mac OSX library locations * library/auto.tcl (tcl_findLibrary): added checking the directories in the tcl_pkgPath for library files on macosx to enable support of the standard Mac OSX library locations * unix/Makefile.in: * unix/configure.in: * unix/tcl.m4: added MAC_OSX_DIR. Added PLAT_OBJS to the OBJS: there are some MacOS X specific files now for Tcl, and when I get he resource & applescript stuff ported over, and restore support for FindFiles, etc, there will be a few more. Added LD_LIBRARY_PATH_VAR configure variable to avoid having to set all possible LD_LIBRARY_PATH analogues on all platforms. LD_LIBRARY_PATH_VAR is "LD_LIBRARY_PATH" by default, "LIBPATH" on AIX, "SHLIB_PATH" on HPUX and "DYLD_LIBRARY_PATH" on Mac OSX. Added configure option to package Tcl as a framework on Mac OSX. * unix/tcl.m4: added MAC_OSX_DIR. Added PLAT_OBJS to the OBJS: there are some MacOS X specific files now for Tcl, and when I get he resource & applescript stuff ported over, and restore support for FindFiles, etc, there will be a few more. Added LD_LIBRARY_PATH_VAR configure variable to avoid having to set all possible LD_LIBRARY_PATH analogues on all platforms. LD_LIBRARY_PATH_VAR is "LD_LIBRARY_PATH" by default, "LIBPATH" on AIX, "SHLIB_PATH" on HPUX and "DYLD_LIBRARY_PATH" on Mac OSX. Added configure option to package Tcl as a framework on Mac OSX. * macosx/tclMacOSXBundle.c (new): support for finding Tcl extension packaged as 'bundles' in the standard Mac OSX library locations. * unix/tclUnixInit.c: added support for findig the tcl script library inside Tcl packaged as a framework on Mac OSX. * unix/tclUnixInit.c: added support for findig the tcl script library inside Tcl packaged as a framework on Mac OSX. * macosx/Tcl.pbproj/jingham.pbxuser (new): * macosx/Tcl.pbproj/project.pbxproj (new): project for Apple's ProjectBuilder IDE. * macosx/Makefile (new): simple makefile for building the project from the command line via the ProjectBuilder tool 'pbxbuild'. * macosx/Makefile (new): simple makefile for building the project from the command line via the ProjectBuilder tool 'pbxbuild'. * unix/configure: * generic/tclStubInit.c: * generic/tclPlatDecls.h: regen 2002-08-29 Andreas Kupries <andreas_kupries@users.sourceforge.net> * win/tclWinThrd.c (TclpFinalizeThreadData, TclWinFreeAllocCache): Applied patch for bug #599428, provided by Miguel Sofer Applied patch for [Bug 599428] (sofer) <msofer@users.sourceforge.net>. 2002-08-28 David Gravereaux <davygrvy@pobox.com> * generic/tclEnv.c: * unix/configure.in: * win/tclWinPort.h: putenv() on some systems copies the buffer rather than taking reference to it. This causes memory leaks and is know to effect mswindows (msvcrt) and NetBSD 1.5.2 . This patch tests for this behavior and turns on -DHAVE_PUTENV_THAT_COPIES=1 when approriate. Thanks to David Welton for assistance. * win/tclWinPort.h: putenv() on some systems copies the buffer rather than taking reference to it. This causes memory leaks and is know to effect mswindows (msvcrt) and NetBSD 1.5.2. This patch tests for this behavior and turns on -DHAVE_PUTENV_THAT_COPIES=1 when approriate. Thanks to David Welton for assistance. [Bug 414910] [Bug 414910] * unix/configure: regen'd 2002-08-28 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/eval.n: Added mention of list command and corrected "SEE ALSO". * unix/configure.in: Cache handling of ac_cv_type_socklen_t was wrong. [Bug 600931] reported by John Ellson. Fixed by putting the brackets where they belong. * unix/configure.in: Cache handling of ac_cv_type_socklen_t was wrong. [Bug 600931] reported by John Ellson. Fixed by putting the brackets where they belong. 2002-08-26 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclCompCmds.c: fix for [Bug 599788] (error in element name causing segfault), reported by Tom Wilkason. Fixed by copying the tokens instead of the source string. * generic/tclCompCmds.c: fix for [Bug 599788] (error in element name causing segfault), reported by Tom Wilkason. Fixed by copying the tokens instead of the source string. 2002-08-26 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclThreadAlloc.c: small optimisation, reducing the new allocator's overhead. * generic/tclThreadAlloc.c: small optimisation, reducing the new allocator's overhead. 2002-08-23 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclObj.c (USE_THREAD_ALLOC): fixed leak [Bug 597936]. Thanks to Zoran Vasiljevic. * generic/tclObj.c (USE_THREAD_ALLOC): fixed leak [Bug 597936]. Thanks to Zoran Vasiljevic. 2002-08-23 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclThreadAlloc.c (USE_THREAD_ALLOC): moving objects between caches as a block, instead of one-by-one. * generic/tclThreadAlloc.c (USE_THREAD_ALLOC): moving objects between caches as a block, instead of one-by-one. 2002-08-22 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclBasic.c: * generic/tclCmdMZ.c: fix for freed memory r/w in delete traces [Bug 589863], patch by Hemang Lavana. * generic/tclCmdMZ.c: fix for freed memory r/w in delete traces [Bug 589863], patch by Hemang Lavana. 2002-08-20 Andreas Kupries <andreas_kupries@users.sourceforge.net> * win/Makefile.in (CFLAGS): * win/Makefile.in (CFLAGS): * unix/Makefile.in (MEM_DEBUG_FLAGS): Added usage of @MEM_DEBUG_FLAGS@. * win/configure.in: * unix/configure.in: Added usage of SC_ENABLE_MEMDEBUG. * win/tcl.m4: * unix/tcl.m4: Added macro SC_ENABLE_MEMDEBUG. Allows a user of configure to (de)activate memory validation and debugging (TCL_MEM_DEBUG). No need to modify the makefile anymore. configure to (de)activate memory validation and debugging (TCL_MEM_DEBUG). No need to modify the makefile anymore. 2002-08-20 Don Porter <dgp@users.sourceforge.net> * generic/tclCkalloc.c: CONSTified MemoryCmd and CheckmemCmd. * README: Bumped version number to 8.4b3 to distinguish * generic/tcl.h: HEAD from the 8.4b2 release. * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: * win/README.binary: * win/configure.in: * unix/configure: autoconf * win/configure: * library/http/http.tcl: Corrected installation directory of * library/msgcat/msgcat.tcl: the package tcltest 2.2. Added * library/opt/optparse.tcl: comments in other packages to remind * library/tcltest/tcltest.tcl: that installation directories need * library/tcltest/tcltest.tcl: that installation directories need * unix/Makefile.in: updates to match increasing version * win/Makefile.in: numbers. [Bug 597450] * win/makefile.bc: * win/makefile.vc: 2002-08-19 Andreas Kupries <andreas_kupries@users.sourceforge.net> * unix/tclUnixTest.c (TestfilehandlerCmd): Changed readable/writable to the more common readable|writable. readable/writable to the more common readable|writable. Fixes [Bug 596034] (lvirden) Fixes SF #596034 reported by Larry Virden <lvirden@users.sourceforge.net>. 2002-08-16 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tests/fCmd.test: Added test to make sure that the cause of the problem is detectable with an unpatched Tcl. * doc/ObjectType.3: Added note on the root cause of this problem to the documentation, since it is possible for user code to trigger this sort of behaviour too. * doc/ObjectType.3: Added note on the root cause of this problem to the documentation, since it is possible for user code to trigger this sort of behaviour too. * generic/tclIOUtil.c (SetFsPathFromAny): Objects should only have their old representation deleted when we know that we are about to install a new one. This stops a weird TclX bug under Linux with certain kinds of memory debugging enabled which essentally came down to a double-free of a string. certain kinds of memory debugging enabled which essentally came down to a double-free of a string. 2002-08-14 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclInt.h: * generic/tclObj.c: (code cleanup) factored the parts in the macros TclNewObj() / TclDecrRefCount() into a common part for all memory allocators and two new macros TclAllocObjStorage() / * generic/tclObj.c: (code cleanup) factored the parts in the macros TclNewObj() / TclDecrRefCount() into a common part for all memory allocators and two new macros TclAllocObjStorage() / TclFreeObjStorage() that are specific to each allocator and fully describe the differences. Removed allocator-specific code from tclObj.c by using the macros. 2002-08-12 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclCmdMZ.c: fixing UMR in delete traces, [Bug 589863]. 2002-08-08 David Gravereaux <davygrvy@pobox.com> * tools/man2help.tcl: Fixed $argv handling bug where if -bitmap wasn't specified $argc was off by one. * tools/man2help.tcl: Fixed $argv handling bug where if -bitmap wasn't specified $argc was off by one. 2002-08-08 Miguel Sofer <msofer@users.sourceforge.net> * tests/uplevel.test: added 6.1 to test [uplevel] with shadowed commands [Bug 524383] * tests/subst.test: added 5.8-10 as further tests for [Bug 495207] * tests/subst.test: added 5.8-10 as further tests for [Bug 495207] 2002-08-08 Don Porter <dgp@users.sourceforge.net> * tests/README: Noted removal of defs.tcl. 2002-08-08 Jeff Hobbs <jeffh@ActiveState.com> * doc/lsearch.n: corrected lsearch docs to use -inline in examples. *** 8.4b2 TAGGED FOR RELEASE *** * tests/fCmd.test: * tests/unixFCmd.test: updated tests for new link copy behavior. * generic/tclFCmd.c (CopyRenameOneFile): changed the behavior to follow links to endpoints and copy that file/directory instead of just copying the surface link. This means that trying to copy a link that has no endpoint (danling link) is an error. follow links to endpoints and copy that file/directory instead of just copying the surface link. This means that trying to copy a link that has no endpoint (danling link) is an error. [Patch 591647] (darley) [Patch #591647] (darley) (CopyRenameOneFile): this is currently disabled by default until further issues with such behavior (like relative links) can be handled correctly. further issues with such behavior (like relative links) can be handled correctly. * tests/README: slight wording improvements 2002-08-07 Miguel Sofer <msofer@users.sourceforge.net> * docs/BoolObj.3: added description of valid string reps for a boolean object [Bug 584794] * docs/BoolObj.3: added description of valid string reps for a boolean object [Bug 584794] * generic/tclObj.c: optimised Tcl_GetBooleanFromObj and SetBooleanFromAny to avoid parsing the string rep when it can be avoided [Bugs 584650, 472576] 2002-08-07 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclCompile.h: * generic/tclObj.c: making tclCmdNameType static ([Bug 584567], * generic/tclObj.c: making tclCmdNameType static [Bug 584567] (dgp) Don Porter). 2002-08-07 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclObj.c (Tcl_NewObj): added conditional code for USE_THREAD_ALLOC; objects allocated through Tcl_NewObj() were otherwise being leaked. [Bug 587488] reported by Sven Sass. 2002-08-06 Daniel Steffen <das@users.sourceforge.net> * generic/tclInt.decls: * unix/tclUnixThrd.c: Added stubs and implementations for non-threaded build for the tclUnixThrd.c procs TclpReaddir, * unix/tclUnixThrd.c: Added stubs and implementations for non-threaded build for the tclUnixThrd.c procs TclpReaddir, TclpLocaltime, TclpLocaltime, TclpGmtime and TclpInetNtoa. Fixes link errors in stubbed & threaded extensions that include tclUnixPort.h and use any of the procs readdir, localtime, gmtime or inet_ntoa (e.g. TclX 8.4) [Bug 589526] TclpGmtime and TclpInetNtoa. Fixes link errors in stubbed & threaded extensions that include tclUnixPort.h and use any of the procs readdir, localtime, gmtime or inet_ntoa (e.g. TclX 8.4) [Bug 589526] * generic/tclIntPlatDecls.h: * generic/tclStubInit.c: Regen. 2002-08-05 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: The setup and cleanup scripts are now * library/tcltest/pkgIndex.tcl: skipped when a test is skipped, fixing * tests/tcltest.test: [Bug 589859]. Test for bug added, and * tests/tcltest.test: [Bug 589859]. Test for bug added, and corrected tcltest package bumped to version 2.2. * generic/tcl.decls: Restored Tcl_Concat to return (char *). Like * generic/tcl.decls: Restored Tcl_Concat to return (char *). Like * generic/tclDecls.h: Tcl_Merge, it transfers ownership of a dynamic * generic/tclUtil.c: allocated string to the caller. 2002-08-04 Don Porter <dgp@users.sourceforge.net> * doc/CmdCmplt.3: Applied Patch 585105 to fully CONST-ify * doc/Concat.3: all remaining public interfaces of Tcl. * doc/CrtCommand.3: Notably, the parser no longer writes on * doc/CrtCommand.3: Notably, the parser no longer writes on * doc/CrtSlave.3: the string it is parsing, so it is no * doc/CrtTrace.3: longer necessary for Tcl_Eval() to be * doc/Eval.3: given a writable string. Also, the * doc/ExprLong.3: refactoring of the Tcl_*Var* routines * doc/LinkVar.3: by Miguel Sofer is included, so that the * doc/ParseCmd.3: "part1" argument for them no longer needs * doc/SetVar.3: to be writable either. * doc/TraceVar.3: * doc/UpVar.3: Compatibility support has been enhanced so * generic/tcl.decls that a #define of USE_NON_CONST will remove * generic/tcl.h all possible source incompatibilities with * generic/tclBasic.c the 8.3 version of the header file(s). * generic/tclCmdMZ.c The new #define of USE_COMPAT_CONST now does * generic/tclCompCmds.c what USE_NON_CONST used to do -- disable * generic/tclCompExpr.c only those new CONST's that introduce * generic/tclCompile.c irreconcilable incompatibilities. * generic/tclCompile.h * generic/tclDecls.h Several bugs are also fixed by this patch. * generic/tclEnv.c [Bugs 584051,580433] [Patches 585105,582429] * generic/tclEvent.c * generic/tclInt.decls * generic/tclInt.h * generic/tclIntDecls.h * generic/tclInterp.c * generic/tclLink.c * generic/tclObj.c * generic/tclParse.c * generic/tclParseExpr.c * generic/tclProc.c * generic/tclTest.c * generic/tclUtf.c * generic/tclUtil.c * generic/tclVar.c * mac/tclMacTest.c * tests/expr-old.test * tests/parseExpr.test * unix/tclUnixTest.c * unix/tclXtTest.c * win/tclWinTest.c * generic/tcl.decls: that a #define of USE_NON_CONST will remove * generic/tcl.h: all possible source incompatibilities with * generic/tclBasic.c: the 8.3 version of the header file(s). * generic/tclCmdMZ.c: The new #define of USE_COMPAT_CONST now does * generic/tclCompCmds.c:what USE_NON_CONST used to do -- disable * generic/tclCompExpr.c:only those new CONST's that introduce * generic/tclCompile.c: irreconcilable incompatibilities. * generic/tclCompile.h: * generic/tclDecls.h: Several bugs are also fixed by this patch. * generic/tclEnv.c: [Bugs 584051,580433] [Patches 585105,582429] * generic/tclEvent.c: * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclInterp.c: * generic/tclLink.c: * generic/tclObj.c: * generic/tclParse.c: * generic/tclParseExpr.c: * generic/tclProc.c: * generic/tclTest.c: * generic/tclUtf.c: * generic/tclUtil.c: * generic/tclVar.c: * mac/tclMacTest.c: * tests/expr-old.test: * tests/parseExpr.test: * unix/tclUnixTest.c: * unix/tclXtTest.c: * win/tclWinTest.c: 2002-08-01 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c: bugfix (reading freed memory). Testsuite passed on linux/i386, compile-13.1 hung on linux/alpha. 2002-08-01 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c: added a reference count for the complete execution stack, instead of Tcl_Preserve/Tcl_Release. execution stack, instead of Tcl_Preserve/Tcl_Release. 2002-08-01 Mo DeJong <mdejong@users.sourceforge.net> * generic/tclCkalloc.c (TclFinalizeMemorySubsystem): * generic/tclCkalloc.c (TclFinalizeMemorySubsystem): Don't lock the Don't lock the ckalloc mutex before invoking the Tcl_DumpActiveMemory function since it also locks the same mutex. This code is only executed when "memory onexit filename" has been executed and Tcl is compiled with -DTCL_MEM_DEBUG. ckalloc mutex before invoking the Tcl_DumpActiveMemory function since it also locks the same mutex. This code is only executed when "memory onexit filename" has been executed and Tcl is compiled with -DTCL_MEM_DEBUG. 2002-08-01 Reinhard Max <max@suse.de> * win/tclWinPort.h: The windows headers don't provide socklen_t, so we have to do it. * win/tclWinPort.h: The windows headers don't provide socklen_t, so we have to do it. 2002-07-31 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclInt.h (USE_THREAD_ALLOC): for unshared objects, TclDecrRefCount now frees the internal rep before the string rep - just like the non-macro Tcl_DecrRefCount/TclFreeObj [Bug 524802]. For the other allocators the fix was done on 2002-03-06. just like the non-macro Tcl_DecrRefCount/TclFreeObj [Bug 524802]. For the other allocators the fix was done on 2002-03-06. 2002-07-31 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclInterp.c: signed/unsigned comparison warning fixed (Vince Darley). 2002-07-31 Donal K. Fellows <fellowsd@cs.man.ac.uk> * unix/tcl.m4 (SC_BUGGY_STRTOD): Enabled caching of test results. * unix/tcl.m4 (SC_BUGGY_STRTOD): Solaris 2.8 still has a buggy strtod() implementation; make sure we detect it. * tests/expr.test (expr-22.*): Marked as non-portable because it seems that these tests have an annoying tendency to fail in unexpected ways. [Bugs 584825, 584950, 585986] * tests/expr.test (expr-22.*): Marked as non-portable because it seems that these tests have an annoying tendency to fail in unexpected ways. [Bugs 584825, 584950, 585986] 2002-07-30 Andreas Kupries <andreas_kupries@users.sourceforge.net> * tests/io.test: * tests/io.test: * generic/tclIO.c (WriteChars): Added flag to break out of loop if nothing of the input is consumed at all, to prevent infinite looping of called with a non-UTF-8 string. Fixes Bug 584603 (partially). Added new test "io-60.1". Might need additional changes to Tcl_Main so that unprintable results are printed as nothing of the input is consumed at all, to prevent infinite looping of called with a non-UTF-8 string. Fixes [Bug 584603] partially. Added new test "io-60.1". Might need additional changes to Tcl_Main so that unprintable results are printed as binary data. binary data. 2002-07-29 Mo DeJong <mdejong@users.sourceforge.net> * unix/Makefile.in: Use CC_SEARCH_FLAGS instead of LD_SEARCH_FLAGS when linking with ${CC}. * unix/Makefile.in: Use CC_SEARCH_FLAGS instead of LD_SEARCH_FLAGS when linking with ${CC}. * unix/configure: Regen. * unix/configure.in: Don't subst CC_SEARCH_FLAGS or LD_SEARCH_FLAGS since this is now done in tcl.m4. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Document and set CC_SEARCH_FLAGS whenever LD_SEARCH_FLAGS is set. * unix/configure.in: Don't subst CC_SEARCH_FLAGS or LD_SEARCH_FLAGS since this is now done in tcl.m4. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Document and set CC_SEARCH_FLAGS whenever LD_SEARCH_FLAGS is set. [Patch 588290] [Tcl patch 588290] 2002-07-29 Reinhard Max <max@suse.de> * unix/tcl.m4 (SC_SERIAL_PORT): Fixed detection for cases when configure's stdin is not a tty. * unix/tclUnixPort.h: * generic/tclIOSock.c: Changed size_t to socklen_t in socket-related function calls. configure's stdin is not a tty. * unix/tclUnixPort.h: * generic/tclIOSock.c: Changed size_t to socklen_t in socket-related function calls. * unix/configure.in: Added test and fallback definition for socklen_t. * unix/configure: generated. * unix/configure.in: Added test and fallback definition for socklen_t. * unix/configure: generated. 2002-07-29 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclObj.c: fixed a comment * generic/tcl.h: * generic/tclBasic.c: * generic/tclInterp.c: added the new flag TCL_EVAL_INVOKE to the interface of the Tcl_Eval* functions, removing the TCL_EVAL_NO_TRACEBACK added yesterday: alias invocations not only require no tracebacks, but also look up the command name in the global scope - see new test interp-9.4 * tests/interp.test: added 9.3 to test for safety of aliases to hidden commands, 9.4 to test for correct command lookup scope. * generic/tcl.h: * generic/tclBasic.c: * generic/tclInterp.c: added the new flag TCL_EVAL_INVOKE to the interface of the Tcl_Eval* functions, removing the TCL_EVAL_NO_TRACEBACK added yesterday: alias invocations not only require no tracebacks, but also look up the command name in the global scope - see new test interp-9.4 * tests/interp.test: added 9.3 to test for safety of aliases to hidden commands, 9.4 to test for correct command lookup scope. 2002-07-29 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/regc_locale.c (cclass): [[:xdigit:]] is only a defined concept on western characters, so should not allow any unicode digit, and hence number of ranges in [[:xdigit:]] is fixed. concept on western characters, so should not allow any unicode digit, and hence number of ranges in [[:xdigit:]] is fixed. * tests/reg.test: Added test to detect the bug. * generic/regc_cvec.c (newcvec): Corrected initial size value in character vector structure. [Bug 578363] Many thanks to character vector structure. [Bug 578363] Many thanks to pvgoran@users.sf.net for tracking this down. 2002-07-28 Miguel Sofer <msofer@users.sourceforge.net> * generic/tcl.h: * generic/tclBasic.c: added the new flag TCL_EVAL_NO_TRACEBACK to the interface of the Tcl_Eval* functions. Modified the error message for too many nested evaluations. * generic/tcl.h: * generic/tclBasic.c: added the new flag TCL_EVAL_NO_TRACEBACK to the interface of the Tcl_Eval* functions. Modified the error message for too many nested evaluations. * generic/tclInterp.h: changed the Alias struct to be of variable length and store the prefix arguments directly (instead of a pointer to a Tcl_Obj list). Made AliasObjCmd call Tcl_EvalObjv instead of TclObjInvoke - thus making aliases trigger execution traces [Bug 582522]. length and store the prefix arguments directly (instead of a pointer to a Tcl_Obj list). Made AliasObjCmd call Tcl_EvalObjv instead of TclObjInvoke - thus making aliases trigger execution traces. [Bug 582522] * tests/interp.test: * tests/stack.test: adapted to the new error message. * tests/trace.test: added tests for aliases firing the exec * tests/trace.test: added tests for aliases firing the exec traces. traces. 2002-07-27 Mo DeJong <mdejong@users.sourceforge.net> * unix/Makefile.in: Revert fix for Tcl bug 529801 since it was incorrect and broke the build on * unix/Makefile.in: Revert fix for Tcl bug 529801 since it was incorrect and broke the build on other systems. Fix [Bug 587299]. Add other systems. Fix Tcl bug 587299. Add MAJOR_VERSION, MINOR_VERSION, PATCH_LEVEL, SHLIB_LD_FLAGS, SHLIB_LD_LIBS, CC_SEARCH_FLAGS, MAJOR_VERSION, MINOR_VERSION, PATCH_LEVEL, SHLIB_LD_FLAGS, SHLIB_LD_LIBS, CC_SEARCH_FLAGS, LD_SEARCH_FLAGS, and LIB_FILE LD_SEARCH_FLAGS, and LIB_FILE variables to support more generic library build/install rules. variables to support more generic library build/install rules. * unix/configure: Regen. * unix/configure.in: Move AC_PROG_RANLIB into * unix/configure.in: Move AC_PROG_RANLIB into tcl.m4. Move shared tcl.m4. Move shared build test and setting of MAKE_LIB and MAKE_STUB_LIB into tcl.m4. Move subst of a number of variables into build test and setting of MAKE_LIB and MAKE_STUB_LIB into tcl.m4. Move subst of a number of variables into tcl.m4 where they are defined. tcl.m4 where they are defined. * unix/tcl.m4 (SC_ENABLE_SYMBOLS, SC_CONFIG_CFLAGS): Subst vars where they are defined. Add MAKE_LIB, Subst vars where they are defined. Add MAKE_LIB, MAKE_STUB_LIB, MAKE_STUB_LIB, INSTALL_LIB, and INSTALL_STUB_LIB rules to deal with the ugly details of running ranlib on static libs at build and install time. Replace TCL_SHLIB_LD_EXTRAS with SHLIB_LD_FLAGS and use it when building a shared library. INSTALL_LIB, and INSTALL_STUB_LIB rules to deal with the ugly details of running ranlib on static libs at build and install time. Replace TCL_SHLIB_LD_EXTRAS with SHLIB_LD_FLAGS and use it when building a shared library. * unix/tclConfig.sh.in: Add TCL_CC_SEARCH_FLAGS. 2002-07-26 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c: fixed Tcl_Obj leak in code corresponding to the macro NEXT_INST_V(x, 0, 1) [Bug 587495]. * generic/tclExecute.c: fixed Tcl_Obj leak in code corresponding to the macro NEXT_INST_V(x, 0, 1). [Bug 587495] 2002-07-26 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclVar.c (TclObjLookupVar): leak fix and improved * generic/tclVar.c (TclObjLookupVar): leak fix and improved comments. comments. 2002-07-26 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclVar.c (TclLookupVar): removed early returns that prevented the parens from being restored. also removed goto label as it was not necessary. prevented the parens from being restored. also removed goto label as it was not necessary. 2002-07-24 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c: * generic/tclExecute.c: * tests/expr-old.test: fix for erroneous error messages in [expr], [Bug 587140] reported by Martin Lemburg. [Bug 587140] reported by Martin Lemburg. 2002-07-25 Joe English <jenglish@users.sourceforge.net> * generic/tclProc.c: fix for Tk Bug #219218 "error handling with bgerror in Tk" * generic/tclProc.c: fix for [Tk Bug 219218] "error handling with bgerror in Tk" 2002-07-24 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c: restoring full TCL_COMPILE_DEBUG functionality. 2002-07-24 Don Porter <dgp@users.sourceforge.net> * tests/unixInit.test: relaxed unixInit-3.1 to accept iso8859-15 as a valid C encoding. [Bug 575336] * tests/unixInit.test: relaxed unixInit-3.1 to accept iso8859-15 as a valid C encoding. [Bug 575336] 2002-07-24 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c: restoring the tcl_traceCompile functionality while I repair tcl_traceExec. The core now compiles and runs also under TCL_COMPILE_DEBUG, but execution in the bytecode engine can still not be traced. * generic/tclExecute.c: restoring the tcl_traceCompile functionality while I repair tcl_traceExec. The core now compiles and runs also under TCL_COMPILE_DEBUG, but execution in the bytecode engine can still not be traced. 2002-07-24 Daniel Steffen <das@users.sourceforge.net> * unix/Makefile.in: * unix/configure.in: corrected fix for [Bug 529801]: ranlib only needed for static builds on Mac OS X. * unix/configure.in: corrected fix for [Bug 529801]: ranlib only needed for static builds on Mac OS X. * unix/configure: Regen. * unix/tclLoadDyld.c: fixed small bugs introduced by Vince, implemented library unloading correctly (needs OS X 10.2). 2002-07-23 Joe English <jenglish@users.sourceforge.net> * doc/OpenFileChnl.3: (Updates from Larry Virden) * doc/open.n: * doc/tclsh.1: Fix section numbers in Unix man page references. * doc/lset.n: In EXAMPLES section, include command to set the initial value used in subsequent examples. * doc/lset.n: In EXAMPLES section, include command to set the initial value used in subsequent examples. * doc/http.n: Package version updated to 2.4. 2002-07-23 Mo DeJong <mdejong@users.sourceforge.net> * unix/configure: Regen. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Enable 64 bit compilation when using the native compiler on a 64 bit version of IRIX. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Enable 64 bit compilation when using the native compiler on a 64 bit version of IRIX. [Bug 219220] [Tcl bug 219220] 2002-07-23 Mo DeJong <mdejong@users.sourceforge.net> * unix/Makefile.in: Combine ranlib tests and avoid printing unless ranlib is actually run. * unix/Makefile.in: Combine ranlib tests and avoid printing unless ranlib is actually run. 2002-07-23 Mo DeJong <mdejong@users.sourceforge.net> * unix/tcl.m4 (SC_PATH_X): Set XINCLUDES to "" instead of "# no special path needed" or "# no include files found" when x headers cannot be located. * unix/tcl.m4 (SC_PATH_X): Set XINCLUDES to "" instead of "# no special path needed" or "# no include files found" when x headers cannot be located. 2002-07-22 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclIOUtil.c: made tclNativeFilesystem static (since 07-19 changes removed its usage elsewhere), and added comments about its usage. * generic/tclIOUtil.c: made tclNativeFilesystem static (since 07-19 changes removed its usage elsewhere), and added comments about its usage. * generic/tclLoad.c: * generic/tcl.h: * generic/tcl.decls: * doc/FileSystem.3: converted last load-related ClientData parameter to Tcl_LoadHandle opaque structure, removing a couple of casts in the process. * generic/tclInt.h: removed tclNativeFilesystem declaration since it is now static again. * generic/tcl.decls: * doc/FileSystem.3: converted last load-related ClientData parameter to Tcl_LoadHandle opaque structure, removing a couple of casts in the process. * generic/tclInt.h: removed tclNativeFilesystem declaration since it is now static again. 2002-07-22 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tests/expr.test (expr-22.*): Added tests to help detect the corrected handling. * generic/tclExecute.c (IllegalExprOperandType): Improved error message generated when attempting to manipulate Inf and NaN values. * generic/tclParseExpr.c (GetLexeme): Allowed parser to recognise 'Inf' as a floating-point number. [Bug 218000] 2002-07-21 Don Porter <dgp@users.sourceforge.net> * tclIOUtil.c: Silence compiler warning. [Bug 584408]. 2002-07-19 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclIOUtil.c: fix to GetFilesystemRecord * win/tclWinFile.c: * unix/tclUnixFile.c: fix to subtle problem with links shown up by latest tclkit builds. * unix/tclUnixFile.c: fix to subtle problem with links shown up by latest tclkit builds. 2002-07-19 Mo DeJong <mdejong@users.sourceforge.net> * unix/configure: * unix/configure.in: * win/configure: * win/configure.in: Add AC_PREREQ(2.13) in an attempt to make it more clear that the configure scripts * win/configure.in: Add AC_PREREQ(2.13) in an attempt to make it more clear that the configure scripts must be generated with autoconf must be generated with autoconf version 2.13. [Bug 583573] version 2.13. [Bug 583573] 2002-07-19 Vince Darley <vincentdarley@users.sourceforge.net> * unix/Makefile.in: fix to build on MacOS X [Bug 529801], bug report and fix from jcw. * unix/Makefile.in: fix to build on MacOS X [Bug 529801], bug report and fix from jcw. 2002-07-19 Donal K. Fellows <fellowsd@cs.man.ac.uk> * win/tclWinSerial.c (no_timeout): Made this variable static. * generic/tclExecute.c, generic/tclCompile.c, generic/tclBasic.c: * generic/tclExecute.c, generic/tclCompile.c, generic/tclBasic.c: * generic/tclCompile.h (builtinFuncTable, instructionTable): Added prefix to these symbols because they are visible outside the Tcl library. * generic/tclCompExpr.c (operatorTable): * generic/tclCompExpr.c (operatorTable): * unix/tclUnixTime.c (tmKey): * generic/tclIOUtil.c (theFilesystemEpoch, filesystemWantToModify, filesystemIteratorsInProgress, filesystemOkToModify): Made these (filesystemIteratorsInProgress, filesystemOkToModify): Made these variables static. * unix/tclUnixFile.c: Renamed nativeFilesystem to * win/tclWinFile.c: tclNativeFilesystem and declared * generic/tclIOUtil.c: it properly in tclInt.h * generic/tclInt.h: * generic/tclInt.h: * generic/tclUtf.c (totalBytes): Made this array static and const. * generic/tclParse.c (typeTable): Made this array static and const. (Tcl_ParseBraces): Simplified error handling case so that scans are only performed when needed, and flags are simpler too. (Tcl_ParseBraces): Simplified error handling case so that scans are only performed when needed, and flags are simpler too. * license.terms: Added AS to list of copyright holders; it's only fair for the current gatekeepers to be listed here! * license.terms: Added AS to list of copyright holders; it's only fair for the current gatekeepers to be listed here! * tests/cmdMZ.test: Renamed constraint for clarity. [Bug#583427] * tests/cmdMZ.test: Renamed constraint for clarity. [Bug 583427] Added tests for the [time] command, which was previously only indirectly tested! 2002-07-18 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclInt.h: * generic/tcl.h: * */*Load*.c: added comments on changes of 07/17 and replaced clientData with Tcl_LoadHandle in all locations. * */*Load*.c: added comments on changes of 07/17 and replaced clientData with Tcl_LoadHandle in all locations. * generic/tclFCmd.c: * tests/fileSystem.test: fixed a 'knownBug' with 'file attributes ""' * tests/winFCmd.test: * tests/winFCmd.test: * tests/winPipe.test: * tests/fCmd.test: * tessts/winFile.test: added 'pcOnly' constraint to some tests to make for more useful 'tests skipped' log from running all tests on non-Windows platforms. * tessts/winFile.test: added 'pcOnly' constraint to some tests to make for more useful 'tests skipped' log from running all tests on non-Windows platforms. 2002-07-17 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclBasic.c (CallCommandTraces): delete traces now receive the FQ old name of the command. * generic/tclBasic.c (CallCommandTraces): delete traces now receive the FQ old name of the command. [Bug 582532] (Don Porter) [Bug 582532] (Don Porter) 2002-07-18 Vince Darley <vincentdarley@users.sourceforge.net> * tests/ioUtil.test: added constraints to 1.4,2.4 so they don't run outside of tcltest. [Bugs 583276,583277] * tests/ioUtil.test: added constraints to 1.4,2.4 so they don't run outside of tcltest. [Bugs 583276,583277] 2002-07-17 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclVar.c (DupParsedVarName): nasty bug fixed, reported by Vince Darley. * generic/tclVar.c (DupParsedVarName): nasty bug fixed, reported by Vince Darley. 2002-07-17 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclVar.c (TclPtrIncrVar): missing CONST in declarations, inconsistent with tclInt.h. Thanks to Vince Darley for reporting, boo to gcc for not complaining. inconsistent with tclInt.h. Thanks to Vince Darley for reporting, boo to gcc for not complaining. 2002-07-17 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclInt.h: * generic/tclIOUtil.c: * generic/tclLoadNone.c: * unix/tclLoadAout.c: * unix/tclLoadDl.c: * unix/tclLoadDld.c: * unix/tclLoadDyld.c: * unix/tclLoadNext.c: * unix/tclLoadOSF.c: * unix/tclLoadShl.c: * mac/tclMacLoad.c: * win/tclWinLoad.c: modified to move more functionality to the generic code and avoid duplication. Partial replacement of internal uses of clientData with opaque Tcl_LoadHandle. A little further work still needed, but significant changes are done. * win/tclWinLoad.c: modified to move more functionality to the generic code and avoid duplication. Partial replacement of internal uses of clientData with opaque Tcl_LoadHandle. A little further work still needed, but significant changes are done. 2002-07-17 D. Richard Hipp <drh@hwaci.com> * library/msgcat/msgcat.tcl: fix a comment that was causing problems for programs (ex: mktclapp) that embed the initialization scripts in strings. * library/msgcat/msgcat.tcl: fix a comment that was causing problems for programs (ex: mktclapp) that embed the initialization scripts in strings. 2002-07-17 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclInt.decls: * generic/tclIntDecls.h: * generic/tclStubInit.c: * generic/tclVar.c: removing the now redundant functions to access indexed variables: Tcl(Get|Set|Incr)IndexedScalar() and Tcl(Get|Set|Incr)ElementOfIndexedArray(). Tcl(Get|Set|Incr)ElementOfIndexedArray(). 2002-07-17 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tclExecute.c (TclExecuteByteCode): Minor fixes to make this file compile with SunPro CC... * generic/tclExecute.c (TclExecuteByteCode): Minor fixes to make this file compile with SunPro CC... 2002-07-17 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c: modified to do variable lookup explicitly, and then either inlining the variable access or else calling the new * generic/tclExecute.c: modified to do variable lookup explicitly, and then either inlining the variable access or else calling the new TclPtr(Set|Get|Incr)Var functions in tclVar.c * generic/tclInt.h: declare some functions previously local to tclVar.c for usage by TEBC. * generic/tclVar.c: removed local declarations; moved all special accessor functions for indexed variables to the end of the file - they are unused and ready for removal, but left there for the time being as they are in the internal stubs table. accessor functions for indexed variables to the end of the file - they are unused and ready for removal, but left there for the time being as they are in the internal stubs table. ** WARNING FOR BYTECODE MAINTAINERS ** TCL_COMPILE_DEBUG is currently not functional; will be fixed ASAP. 2002-07-16 Mo DeJong <mdejong@users.sourceforge.net> * unix/Makefile.in: * win/Makefile.in: Add a more descriptive warning in the event `make genstubs` needs to be rerun. * win/Makefile.in: Add a more descriptive warning in the event `make genstubs` needs to be rerun. 2002-07-16 Mo DeJong <mdejong@users.sourceforge.net> * unix/Makefile.in: Use dltest.marker file * unix/Makefile.in: Use dltest.marker file to keep track of when the to keep track of when the dltest package is up to date. This fixes [Tcl bug 575768] since tcltest is no longer linked every time. * unix/dltest/Makefile.in: Create ../dltest.marker after a successful `make all` run in dltest. dltest package is up to date. This fixes [Bug 575768] since tcltest is no longer linked every time. * unix/dltest/Makefile.in: Create ../dltest.marker after a successful `make all` run in dltest. 2002-07-16 Mo DeJong <mdejong@users.sourceforge.net> * unix/configure: Regen. * unix/configure.in: Remove useless subst of TCL_BIN_DIR. 2002-07-15 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclVar.c: inaccurate comment fixed 2002-07-15 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclBasic.c (Tcl_AddObjErrorInfo): * generic/tclExecute.c (TclUpdateReturnInfo): * generic/tclInt.h: * generic/tclProc.c: Added two Tcl_Obj to the ExecEnv structure to hold the fully qualified names "::errorInfo" and "::errorCode" to cache the addresses of the corresponding variables. The two most frequent setters of these variables now profit from the new variable name * generic/tclInt.h: * generic/tclProc.c: Added two Tcl_Obj to the ExecEnv structure to hold the fully qualified names "::errorInfo" and "::errorCode" to cache the addresses of the corresponding variables. The two most frequent setters of these variables now profit from the new variable name caching. caching. 2002-07-15 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclVar.c: refactorisation to reuse already looked-up Var pointers; definition of three new Tcl_Obj types to cache variable name parsing and lookup for later reuse; modification of internal functions to profit from the caching. pointers; definition of three new Tcl_Obj types to cache variable name parsing and lookup for later reuse; modification of internal functions to profit from the caching. * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclNamesp.c: adding CONST qualifiers to variable names passed to Tcl_FindNamespaceVar and to variable resolvers; adding CONST qualifier to the 'msg' argument to TclLookupVar. Needed to avoid code duplication in the new tclVar.c code. passed to Tcl_FindNamespaceVar and to variable resolvers; adding CONST qualifier to the 'msg' argument to TclLookupVar. Needed to avoid code duplication in the new tclVar.c code. * tests/set-old.test: * tests/var.test: slight modification of error messages due to the modifications in the tclVar.c code. 2002-07-15 Don Porter <dgp@users.sourceforge.net> * tests/unixInit.test: Improved constraints to protect /tmp. [Bug 581403] * tests/unixInit.test: Improved constraints to protect /tmp. [Bug 581403] 2002-07-15 Vince Darley <vincentdarley@users.sourceforge.net> * tests/winFCmd.test: renamed 'win2000' and 'notWin2000' to more appropriate constraint names. * tests/winFCmd.test: renamed 'win2000' and 'notWin2000' to more appropriate constraint names. * win/tclWinFile.c: updated comments to reflect 07-11 changes. * win/tclWinFCmd.c: made ConvertFileNameFormat static again, since no longer used in tclWinFile.c * mac/tclMacFile.c: completed TclpObjLink implementation which was previously lacking. * win/tclWinFCmd.c: made ConvertFileNameFormat static again, since no longer used in tclWinFile.c * mac/tclMacFile.c: completed TclpObjLink implementation which was previously lacking. * generic/tclIOUtil.c: comment cleanup and code speedup. 2002-07-14 Don Porter <dgp@users.sourceforge.net> * generic/tclInt.h: Removed declarations that duplicated entries in the (internal) stub table. * library/tcltest/tcltest.tcl: Corrected errors in handling of configuration options -constraints and -limitconstraints. in the (internal) stub table. * library/tcltest/tcltest.tcl: Corrected errors in handling of configuration options -constraints and -limitconstraints. * README: Bumped HEAD to version 8.4b2 so we can * generic/tcl.h: distinguish it from the 8.4b1 release. * tools/tcl.wse.in: * unix/configure*: * unix/tcl.spec: * win/README.binary: * win/configure*: 2002-07-11 Vince Darley <vincentdarley@users.sourceforge.net> * doc/file.n: * win/tclWinFile.c: on Win 95/98/ME the long form of the path is used as a normalized form. This is required because short forms are not a robust representation. The file normalization function has been sped up, but more performance gains might be possible, if speed is still an issue on these platforms. * win/tclWinFile.c: on Win 95/98/ME the long form of the path is used as a normalized form. This is required because short forms are not a robust representation. The file normalization function has been sped up, but more performance gains might be possible, if speed is still an issue on these platforms. 2002-07-11 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: Corrected reaction to existing but false ::tcl_interactive. * doc/Hash.3: Overlooked CONST documentation update. 2002-07-11 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tclCkalloc.c: ckalloc() and friends take the block size as an unsigned, so we should use %ud when reporting it in fprintf() and panic(). * generic/tclCkalloc.c: ckalloc() and friends take the block size as an unsigned, so we should use %ud when reporting it in fprintf() and panic(). 2002-07-11 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclCompile.c: now setting local vars undefined at compile time, instead of waiting until the proc is initialized. * generic/tclProc.c: use macro TclSetVarUndefined instead of directly etting the flag. * generic/tclCompile.c: now setting local vars undefined at compile time, instead of waiting until the proc is initialized. * generic/tclProc.c: use macro TclSetVarUndefined instead of directly setting the flag. 2002-07-11 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tests/cmdAH.test: [file attr -perm] is Unix-only, so add [catch] when not inside a suitably-protected test. 2002-07-10 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tests/unixFCmd.test, tests/fileName.test: * tests/unixFCmd.test, tests/fileName.test: * tests/fCmd.test: Removed [exec] of Unix utilities that have equivalents in standard Tcl. [Bug 579268] Also simplified some of unixFCmd.test while I was at it. equivalents in standard Tcl. [Bug 579268] Also simplified some of unixFCmd.test while I was at it. 2002-07-10 Don Porter <dgp@users.sourceforge.net> * tests/tcltest.test: Greatly reduced the number of [exec]s, using slave interps instead. * library/tcltest/tcltest.tcl: Fixed bug uncovered in the conversion * library/tcltest/tcltest.tcl: Fixed bug uncovered in the conversion where a message was written to stdout instead of [outputChannel]. * tests/basic.test: Cleaned up, constrained, and reduced the * tests/compile.test: amount of [exec] usage in the test suite. * tests/encoding.test: * tests/env.test: * tests/event.test:
︙
2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 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 2698 2699 2700 2701 2702 2703 2704 2705 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 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830	7277 7278 7279 7280 7281 7282 7283 7284 7285 7286 7287 7288 7289 7290 7291 7292 7293 7294 7295 7296 7297 7298 7299 7300 7301 7302 7303 7304 7305 7306 7307 7308 7309 7310 7311 7312 7313 7314 7315 7316 7317 7318 7319 7320 7321 7322 7323 7324 7325 7326 7327 7328 7329 7330 7331 7332 7333 7334 7335 7336 7337 7338 7339 7340 7341 7342 7343 7344 7345 7346 7347 7348 7349 7350 7351 7352 7353 7354 7355 7356 7357 7358 7359 7360 7361 7362 7363 7364 7365 7366 7367 7368 7369 7370 7371 7372 7373 7374 7375 7376 7377 7378 7379 7380 7381 7382 7383 7384 7385 7386 7387 7388 7389 7390 7391 7392 7393 7394 7395 7396 7397 7398 7399 7400 7401 7402 7403 7404 7405 7406 7407 7408 7409 7410 7411 7412 7413 7414 7415 7416 7417 7418 7419 7420 7421 7422 7423 7424 7425 7426 7427 7428 7429 7430 7431 7432 7433 7434 7435 7436 7437 7438 7439 7440 7441 7442 7443 7444 7445 7446 7447 7448 7449 7450 7451 7452 7453 7454 7455 7456 7457 7458 7459 7460 7461 7462 7463 7464 7465 7466 7467 7468 7469	- - + + - - - - + + + + - + - - + + - - - - + + + + + - - + + - - - - - + + + + + - - - + + + - - - - + + + + - - - + + + - + - - - - + + + + - - + + - - - - + + + + - - + + - - - + + + - + - - + + - - - + + - + - - + + - - + + - - - + + - - - + + +	* tests/winPipe.test: 2002-07-10 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tests/cmdAH.test: Removed [exec] of Unix utilities. [Bug 579211] * tests/expr.test: Added tests to make sure that this works. * generic/tclExecute.c (ExprCallMathFunc): Functions should also be able to return wide-ints. [Bug 579284] * generic/tclExecute.c (ExprCallMathFunc): Functions should also be able to return wide-ints. [Bug 579284] 2002-07-08 Andreas Kupries <andreas_kupries@users.sourceforge.net> * tests/socket.test: Fixed bug #578164. The original reason for the was a DNS outage while running the testsuite. Changed [info hostname] to 127.0.0.1 to bypass DNS, knowing that we operate on the local host. * tests/socket.test: Fixed [Bug 578164]. The original reason for the was a DNS outage while running the testsuite. Changed [info hostname] to 127.0.0.1 to bypass DNS, knowing that we operate on the local host. 2002-07-08 Don Porter <dgp@users.sourceforge.net> * doc/tcltest.n: Fixed incompatibility in [viewFile]. * library/tcltest/tcltest.tcl: Corrected docs. Bumped to 2.2.1. * library/tcltest/tcltest.tcl: Corrected docs. Bumped to 2.2.1. * library/tcltest/pkgIndex.tcl: [Bug 578163] 2002-07-08 Vince Darley <vincentdarley@users.sourceforge.net> * tests/cmdAH.test: * tests/fCmd.test: * tests/fileName.test: tests which rely on 'file link' need a constraint so they don't run on older Windows OS. [Bug 578158] * generic/tclIOUtil.c: * generic/tcl.h: * generic/tclInt.h: * generic/tclTest.c: * mac/tclMacChan.c: * unix/tclUnixChan.c: * win/tclWinChan.c: * doc/FileSystem.3: cleaned up internal handling of Tcl_FSOpenFileChannel to remove duplicate code, and make writing external vfs's clearer and easier. No Tcl_FSOpenFileChannel to remove duplicate code, and make writing external vfs's clearer and easier. No functionality change. Also functionality change. Also clarify that objects with refCount zero should not be passed in to the Tcl_FS API, and prevent segfaults from occuring on such user errors. [Bug 578617] clarify that objects with refCount zero should not be passed in to the Tcl_FS API, and prevent segfaults from occuring on such user errors. [Bug 578617] 2002-07-06 Don Porter <dgp@users.sourceforge.net> * tests/pkgMkIndex.test: Constrained tests of [load] package indexing to those platforms where the testing shared libraries have been built. [Bug 578166]. 2002-07-05 Don Porter <dgp@users.sourceforge.net> * changes: added recent changes 2002-07-05 Reinhard Max <max@suse.de> * generic/tclClock.c (FormatClock): Convert the format string to UTF8 before calling TclpStrftime, so that non-ASCII characters don't get mangled when the result string is being converted back. UTF8 before calling TclpStrftime, so that non-ASCII characters don't get mangled when the result string is being converted back. * tests/clock.test: Added a test for that. 2002-07-05 Donal K. Fellows <fellowsd@cs.man.ac.uk> * unix/Makefile.in (ro-test,ddd,GDB,DDD): Created new targets to allow running the test suite with a read-only current directory, running under ddd instead of gdb, and factored out some executable names for broken sites (like mine) where gdb and ddd are installed with non-standard names... * unix/Makefile.in (ro-test,ddd,GDB,DDD): Created new targets to allow running the test suite with a read-only current directory, running under ddd instead of gdb, and factored out some executable names for broken sites (like mine) where gdb and ddd are installed with non-standard names... * tests/httpold.test: Altered test names to httpold-* to avoid clashes with http.test, and stopped tests from failing when the current directory is not writable... * tests/httpold.test: Altered test names to httpold-* to avoid clashes with http.test, and stopped tests from failing when the current directory is not writable... * tests/event.test: Stop these tests from failing * tests/ioUtil.test: when the current directory is * tests/regexp.test: not writable... * tests/regexpComp.test: * tests/source.test: * tests/unixFile.test: * tests/unixNotfy.test: * tests/regexpComp.test: * tests/source.test: * tests/unixFile.test: * tests/unixNotfy.test: * tests/unixFCmd.test: Trying to make these test-files * tests/macFCmd.test: not bomb out with an error when * tests/http.test: the current directory is not * tests/fileName.test: writable... * tests/env.test: 2002-07-05 Jeff Hobbs <jeffh@ActiveState.com> *** 8.4b1 TAGGED FOR RELEASE *** 2002-07-04 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tests/cmdMZ.test (cmdMZ-1.4): * tests/cmdAH.test: More fixing of writable-current-dir assumption. [Bug 575824] * tests/cmdMZ.test (cmdMZ-1.4): * tests/cmdAH.test: More fixing of writable-current-dir assumption. [Bug 575824] 2002-07-04 Miguel Sofer <msofer@users.sourceforge.net> * tests/basic.test: Same issue as below; fixed [Bug 575817] 2002-07-04 Andreas Kupries <andreas_kupries@users.sourceforge.net> * tests/socket.test: * tests/winPipe.test: * tests/pid.test: Fixed SF Bug #575848. See below for a description the general problem. * tests/socket.test: * tests/winPipe.test: * tests/pid.test: Fixed [Bug 575848]. See below for a description the general problem. * All the bugs below are instances of the same problem: The testsuite assumes [pwd] = [temporaryDirectory] and writable. All the bugs below are instances of the same problem: The testsuite assumes [pwd] = [temporaryDirectory] and writable. * tests/iogt.test: Fixed bug #575860. * tests/io.test: Fixed bug #575862. * tests/exec.test: * tests/ioCmd.test: Fixed bug #575836. * tests/iogt.test: Fixed [Bug 575860] * tests/io.test: Fixed [Bug 575862] * tests/exec.test: * tests/ioCmd.test: Fixed [Bug 575836] 2002-07-03 Don Porter <dgp@users.sourceforge.net> * tests/pkg1/direct1.tcl: removed * tests/pkg1/pkgIndex.tcl: removed * tests/pkgMkIndex.test: Imported auxilliary files from tests/pkg1 into the test file pkgMkIndex.test itself. Formatting fixes. * tests/pkgMkIndex.test: Imported auxilliary files from tests/pkg1 into the test file pkgMkIndex.test itself. Formatting fixes. * unix/Makefile.in: removed tests/pkg/* from `make dist` * tests/pkg/circ1.tcl: removed * tests/pkg/circ2.tcl: removed * tests/pkg/circ3.tcl: removed * tests/pkg/global.tcl: removed * tests/pkg/import.tcl: removed * tests/pkg/pkg1.tcl: removed * tests/pkg/pkg2_a.tcl: removed * tests/pkg/pkg2_b.tcl: removed * tests/pkg/pkg3.tcl: removed * tests/pkg/pkg4.tcl: removed * tests/pkg/pkg5.tcl: removed * tests/pkg/pkga.tcl: removed * tests/pkg/samename.tcl: removed * tests/pkg/simple.tcl: removed * tests/pkg/spacename.tcl: removed * tests/pkg/std.tcl: removed * tests/pkgMkIndex.test: Fixed [Bug 575857] where this test file expected to be able to write to [file join [testsDirectory] pkg]. Part of the fix was to import several auxilliary files into the test file itself. expected to be able to write to [file join [testsDirectory] pkg]. Part of the fix was to import several auxilliary files into the test file itself. * tests/main.test: Cheap fix for [Bugs 575851, 575858]. Avoid * tests/main.test: Cheap fix for [Bugs 575851, 575858]. Avoid * tests/tcltest.test: non-writable . by [cd [temporaryDirectory]]. * library/auto.tcl: Fix [tcl_findLibrary] to be sure it sets $varName only if a successful library script is found. * library/auto.tcl: Fix [tcl_findLibrary] to be sure it sets $varName only if a successful library script is found. [Bug 577033] [Bug 577033] 2002-07-03 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclCompCmds.c (TclCompileCatchCmd): return TCL_OUT_LINE_COMPILE instead of TCL_ERROR: let the failure happen at runtime so that it can be caught [Bug 577015]. TCL_OUT_LINE_COMPILE instead of TCL_ERROR: let the failure happen at runtime so that it can be caught [Bug 577015]. 2002-07-02 Joe English <jenglish@users.sourceforge.net> * doc/tcltest.n: Markup fixes, spellcheck. 2002-07-02 Don Porter <dgp@users.sourceforge.net> * doc/tcltest.n: more refinements of the documentation. * library/tcltest/tcltest.tcl: Added trace to be sure the stdio constraint is updated whenever the [interpreter] changes. constraint is updated whenever the [interpreter] changes. * doc/tcltest.n: Reverted [makeFile] and [viewFile] to * library/tcltest/tcltest.tcl: their former behavior, and documented * tests/cmdAH.test: it. Corrected misspelling of hook * tests/event.test: procedure. Restored tests. * tests/cmdAH.test: it. Corrected misspelling of hook * tests/event.test: procedure. Restored tests. * tests/http.test: * tests/io.test: * library/tcltest/tcltest.tcl: Simplified logic of [GetMatchingFiles] and [GetMatchingDirectories], removing * library/tcltest/tcltest.tcl: Simplified logic of [GetMatchingFiles] and [GetMatchingDirectories], removing special case processing. special case processing. * doc/tcltest.n: More documentation updates. Reference sections are complete. Only examples need adding. * doc/tcltest.n: More documentation updates. Reference sections are complete. Only examples need adding. 2002-07-02 Vince Darley <vincentdarley@users.sourceforge.net> * tests/fCmd.test: * generic/tclCmdAH.c: clearer error msgs for 'file link', as per the man page. * tests/fCmd.test: * generic/tclCmdAH.c: clearer error msgs for 'file link', as per the man page. 2002-07-01 Joe English <jenglish@users.sourceforge.net> * doc/Access.3: * doc/AddErrInfo.3: * doc/Alloc.3: * doc/Backslash.3:
︙
2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 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 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 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 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 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 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 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 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 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 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379	7493 7494 7495 7496 7497 7498 7499 7500 7501 7502 7503 7504 7505 7506 7507 7508 7509 7510 7511 7512 7513 7514 7515 7516 7517 7518 7519 7520 7521 7522 7523 7524 7525 7526 7527 7528 7529 7530 7531 7532 7533 7534 7535 7536 7537 7538 7539 7540 7541 7542 7543 7544 7545 7546 7547 7548 7549 7550 7551 7552 7553 7554 7555 7556 7557 7558 7559 7560 7561 7562 7563 7564 7565 7566 7567 7568 7569 7570 7571 7572 7573 7574 7575 7576 7577 7578 7579 7580 7581 7582 7583 7584 7585 7586 7587 7588 7589 7590 7591 7592 7593 7594 7595 7596 7597 7598 7599 7600 7601 7602 7603 7604 7605 7606 7607 7608 7609 7610 7611 7612 7613 7614 7615 7616 7617 7618 7619 7620 7621 7622 7623 7624 7625 7626 7627 7628 7629 7630 7631 7632 7633 7634 7635 7636 7637 7638 7639 7640 7641 7642 7643 7644 7645 7646 7647 7648 7649 7650 7651 7652 7653 7654 7655 7656 7657 7658 7659 7660 7661 7662 7663 7664 7665 7666 7667 7668 7669 7670 7671 7672 7673 7674 7675 7676 7677 7678 7679 7680 7681 7682 7683 7684 7685 7686 7687 7688 7689 7690 7691 7692 7693 7694 7695 7696 7697 7698 7699 7700 7701 7702 7703 7704 7705 7706 7707 7708 7709 7710 7711 7712 7713 7714 7715 7716 7717 7718 7719 7720 7721 7722 7723 7724 7725 7726 7727 7728 7729 7730 7731 7732 7733 7734 7735 7736 7737 7738 7739 7740 7741 7742 7743 7744 7745 7746 7747 7748 7749 7750 7751 7752 7753 7754 7755 7756 7757 7758 7759 7760 7761 7762 7763 7764 7765 7766 7767 7768 7769 7770 7771 7772 7773 7774 7775 7776 7777 7778 7779 7780 7781 7782 7783 7784 7785 7786 7787 7788 7789 7790 7791 7792 7793 7794 7795 7796 7797 7798 7799 7800 7801 7802 7803 7804 7805 7806 7807 7808 7809 7810 7811 7812 7813 7814 7815 7816 7817 7818 7819 7820 7821 7822 7823 7824 7825 7826 7827 7828 7829 7830 7831 7832 7833 7834 7835 7836 7837 7838 7839 7840 7841 7842 7843 7844 7845 7846 7847 7848 7849 7850 7851 7852 7853 7854 7855 7856 7857 7858 7859 7860 7861 7862 7863 7864 7865 7866 7867 7868 7869 7870 7871 7872 7873 7874 7875 7876 7877 7878 7879 7880 7881 7882 7883 7884 7885 7886 7887 7888 7889 7890 7891 7892 7893 7894 7895 7896 7897 7898 7899 7900 7901 7902 7903 7904 7905 7906 7907 7908 7909 7910 7911 7912 7913 7914 7915 7916 7917 7918 7919 7920 7921 7922 7923 7924 7925 7926 7927 7928 7929 7930 7931 7932 7933 7934 7935 7936 7937 7938 7939 7940 7941 7942 7943 7944 7945 7946 7947 7948 7949 7950 7951 7952 7953 7954 7955 7956 7957 7958 7959 7960 7961 7962 7963 7964 7965 7966 7967 7968 7969 7970 7971 7972 7973 7974 7975 7976 7977 7978 7979 7980 7981 7982 7983 7984 7985 7986 7987 7988 7989 7990 7991 7992 7993 7994 7995 7996 7997 7998 7999 8000 8001 8002 8003 8004 8005 8006 8007 8008 8009 8010 8011 8012 8013 8014 8015 8016 8017 8018 8019 8020 8021 8022 8023 8024 8025 8026 8027 8028 8029 8030 8031 8032 8033 8034 8035 8036 8037 8038 8039 8040 8041 8042 8043 8044 8045 8046 8047 8048 8049 8050 8051 8052 8053 8054 8055 8056 8057 8058 8059 8060 8061 8062 8063 8064 8065 8066 8067 8068 8069 8070 8071 8072 8073 8074 8075 8076 8077 8078 8079 8080 8081 8082 8083 8084 8085 8086 8087 8088 8089 8090 8091 8092 8093 8094 8095 8096 8097 8098 8099 8100 8101 8102 8103 8104 8105 8106 8107 8108 8109 8110 8111 8112 8113 8114 8115 8116 8117 8118 8119 8120 8121 8122 8123 8124 8125 8126 8127 8128 8129 8130 8131 8132 8133 8134 8135 8136 8137 8138 8139 8140 8141 8142 8143 8144 8145 8146 8147 8148 8149 8150 8151 8152 8153 8154 8155 8156 8157 8158 8159 8160 8161 8162 8163 8164 8165 8166 8167 8168 8169 8170 8171 8172 8173 8174 8175 8176 8177 8178 8179 8180 8181 8182 8183 8184 8185 8186 8187 8188 8189 8190 8191 8192 8193 8194 8195 8196 8197 8198 8199 8200 8201 8202 8203 8204 8205 8206 8207 8208 8209 8210 8211 8212 8213 8214 8215 8216 8217 8218 8219 8220 8221 8222 8223 8224 8225 8226 8227 8228 8229 8230 8231 8232 8233 8234 8235 8236 8237 8238 8239 8240 8241 8242 8243 8244 8245 8246 8247 8248 8249 8250 8251 8252 8253 8254 8255 8256 8257 8258 8259 8260 8261 8262 8263 8264 8265 8266 8267 8268 8269 8270 8271 8272 8273 8274 8275 8276 8277 8278 8279 8280 8281 8282 8283 8284 8285 8286 8287 8288 8289 8290 8291 8292 8293 8294 8295 8296 8297 8298 8299 8300 8301 8302 8303 8304 8305 8306 8307 8308 8309 8310 8311 8312 8313 8314 8315 8316 8317 8318 8319 8320 8321 8322 8323 8324 8325 8326 8327 8328 8329 8330 8331 8332 8333 8334 8335 8336 8337 8338 8339 8340 8341 8342 8343 8344 8345 8346 8347 8348 8349 8350 8351 8352 8353 8354 8355 8356 8357 8358 8359 8360 8361 8362 8363 8364 8365 8366 8367 8368 8369 8370 8371 8372 8373 8374 8375 8376 8377 8378 8379 8380 8381 8382 8383 8384 8385 8386 8387 8388 8389 8390 8391 8392 8393 8394 8395 8396 8397 8398 8399 8400 8401 8402 8403 8404 8405 8406 8407 8408 8409 8410 8411 8412 8413 8414 8415 8416 8417 8418 8419 8420 8421 8422 8423 8424 8425 8426 8427 8428 8429 8430 8431 8432 8433 8434 8435 8436 8437 8438 8439 8440 8441 8442 8443 8444 8445 8446 8447 8448 8449 8450 8451 8452 8453 8454 8455 8456 8457 8458 8459 8460 8461 8462 8463 8464 8465 8466 8467 8468 8469 8470 8471 8472 8473 8474 8475 8476 8477 8478 8479 8480 8481 8482 8483 8484 8485 8486 8487 8488 8489 8490 8491 8492 8493 8494 8495 8496 8497 8498 8499 8500 8501 8502 8503 8504 8505 8506 8507 8508 8509 8510 8511 8512 8513 8514 8515 8516 8517 8518 8519 8520 8521 8522 8523 8524 8525 8526 8527 8528 8529 8530 8531 8532 8533 8534 8535 8536 8537 8538 8539 8540 8541 8542 8543 8544 8545 8546 8547 8548 8549 8550 8551 8552 8553 8554 8555 8556 8557 8558 8559 8560 8561 8562 8563 8564 8565 8566 8567 8568 8569 8570 8571 8572 8573 8574 8575 8576 8577 8578 8579 8580 8581 8582 8583 8584 8585 8586 8587 8588 8589 8590 8591 8592 8593 8594 8595 8596 8597 8598 8599 8600 8601 8602 8603 8604 8605 8606 8607 8608 8609 8610 8611 8612 8613 8614 8615 8616 8617 8618 8619 8620 8621 8622 8623 8624 8625 8626 8627 8628 8629 8630 8631 8632 8633 8634 8635 8636 8637 8638 8639 8640 8641 8642 8643 8644 8645 8646 8647 8648 8649 8650 8651 8652 8653 8654 8655 8656 8657 8658 8659 8660 8661 8662 8663 8664 8665 8666 8667 8668 8669 8670 8671 8672 8673 8674 8675 8676 8677 8678 8679 8680 8681 8682 8683 8684 8685 8686 8687 8688 8689 8690 8691 8692 8693 8694 8695 8696 8697 8698 8699 8700 8701 8702 8703 8704 8705 8706 8707 8708 8709 8710 8711 8712 8713 8714 8715 8716 8717 8718 8719 8720 8721 8722 8723 8724 8725 8726 8727 8728 8729 8730 8731 8732 8733 8734 8735 8736 8737 8738 8739 8740 8741 8742 8743 8744 8745 8746 8747 8748 8749 8750 8751 8752 8753 8754 8755 8756 8757 8758 8759 8760 8761 8762 8763 8764 8765 8766 8767 8768 8769 8770 8771 8772 8773 8774 8775 8776 8777 8778 8779 8780 8781 8782 8783 8784 8785 8786 8787 8788 8789 8790 8791 8792 8793 8794 8795 8796 8797 8798 8799 8800 8801 8802 8803 8804 8805 8806 8807 8808 8809 8810 8811 8812 8813 8814 8815 8816 8817 8818 8819 8820 8821 8822 8823 8824 8825 8826 8827 8828 8829 8830 8831 8832 8833 8834 8835 8836 8837 8838 8839 8840 8841 8842 8843 8844 8845 8846 8847 8848 8849 8850 8851 8852 8853 8854 8855 8856 8857 8858 8859 8860 8861 8862 8863 8864 8865 8866 8867 8868 8869 8870 8871 8872 8873 8874 8875 8876 8877 8878 8879 8880 8881 8882 8883 8884 8885 8886 8887 8888 8889 8890 8891 8892 8893 8894 8895 8896 8897 8898 8899 8900 8901 8902 8903 8904 8905 8906 8907 8908 8909 8910 8911 8912 8913 8914 8915 8916 8917 8918 8919 8920 8921 8922 8923 8924 8925 8926 8927 8928 8929 8930 8931 8932 8933 8934 8935 8936 8937 8938 8939 8940 8941 8942 8943 8944 8945 8946 8947 8948 8949 8950 8951 8952 8953 8954 8955 8956 8957 8958 8959 8960 8961 8962 8963 8964 8965 8966 8967 8968 8969 8970 8971 8972 8973 8974 8975 8976 8977 8978 8979 8980 8981	- + - + - - - + + + - - + - - - + + + - - - + + + - - - + + + - - - + + + - + - - - + + + - + - - - - + + + + - - - + + + - + - + - - + - - + + - + - + - + - - - - + + + + - - + - - + + - - + + - - - - - + + + + + - - + + - - - - - - - + + + + + + + - + - - - - + + + - - + + + - - - + + + - + - + - - - - - - - + + + + + + + - - - - + + + - - + + - - + + - - + + - - - - + + + + - - - - + + + + - - + + - - + + - - + + - - - + + + - - - + + - - + + - + - - + + - - - - + + + + - + - - - + + - - - + + - + - - + + - - + + - - - - + + + + - - + + - - + + - - - + + + - + - - - - - - + + + + + + - - - - + + + - + - - + + - - - - - - + + + + + + - - - - - - - + + + + + + + - - + - + - - + + - - - - - + + + + + - - + + - - - - + + + + - - - - - - + + + + + + - - + + - - - - + + + + - - - + + + - - - + + + - - - + + + - - + + - - + + - - + + - - - - + + + + - - + + - + - - - - - + + + + + - - + + - - - + + + - - + + - - + + - + - - - + + + - - + - - + + - - - - - - + + + + + + - - + + - - + - - - - + + + + - - - + + + - + - - + + - - - - - - + + + + + + - - - - - - + + + + + - - - - + + + - - - - - - + + + + + + - - + + - - + + - - - - - + + + + + - - - - + + + + - - + + - - - - + + + + - - - - - - + + + + + + - - - + + + - - - + + + - - - - - + + + + - - + - - + + - - - + + - - - + + + - - - - + + + + - + - - + + - - - + + - + - - - + + + - - - - - - + + + + + - - + + - - + - - - - + + + - - + + - - + + - - - - + + + + - + - + - - + + - - - - + + + + - - + + - - - - - + + + + + - + - - - + + - - + + - + - - + + - - + + - + - - - + + - - - - - - + + + + + + - - - + + + - - + + - - + + - - + + - - - - + + + + - - + + - - - - - - + + + + + + - - - + + + - - + + - - - + + + - - - + + + - - - + + + - - - - + + + - - - - + + + + - - - - + + + + - - + + - - - + + + - + - - + - - + + - - + + - - - + + + - - + + - - + + - - - - - + + + + + - - + + - - - + + + - - - - - + + + + - - - + + + - + - - - - - + + + + + - - - - + + + + - - - + + + - - + + - - - - + + + + - - + - - - - + + + + - - - - - - + + + + + - - + - - + + - + - - + + - + - - + + - - + + - - - - - + + + + + - - - - - + + + + - - - - - - - - + + + + + + + - - + - - - + + + - + - - - - + + + + - - - + + + - - - - + + + + - + - - + + - + - - - + + + - - - + + - - + + - - - - + + + - - + + - - - - + + + - - + + - - - + + - + - - - + + - - + + - - + - + + - - - + + + - - - + + + -	* doc/msgcat.n: * doc/packagens.n: * doc/pkgMkIndex.n: * doc/registry.n: * doc/resource.n: * doc/safe.n: * doc/scan.n: * doc/tclvars.n: Spell-check, fixed typos (Updates from Larry Virden). * doc/tclvars.n: Spell-check, fixed typos (Updates from Larry Virden) 2002-07-01 Donal K. Fellows <fellowsd@cs.man.ac.uk> * unix/tcl.m4 (SC_CONFIG_CFLAGS): Made Solaris use gcc for linking when building with gcc to resolve problems with undefined symbols being present when tcl library used with non-gcc linker at later stage. Symbols were compiler-generated, so it is the compiler's business to define them. [Bug #541181] business to define them. [Bug 541181] 2002-07-01 Don Porter <dgp@users.sourceforge.net> * doc/tcltest.n: more work in progress updating tcltest docs. * library/tcltest/tcltest.tcl: Change [configure -match] to stop treating an empty list as a list of the single pattern "*". Changed the default value to [list *] so default operation * library/tcltest/tcltest.tcl: Change [configure -match] to stop treating an empty list as a list of the single pattern "*". Changed the default value to [list *] so default operation remains the same. remains the same. * tests/pkg/samename.tcl: restored. needed by pkgMkIndex.test. * tests/pkg/samename.tcl: restored. Needed by pkgMkIndex.test. * library/tcltest/tcltest.tcl: restored writeability testing of -tmpdir, augmented by a special exception for the deafault value. 2002-07-01 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/concat.n: Documented the *real* behaviour of [concat]! 2002-06-30 Don Porter <dgp@users.sourceforge.net> * doc/tcltest.n: more work in progress updating tcltest docs. * tests/README: Updated the instructions on running and * tests/cmdMZ.test: adding to the test suite. Also updated * tests/encoding.test: several tests, mostly to correctly create * tests/fCmd.test: and destroy any temporary files in the * tests/info.test: [temporaryDirectory] of tcltest. * tests/interp.test: * library/tcltest/tcltest.tcl: Stopped checking for writeability of -tmpdir value because no default directory can be guaranteed to be writeable. * library/tcltest/tcltest.tcl: Stopped checking for writeability of -tmpdir value because no default directory can be guaranteed to be writeable. * tests/autoMkindex.tcl: removed. * tests/pkg/samename.tcl: removed. * tests/pkg/magicchar.tcl: removed. * tests/pkg/magicchar2.tcl: removed. * tests/autoMkindex.test: Updated auto_mkIndex tests to use [makeFile] and [removeFile] so tests are done in [temporaryDirecotry] where write access is guaranteed. * tests/autoMkindex.test: Updated auto_mkIndex tests to use [makeFile] and [removeFile] so tests are done in [temporaryDirecotry] where write access is guaranteed. * library/tcltest/tcltest.tcl: Fixed [makeFile] and [viewFile] to * tests/cmdAH.test: accurately reflect a file's contents. * tests/event.test: Updated tests that depended on buggy * tests/http.test: behavior. Also added warning messages * tests/io.test: to "-debug 1" operations to debug test * tests/iogt.test: calls to (make|remove)(File|Directory). * unix/mkLinks: `make mklinks` on 6-27 commits. 2002-06-28 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclCompile.h: modified the macro TclEmitPush to not call its first argument repeatedly or pass it to other macros, [Bug 575194] reported by Peter Spjuth. * generic/tclCompile.h: modified the macro TclEmitPush to not call its first argument repeatedly or pass it to other macros, [Bug 575194] reported by Peter Spjuth. 2002-06-28 Don Porter <dgp@users.sourceforge.net> * docs/tcltest.n: Doc revisions in progress. * library/tcltest/tcltest.tcl: Corrected -testdir default value. Was not reliable, and disagreed with docs! Thanks to Hemang Lavana. [Bug 575150] * library/tcltest/tcltest.tcl: Corrected -testdir default value. Was not reliable, and disagreed with docs! Thanks to Hemang Lavana. [Bug 575150] 2002-06-28 Donal K. Fellows <fellowsd@cs.man.ac.uk> * unix/tclUnixThrd.c: Renamed the Tcl_Platform* #defines to * unix/tclUnixPipe.c: TclOS* because they are only used * unix/tclUnixFile.c: internally. Also stopped double-#def * unix/tclUnixFCmd.c: of TclOSlstat [Bug #566099, post-rename] * unix/tclUnixFCmd.c: of TclOSlstat [Bug 566099, post-rename] * unix/tclUnixChan.c: * unix/tclUnixPort.h: * doc/string.n: Improved documentation for [string last] along lines described in Bug #574799 so it indicates that the supplied index marks the end of the search space. * doc/string.n: Improved documentation for [string last] along lines described in [Bug 574799] so it indicates that the supplied index marks the end of the search space. 2002-06-27 Don Porter <dgp@users.sourceforge.net> * doc/dde.n: Work in progress updating the documentation * doc/http.n: of the packages that come bundled with * doc/msgcat.n: the Tcl source distribution, notably tcltest. * doc/registry.n: * doc/tcltest.n: * library/tcltest/tcltest.tcl: Made sure that the TCLTEST_OPTIONS * library/tcltest/tcltest.tcl: Made sure that the TCLTEST_OPTIONS environment variablle configures tcltest at package load time. 2002-06-26 Vince Darley <vincentdarley@users.sourceforge.net> * tests/fileSystem.test: * generic/tclIOUtil.c: fix to handling of empty paths "" which are not claimed by any filesystem (Bug #573758). Ensure good error messages are given in all cases. * tests/fileSystem.test: * generic/tclIOUtil.c: fix to handling of empty paths "" which are not claimed by any filesystem [Bug 573758]. Ensure good error messages are given in all cases. * tests/cmdAH.test: * unix/tclUnixFCmd.c: fix to bug reported as part of (Patch #566669). Thanks to Taguchi, Takeshi for the report. * unix/tclUnixFCmd.c: fix to bug reported as part of [Patch 566669]. Thanks to Taguchi, Takeshi for the report. 2002-06-26 Reinhard Max <max@suse.de> * unix/tclUnixTime.c: Make [clock format] respect locale settings. * tests/clock.test: Bug #565880. ***POTENTIAL INCOMPATIBILITY*** * tests/clock.test: [Bug 565880]. ***POTENTIAL INCOMPATIBILITY*** 2002-06-26 Miguel Sofer <msofer@users.sourceforge.net> * doc/CrtInterp.3: * doc/StringObj.3: clarifications by Don Porter, bugs #493995 and * doc/StringObj.3: clarifications by Don Porter, [Bugs 493995, 500930] #500930. 2002-06-24 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: Corrected suppression of -verbose skip * tests/tcltest.test: and start by [test -output]. Also corrected test suite errors exposed by corrected code. [Bug 564656] * tests/tcltest.test: and start by [test -output]. Also corrected test suite errors exposed by corrected code. [Bug 564656] 2002-06-25 Reinhard Max <max@suse.de> * unix/tcl.m4: New macro SC_CONFIG_MANPAGES. * unix/tcl.m4: New macro SC_CONFIG_MANPAGES. * unix/configure.in: Added support for symlinks and compression * unix/Makefile.in: when installing the manpages. [Patch 518052] * unix/mkLinks.tcl: Default is still hardlinks and no compression. * unix/mkLinks: generated * unix/mkLinks: generated * unix/configure: * unix/README: Added documentation for the new features. * unix/README: Added documentation for the new features. * unix/tcl.m4 (SC_PATH_TCLCONFIG): Replaced ${exec_prefix}/lib by ${libdir}. 2002-06-25 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tclUtil.c (TclGetIntForIndex): Fix of critical bug #533364 generated when the index is bad and the result is a shared object. The T_ASTO(T_GOR, ...) idiom likely exists elsewhere though. Also removed some cruft that just complicated things to * generic/tclUtil.c (TclGetIntForIndex): Fix of critical [Bug 533364] generated when the index is bad and the result is a shared object. The T_ASTO(T_GOR, ...) idiom likely exists elsewhere though. Also removed some cruft that just complicated things to no advantage. no advantage. (SetEndOffsetFromAny): Same fix, though this wasn't on the path excited by the bug. 2002-06-24 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: Implementation of TIP 101. Adds * tests/parseOld.test: and exports a [configure] command * tests/tcltest.test: from tcltest. 2002-06-22 Don Porter <dgp@users.sourceforge.net> * changes: updated changes file for 8.4b1 release. * library/tcltest/tcltest.tcl: Corrections to tcltest and the * tests/basic.test: Tcl test suite so that a test * tests/cmdInfo.test: with options -constraints knownBug * tests/compile.test: -limitConstraints 1 only tests the * tests/encoding.test: knownBug tests. Mostly involves * tests/encoding.test: knownBug tests. Mostly involves * tests/env.test: replacing direct access to the * tests/event.test: testConstraints array with calls * tests/exec.test: to the testConstraint command * tests/execute.test: (which requires tcltest version 2) * tests/fCmd.test: * tests/format.test: * tests/http.test: * tests/httpold.test: * tests/ioUtil.test: * tests/link.test: * tests/load.test: * tests/namespace.test: * tests/pkgMkIndex.test: * tests/reg.test: * tests/result.test: * tests/scan.test: * tests/stack.test: 2002-06-22 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tools/tcl.wse.in (Disk Label), unix/tcl.spec (version): * win/README.binary, README, win/configure.in, unix/configure.in: * tools/tcl.wse.in (Disk Label), unix/tcl.spec (version): * win/README.binary, README, win/configure.in, unix/configure.in: * generic/tcl.h (TCL_RELEASE_*, TCL_PATCH_LEVEL): Bump to beta1. 2002-06-21 Joe English <jenglish@users.sourceforge.net> * generic/tclCompExpr.c: * generic/tclParseExpr.c: LogSyntaxError() should reset the interpreter result [Bug 550142 "Tcl_ExprObj -> abort"] * generic/tclParseExpr.c: LogSyntaxError() should reset the interpreter result [Bug 550142 "Tcl_ExprObj -> abort"] 2002-06-21 Don Porter <dgp@users.sourceforge.net> * unix/Makefile.in: Updated all package install directories * win/Makefile.in: to match current Major.minor versions * win/makefile.bc: of the packages. Added tcltest package * win/makefile.vc: to installation on Windows. * unix/Makefile.in: Updated all package install directories to * win/Makefile.in: match current Major.minor versions of the * win/makefile.bc: packages. Added tcltest package to * win/makefile.vc: installation on Windows. * library/init.tcl: Corrected comments and namespace style issues. Thanks to Bruce Stephens. [Bug 572025] * library/init.tcl: Corrected comments and namespace style issues. Thanks to Bruce Stephens. [Bug 572025] 2002-06-21 Vince Darley <vincentdarley@users.sourceforge.net> * tests/cmdAH.test: Added TIP#99 implementation * tests/fCmd.test: of 'file link'. Supports creation * tests/fileName.test: of symbolic and hard links in the * tests/fileSystem.test: native filesystems and in vfs's, * generic/tclTest.c: when the individual filesystem * generic/tclCmdAH.c: supports the concept. * generic/tclIOUtil.c: * tests/cmdAH.test: Added TIP#99 implementation of 'file * tests/fCmd.test: link'. Supports creation of symbolic and * tests/fileName.test: hard links in the native filesystems and * tests/fileSystem.test: in vfs's, when the individual filesystem * generic/tclTest.c: supports the concept. * generic/tclCmdAH.c: * generic/tclIOUtil.c: * generic/tcl.h: * generic/tcl.decls: * doc/FileSystem.3: * doc/file.n: * mac/tclMacFile.c: * unix/tclUnixFile.c: * win/tclWinFile.c: Also enhanced speed of 'file normalize' on * win/tclWinFile.c: Also enhanced speed of 'file normalize' on Windows Windows. 2002-06-20 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclBasic.c (TclEvalObjvInternal): fix for [Bug 571385] in the implementation of TIP#62 (command tracing). Vince Darley, Hemang Lavana & Don Porter: thanks. * generic/tclBasic.c (TclEvalObjvInternal): fix for [Bug 571385] in the implementation of TIP#62 (command tracing). Vince Darley, Hemang Lavana & Don Porter: thanks. 2002-06-20 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c (TclCompEvalObj): clarified and simplified the logic for compilation/recompilation. * generic/tclExecute.c (TclCompEvalObj): clarified and simplified the logic for compilation/recompilation. 2002-06-19 Joe English <jenglish@users.sourceforge.net> * doc/file.n: Fixed indentation. No substantive changes. 2002-06-19 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): get the resultPtr again as the Tcl_ObjSetVar2 may cause the result to change. [Patch #558324] (watson) * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): get the resultPtr again as the Tcl_ObjSetVar2 may cause the result to change. [Patch 558324] (watson) 2002-06-19 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c (TEBC): removing unused "for(;;)" loop; improved comments; re-indentation. 2002-06-18 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c (TEBC): * generic/tclExecute.c (TEBC): - elimination of duplicated code in the non-immediate INST_INCR instructions. instructions. - elimination of 103 (!) TclDecrRefCount macros. The different instructions now jump back to a common "DecrRefCount zone" at the top of the loop. The macro "ADJUST_PC" was replaced by two macros "NEXT_INST_F" and "NEXT_INST_V" that take three params (pcAdjustment, # of stack objects to discard, resultObjPtr handling flag). The only instructions that retain a TclDecrRefCount are INST_POP (for speed), the common code for the non-immediate INST_INCR, INST_FOREACH_STEP and the two instructions now jump back to a common "DecrRefCount zone" at the top of the loop. The macro "ADJUST_PC" was replaced by two macros "NEXT_INST_F" and "NEXT_INST_V" that take three params (pcAdjustment, # of stack objects to discard, resultObjPtr handling flag). The only instructions that retain a TclDecrRefCount are INST_POP (for speed), the common code for the non-immediate INST_INCR, INST_FOREACH_STEP and the two INST_LSET. INST_LSET. The object size of tclExecute.o was reduced by approx 20% since the start of the consolidation drive, while making room for some peep-hole optimisation at runtime. The object size of tclExecute.o was reduced by approx 20% since the start of the consolidation drive, while making room for some peep-hole optimisation at runtime. 2002-06-18 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c (TEBC, INST_DONE): small bug in the panic code for tcl-stack corruption. * generic/tclExecute.c (TEBC, INST_DONE): small bug in the panic code for tcl-stack corruption. 2002-06-17 David Gravereaux <davygrvy@pobox.com> Trims to support the removal of RESOURCE_INCLUDED from rc scripts from FR #565088. Trims to support the removal of RESOURCE_INCLUDED from rc scripts from [FRQ 565088]. * generic/tcl.h: moved the #ifndef RC_INVOKED start block up in the file. rc scripts don't need to know thread mutexes. * generic/tcl.h: moved the #ifndef RC_INVOKED start block up in the file. rc scripts don't need to know thread mutexes. * win/tcl.rc: * win/tclsh.rc: removed the #define RESOURCE_INCLUDED to let the built-in -DRC_INVOKED to the work. 2002-06-17 Jeff Hobbs <jeffh@ActiveState.com> * doc/CrtTrace.3: Added TIP#62 implementation of command * doc/trace.n: execution tracing [FR #462580] (lavana). * generic/tcl.h: This includes enter/leave tracing as well * generic/tclBasic.c: as inter-procedure stepping. * doc/CrtTrace.3: Added TIP#62 implementation of command * doc/trace.n: execution tracing [FRQ 462580] (lavana). * generic/tcl.h: This includes enter/leave tracing as well * generic/tclBasic.c: as inter-procedure stepping. * generic/tclCmdMZ.c: * generic/tclCompile.c: * generic/tclExecute.c: * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclStubInit.c: * generic/tclVar.c: * tests/trace.test: 2002-06-17 Andreas Kupries <andreas_kupries@users.sourceforge.net> * win/tclWinPipe.c (BuildCommandLine): Fixed bug #554068 ([exec] on windows did not treat { in filenames well.). Bug reported by Vince Darley <vincentdarley@users.sourceforge.net>, patch provided by Vince too. * win/tclWinPipe.c (BuildCommandLine): Fixed [bug 554068] ([exec] on windows did not treat { in filenames well.). Bug reported by Vince Darley <vincentdarley@users.sourceforge.net>, patch provided by Vince too. 2002-06-17 Joe English <jenglish@users.sourceforge.net> * generic/tcl.h: #ifdef logic for K&R C backwards compatibility changed to assume modern C by default. See SF FR #565088 for full details. changed to assume modern C by default. See [FRQ 565088] for full details. 2002-06-17 Don Porter <dgp@users.sourceforge.net> * doc/msgcat.n: Corrected en_UK references to en_GB. UK is not a country designation recognized in ISO 3166. * doc/msgcat.n: Corrected en_UK references to en_GB. UK is not a country designation recognized in ISO 3166. * library/msgcat/msgcat.tcl: More Windows Registry locale codes from Bruno Haible. * library/msgcat/msgcat.tcl: More Windows Registry locale codes from Bruno Haible. * doc/msgcat.n: * library/msgcat/msgcat.tcl: * library/msgcat/pkgIndex.tcl: * tests/msgcat.test: Revised locale initialization to interpret environment variable locale values according to XPG4, and to recognize the LC_ALL and LC_MESSAGES values over that of LANG. Also added many Windows Registry locale values to those environment variable locale values according to XPG4, and to recognize the LC_ALL and LC_MESSAGES values over that of LANG. Also added many Windows Registry locale values to those recognized by msgcat. Revised recognized by msgcat. Revised tests and docs. Bumped to version 1.3. Thanks to Bruno Haible for the report and assistance crafting the solution. [Bug 525522, 525525] tests and docs. Bumped to version 1.3. Thanks to Bruno Haible for the report and assistance crafting the solution. [Bug 525522, 525525] 2002-06-16 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclCompile.c (TclCompileTokens): a better algorithm for the previous bug fix. * generic/tclCompile.c (TclCompileTokens): a better algorithm for the previous bug fix. 2002-06-16 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclCompile.c (TclCompileTokens): * generic/tclCompile.c (TclCompileTokens): * tests/compile.test: [Bug 569438] in the processing of dollar variables; report by Georgios Petasis. variables; report by Georgios Petasis. 2002-06-16 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c: bug in the consolidation of the INCR_..._STK instructions; the bug could not be exercised as the (faulty) instruction INST_INCR_ARRAY_STK was never compiled-in (related to [Bug 569438]). * generic/tclExecute.c: bug in the consolidation of the INCR_..._STK instructions; the bug could not be exercised as the (faulty) instruction INST_INCR_ARRAY_STK was never compiled-in (related to [Bug 569438]). 2002-06-14 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c (TclExecuteByteCode): runtime peep-hole optimisation of variables (INST_STORE, INST_INCR) and commands (INST_INVOKE); faster check for the existence of a catch. (TclExecuteByteCode): runtime peep-hole optimisation of (TclExecuteByteCode): runtime peep-hole optimisation of comparisons. comparisons. (TclExecuteByteCode): runtime peep-hole optimisation of INST_FOREACH - relies on peculiarities of the code produced by the (TclExecuteByteCode): runtime peep-hole optimisation of INST_FOREACH - relies on peculiarities of the code produced by the bytecode compiler. bytecode compiler. 2002-06-14 David Gravereaux <davygrvy@pobox.com> * win/rules.vc: The test for compiler optimizations was in error. Thanks goes to Roy Terry <royterry@earthlink.net> for his assistance with this. Thanks goes to Roy Terry <royterry@earthlink.net> for his assistance with this. 2002-06-14 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/trace.n, tests/trace.test: * doc/trace.n, tests/trace.test: * generic/tclCmdMZ.c (Tcl_TraceObjCmd,TclTraceCommandObjCmd) (TclTraceVariableObjCmd): Changed references to "trace list" to "trace info" as mandated by TIP#102. (TclTraceVariableObjCmd): Changed references to "trace list" to "trace info" as mandated by TIP#102. 2002-06-13 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c (TclExecuteByteCode): consolidated code for the conditional branch instructions. * generic/tclExecute.c (TclExecuteByteCode): consolidated code for the conditional branch instructions. 2002-06-13 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c (TclExecuteByteCode): fixed the previous patch - wouldn't compile with TCL_COMPILE_DEBUG set. 2002-06-13 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c (TclExecuteByteCode): consolidated the handling of exception returns to INST_INVOKE and INST_EVAL, as well as most of the code for INST_CONTINUE and INST_BREAK, in the new jump target "processExceptionReturn". * generic/tclExecute.c (TclExecuteByteCode): consolidated the handling of exception returns to INST_INVOKE and INST_EVAL, as well as most of the code for INST_CONTINUE and INST_BREAK, in the new jump target "processExceptionReturn". 2002-06-13 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c (TclExecuteByteCode): consolidated variable handling opcodes, replaced redundant code with some 'goto'. All store/append/lappend opcodes on the same data type now share the main code; same with incr opcodes. store/append/lappend opcodes on the same data type now share the main code; same with incr opcodes. * generic/tclVar.c: added the bit TCL_TRACE_READS to the possible flags to Tcl_SetVar2Ex - it causes read traces to be fired prior to setting the variable. This is used in the core for [lappend]. flags to Tcl_SetVar2Ex - it causes read traces to be fired prior to setting the variable. This is used in the core for [lappend]. ***NOTE*** the usage of TCL_TRACE_READS in Tcl_(Obj)?GetVar.* is not documented; there, it causes the call to create the variable if it does not exist. The new usage in Tcl_(Obj)?SetVar.* remains ***NOTE*** the usage of TCL_TRACE_READS in Tcl_(Obj)?GetVar.* is not documented; there, it causes the call to create the variable if it does not exist. The new usage in Tcl_(Obj)?SetVar.* remains undocumented too ... 2002-06-13 Vince Darley <vincentdarley@users.sourceforge.net> * tests/fCmd.test: * tests/winFile.test: * tests/fileSystem.test: * generic/tclTest.c: * generic/tclCmdAH.c: * generic/tclIOUtil.c: * doc/FileSystem.3: * mac/tclMacFile.c: * unix/tclUnixFile.c: * win/tclWinFile.c: fixed up further so both compiles and actually works with VC++ 5 or 6. * win/tclWinInt.h: * win/tclWin32Dll.c: cleaned up code and vfs tests and added tests for the internal changes of 2002-06-12, to see whether WinTcl on NTFS can coexist peacefully with links * win/tclWinFile.c: fixed up further so both compiles and actually works with VC++ 5 or 6. * win/tclWinInt.h: * win/tclWin32Dll.c: cleaned up code and vfs tests and added tests for the internal changes of 2002-06-12, to see whether WinTcl on NTFS can coexist peacefully with links in the filesystem. Added new test in the filesystem. Added new test command 'testfilelink' to enable the newer code to be tested. * tests/fCmd.test: (made certain tests of 'testfilelink' not run on unix). command 'testfilelink' to enable the newer code to be tested. * tests/fCmd.test: (made certain tests of 'testfilelink' not run on unix). 2002-06-12 Miguel Sofer <msofer@users.sourceforge.net> * tclBasic.c (Tcl_DeleteTrace): fixed [Bug 568123] (thanks to Hemang Lavana) 2002-06-12 Jeff Hobbs <jeffh@ActiveState.com> * win/tclWinFile.c: corrected the symbolic link handling code to allow it to compile. Added real definition of REPARSE_DATA_BUFFER (found in winnt.h). Most of the added definitions appear to have allow it to compile. Added real definition of REPARSE_DATA_BUFFER (found in winnt.h). Most of the added definitions appear to have correct, cross-Win-version equivalents in winnt.h and should be removed, but just making things "work" for now. 2002-06-12 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclIOUtil.c: * generic/tcl.decls: * generic/tclDecls.h: made code for Tcl_FSNewNativePath agree with man pages. * doc/FileSystem.3: clarified the circumstances under which certain functions are called in the presence of symlinks. * generic/tclDecls.h: made code for Tcl_FSNewNativePath agree with man pages. * doc/FileSystem.3: clarified the circumstances under which certain functions are called in the presence of symlinks. * win/tclWinFile.c: * win/tclWinPort.h: * win/tclWinInt.h: * win/tclWinFCmd.c: Fix for Windows to allow 'file lstat', 'file type', 'glob -type l', 'file copy', 'file delete', 'file normalize', and all VFS code to work correctly in the presence of symlinks (previously Tcl's behaviour was not very well defined). This also fixes possible serious problems in * win/tclWinPort.h: * win/tclWinInt.h: * win/tclWinFCmd.c: Fix for Windows to allow 'file lstat', 'file type', 'glob -type l', 'file copy', 'file delete', 'file normalize', and all VFS code to work correctly in the presence of symlinks (previously Tcl's behaviour was not very well defined). This also fixes possible serious problems in all versions of WinTcl where 'file all versions of WinTcl where 'file delete' on a NTFS symlink could delete the original, not the symlink. delete' on a NTFS symlink could delete the original, not the symlink. Note: symlinks cannot yet be created in pure Tcl. 2002-06-11 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclBasic.c: * generic/tclBasic.c: * generic/tclCompCmds.c: * generic/tclInt.h: reverted the new compilation functions; replaced by a more general approach described below. * generic/tclInt.h: reverted the new compilation functions; replaced by a more general approach described below. * generic/tclCompCmds.c: * generic/tclCompile.c: made *all* compiled variable access attempts create an indexed variable - even get or incr without previous set. This allows indexed access to local variables that are created and set at runtime, for example by [global], [upvar], [variable], [regexp], [regsub]. * generic/tclCompile.c: made *all* compiled variable access attempts create an indexed variable - even get or incr without previous set. This allows indexed access to local variables that are created and set at runtime, for example by [global], [upvar], [variable], [regexp], [regsub]. 2002-06-11 Miguel Sofer <msofer@users.sourceforge.net> * doc/global.n: * doc/info.n: * test/info.test: * generic/tclCmdIL.c: fix for [Bug 567386], [info locals] was reporting some linked variables. * generic/tclBasic.c: * generic/tclBasic.c: * generic/tclCompCmds.c: * generic/tclInt.h: added compile functions for [global], [variable] and [upvar]. They just declare the new local variables, the commands themselves are not compiled-in. This gives a notably faster read access to these linked variables. * generic/tclInt.h: added compile functions for [global], [variable] and [upvar]. They just declare the new local variables, the commands themselves are not compiled-in. This gives a notably faster read access to these linked variables. 2002-06-11 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c: optimised algorithm for exception range lookup; part of [Patch 453709]. 2002-06-10 Vince Darley <vincentdarley@users.sourceforge.net> * unix/tclUnixFCmd.c: fixed [Bug #566669] * generic/tclIOUtil.c: improved and sped up handling of native paths (duplication and conversion to normalized paths), particularly on Windows. * modified part of above commit, due to problems on Linux. Will re-examine bug report and evaluate more closely. * unix/tclUnixFCmd.c: fixed [Bug 566669] * generic/tclIOUtil.c: improved and sped up handling of native paths (duplication and conversion to normalized paths), particularly on Windows. * modified part of above commit, due to problems on Linux. Will re-examine bug report and evaluate more closely. 2002-06-07 Don Porter <dgp@users.sourceforge.net> * tests/tcltest.test: More corrections to test suite so that tests of failing [test]s don't show up themselves as failing tests. * tests/tcltest.test: More corrections to test suite so that tests of failing [test]s don't show up themselves as failing tests. 2002-06-07 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tclExecute.c: Tidied up headers in relation to float.h to cut the cruft and ensure DBL_MAX is defined since doubles seem to be the same size everywhere; if the assumption isn't true, the variant platforms had better have run configure... * generic/tclExecute.c: Tidied up headers in relation to float.h to cut the cruft and ensure DBL_MAX is defined since doubles seem to be the same size everywhere; if the assumption isn't true, the variant platforms had better have run configure... * unix/tclUnixPort.h (EOVERFLOW): Added code to define it if it wasn't previously defined. Also some other general tidying and adding of comments. [Tcl bugs 563122, 564595] * unix/tclUnixPort.h (EOVERFLOW): Added code to define it if it wasn't previously defined. Also some other general tidying and adding of comments. [Bugs 563122, 564595] * compat/tclErrno.h: Added definition for EOVERFLOW copied from Solaris headers; I've been unable to find any uses of EFTYPE, which was the error code previously occupying the slot, in Tcl, or any definition of it in the Solaris headers. Solaris headers; I've been unable to find any uses of EFTYPE, which was the error code previously occupying the slot, in Tcl, or any definition of it in the Solaris headers. 2002-06-06 Mo DeJong <mdejong@users.sourceforge.net> * unix/dltest/Makefile.in: Remove hard coded CFLAGS=-g and add CFLAGS_DEBUG, CFLAGS_OPTIMIZE, and CFLAGS_DEFAULT varaibles. [Tcl bug 565488] * unix/dltest/Makefile.in: Remove hard coded CFLAGS=-g and add CFLAGS_DEBUG, CFLAGS_OPTIMIZE, and CFLAGS_DEFAULT varaibles. [Bug 565488] 2002-06-06 Don Porter <dgp@users.sourceforge.net> * tests/tcltest.test: Corrections to test suite so that tests of failing [test]s don't show up themselves as failing tests. * tests/tcltest.test: Corrections to test suite so that tests of failing [test]s don't show up themselves as failing tests. * tests/io.test: Fixed up namespace variable resolution issues revealed by running test suite with "-singleproc 1". * doc/tcltest.n: * library/tcltest/tcltest.tcl: * tests/tcltest.test: Several updates to tcltest. 1) changed to lazy initialization of test constraints 2) deprecated [initConstraintsHook] 3) repaired badly broken [limitConstraints]. 4) deprecated [threadReap] and [mainThread] [Patch 512214, Bug 558742, Bug 461000, Bug 534903] 2002-06-06 Daniel Steffen <das@users.sourceforge.net> * unix/tclUnixThrd.c (TclpReaddir, TclpLocaltime, TclpGmtime): added mutex wrapped calls to readdir, localtime & gmtime in case their thread-safe *_r counterparts are not available. added mutex wrapped calls to readdir, localtime & gmtime in case their thread-safe *_r counterparts are not available. * unix/tcl.m4: added configure check for readdir_r * unix/tcl.m4 (Darwin): set TCL_DEFAULT_ENCODING to utf-8 on MacOSX (where posix file apis expect utf-8, not iso8859-1). * unix/tcl.m4 (Darwin): set TCL_DEFAULT_ENCODING to utf-8 on MacOSX (where posix file apis expect utf-8, not iso8859-1). * unix/configure: regen * unix/Makefile.in: set DYLD_LIBRARY_PATH in parallel to LD_LIBRARY_PATH for MacOSX dynamic linker. * generic/tclEnv.c (TclSetEnv): fix env var setting on MacOSX (adapted from patch #524352 by jkbonfield). * unix/Makefile.in: set DYLD_LIBRARY_PATH in parallel to LD_LIBRARY_PATH for MacOSX dynamic linker. * generic/tclEnv.c (TclSetEnv): fix env var setting on MacOSX. Adapted from [Patch 524352] (jkbonfield). 2002-06-05 Don Porter <dgp@users.sourceforge.net> * doc/Tcl_Main.3: Documented $tcl_rcFileName and added more clarifications about the intended use of Tcl_Main(). [Bug 505651] 2002-06-05 Daniel Steffen <das@users.sourceforge.net> * generic/tclFileName.c (TclGlob): mac specific fix to recent changes in 'glob -tails' handling. * generic/tclFileName.c (TclGlob): mac specific fix to recent changes in 'glob -tails' handling. * mac/tclMacPort.h: * mac/tclMacChan.c: fixed TIP#91 bustage. * mac/tclMacResource.c (Tcl_MacConvertTextResource): added utf conversion of text resource contents. * tests/macFCmd.test (macFCmd-1.2): allow CWIE creator. 2002-06-04 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: * tests/init.test: * tests/tcltest.test: Added more TIP 85 tests from Arjen Markus. Converted tcltest.test to use a private namespace. Fixed bugs in Converted tcltest.test to use a private namespace. Fixed bugs in [tcltest::Eval] revealed by calling [tcltest::test] from a non-global namespace, and namespace errors in init.test. 2002-06-04 Mo DeJong <mdejong@users.sourceforge.net> * win/README: Update msys+mingw URL. 2002-06-03 Don Porter <dgp@users.sourceforge.net> * doc/tcltest.n: * library/tcltest/tcltest.tcl: * library/tcltest/pkgIndex.tcl: * tests/tcltest.test: Implementation of TIP 85. Allows tcltest users to add new legal values of the -match option to [test], associating each with a Tcl command that does the matching of expected results with actual results of tests. Thanks to Arjen Markus. => tcltest 2.1 [Patch 521362] * tests/tcltest.test: Implementation of TIP 85. Allows tcltest users to add new legal values of the -match option to [test], associating each with a Tcl command that does the matching of expected results with actual results of tests. Thanks to Arjen Markus. => tcltest 2.1 [Patch 521362] 2002-06-03 Miguel Sofer <msofer@users.sourceforge.net> * doc/namespace.n: added description of [namepace forget] behaviour for unqualified patterns [Bug 559268] * doc/namespace.n: added description of [namepace forget] behaviour for unqualified patterns [Bug 559268] 2002-06-03 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c: reverting an accidental modification in the last commit. * generic/tclExecute.c: reverting an accidental modification in the last commit. 2002-06-03 Miguel Sofer <msofer@users.sourceforge.net> * doc/Tcl.n: clarify the empty variable name issue ([Bug 549285] reported by Tom Krehbiel, patch by Don Porter). 2002-05-31 Don Porter <dgp@users.sourceforge.net> * library/package.tcl: Fixed leak of slave interp in [pkg_mkIndex]. Thanks to Helmut for report. [Bug 550534] * library/package.tcl: Fixed leak of slave interp in [pkg_mkIndex]. Thanks to Helmut for report. [Bug 550534] * tests/io.test: * tests/main.test: Use the "stdio" constraint to control whether an [open "|[interpreter]"] is attempted. * tests/main.test: Use the "stdio" constraint to control whether an [open "|[interpreter]"] is attempted. * generic/tclExecute.c (TclMathInProgress,TclExecuteByteCode ExprCallMathFunc): (ExprCallMathFunc): * generic/tclInt.h (TclMathInProgress): * unix/Makefile.in (tclMtherr.*): * unix/configure.in (NEED_MATHERR): * unix/tclAppInit.c (matherr): * unix/tclMtherr.c (removed file): * win/tclWinMtherr.c (_matherr): Removed internal routine TclMathInProgress and Unix implementation of matherr(). These are now obsolete, dealing with very old versions of the C math library. Windows version is retained in case Borland compilers TclMathInProgress and Unix implementation of matherr(). These are now obsolete, dealing with very old versions of the C math library. Windows version is retained in case Borland compilers require it, but require it, but it is inactive. Thanks to Joe English. [Bug 474335, Patch 555635]. it is inactive. Thanks to Joe English. [Bug 474335, Patch 555635] * unix/configure: regen 2002-05-30 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclCompExpr.c: * generic/tclCompile.c: * generic/tclCompile.h: removed exprIsJustVarRef and exprIsComparison from the ExprInfo and CompileEnv structs. These were set, but not used since dec 1999 [Bug 562383]. exprIsComparison from the ExprInfo and CompileEnv structs. These were set, but not used since dec 1999 [Bug 562383]. 2002-05-30 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclFileName.c (TclGlob): fix to longstanding 'knownBug' in fileName tests 15.2-15.4, and fix to a new Tcl 8.4 bug in certain uses of 'glob -tails'. * tests/fileName.test: removed 'knownBug' flag from some tests, added some new tests for above bugs. * generic/tclFileName.c (TclGlob): fix to longstanding 'knownBug' in fileName tests 15.2-15.4, and fix to a new Tcl 8.4 bug in certain uses of 'glob -tails'. * tests/fileName.test: removed 'knownBug' flag from some tests, added some new tests for above bugs. 2002-05-29 Jeff Hobbs <jeffh@ActiveState.com> * unix/configure: regen'ed * unix/configure.in: replaced bigendian check with autoconf standard AC_C_BIG_ENDIAN, which defined WORDS_BIGENDIAN on * unix/configure.in: replaced bigendian check with autoconf standard AC_C_BIG_ENDIAN, which defined WORDS_BIGENDIAN on bigendian systems. bigendian systems. * generic/tclUtf.c (Tcl_UniCharNcmp): * generic/tclUtf.c (Tcl_UniCharNcmp): * generic/tclInt.h (TclUniCharNcmp): use WORDS_BIGENDIAN instead of TCL_OPTIMIZE_UNICODE_COMPARE to enable memcmp alternative. * generic/tclExecute.c (TclExecuteByteCode INST_STR_CMP): * generic/tclCmdMZ.c (Tcl_StringObjCmd): changed the case for choosing the Tcl_UniCharNcmp compare to when both objs are of StringType, as benchmarks show that is the optimal check (both bigendian and littleendian systems). * generic/tclCmdMZ.c (Tcl_StringObjCmd): changed the case for choosing the Tcl_UniCharNcmp compare to when both objs are of StringType, as benchmarks show that is the optimal check (both bigendian and littleendian systems). 2002-05-29 Don Porter <dgp@users.sourceforge.net> * generic/tclMain.c: Removed "dummy" reference to Tcl_LinkVar. It is no longer needed since Tcl_Main() now actually calls Tcl_LinkVar(). Thanks to Joe English for pointing that out. * generic/tclMain.c: Removed "dummy" reference to Tcl_LinkVar. It is no longer needed since Tcl_Main() now actually calls Tcl_LinkVar(). Thanks to Joe English for pointing that out. 2002-05-29 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tclExecute.c (TclExecuteByteCode): * generic/tclExecute.c (TclExecuteByteCode): * generic/tclCmdMZ.c (Tcl_StringObjCmd): Use the macro version. * generic/tclInt.h (TclUniCharNcmp): Optimised still further with a macro for use in sensitive places like tclExecute.c * generic/tclInt.h (TclUniCharNcmp): Optimised still further with a macro for use in sensitive places like tclExecute.c * generic/tclUtf.c (Tcl_UniCharNcmp): Use new flag to figure out when we can use an optimal comparison scheme, and default to the old scheme in other cases which is at least safe. * unix/configure.in (TCL_OPTIMIZE_UNICODE_COMPARE): New optional flag that indicates when we can use memcmp() to compare Unicode strings (i.e. when the high-byte of a Tcl_UniChar precedes the * generic/tclUtf.c (Tcl_UniCharNcmp): Use new flag to figure out when we can use an optimal comparison scheme, and default to the old scheme in other cases which is at least safe. * unix/configure.in (TCL_OPTIMIZE_UNICODE_COMPARE): New optional flag that indicates when we can use memcmp() to compare Unicode strings (i.e. when the high-byte of a Tcl_UniChar precedes the low-byte.) low-byte.) 2002-05-29 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclInt.decls: * generic/tclIntDecls.h: * generic/tclStubInit.c: * generic/tclUtf.c: added TclpUtfNcmp2 private command that mirrors Tcl_UtfNcmp, but takes n in bytes, not utf-8 chars. This provides a faster alternative for comparing utf strings internally. (Tcl_UniCharNcmp, Tcl_UniCharNcasecmp): removed the explicit end of string check as it wasn't correct for the function (by doc and * generic/tclUtf.c: added TclpUtfNcmp2 private command that mirrors Tcl_UtfNcmp, but takes n in bytes, not utf-8 chars. This provides a faster alternative for comparing utf strings internally. (Tcl_UniCharNcmp, Tcl_UniCharNcasecmp): removed the explicit end of string check as it wasn't correct for the function (by doc and logic). logic). * generic/tclCmdMZ.c (Tcl_StringObjCmd): reworked the string equal comparison code to use TclpUtfNcmp2 as well as short-circuit for equal objects or unequal length strings in the equal case. Removed the use of goto and streamlined the other parts. comparison code to use TclpUtfNcmp2 as well as short-circuit for equal objects or unequal length strings in the equal case. Removed the use of goto and streamlined the other parts. * generic/tclExecute.c (TclExecuteByteCode): added check for object equality in the comparison instructions. Added short-circuit for != length strings in INST_EQ, INST_NEQ and INST_STR_CMP. Reworked INST_STR_CMP to use TclpUtfNcmp2 where appropriate, and only use Tcl_UniCharNcmp when at least one of the objects is a Unicode obj with no utf bytes. * generic/tclExecute.c (TclExecuteByteCode): added check for object equality in the comparison instructions. Added short-circuit for != length strings in INST_EQ, INST_NEQ and INST_STR_CMP. Reworked INST_STR_CMP to use TclpUtfNcmp2 where appropriate, and only use Tcl_UniCharNcmp when at least one of the objects is a Unicode obj with no utf bytes. * generic/tclCompCmds.c (TclCompileStringCmd): removed error creation in code that no longer throws an error. * generic/tclCompCmds.c (TclCompileStringCmd): removed error creation in code that no longer throws an error. * tests/string.test: * tests/stringComp.test: added more string comparison checks. * tests/clock.test: better qualified 9.1 constraint check for %s. 2002-05-28 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclThreadAlloc.c (TclpRealloc, TclpFree): protect against the case when NULL is based. * generic/tclThreadAlloc.c (TclpRealloc, TclpFree): protect against the case when NULL is based. * tests/clock.test: added clock-9.1 * compat/strftime.c: * generic/tclClock.c: * generic/tclInt.decls: * generic/tclIntDecls.h: * unix/tclUnixTime.c: fix for Windows msvcrt mem leak caused by using an env(TZ) setting trick for in clock format -gmt 1. This also makes %s seem to work correctly with -gmt 1 as well as making it a lot faster by avoid the env(TZ) hack. TclpStrftime now takes useGMT as an arg. [Bug #559376] * unix/tclUnixTime.c: fix for Windows msvcrt mem leak caused by using an env(TZ) setting trick for in clock format -gmt 1. This also makes %s seem to work correctly with -gmt 1 as well as making it a lot faster by avoid the env(TZ) hack. TclpStrftime now takes useGMT as an arg. [Bug 559376] 2002-05-28 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclIOUtil.c: fixes to Tcl_FSLoadFile when called on a file inside a vfs. This should avoid leaving temporary files sitting around on exit. [Bug #545579] * generic/tclIOUtil.c: fixes to Tcl_FSLoadFile when called on a file inside a vfs. This should avoid leaving temporary files sitting around on exit. [Bug 545579] 2002-05-27 Donal K. Fellows <fellowsd@cs.man.ac.uk> * win/tclWinError.c: Added comment on conversion of ERROR_NEGATIVE_SEEK because that is a mapping that really belongs, and not a catch-all case. ERROR_NEGATIVE_SEEK because that is a mapping that really belongs, and not a catch-all case. * win/tclWinPort.h (EOVERFLOW): Should be either EFBIG or EINVAL * generic/tclPosixStr.c (Tcl_ErrnoId, Tcl_ErrnoMsg): EOVERFLOW can potentially be a synonym for EINVAL. 2002-05-24 Donal K. Fellows <fellowsd@cs.man.ac.uk> === Changes due to TIP#91 === * win/tclWinPort.h: Added declaration of EOVERFLOW. * doc/CrtChannel.3: Added documentation of wideSeekProc. * generic/tclIOGT.c (TransformSeekProc, TransformWideSeekProc): Adapted to use the new channel mechanism. * unix/tclUnixChan.c (FileSeekProc, FileWideSeekProc): Renamed FileSeekProc to FileWideSeekProc and created new FileSeekProc which has the old-style interface and which errors out with EOVERFLOW when the returned file position can't fit into the return type (int for historical reasons.) FileSeekProc to FileWideSeekProc and created new FileSeekProc which has the old-style interface and which errors out with EOVERFLOW when the returned file position can't fit into the return type (int for historical reasons.) * win/tclWinChan.c (FileSeekProc, FileWideSeekProc): Renamed FileSeekProc to FileWideSeekProc and created new FileSeekProc which has the old-style interface and which errors out with EOVERFLOW when the returned file position can't fit into the return type (int for historical reasons.) * mac/tclMacChan.c (FileSeek): Reverted to old interface; Macs lack large-file support because I can't see how to add it. FileSeekProc to FileWideSeekProc and created new FileSeekProc which has the old-style interface and which errors out with EOVERFLOW when the returned file position can't fit into the return type (int for historical reasons.) * mac/tclMacChan.c (FileSeek): Reverted to old interface; Macs lack large-file support because I can't see how to add it. * generic/tclIO.c (Tcl_Seek, Tcl_Tell): Given these functions knowledge of the new arrangement of channel types. (Tcl_ChannelVersion): Added recognition of new version code. (HaveVersion): New function to do version checking. (Tcl_ChannelBlockModeProc, Tcl_ChannelFlushProc) (Tcl_ChannelHandlerProc): Made these functions use HaveVersion for ease of future maintainability. (Tcl_ChannelBlockModeProc): Obvious lookup function. * generic/tcl.h (Tcl_ChannelType): New wideSeekProc field, and seekProc type restored to old interpretation. (TCL_CHANNEL_VERSION_3): New channel version. 2002-05-24 Andreas Kupries <andreas_kupries@users.sourceforge.net> * tests/winPipe.test: Applied patch for SF Tcl Bug #549617. Patch and bug report by Kevin Kenny <kennykb@users.sourceforge.net>. * tests/winPipe.test: Applied patch for [Bug 549617]. Patch and bug report by Kevin Kenny <kennykb@users.sourceforge.net>. * win/tclWinSock.c (TcpWatchProc): Fixed SF Tcl Bug #557878. We are not allowed to mess with the watch mask if the socket is a server socket. I believe that the original reporter is George * win/tclWinSock.c (TcpWatchProc): Fixed [Bug 557878]. We are not allowed to mess with the watch mask if the socket is a server socket. I believe that the original reporter is George Peter Staplin. Peter Staplin. 2002-05-21 Mo DeJong <mdejong@users.sourceforge.net> * unix/configure: Regen. * unix/configure.in: Invoke SC_ENABLE_SHARED before calling SC_CONFIG_CFLAGS so that the SHARED_BUILD variable can be checked inside SC_CONFIG_CFLAGS. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Pass -non_shared * unix/configure.in: Invoke SC_ENABLE_SHARED before calling SC_CONFIG_CFLAGS so that the SHARED_BUILD variable can be checked inside SC_CONFIG_CFLAGS. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Pass -non_shared instead of -shared instead of -shared to ld when configured with --disable-shared under OSF. [Tcl bug 540390] to ld when configured with --disable-shared under OSF. [Bug 540390] 2002-05-20 Daniel Steffen <das@users.sourceforge.net> * generic/tclInt.h: added prototype for TclpFilesystemPathType(). * mac/tclMacChan.c: use MSL provided creator type if available instead of the default 'MPW '. * mac/tclMacChan.c: use MSL provided creator type if available instead of the default 'MPW '. 2002-05-16 Joe English <jenglish@users.sf.net> * doc/CrtObjCmd.3: Added Tcl_GetCommandFromObj, Tcl_GetCommandFullName (Tcl Bug #547987, #414921) * doc/CrtObjCmd.3: Added Tcl_GetCommandFromObj, Tcl_GetCommandFullName [Bugs 547987, 414921] 2002-05-14 Donal K. Fellows <fellowsd@cs.man.ac.uk> * unix/tclUnixChan.c (TtyOutputProc): #if/#endif-ed this function out to stop compiler warnings. Also much general tidying of comments in this file and removal of whitespace from blank lines. * unix/tclUnixChan.c (TtyOutputProc): #if/#endif-ed this function out to stop compiler warnings. Also much general tidying of comments in this file and removal of whitespace from blank lines. 2002-05-13 Donal K. Fellows <fellowsd@cs.man.ac.uk> * unix/tclUnixChan.c (SETBREAK): Solaris thinks ioctl() takes a signed second argument, and Linux thinks ioctl() takes an unsigned second argument. So need a longer definition of this macro to get neither to spew warnings... * unix/tclUnixChan.c (SETBREAK): Solaris thinks ioctl() takes a signed second argument, and Linux thinks ioctl() takes an unsigned second argument. So need a longer definition of this macro to get neither to spew warnings... 2002-05-13 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclEvent.c: * generic/tclEvent.c: * generic/tclIOUtil.c: * generic/tclInt.h: clean up all memory allocated by the filesystem, via introduction of 'TclFinalizeFilesystem'. * generic/tclInt.h: clean up all memory allocated by the filesystem, via introduction of 'TclFinalizeFilesystem'. Move TclFinalizeLoad into Move TclFinalizeLoad into TclFinalizeFilesystem so we can be sure it is called at just the right time. Fix bad comment also. [Bug #555078 and 'fs' part of #543549] TclFinalizeFilesystem so we can be sure it is called at just the right time. Fix bad comment also. [Bug 555078 and 'fs' part of 543549] * win/tclWinChan.c: fix comment referring to wrong function. 2002-05-10 Don Porter <dgp@users.sourceforge.net> * tests/load.test: * tests/safe.test: * tests/tcltest.test: Corrected some list-quoting issues and other matters that cause tests to fail when the patch includes special characters. Report from Vince Darley. [Bug 554068]. * tests/tcltest.test: Corrected some list-quoting issues and other matters that cause tests to fail when the patch includes special characters. Report from Vince Darley. [Bug 554068]. 2002-05-08 David Gravereaux <davygrvy@pobox.com> * doc/file.n: * tools/man2tcl.c: * tools/man2help2.tcl: Thanks to Peter Spjuth <peter.spjuth@space.se>, again. My prior fix for single-quote macro mis-understanding was wrong. Reverted to reimpliment the 'macro2' proc which handles single-quote macros and restored file.n text arrangement to avoid single-quotes on the first line. Sorry for all the confusion. * tools/man2help2.tcl: Thanks to Peter Spjuth <peter.spjuth@space.se>, again. My prior fix for single-quote macro mis-understanding was wrong. Reverted to reimpliment the 'macro2' proc which handles single-quote macros and restored file.n text arrangement to avoid single-quotes on the first line. Sorry for all the confusion. 2002-05-08 David Gravereaux <davygrvy@pobox.com> * tools/man2tcl.c: * tools/man2help2.tcl: Proper source of macro error mis- understanding single-quote as the leading macro command found * tools/man2help2.tcl: Proper source of macro error mis-understanding single-quote as the leading macro command found and repaired. and repaired. * doc/file.n: Reverted to prior state before I messed with * doc/file.n: Reverted to prior state before I messed with it. it. 2002-05-08 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: Corrected [uplevel] quoting when [source]-ing test script in subdirectories. * tests/fileName.test: * tests/load.test: * tests/main.test: * tests/tcltest.test: * tests/unixInit.test: Fixes to test suite when there's a space in the working path. Thanks to Kevin Kenny. * tests/tcltest.test: * tests/unixInit.test: Fixes to test suite when there's a space in the working path. Thanks to Kevin Kenny. 2002-05-07 David Gravereaux <davygrvy@pobox.com> -- Changes from Peter Spjuth <peter.spjuth@space.se> * tools/man2tcl.c: Increased line buffer size and a bail-out if that should ever be over-run. * tools/man2tcl.c: Increased line buffer size and a bail-out if that should ever be over-run. * tools/man2help.tcl: Include Courier New font in rtf header. * tools/man2help2.tcl: Improved handling of CS/CE fields. Use Courier New for code samples and indent better. * tools/man2help2.tcl: Improved handling of CS/CE fields. Use Courier New for code samples and indent better. * doc/file.n: * doc/TraceCmd.3: winhelp conversion tools where understanding a ' as the first character on a line to be an unknown macro. Not knowing how to repair tools/man2tcl.c, I decided to rearrange the text in the docs instead. * doc/TraceCmd.3: winhelp conversion tools where understanding a ' as the first character on a line to be an unknown macro. Not knowing how to repair tools/man2tcl.c, I decided to rearrange the text in the docs instead. 2002-05-07 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclFileName.c: fix to similar segfault when using * generic/tclFileName.c: fix to similar segfault when using 'glob -types nonsense -dir dirname -join * *'. [Bug 553320] * doc/FileSystem.3: further documentation on vfs. * tests/cmdAH.test: * tests/fileSystem.test: * tests/pkgMkindex.test: Fix to testsuite bugs when running out of directory whose name contains '{' or '['. * tests/pkgMkindex.test: Fix to testsuite bugs when running out of directory whose name contains '{' or '['. 2002-05-07 Miguel Sofer <msofer@users.sourceforge.net> * tests/basic.test: Fix for [Bug 549607] * tests/encoding.test: Fix for [Bug 549610] These are testsuite bugs that caused failures when the filename contained spaces. Report & fix by Kevin Kenny. 2002-05-02 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclFileName.c: fix to freeing a bad object (i.e. segfault) when using 'glob -types nonsense -dir dirname'. * generic/tclWinFile.c: fix to [Bug 551306], also wrapped some long lines. * generic/tclFileName.c: fix to freeing a bad object (i.e. segfault) when using 'glob -types nonsense -dir dirname'. * generic/tclWinFile.c: fix to [Bug 551306], also wrapped some long lines. * tests/fileName.test: added several tests for the above bugs. * doc/FileSystem.3: clarified documentation on refCount requirements of the object returned by the path type function. * doc/FileSystem.3: clarified documentation on refCount requirements of the object returned by the path type function. * generic/tclIOUtil.c: * win/tclWinFile.c: * unix/tclUnixFile.c: * mac/tclMacFile.c: moved TclpFilesystemPathType to the platform specific directories, so we can add missing platform- specific implementations. On Windows, 'file system' now returns useful results like "native NTFS", "native FAT" for that system. Unix and MacOS still only return "native". * mac/tclMacFile.c: moved TclpFilesystemPathType to the platform specific directories, so we can add missing platform-specific implementations. On Windows, 'file system' now returns useful results like "native NTFS", "native FAT" for that system. Unix and MacOS still only return "native". * doc/file.n: clarified documentation. * tests/winFile.test: test for 'file system' returning correct * tests/winFile.test: test for 'file system' returning correct values. values. * tests/fileSystem.test: test for 'file system' returning correct values. Clean up after failed previous test run. values. Clean up after failed previous test run. 2002-04-26 Jeff Hobbs <jeffh@ActiveState.com> * unix/configure: * unix/tcl.m4: change HP-11 SHLIB_LD_LIBS from "" to ${LIBS} so that the .sl knows its dependent libs. * unix/tcl.m4: change HP-11 SHLIB_LD_LIBS from "" to ${LIBS} so that the .sl knows its dependent libs. 2002-04-26 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tests/obj.test (obj-11.[56]): Test conversion to boolean more thoroughly. * generic/tclObj.c (SetBooleanFromAny): Was not calling an integer parsing function on native 64-bit platforms! [Bug 548686] parsing function on native 64-bit platforms! [Bug 548686] 2002-04-24 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclInt.h: corrected TclRememberJoinableThread decl to use VOID instead of void. * generic/tclInt.h: corrected TclRememberJoinableThread decl to use VOID instead of void. * generic/tclThreadJoin.c: noted that this code isn't needed on Unix. 2002-04-23 Jeff Hobbs <jeffh@ActiveState.com> * doc/exec.n: * doc/tclvars.n: doc updates [Patch #509426] (gravereaux) * doc/exec.n: * doc/tclvars.n: doc updates [Patch 509426] (gravereaux) 2002-04-24 Daniel Steffen <das@users.sourceforge.net> * mac/tclMacResource.r: added check of * mac/tclMacResource.r: added check of TCLTK_NO_LIBRARY_TEXT_RESOURCES TCLTK_NO_LIBRARY_TEXT_RESOURCES #define to allow disabling the inclusion of the tcl library code in the resource fork of Tcl executables and shared libraries. #define to allow disabling the inclusion of the tcl library code in the resource fork of Tcl executables and shared libraries. 2002-04-23 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/TraceCmd.3: New file that documents Tcl_CommandTraceInfo, Tcl_TraceCommand and Tcl_UntraceCommand [Bug 414927] 2002-04-22 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclAlloc.c: * generic/tclInt.h: * generic/tclThreadAlloc.c (new): * unix/Makefile.in: * unix/tclUnixThrd.c: * win/Makefile.in: * win/tclWinInt.h: * win/tclWinThrd.c: added new threaded allocator contributed by AOL that significantly reduces lock contention when multiple threads are in use. Only Windows and Unix implementations are ready, and the Windows one may need work. It is only used by default on Unix for now, and requires that USE_THREAD_ALLOC be defined (--enable-threads on Unix will define this). * win/tclWinThrd.c: added new threaded allocator contributed by AOL that significantly reduces lock contention when multiple threads are in use. Only Windows and Unix implementations are ready, and the Windows one may need work. It is only used by default on Unix for now, and requires that USE_THREAD_ALLOC be defined (--enable-threads on Unix will define this). * generic/tclIOUtil.c (Tcl_FSRegister, Tcl_FSUnregister): corrected calling of Tcl_ConditionWait to ensure that there would be a condition to wait upon. * generic/tclIOUtil.c (Tcl_FSRegister, Tcl_FSUnregister): corrected calling of Tcl_ConditionWait to ensure that there would be a condition to wait upon. * generic/tclCmdAH.c (Tcl_FileObjCmd): added cast in FILE_SIZE. * win/tclWinFCmd.c (DoDeleteFile): check return of setattr API calls in file deletion for correct Win32 API handling. * win/tclWinFCmd.c (DoDeleteFile): check return of setattr API calls in file deletion for correct Win32 API handling. * win/Makefile.in: correct dependencies for shell, gdb, runtest targets. * doc/clock.n: * compat/strftime.c (_fmt): change strftime to correctly handle localized %c, %x and %X on Windows. Added some notes about how the other values could be further localized. localized %c, %x and %X on Windows. Added some notes about how the other values could be further localized. 2002-04-19 Don Porter <dgp@users.sourceforge.net> * generic/tclMain.c (Tcl_Main): Free the memory allocated for the startup script path. [Bug 543549] * generic/tclMain.c (Tcl_Main): Free the memory allocated for the startup script path. [Bug 543549] * library/msgcat/msgcat.tcl: [mcmax] wasn't using the caller's namespace when determining the max translated length. Also made revisions for better use of namespace variables and more efficient [uplevel]s. * library/msgcat/msgcat.tcl: [mcmax] wasn't using the caller's namespace when determining the max translated length. Also made revisions for better use of namespace variables and more efficient [uplevel]s. * doc/msgcat.n: * library/msgcat/msgcat.tcl: * library/msgcat/pkgIndex.tcl: Added [mcload] to the export list of msgcat; bumped to 1.2.3. [Bug 544727] * library/msgcat/pkgIndex.tcl: Added [mcload] to the export list of msgcat; bumped to 1.2.3. [Bug 544727] 2002-04-20 Daniel Steffen <das@users.sourceforge.net> * generic/tclInt.decls: * generic/tclIntPlatDecls.h: * generic/tclStubInit.c: * mac/tclMacFCmd.c: * mac/tclMacFile.c: * mac/tclMacUtil.c: Modified TclpObjNormalizePath to be alias file aware, and replaced various calls to FSpLocationFrom*Path by calls to new alias file aware versions FSpLLocationFrom*Path. The alias file aware routines don't resolve the last component of a path if it is an alias. This allows [file copy/delete] etc. to act correctly on alias files. (c.f. discussion in Bug #511666) * mac/tclMacUtil.c: Modified TclpObjNormalizePath to be alias file aware, and replaced various calls to FSpLocationFrom*Path by calls to new alias file aware versions FSpLLocationFrom*Path. The alias file aware routines don't resolve the last component of a path if it is an alias. This allows [file copy/delete] etc. to act correctly on alias files. (c.f. discussion in [Bug 511666]) 2002-04-19 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tests/lindex.test (lindex-3.7): * generic/tclUtil.c (TclGetIntForIndex): Stopped indexes from hitting wide ints. [Bug #526717] * tests/lindex.test (lindex-3.7): * generic/tclUtil.c (TclGetIntForIndex): Stopped indexes from hitting wide ints. [Bug 526717] 2002-04-18 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclNamesp.c: * tests/info.test: [Bug 545325] info level didn't report namespace eval, bug report by Richard Suchenwirth. * tests/info.test: [Bug 545325] info level didn't report namespace eval, bug report by Richard Suchenwirth. 2002-04-18 Don Porter <dgp@users.sourceforge.net> * doc/subst.n: Clarified documentation on handling unusual return codes during substitution, and on variable substitutions implied by command substitution, and vice versa. [Bug 536838] * doc/subst.n: Clarified documentation on handling unusual return codes during substitution, and on variable substitutions implied by command substitution, and vice versa. [Bug 536838] 2002-04-18 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tclCmdIL.c (InfoBodyCmd): * tests/info.test (info-2.6): Proc bodies without string reps would report as empty [Bug #545644] * generic/tclCmdIL.c (InfoBodyCmd): * tests/info.test (info-2.6): Proc bodies without string reps would report as empty [Bug 545644] * generic/tclCmdMZ.c (Tcl_SubstObj): More clarification for comment on behaviour when substitutions are not well-formed, prompted by [Bug #536831]; alas, removing the ill-defined * generic/tclCmdMZ.c (Tcl_SubstObj): More clarification for comment on behaviour when substitutions are not well-formed, prompted by [Bug 536831]; alas, removing the ill-defined behaviour is a lot of work. behaviour is a lot of work. 2002-04-18 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c: * tests/expr-old.test: fix for [Bug #542588] (Phil Ehrens), where "too large integers" were reported as "floating-point value" in [expr] error messages. * tests/expr-old.test: fix for [Bug 542588] (Phil Ehrens), where "too large integers" were reported as "floating-point value" in [expr] error messages. 2002-04-17 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclEncoding.c (EscapeFromUtfProc): * generic/tclIO.c (WriteChars, Tcl_Close): corrected the handling of outputting end escapes for escape-based encodings. [Bug #526524] (yamamoto) * generic/tclEncoding.c (EscapeFromUtfProc): * generic/tclIO.c (WriteChars, Tcl_Close): corrected the handling of outputting end escapes for escape-based encodings. [Bug 526524] (yamamoto) 2002-04-17 Don Porter <dgp@users.sourceforge.net> * doc/tcltest.n: Removed [saveState] and [restoreState] from tcltest 2 documentation, effectively deprecating them. [Bug 495660] * library/tcltest/tcltest.tcl: Made separate export for commands kept only for tcltest 1 compatibility. * doc/tcltest.n: Removed [saveState] and [restoreState] from tcltest 2 documentation, effectively deprecating them. [Bug 495660] * library/tcltest/tcltest.tcl: Made separate export for commands kept only for tcltest 1 compatibility. * tests/iogt.test: Revised to run tests in a namespace, rather than use the useless and buggy [saveState] and [restoreState] commands of tcltest. Updated to use tcltest 2 as well. [Patch 544911] use the useless and buggy [saveState] and [restoreState] commands of tcltest. Updated to use tcltest 2 as well. [Patch 544911] 2002-04-16 Don Porter <dgp@users.sourceforge.net> * tests/io.test: Revised to run tests in a namespace, rather than use the useless and buggy [saveState] and [restoreState] commands of tcltest. Updated to use tcltest 2 as well. [Patch 544546] * tests/io.test: Revised to run tests in a namespace, rather than use the useless and buggy [saveState] and [restoreState] commands of tcltest. Updated to use tcltest 2 as well. [Patch 544546] 2002-04-15 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclProc.c: * tests/proc-old.test: Improved stack trace for TCL_BREAK and TCL_CONTINUE returns from procs. Patch by Don Porter TCL_CONTINUE returns from procs. [Bug 536955] (dgp) [Bug 536955]. * generic/tclExecute.c: * tests/compile.test: made bytecodes check for a catch before returning; the compiled [return] is otherwise non-catchable. [Bug 542142] reported by Andreas Kupries. returning; the compiled [return] is otherwise non-catchable. [Bug 542142] reported by Andreas Kupries. 2002-04-15 Don Porter <dgp@users.sourceforge.net> * tests/socket.test: Increased timeout values so that tests have time to successfully complete even on slow/busy machines. [Bug 523470] * tests/socket.test: Increased timeout values so that tests have time to successfully complete even on slow/busy machines. [Bug 523470] * doc/tcltest.n: * library/tcltest/tcltest.tcl: * tests/tcltest.test: Revised [tcltest::test] to return errors when called with invalid syntax and to accept exactly two arguments as documented. Improved error messages. [Bug 497446, Patch 513983] * tests/tcltest.test: Revised [tcltest::test] to return errors when called with invalid syntax and to accept exactly two arguments as documented. Improved error messages. [Bug 497446, Patch 513983] ***POTENTIAL INCOMPATIBILITY***: Incompatible with previous tcltest 2.* releases, found only in alpha releases of Tcl 8.4. 2002-04-11 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclNotify.c (TclFinalizeNotifier): remove remaining unserviced events on finalization. * win/tcl.m4: Enabled COFF as well as CV style debug info with --enable-symbols to allow Dr. Watson users to see function info. More info on debugging levels can be obtained at: --enable-symbols to allow Dr. Watson users to see function info. More info on debugging levels can be obtained at: http://msdn.microsoft.com/library/en-us/dnvc60/html/gendepdebug.asp * tests/ioCmd.test: fixed iocmd-8.15 to have mac and unixPc variants. * generic/tclParse.c (Tcl_ParseVar): conditionally incr obj refcount to prevent possible mem leak. * generic/tclParse.c (Tcl_ParseVar): conditionally incr obj refcount to prevent possible mem leak. 2002-04-08 Daniel Steffen <das@users.sourceforge.net> * generic/tcl.h: no <sys/types.h> on mac. * mac/tclMacFile.c: minor fixes to Vince's changes from 03-24. * mac/tclMacOSA.c: * mac/tclMacResource.c: added missing Tcl_UtfToExternalDString conversions of resource file names. * mac/tclMacSock.c (TcpGetOptionProc): fixed bug introduced by Andreas on 02-25; changed strcmp's to strncmp's so that option comparison behaves like on other platforms. * mac/tcltkMacBuildSupport.sea.hqx (CW Pro6 changes): added support to allow Tk to hookup C library stderr/stdout to TkConsole. * mac/tclMacSock.c (TcpGetOptionProc): fixed bug introduced by Andreas on 02-25; changed strcmp's to strncmp's so that option comparison behaves like on other platforms. * mac/tcltkMacBuildSupport.sea.hqx (CW Pro6 changes): added support to allow Tk to hookup C library stderr/stdout to TkConsole. * tests/basic.test: * tests/cmdAH.test: * tests/encoding.test: * tests/fileSystem.test: * tests/ioCmd.test: fixed tests failing on mac: check for existence of [exec], changed some result strings. * tests/ioCmd.test: fixed tests failing on mac: check for existence of [exec], changed some result strings. 2002-04-06 Jeff Hobbs <jeffh@ActiveState.com> * unix/tclUnixFCmd.c (Realpath): added a little extra code to initialize a realpath arg when compiling in PURIFY mode in order to prevent spurious purify warnings. We should really create our own realpath implementation, but this will at least quiet purify initialize a realpath arg when compiling in PURIFY mode in order to prevent spurious purify warnings. We should really create our own realpath implementation, but this will at least quiet purify for now. for now. 2002-04-05 Don Porter <dgp@users.sourceforge.net> * generic/tclCmdMZ.c (Tcl_SubstObj): * tests/subst.test: Corrected [subst] so that return codes TCL_BREAK and TCL_CONTINUE returned by variable substitution have the same effect as when those codes are returned by command substitution. [Bug 536879] * tests/subst.test: Corrected [subst] so that return codes TCL_BREAK and TCL_CONTINUE returned by variable substitution have the same effect as when those codes are returned by command substitution. [Bug 536879] 2002-04-03 Jeff Hobbs <jeffh@ActiveState.com> * library/tcltest/tcltest.tcl: added getMatchingFiles back (alias to GetMatchingFiles), which was a public function in tcltest 1.0. 2002-04-01 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclEnv.c: * generic/tclIOUtil.c: invalidate filesystem cache when the user changes env(HOME). Fixes [Bug #535621]. Also cleaned up some of the documentation. * generic/tclIOUtil.c: invalidate filesystem cache when the user changes env(HOME). Fixes [Bug 535621]. Also cleaned up some of the documentation. * tests/fileSystem.test: added test for bug just fixed. 2002-04-01 Kevin Kenny <kennykb@acm.org> * win/tclWinTime.c (Tcl_GetTime): made the checks of clock frequency more permissive to cope with the fact that Win98SE is observed to return 1.19318 in place of 1.193182 for the performance counter frequency. * win/tclWinTime.c (Tcl_GetTime): made the checks of clock frequency more permissive to cope with the fact that Win98SE is observed to return 1.19318 in place of 1.193182 for the performance counter frequency. 2002-03-29 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclCmdMZ.c (Tcl_TraceObjCmd, TraceVarProc) (TraceCommandProc, TclTraceCommandObjCmd): corrected potential double-free of traces on variables by flagging in Trace*Proc that it will free the var in case the eval wants to delete the var trace as well. [Bug #536937] (TraceCommandProc, TclTraceCommandObjCmd): corrected potential double-free of traces on variables by flagging in Trace*Proc that it will free the var in case the eval wants to delete the var trace as well. [Bug 536937] Also converted Tcl_UntraceVar -> Tcl_UntraceVar2 and Tcl_Eval to Tcl_EvalEx in Trace*Proc for slight efficiency improvement. 2002-03-29 Don Porter <dgp@users.sourceforge.net> * doc/AllowExc.3: * generic/tclBasic.c (Tcl_EvalObjv,Tcl_EvalEx,Tcl_EvalObjEx): * generic/tclCompile.h (TclCompEvalObj): * generic/tclExecute.c (TclCompEvalObj,TclExecuteByteCode): * tests/basic.test: Corrected problems with Tcl_AllowExceptions having influence over the wrong scope of Tcl_*Eval* calls. Patch from Miguel Sofer. Report from Jean-Claude Wippler. [Bug 219181] * tests/basic.test: Corrected problems with Tcl_AllowExceptions having influence over the wrong scope of Tcl_*Eval* calls. Patch from Miguel Sofer. Report from Jean-Claude Wippler. [Bug 219181] 2002-03-28 Don Porter <dgp@users.sourceforge.net> * generic/tclVar.c: Refactored CallTraces to collect repeated handling of its returned value into CallTraces itself. * generic/tclVar.c: Refactored CallTraces to collect repeated handling of its returned value into CallTraces itself. 2002-03-28 David Gravereaux <davygrvy@pobox.com> * tools/feather.bmp: * tools/man2help.tcl: * tools/man2help2.tcl: * win/makefile.vc: More winhelp target fixups. Added a feather bitmap to the non-scrollable area and changed the color to be yellow from a plain white. The colors can be whatever we want them to be, but thought I would start with something bold. * win/makefile.vc: More winhelp target fixups. Added a feather bitmap to the non-scrollable area and changed the color to be yellow from a plain white. The colors can be whatever we want them to be, but thought I would start with something bold. [Bug 527941] [Bug 527941] * doc/SetVar.3: * doc/TraceVar.3: * doc/UpVar.3: .AP macro syntax repair. * doc/UpVar.3: .AP macro syntax repair. 2002-03-27 David Gravereaux <davygrvy@pobox.com> * tools/man2help.tcl: * win/makefile.vc: winhelp target now copies all needed files from tools/ to a workarea under $(OUT_DIR) and builds it from there. No build cruft is left in tools/ anymore. All paths used in man2help.tcl are now relative to where the script is. * win/makefile.vc: winhelp target now copies all needed files from tools/ to a workarea under $(OUT_DIR) and builds it from there. No build cruft is left in tools/ anymore. All paths used in man2help.tcl are now relative to where the script is. [Bug 527941] [Bug 527941] 2002-03-27 David Gravereaux <davygrvy@pobox.com> * win/.cvsignore: * win/buildall.vc.bat: * win/coffbase.txt: * win/makefile.vc: * win/nmakehlp.c (new): * win/rules.vc: First draft fix for [Bug 527941]. More changes need to done to the makehelp target to get to stop leaving build files in the tools/ directory. This does not address the syntax errors in the man files. Having the contents of tcl.hpj(.in) inside makefile.vc allows for version numbers to be replaced with * win/rules.vc: First draft fix for [Bug 527941]. More changes need to done to the makehelp target to get to stop leaving build files in the tools/ directory. This does not address the syntax errors in the man files. Having the contents of tcl.hpj(.in) inside makefile.vc allows for version numbers to be replaced with macros. macros. The new nmakehlp.c is built by rules.vc in preprocessing and removes the need to use tricky shell syntax that wasn't compatible on Win9x systems. Clean targets made Win9x complient. This is a first draft repair for [Bug 533862]. 2002-03-28 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclBasic.c (Tcl_EvalEx): passing the correct commandSize to TclEvalObjvInternal. [Bug 219362], fix by David Knoll. 2002-03-28 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclBasic.c (Tcl_EvalEx): * tests/basic.test: avoid exceptional returns at level 0 [Bug 219181] * tests/basic.test: avoid exceptional returns at level 0 [Bug 219181] 2002-03-27 Don Porter <dgp@users.sourceforge.net> * doc/tcltest.n ([mainThread]): * library/tcltest/tcltest.tcl: * tests/tcltest.test: Major code cleanup to deal with whitespace, coding conventions, and namespace issues, with several minor bugs fixed in the process. * tests/main.test: Added missing [after cancel]s. 2002-03-25 Don Porter <dgp@users.sourceforge.net> * tests/main.test: Removed workarounds for Bug 495977. * library/tcltest/tcltest.tcl: Keep the value of $::auto_path * library/tcltest/tcltest.tcl: Keep the value of $::auto_path unchanged, so that the tcltest package can test code that depends on auto-loading. If a testing application needs $::auto_path pruned, it should do that itself. [Bug 495726] on auto-loading. If a testing application needs $::auto_path pruned, it should do that itself. [Bug 495726] Improve the processing of the -constraints option to [test] so that constraint lists can have arbitrary whitespace, and non-lists don't blow things up. [Bug 495977] blow things up. [Bug 495977] Corrected faulty variable initialization. [Bug 534845] 2002-03-25 Miguel Sofer <msofer@users.sourceforge.net> * doc/CrtTrace.3: small doc correction * generic/tclBasic.c (Tcl_DeleteTrace): Allow NULL callback on trace deletions [Bug 534728] (Hemang Lavana). 2002-03-24 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclBasic.c (Tcl_EvalObjv): replaced obscure, incorrect code as described in [Bug 533907] (Don Porter). 2002-03-24 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: Use [interpreter] to set/query the executable currently running the tcltest package. [Bug 454050] * library/tcltest/tcltest.tcl: Use [interpreter] to set/query the executable currently running the tcltest package. [Bug 454050] * library/tcltest/tcltest.tcl: Allow non-proc commands to be used as the customization hooks. [Bug 495662] * library/tcltest/tcltest.tcl: Allow non-proc commands to be used as the customization hooks. [Bug 495662] 2002-03-24 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclFilename.c: * generic/tclFCmd.c: * generic/tclTest.c: * generic/tcl.h: * generic/tclIOUtil.c: * win/tclWinFile.c: * win/tclWinFCmd.c: * win/tclWinPipe.c: * unix/tclUnixFile.c: * unix/tclUnixFCmd.c: * mac/tclMacFile.c: * doc/FileSystem.3: * doc/file.n: * tests/cmdAH.test: * tests/fileName.test: * tests/fileSystem.test: (new file) * tests/winFCmd.test: fix [Bug 511666] and [Bug 511658], and improved documentation of some aspects of the filesystem, particularly 'Tcl_FSMatchInDirectory' which now might match a single file/directory only, and 'file normalize' which * tests/fileSystem.test: (new file) * tests/winFCmd.test: fix [Bug 511666] and [Bug 511658], and improved documentation of some aspects of the filesystem, particularly 'Tcl_FSMatchInDirectory' which now might match a single file/directory only, and 'file normalize' which wasn't very clear before. Removed wasn't very clear before. Removed inconsistency betweens docs and the Tcl_Filesystem structure. Also fixed [Bug 523217] and corrected file normalization on Unix so that it expands symbolic links. Added some new tests of the filesystem code (in the new file 'fileSystem.test'), and inconsistency betweens docs and the Tcl_Filesystem structure. Also fixed [Bug 523217] and corrected file normalization on Unix so that it expands symbolic links. Added some new tests of the filesystem code (in the new file 'fileSystem.test'), and some extra tests for correct some extra tests for correct handling of symbolic links. Fix to [Bug 530960] which shows up on Win98. Made comparison with ".com" case insensitive in tclWinPipe.c ***POTENTIAL INCOMPATIBILITY***: But only between alpha releases (users of the new Tcl_Filesystem lookup table in Tcl 8.4a4 need to handle the new way in which Tcl may call Tcl_FSMatchInDirectory, and 'file normalize' on unix now handling of symbolic links. Fix to [Bug 530960] which shows up on Win98. Made comparison with ".com" case insensitive in tclWinPipe.c ***POTENTIAL INCOMPATIBILITY***: But only between alpha releases (users of the new Tcl_Filesystem lookup table in Tcl 8.4a4 need to handle the new way in which Tcl may call Tcl_FSMatchInDirectory, and 'file normalize' on unix now behaves correctly). Only known impact is behaves correctly). Only known impact is with the 'tclvfs' extension. with the 'tclvfs' extension. 2002-03-22 Miguel Sofer <msofer@users.sourceforge.net> * tests/basic.test (basic-46.1): adding test for [Bug 533758], fixed earlier today. * tests/basic.test (basic-46.1): adding test for [Bug 533758], fixed earlier today. 2002-03-22 Jeff Hobbs <jeffh@ActiveState.com> * win/tclWinInt.h: moved undef of TCL_STORAGE_CLASS. [Bug #478579] * win/tclWinInt.h: moved undef of TCL_STORAGE_CLASS. [Bug 478579] 2002-03-22 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclBasic.c (Tcl_EvalObjEx): * generic/tclExecute.c (TclCompEvalObj): fixed the errorInfo for return codes other than (TCL_OK, TCL_ERROR) to runLevel 0 [Bug 533758]. Removed the static RecordTracebackInfo(), as its functionality is easily replicated by Tcl_LogCommandInfo. Bug and redundancy noted by Don Porter. return codes other than (TCL_OK, TCL_ERROR) to runLevel 0 [Bug 533758]. Removed the static RecordTracebackInfo(), as its functionality is easily replicated by Tcl_LogCommandInfo. Bug and redundancy noted by Don Porter. 2002-03-21 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/expr.n: Improved documentation for ceil and floor [Bug 530535] 2002-03-20 Don Porter <dgp@users.sourceforge.net> * doc/SetVar.3: * doc/TraceVar.3: * doc/UpVar.3: * generic/tcl.h (Tcl_VarTraceProc): * generic/tcl.decls (Tcl_GetVar2, Tcl_SetVar2, Tcl_TraceVar2, Tcl_UnsetVar2, Tcl_UntraceVar2, Tcl_UpVar2, Tcl_VarTraceInfo2, Tcl_GetVar2Ex, TclSetVar2Ex): * generic/tcl.decls (Tcl_GetVar2, Tcl_SetVar2, Tcl_TraceVar2) (Tcl_UnsetVar2, Tcl_UntraceVar2, Tcl_UpVar2, Tcl_VarTraceInfo2) (Tcl_GetVar2Ex, TclSetVar2Ex): * generic/tclCmdMZ.c (TraceVarProc): * generic/tclEnv.c (EnvTraceProc): * generic/tclEvent.c (VwaitVarProc): * generic/tclInt.decls (TclLookupVar,TclPrecTraceProc): * generic/tclLink.c (LinkTraceProc): * generic/tclUtil.c (TclPrecTraceProc): * generic/tclVar.c (CallTraces, MakeUpvar, VarErrMsg, TclLookupVar, Tcl_GetVar2, Tcl_SetVar2, Tcl_TraceVar2, Tcl_UnsetVar2, Tcl_UntraceVar2, Tcl_UpVar2, Tcl_VarTraceInfo2, Tcl_GetVar2Ex, TclSetVar2Ex): Updated interfaces of generic/tclVar.c according to TIP 27. In particular, the "part2" arguments were CONSTified. (Tcl_GetVar2, Tcl_SetVar2, Tcl_TraceVar2, Tcl_UnsetVar2) (Tcl_UntraceVar2, Tcl_UpVar2, Tcl_VarTraceInfo2, Tcl_GetVar2Ex) (TclSetVar2Ex): Updated interfaces of generic/tclVar.c according to TIP 27. In particular, the "part2" arguments were CONSTified. [Patch 532642] * generic/tclDecls.h: * generic/tclDecls.h: * generic/tclIntDecls.h: make genstubs 2002-03-15 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tests/compile.test (compile-12.3): Test to detect bug 530320. * generic/tclCompile.c (TclCompileTokens): Fixed buffer overrun reported in bug 530320. 2002-03-14 Mo DeJong <mdejong@users.sourceforge.net> * win/configure: Regen. * win/configure.in: Add configure time test for SEH support in the compiler. * win/configure.in: Add configure time test for SEH support in the compiler. * win/tclWin32Dll.c (ESP, EBP, TclpCheckStackSpace, _except_checkstackspace_handler): (_except_checkstackspace_handler): * win/tclWinChan.c (ESP, EBP, Tcl_MakeFileChannel, _except_makefilechannel_handler): * win/tclWinFCmd.c (ESP, EBP, DoRenameFile, _except_dorenamefile_handler, (_except_makefilechannel_handler): * win/tclWinFCmd.c (ESP, EBP, DoRenameFile, DoCopyFile, (_except_dorenamefile_handler, _except_docopyfile_handler): Implement DoCopyFile, _except_docopyfile_handler): Implement SEH support under gcc using inline asm. Tcl and Tk should now compile with Mingw 1.1. [Patch 525746] SEH support under gcc using inline asm. Tcl and Tk should now compile with Mingw 1.1. [Patch 525746] 2002-03-14 Mo DeJong <mdejong@users.sourceforge.net> * win/tclWinFCmd.c (DoRenameFile, DoCopyFile): Handle an SEH exception with EXCEPTION_EXECUTE_HANDLER instead * win/tclWinFCmd.c (DoRenameFile, DoCopyFile): Handle an SEH exception with EXCEPTION_EXECUTE_HANDLER instead of restarting the faulting of restarting the faulting instruction with EXCEPTION_CONTINUE_EXECUTION. Bug 466102 provides an example of how restarting could send Tcl into an infinite loop. [Patch 525746] instruction with EXCEPTION_CONTINUE_EXECUTION. Bug 466102 provides an example of how restarting could send Tcl into an infinite loop. [Patch 525746] 2002-03-11 Mo DeJong <mdejong@users.sourceforge.net> * win/tclWinFCmd.c (DoRenameFile, DoCopyFile, DoDeleteFile, DoRemoveJustDirectory): Make sure we don't pass NULL or "" as a path name to Win32 API functions since this was (DoRemoveJustDirectory): Make sure we don't pass NULL or "" as a path name to Win32 API functions since this was crashing under Windows 98. crashing under Windows 98. 2002-03-11 Don Porter <dgp@users.sourceforge.net> * library/tcltest/tcltest.tcl: * library/tcltest/pkgIndex.tcl: Bumped tcltest package to 2.0.2. 2002-03-11 Mo DeJong <mdejong@users.sourceforge.net> * library/tcltest/tcltest.tcl (getMatchingFiles): Pass a proper list to foreach to avoid munging a Windows patch like D:\Foo\Bar into D:FooBar before the glob. * library/tcltest/tcltest.tcl (getMatchingFiles): Pass a proper list to foreach to avoid munging a Windows patch like D:\Foo\Bar into D:FooBar before the glob. 2002-03-11 Mo DeJong <mdejong@users.sourceforge.net> * generic/tclEncoding.c: Fix typo in comment. * generic/tclIO.c (DoReadChars, ReadBytes, ReadChars): Use NULL value instead of pointer set to NULL to make * generic/tclIO.c (DoReadChars, ReadBytes, ReadChars): Use NULL value instead of pointer set to NULL to make things more clear. Reorder things more clear. Reorder arguments so that they match the function signatures. Cleanup little typos and add more descriptive comment. arguments so that they match the function signatures. Cleanup little typos and add more descriptive comment. 2002-03-08 Mo DeJong <mdejong@users.sourceforge.net> * win/README: Update to indicate that Mingw 1.1 is * win/README: Update to indicate that Mingw 1.1 is required to build required to build Tcl. Add section describing new msys based build process. Update Cygwin build instructions so users know where to find Mingw 1.1. Tcl. Add section describing new msys based build process. Update Cygwin build instructions so users know where to find Mingw 1.1. 2002-03-08 Jeff Hobbs <jeffh@ActiveState.com> * win/tclWinFCmd.c (DoCopyFile): correctly set retval to TCL_OK. 2002-03-07 Mo DeJong <mdejong@users.sourceforge.net> * win/tclWin32Dll.c (TclpCheckStackSpace): * win/tclWinFCmd.c (DoRenameFile, DoCopyFile): Replace hard coded constants with Win32 symbolic names. * win/tclWinFCmd.c (DoRenameFile, DoCopyFile): Replace hard coded constants with Win32 symbolic names. Move control flow statements out Move control flow statements out of __try blocks since the documentation indicates it is frowned upon. of __try blocks since the documentation indicates it is frowned upon. 2002-03-07 Don Porter <dgp@users.sourceforge.net> * doc/interp.n: * generic/tclInterp.c(Tcl_InterpObjCmd,SlaveObjCmd,SlaveRecursionLimit): * generic/tclInterp.c (Tcl_InterpObjCmd,SlaveObjCmd, (SlaveRecursionLimit): * generic/tclTest.c: * tests/interp.test: Added the [interp recursionlimit] command to set/query the recursion limit of an interpreter. Proposal and implementation from Stephen Trier. [TIP 87, Patch 522849] 2002-03-06 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tcl.h, tools/tcl.wse.in, unix/configure.in, * unix/tcl.spec, win/README.binary, win/configure.in, README: Bumped patchlevel; this might need to change in the future, but it will help us distinguish between the CVS version and the most recent released version. 2002-03-06 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclInt.h: for unshared objects, TclDecrRefCount now frees the internal rep before the string rep - just like the non-macro Tcl_DecrRefCount/TclFreeObj [Bug 524802]. * generic/tclInt.h: for unshared objects, TclDecrRefCount now frees the internal rep before the string rep - just like the non-macro Tcl_DecrRefCount/TclFreeObj [Bug 524802]. 2002-03-06 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/lsearch.n: Documentation of new features, plus examples. * tests/lsearch.test: Tests of new features. * generic/tclCmdIL.c (Tcl_LsearchObjCmd): TIP#80 support. See http://purl.org/tcl/tip/80 for details. 2002-03-05 Jeff Hobbs <jeffh@ActiveState.com> *** 8.4a4 TAGGED FOR RELEASE *** * unix/tclUnixChan.c: initial remedy for [Bug #525783] flush problem introduced by TIP #35. This may not satisfy true serial channels, but it restores the correct flushing of std* channels on * unix/tclUnixChan.c: initial remedy for [Bug 525783] flush problem introduced by TIP #35. This may not satisfy true serial channels, but it restores the correct flushing of std* channels on exit. exit. * unix/README: added --enable-langinfo doc. * unix/tcl.spec: * tools/tcl.wse.in: fixed URL refs to use www.tcl.tk or SF. 2002-03-04 Jeff Hobbs <jeffh@ActiveState.com>
︙
4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584	8989 8990 8991 8992 8993 8994 8995 8996 8997 8998 8999 9000 9001 9002 9003 9004 9005 9006 9007 9008 9009 9010 9011 9012 9013 9014 9015 9016 9017 9018 9019 9020 9021 9022 9023 9024 9025 9026 9027 9028 9029 9030 9031 9032 9033 9034 9035 9036 9037 9038 9039 9040 9041 9042 9043 9044 9045 9046 9047 9048 9049 9050 9051 9052 9053 9054 9055 9056 9057 9058 9059 9060 9061 9062 9063 9064 9065 9066 9067 9068 9069 9070 9071 9072 9073 9074 9075 9076 9077 9078 9079 9080 9081 9082 9083 9084 9085 9086 9087 9088 9089 9090 9091 9092 9093 9094 9095 9096 9097 9098 9099 9100 9101 9102 9103 9104 9105 9106 9107 9108 9109 9110 9111 9112 9113 9114 9115 9116 9117 9118 9119 9120 9121 9122 9123 9124 9125 9126 9127 9128 9129 9130 9131 9132 9133 9134 9135 9136 9137 9138 9139 9140 9141 9142 9143 9144 9145 9146 9147 9148 9149 9150 9151 9152 9153 9154 9155 9156 9157 9158 9159 9160 9161 9162 9163 9164 9165 9166 9167 9168 9169 9170 9171 9172 9173 9174 9175 9176 9177 9178 9179 9180 9181	- + - + - - + + - + - + - - - + + + - - + + - + - - - + + + - - - + + + - - - - + + + - - + + - + - - + + - - + - + - - - + + + - - - + + + - + - - - + + + - - - + + - - - - + + + + - - + + - - - - - - + + + + + + - - + - - - + + + - - + + -	* unix/Makefile.in: added older ChangeLogs to dist target. * tests/io.test: * tests/encoding.test: corrected iso2022 encoding results. added encoding-24.* * generic/tclEncoding.c (EscapeFromUtfProc): corrected output of escape codes as per RFC 1468. [Patch #474358] (taguchi) escape codes as per RFC 1468. [Patch 474358] (taguchi) (TclFinalizeEncodingSubsystem): corrected potential double-free when encodings were finalized on exit. [Bug #219314, #524674] when encodings were finalized on exit. [Bug 219314, 524674] 2002-03-01 Jeff Hobbs <jeffh@ActiveState.com> * library/encoding/iso2022-jp.enc: * library/encoding/iso2022.enc: * library/encoding/iso2022-jp.enc: * library/encoding/iso2022.enc: * tools/encoding/iso2022-jp.esc: * tools/encoding/iso2022.esc: gave <ESC>$B precedence over <ESC>$@, based on comments (point 1) in [Bug #219283] (rfc 1468) based on comments (point 1) in [Bug 219283] (RFC 1468) * tests/encoding.test: added encoding-23.* tests * generic/tclIO.c (FilterInputBytes): reset the TCL_ENCODING_START flags in the ChannelState when using 'gets'. [Bug #523988] flags in the ChannelState when using 'gets'. [Bug 523988] Also reduced the value of ENCODING_LINESIZE from 30 to 20 as this seems to improve the performance of 'gets' according to tclbench. 2002-02-28 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclCmdMZ.c (TraceCommandProc): ensure that TraceCommandInfo structure was also deleted when a command was deleted to prevent a mem leak. * generic/tclBasic.c (Tcl_CreateObjTrace): set tracePtr->flags correctly. * generic/tclTimer.c (TimerExitProc): remove remaining events in tls on thread exit. 2002-02-28 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclNamesp.c: allow cached fully-qualified namespace names to be usable from different namespaces within the same interpreter without forcing a new lookup [Patch 458872]. * generic/tclNamesp.c: allow cached fully-qualified namespace names to be usable from different namespaces within the same interpreter without forcing a new lookup [Patch 458872]. 2002-02-28 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c: Replaced a few direct stack accesses with the POP_OBJECT() macro [Bug 507181] (Don Porter). * generic/tclExecute.c: Replaced a few direct stack accesses with the POP_OBJECT() macro [Bug 507181] (Don Porter). 2002-02-27 Don Porter <dgp@users.sourceforge.net> * doc/GetIndex.3: * generic/tcl.decls (Tcl_GetIndexFromObjStruct): * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): Revised the prototype of the Tcl_GetIndexFromObjStruct to take its struct table as a (CONST VOID *) argument, better describing what it is, maintaining source compatibility, and adding CONST correctness according to TIP 27. Thanks to Joe English for an elegant solution. [Bug 520304] * generic/tclDecls.h: make genstubs * generic/tclMain.c (Tcl_Main,StdinProc): Corrected some reference count management errors on the interactive command Tcl_Obj found by Purify. Thanks to Jeff Hobbs for the report and assistance. Purify. Thanks to Jeff Hobbs for the report and assistance. 2002-02-27 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclBasic.c (Tcl_EvalTokensStandard): corrected mem leak in error case. * generic/tclTest.c (TestStatProc[123]): correct harmless UMRs. * generic/tclLink.c (Tcl_LinkVar): correct mem leak in error case. 2002-02-27 Andreas Kupries <andreas_kupries@users.sourceforge.net> * tests/socket.test (2.7): Accepted and applied patch for Tcl SF bug #523470 provided by Don Porter <dgp@users.sourceforge.net> to avoid timing problems in that test. * tests/socket.test (2.7): Accepted and applied patch for [Bug 523470] provided by Don Porter <dgp@users.sourceforge.net> to avoid timing problems in that test. * unix/tclUnixChan.c (TclpOpenFileChannel): Added code to regonize "/dev/tty" (by name) and to not handle it as tty / serial line. This is the controlling terminal and is special. Setting it into raw mode as is done for other tty's is a bad idea. This "/dev/tty" (by name) and to not handle it as tty / serial line. This is the controlling terminal and is special. Setting it into raw mode as is done for other tty's is a bad idea. This is a hackish fix for is a hackish fix for expect SGF Bug #520624. The fix has limitation: Tcl_MakeFileChannel handles tty's specially too, but is unable to recognize /dev/tty as it only gets a file descriptor, and no name for it. expect [Bug 520624]. The fix has limitation: Tcl_MakeFileChannel handles tty's specially too, but is unable to recognize /dev/tty as it only gets a file descriptor, and no name for it. 2002-02-26 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclCmdAH.c (StoreStatData): corrected mem leak. * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): prevent obj leak in remedial regsub case. * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): prevent obj leak in remedial regsub case. * generic/tclFileName.c (Tcl_TranslateFileName): decr refcount for error case to prevent mem leak. error case to prevent mem leak. * generic/tclVar.c (Tcl_ArrayObjCmd): removed extra obj allocation. * unix/tclUnixSock.c (Tcl_GetHostName): added an extra gethostbyname check to guard against failure with truncated * unix/tclUnixSock.c (Tcl_GetHostName): added an extra gethostbyname check to guard against failure with truncated names returned by uname. names returned by uname. * unix/configure: * unix/tcl.m4 (SC_SERIAL_PORT): added sys/modem.h check and defined _XOPEN_SOURCE_EXTENDED for HP-11 to get updated header decls. _XOPEN_SOURCE_EXTENDED for HP-11 to get updated header decls. * unix/tclUnixChan.c: added Unix implementation of TIP #35, serial port support. [Patch #438509] (schroedter) port support. [Patch 438509] (schroedter) 2002-02-26 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclCmpCmds.c: (bugfix to the bugfix, hopefully the last) Bugfix to the new [for] compiling code: was setting a exceptArray parameter using another param which wasn't yet initialised, thus filling it with noise. Bugfix to the new [for] compiling code: was setting a exceptArray parameter using another param which wasn't yet initialised, thus filling it with noise. 2002-02-25 Andreas Kupries <andreas_kupries@users.sourceforge.net> * mac/tclMacSock.c (TcpGetOptionProc): Changed to recognize the option "-error". Essentially ignores the option, always returning an empty string. * mac/tclMacSock.c (TcpGetOptionProc): Changed to recognize the option "-error". Essentially ignores the option, always returning an empty string. 2002-02-25 Jeff Hobbs <jeffh@ActiveState.com> * doc/Alloc.3: * doc/LinkVar.3: * doc/ObjectType.3: * doc/PkgRequire.3: * doc/Preserve.3: * doc/TCL_MEM_DEBUG.3: Updated documentation to describe the ckalloc, ckfree, ckrealloc, attemptckalloc, and attemptckrealloc macros, and to accurately describe when and how they are used. [Bug #497459] (dgp) to accurately describe when and how they are used. [Bug 497459] (dgp) * generic/tclHash.c (AllocArrayEntry, AllocStringEntry): Before invoking ckalloc when creating a Tcl_HashEntry, check that the amount of memory being allocated is * generic/tclHash.c (AllocArrayEntry, AllocStringEntry): Before invoking ckalloc when creating a Tcl_HashEntry, check that the amount of memory being allocated is at least as large as at least as large as sizeof(Tcl_HashEntry). The previous code was allocating memory regions that were one or two bytes short. [Bug #521950] (dejong) sizeof(Tcl_HashEntry). The previous code was allocating memory regions that were one or two bytes short. [Bug 521950] (dejong) 2002-02-25 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclBasic.c (Tcl_EvalEx): avoiding a buffer overrun reported by Joe English, and restoring tcl7.6 behaviour for [subst]: badly terminated nested scripts will raise an error and not be evaluated. [Bug #495207] * generic/tclBasic.c (Tcl_EvalEx): avoiding a buffer overrun reported by Joe English, and restoring tcl7.6 behaviour for [subst]: badly terminated nested scripts will raise an error and not be evaluated. [Bug 495207] 2002-02-25 Don Porter <dgp@users.sourceforge.net> * unix/tclUnixPort.h: corrected strtoll prototype mismatch on Tru64. * compat/strtod.c (strtod): simplified #includes * compat/strtol.c (strtol): gather result in a long before returning as a long: necessary on platforms where sizeof(int) != sizeof(long). 2002-02-25 Daniel Steffen <das@users.sourceforge.net> * unix/tclLoadDyld.c: updated to use Mac OS X 10.1 dyld APIs that have more libdl-like semantics. (bug #514392) * unix/tclLoadDyld.c: updated to use Mac OS X 10.1 dyld APIs that have more libdl-like semantics. [Bug 514392] 2002-02-25 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclCompCmds: fixing a bug in patch dated 2002-02-22, in the code for [for] and [while]. Under certain conditions, for long bodies, the exception range parameters were badly computed. Tests forthcoming: I still can't reproduce the conditions in the testsuite (!), although the bug (with assorted segfault or panic!) can be triggered from the console or with the new parse.bench in * generic/tclCompCmds: fixing a bug in patch dated 2002-02-22, in the code for [for] and [while]. Under certain conditions, for long bodies, the exception range parameters were badly computed. Tests forthcoming: I still can't reproduce the conditions in the testsuite (!), although the bug (with assorted segfault or panic!) can be triggered from the console or with the new parse.bench in tclbench. tclbench. 2002-02-25 Donal K. Fellows <fellowsd@cs.man.ac.uk> * compat/strtoul.c, compat/strtol.c, compat/strtod.c: Added UCHAR, CONST and #includes to clean up GCC output. 2002-02-23 Don Porter <dgp@users.sourceforge.net> * compat/strtoull.c (strtoull): * compat/strtoll.c (strtoll): * compat/strtoul.c (strtoul): Fixed failure to handle leading sign symbols '+' and '-' and '0X' and raise overflow errors. [Bug 440916] Also corrects prototype and errno problems. * compat/strtoul.c (strtoul): Fixed failure to handle leading sign symbols '+' and '-' and '0X' and raise overflow errors. [Bug 440916] Also corrects prototype and errno problems. 2002-02-23 Mo DeJong <mdejong@users.sourceforge.net> * configure: Regen. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Link with -n32 instead of -32 when building on IRIX64-6.* system. * unix/tcl.m4 (SC_CONFIG_CFLAGS): Link with -n32 instead of -32 when building on IRIX64-6.* system. [Bug 521707] [Tcl bug 521707] 2002-02-22 Don Porter <dgp@users.sourceforge.net> * generic/tclInt.h: * generic/tclObj.c: renamed global variable emptyString -> tclEmptyString because it is no longer static. * generic/tclPkg.c: Fix for panic when library is loaded on a
︙
4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 4865	9190 9191 9192 9193 9194 9195 9196 9197 9198 9199 9200 9201 9202 9203 9204 9205 9206 9207 9208 9209 9210 9211 9212 9213 9214 9215 9216 9217 9218 9219 9220 9221 9222 9223 9224 9225 9226 9227 9228 9229 9230 9231 9232 9233 9234 9235 9236 9237 9238 9239 9240 9241 9242 9243 9244 9245 9246 9247 9248 9249 9250 9251 9252 9253 9254 9255 9256 9257 9258 9259 9260 9261 9262 9263 9264 9265 9266 9267 9268 9269 9270 9271 9272 9273 9274 9275 9276 9277 9278 9279 9280 9281 9282 9283 9284 9285 9286 9287 9288 9289 9290 9291 9292 9293 9294 9295 9296 9297 9298 9299 9300 9301 9302 9303 9304 9305 9306 9307 9308 9309 9310 9311 9312 9313 9314 9315 9316 9317 9318 9319 9320 9321 9322 9323 9324 9325 9326 9327 9328 9329 9330 9331 9332 9333 9334 9335 9336 9337 9338 9339 9340 9341 9342 9343 9344 9345 9346 9347 9348 9349 9350 9351 9352 9353 9354 9355 9356 9357 9358 9359 9360 9361 9362 9363 9364 9365 9366 9367 9368 9369 9370 9371 9372 9373 9374 9375 9376 9377 9378 9379 9380 9381 9382 9383 9384 9385 9386 9387 9388 9389 9390 9391 9392 9393 9394 9395 9396 9397 9398 9399 9400 9401 9402 9403 9404 9405 9406 9407 9408 9409 9410 9411 9412 9413 9414 9415 9416 9417 9418 9419 9420 9421 9422 9423 9424 9425 9426 9427 9428 9429 9430 9431 9432 9433 9434 9435 9436 9437 9438 9439 9440 9441 9442 9443 9444 9445 9446 9447 9448 9449 9450 9451 9452 9453 9454 9455	- + - - - + + + - - + + - - - + + + - - - - - + + + + - - - + + + - + - - - - + + + - - - - + + + - - - - - + + + + + - - - - - - + + + + + + - - - - + + + + - - - + + + - - + + - - + + - - + + - - + + - + - - - + + + - - + + - - - + + - - - - - - - - + + + + + + + - + - - - - + + + + - - - - + + + - - + + - - - - + + + + - - - - + + + + - - - - - + + + + + - - +	* unix/tcl.m4: added --enable-64bit support for AIX-4 (using -q64 flag) when using IBM's xlc compiler. * tests/safe.test: updated safe-8.5 and safe-8.7 * library/safe.tcl (CheckFileName): removed the limit on sourceable file names (was only *.tcl or tclIndex files with no more than one dot and 14 chars). There is enough internal protection in a safe interpreter already. Fixes [Tk Bug #521560]. protection in a safe interpreter already. Fixes [Tk Bug 521560]. 2002-02-22 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclCompCmds: [FR 465811]. Optimising [if], [for] and [while] for constant conditions; in addition, [for] and [while] are now compiled with the "loop rotation" optimisation (thanks to Kevin Kenny). [while] for constant conditions; in addition, [for] and [while] are now compiled with the "loop rotation" optimisation (thanks to Kevin Kenny). 2002-02-22 Donal K. Fellows <fellowsd@cs.man.ac.uk> --- TIP#76 CHANGES --- * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): Final-argument-less [regsub] returns the modified string. * doc/regsub.n: Updated docs. * tests/regexp.test: Updated and added tests. * compat/strtoll.c (strtoll): * compat/strtoull.c (strtoull): * compat/strtoll.c (strtoll): * compat/strtoull.c (strtoull): * unix/tclUnixPort.h: * win/tclWinPort.h: Const-ing 64-bit compatability declarations. Note that the return pointer is non-const because it is entirely legal for the functions to be called from somewhere that owns the string being passed. Fixes problem reported by Larry Virden. 2002-02-21 David Gravereaux <davygrvy@pobox.com> * win/mkd.bat (removed): * win/coffbase.txt (new): * win/makefile.bc: * win/makefile.vc: Changed the 'setup' target to stop using the mkd.bat file and just make the directory right in the rule. Same change to makefile.bc. configure.in nor Makefile.in use * win/makefile.vc: Changed the 'setup' target to stop using the mkd.bat file and just make the directory right in the rule. Same change to makefile.bc. configure.in nor Makefile.in use it. it. coffbase.txt will be the master list for our "prefered base addresses" set by the linker. This should improve load-time (NT only) by avoiding relocations. Submissions to the list by extension authors are encouraged. coffbase.txt will be the master list for our "prefered base addresses" set by the linker. This should improve load-time (NT only) by avoiding relocations. Submissions to the list by extension authors are encouraged. Added a 'tidy' target to compliment 'clean' and 'hose' to remove just the outputs. Also removed the $(winlibs) macro as it wasn't being used. Added a 'tidy' target to compliment 'clean' and 'hose' to remove just the outputs. Also removed the $(winlibs) macro as it wasn't being used. Stuff left to do: 1) get the winhelp target to stop building in the tools/ 1) get the winhelp target to stop building in the tools/ directory. directory. 2) stop using rmd.bat 3) add more dependacy rules. * win/tclAppInit.c: Reverted back to -r1.6, as the header file change to tclPort.h won't allow for easy embedded support outside of the source dist. Thanks to Don Porter for pointing * win/tclAppInit.c: Reverted back to -r1.6, as the header file change to tclPort.h won't allow for easy embedded support outside of the source dist. Thanks to Don Porter for pointing this out to me. this out to me. 2002-02-21 David Gravereaux <davygrvy@pobox.com> * win/makefile.vc: * win/rules.vc: Added a new "loimpact" option that sets the -ws:aggressive linker option. Off by default. It's said to keep the heap use low at the expense of alloc speed. * win/rules.vc: Added a new "loimpact" option that sets the -ws:aggressive linker option. Off by default. It's said to keep the heap use low at the expense of alloc speed. * win/tclAppInit.c: Changed #include "tcl.h" to be tclPort.h to remove the raw windows.h include. tclPort.h brings in windows.h already and lessens the pre-compiled-header mush and the randomly useless #pragma comment (lib,...) references throughout the big windows.h tree (as observed at high linker warning levels). * win/tclAppInit.c: Changed #include "tcl.h" to be tclPort.h to remove the raw windows.h include. tclPort.h brings in windows.h already and lessens the pre-compiled-header mush and the randomly useless #pragma comment (lib,...) references throughout the big windows.h tree (as observed at high linker warning levels). 2002-02-21 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tcl.h: Better guessing of LP64/ILP32 architecture, but now sensitive to presence of (suitable) <limits.h> 2002-02-20 Don Porter <dgp@users.sourceforge.net> * generic/tcl.decls (Tcl_RegExpRange,Tcl_GetIndexFromObjStruct): Overlooked a few source incompatibilities. Now using CONST84. * generic/tclDecls.h: make genstubs * generic/tcl.h (Tcl_CmdObjTraceProc): silence warning from Sun Workshop compiler. 2002-02-20 David Gravereaux <davygrvy@pobox.com> * win/buildall.vc.bat: * win/makefile.vc: * win/rules.vc: General clean-ups. Added compiler and linker tests for a) the pentium 0x0F errata, b) optimizing (not all have this), and c) linker v6 section alignment confusion. All these are tested first to make sure any D4002 or LNK1117 warnings aren't displayed. The pentium 0x0F errata is a recommended switch. The v5 linker's section alignment default is 512, but the v6 linker was changed * win/rules.vc: General clean-ups. Added compiler and linker tests for a) the pentium 0x0F errata, b) optimizing (not all have this), and c) linker v6 section alignment confusion. All these are tested first to make sure any D4002 or LNK1117 warnings aren't displayed. The pentium 0x0F errata is a recommended switch. The v5 linker's section alignment default is 512, but the v6 linker was changed to 4096 in an attempt to to 4096 in an attempt to speed loading on Win98. I changed the default to always be 512 across both linkers, unless linking statically, then 4096 is used for the claimed speed effect. Using a 512 alignment saves 12k bytes of dead space in the DLL. speed loading on Win98. I changed the default to always be 512 across both linkers, unless linking statically, then 4096 is used for the claimed speed effect. Using a 512 alignment saves 12k bytes of dead space in the DLL. Added IA64 B-stepping errata switch when the compiler supports it. Added profiling to $(lflags) when requested and also removed the explict -entry option as the default works fine as is. Removed win/tclWinInit.c from the special case section to let it use the common implicit rule as the $(EXTFLAGS) macro it had was never referenced anywhere. Removed win/tclWinInit.c from the special case section to let it use the common implicit rule as the $(EXTFLAGS) macro it had was never referenced anywhere. 2002-02-20 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tcl.h: Added code to guess the correct settings for TCL_WIDE_INT_IS_LONG and TCL_WIDE_INT_TYPE when configure doesn't tell us them, as can happen with extensions. TCL_WIDE_INT_IS_LONG and TCL_WIDE_INT_TYPE when configure doesn't tell us them, as can happen with extensions. 2002-02-19 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/format.n: Updated docs to list the specification. * generic/tclCmdAH.c (Tcl_FormatObjCmd): Made behaviour on 64-bit platforms correctly meet the specification, that %d works with the native word-sized integer, instead of trying to guess (wrongly) from the value being passed. native word-sized integer, instead of trying to guess (wrongly) from the value being passed. 2002-02-19 Don Porter <dgp@users.sourceforge.net> * changes: First draft of updated changes for 8.4a4 release. 2002-02-15 Jeff Hobbs <jeffh@ActiveState.com> * unix/tclUnixPort.h: add strtoll/strtoull declarations for platforms that do not define them. * unix/tclUnixPort.h: add strtoll/strtoull declarations for platforms that do not define them. * generic/tclIndexObj.c (STRING_AT): removed ptrdiff_t cast and use of VOID* in default case (GNU-ism). * generic/tclIndexObj.c (STRING_AT): removed ptrdiff_t cast and use of VOID* in default case (GNU-ism). 2002-02-15 Kevin Kenny <kennykb@acm.org> * compat/strtoll.c: * compat/strtoul.c: * compat/strtoull.c: * generic/tclIOUtil.c: * generic/tclPosixStr.c: * generic/tclTest.c: * generic/tclTestObj.c: * tests/get.test: * win/Makefile.vc: Further tweaks to the TIP 72 patch to make it compile under VC++. 2002-02-15 Andreas Kupries <andreas_kupries@users.sourceforge.net> * tclExecute.c: * tclIOGT.c: * tclIndexObj.c: Touchups to the TIP 72 patch to make it compileable under Windows again. The changes are not complete, there is one nasty regarding _stati64 * tclIndexObj.c: Touchups to the TIP 72 patch to make it compileable under Windows again. The changes are not complete, there is one nasty regarding _stati64 2002-02-15 Donal K. Fellows <fellowsd@cs.man.ac.uk> +----------------------+ | TIP #72 IMPLEMENTED. | +----------------------+ There are a lot of changes from this TIP, so please see http://purl.org/tcl/tip/72.html for discussion of backward-compatability issues, but the main ones modifications are http://tip.tcl.tk/72.html for discussion of backward-compatability issues, but the main ones modifications are in: in: * generic/tcl.h: New types. * generic/tcl.decls: New public functions. * generic/tclExecute.c: 64-bit aware bytecode engine. * generic/tclBinary.c: 64-bit handling in [binary] command. * generic/tclScan.c: 64-bit handling in [scan] command. * generic/tclCmdAH.c: 64-bit handling in [file] and [format] commands. * generic/tclBasic.c: New "wordSize" entry in ::tcl_platform. * generic/tclFCmd.c: Large-file support (with many consequences.) * generic/tclIO.c: Large-file support (with many consequences.) * compat/strtoll.c, compat/strtoull.c: New support functions. * unix/tcl.m4, unix/configure: 64-bit support and greatly enhanced cacheing. Most other changes, including all those in doc/* and test/* as well as the majority in the platform directories, follow on from Most other changes, including all those in doc/* and test/* as well as the majority in the platform directories, follow on from these. these. Also coming out of the woodwork: * generic/tclIndex.c: Better support for Cray PVP. * win/tclWinMtherr.c: Better Borland support. Note that, in a number of places through the Unix part of the platform support, there are Tcl_Platform* references. These are expanded into the correct way to call that particular underlying function, i.e. with or without a '64' suffix, and should be used by people working on the core in preference to the API functions they overlay so that the code remains portable depending on the presence or absence of 64-bit support on the underlying platform. Note that, in a number of places through the Unix part of the platform support, there are Tcl_Platform* references. These are expanded into the correct way to call that particular underlying function, i.e. with or without a '64' suffix, and should be used by people working on the core in preference to the API functions they overlay so that the code remains portable depending on the presence or absence of 64-bit support on the underlying platform. ***POTENTIAL INCOMPATIBILITY***: Extracted from the TIP SUMMARY OF INCOMPATIBILITIES AND FIXES SUMMARY OF INCOMPATIBILITIES AND FIXES ====================================== The behaviour of expressions containing constants that appear positive but which have a negative internal representation will change, as these will now usually be interpreted as wide integers. This is always fixable by replacing the constant with The behaviour of expressions containing constants that appear positive but which have a negative internal representation will change, as these will now usually be interpreted as wide integers. This is always fixable by replacing the constant with int(constant). int(constant). Extensions creating new channel types will need to be altered as different types are now in use in those areas. The change to the declaration of Tcl_FSStat and Tcl_FSLstat (which are the new preferred API in any case) are less serious as no non-alpha releases have been made yet with those API functions. declaration of Tcl_FSStat and Tcl_FSLstat (which are the new preferred API in any case) are less serious as no non-alpha releases have been made yet with those API functions. Scripts that are lax about the use of the l modifier in format and scan will probably need to be rewritten. This should be very uncommon though as previously it had absolutely no effect. scan will probably need to be rewritten. This should be very uncommon though as previously it had absolutely no effect. Extensions that create new math functions that take more than one argument will need to be recompiled (the size of Tcl_Value changes), and functions that accept arguments of any type (TCL_EITHER) will need to be rewritten to handle wide integer values. (I do not expect this to affect many extensions at all.) argument will need to be recompiled (the size of Tcl_Value changes), and functions that accept arguments of any type (TCL_EITHER) will need to be rewritten to handle wide integer values. (I do not expect this to affect many extensions at all.) 2002-02-14 Andreas Kupries <andreas_kupries@users.sourceforge.net> * generic/tclIOCmd.c (Tcl_GetsObjCmd): Trivial fix for bug #517503, a memory leak reported by Miguel Sofer <msofer@users.sourceforge.net>. The leak happens if an error occurs for "set var [gets $chan]" and leak one empty object. * generic/tclIOCmd.c (Tcl_GetsObjCmd): Trivial fix for [Bug 517503], a memory leak reported by Miguel Sofer <msofer@users.sourceforge.net>. The leak happens if an error occurs for "set var [gets $chan]" and leak one empty object. 2002-02-12 David Gravereaux <davygrvy@pobox.com> * djgpp/ (new directory) * djgpp/Makefile (new): * unix/tclAppInit.c: * unix/tclMtherr.c: * unix/tclUnixFCmd.c: * unix/tclUnixFile.c: * unix/tclUnixInit.c: * unix/tclUnixPort.h: Early stage of DJGPP support for building Tcl on DOS. Dynamic loading isn't working, yet. Requires watt32 for the TCP/IP stack. No autoconf, yet. Barely tested, but makes a working exe that runs Tcl in protected-mode, flat memory. [exec] and pipes will need the most work as multi-tasking on DOS * unix/tclUnixPort.h: Early stage of DJGPP support for building Tcl on DOS. Dynamic loading isn't working, yet. Requires watt32 for the TCP/IP stack. No autoconf, yet. Barely tested, but makes a working exe that runs Tcl in protected-mode, flat memory. [exec] and pipes will need the most work as multi-tasking on DOS has to be carefully. has to be carefully. 2002-02-10 Kevin Kenny <kennykb@acm.org> * doc/CrtObjCmd.3: * doc/CrtTrace.3: * generic/tcl.decls: * generic/tcl.h: * generic/tclBasic.c: * generic/tclInt.h: * generic/tclTest.c: * tests/basic.test: Added Tcl_CreateObjTrace, Tcl_GetCommandInfoFromToken and Tcl_SetCommandInfoFromToken. (TIPs #32 and #79.) * generic/tclDecls.h: * generic/tclStubInit.c: Regenerated Stubs tables. 2002-02-08 Jeff Hobbs <jeffh@ActiveState.com> * unix/configure: * unix/tcl.m4: added -pthread for FreeBSD to EXTRA_CFLAGS and LDFLAGS. Also triggered nodots only for FreeBSD-3. Added AC_DEFINE(_POSIX_PTHREAD_SEMANTICS) for Solaris.
︙
4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923	9483 9484 9485 9486 9487 9488 9489 9490 9491 9492 9493 9494 9495 9496 9497 9498 9499 9500 9501 9502 9503 9504 9505 9506 9507 9508 9509 9510 9511 9512 9513	- - + + - - - + + +	* win/tclWin32Dll.c: * win/tclWinFCmd.c: * win/tclWinFile.c: * win/tclWinInit.c: Partial TIP 27 rollback. Following routines restored to return (char *): Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_JoinPath, Tcl_TranslateFileName, Tcl_ExternalToUtfDString, Tcl_UtfToExternalDString, Tcl_UniCharToUtfDString, Tcl_GetCwd, Tcl_WinTCharToUtf. Also restored Tcl_WinUtfToTChar to return (TCHAR *) and Tcl_UniCharToUtfDString, Tcl_GetCwd, Tcl_WinTCharToUtf. Also restored Tcl_WinUtfToTChar to return (TCHAR *) and Tcl_UtfToUniCharDString to return (Tcl_UniChar *). Modified some callers. This change recognizes that Tcl_DStrings are de-facto white-box objects. * generic/tclDecls.h: * generic/tclPlatDecls.h: make genstubs * generic/tclCmdMZ.c: corrected use of C++-style comment. 2002-02-06 Jeff Hobbs <jeffh@ActiveState.com> * tests/scan.test: * generic/tclScan.c (Tcl_ScanObjCmd): corrected scan 0x... %x handling that didn't accept the 0x as a prelude to a base 16 number. [Bug #495213] * generic/tclScan.c (Tcl_ScanObjCmd): corrected scan 0x... %x handling that didn't accept the 0x as a prelude to a base 16 number. [Bug 495213] * generic/tclCompCmds.c (TclCompileRegexpCmd): made early check for bad RE to stop checking further. * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): added special case to search for simple 'string map' style regsub calls. Delayed creation of resultPtr object until an initial match is
︙
4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018	9526 9527 9528 9529 9530 9531 9532 9533 9534 9535 9536 9537 9538 9539 9540 9541 9542 9543 9544 9545 9546 9547 9548 9549 9550 9551 9552 9553 9554 9555 9556 9557 9558 9559 9560 9561 9562 9563 9564 9565 9566 9567 9568 9569 9570 9571 9572 9573 9574 9575 9576 9577 9578 9579 9580 9581 9582 9583 9584 9585 9586 9587 9588 9589 9590 9591 9592 9593 9594 9595 9596 9597 9598 9599 9600 9601 9602 9603 9604	- - - - - + + + + + - - - - + + + - - + + - - + + - + - - - - - - + + + + + + - - - + + - - + + - - - - + + + - - +	* library/http/http.tcl: * library/http/pkgIndex.tcl: Corrected use of http::error when ::error was intended. Bump to http 2.4.2. 2002-02-04 Andreas Kupries <andreas_kupries@users.sourceforge.net> * unix/tclUnixChan.c (FileOutputProc): Fixed [bug 465765] reported by Dale Talcott <daletalcott@users.sourceforge.net>. Avoid writing nothing into a file as STREAM based implementations will consider this a EOF (if the file is a pipe). Not done in the generic layer as this type of writing is actually useful to * unix/tclUnixChan.c (FileOutputProc): Fixed [bug 465765] reported by Dale Talcott <daletalcott@users.sourceforge.net>. Avoid writing nothing into a file as STREAM based implementations will consider this a EOF (if the file is a pipe). Not done in the generic layer as this type of writing is actually useful to check the state of a socket. check the state of a socket. * doc/open.n: Fixed [Bug 511540], added cross-reference to 'pid' as the command to use to retrieve the pid of a command pipeline created via 'open'. * doc/open.n: Fixed [Bug 511540], added cross-reference to 'pid' as the command to use to retrieve the pid of a command pipeline created via 'open'. 2002-02-01 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): handle quirky about case earlier to avoid shimmering problem. 2002-02-01 Andreas Kupries <andreas_kupries@users.sourceforge.net> * tests/io.test: io-39.22 split into two tests, one platform dependent, the other not. -eofchar is not empty on the windows platform. dependent, the other not. -eofchar is not empty on the windows platform. 2002-02-01 Vince Darley <vincentdarley@users.sourceforge.net> * generic/tclTest.c: fix to picky windows compiler problem with the 'MainLoop' function declaration. * generic/tclTest.c: fix to picky windows compiler problem with the 'MainLoop' function declaration. 2002-01-31 Andreas Kupries <andreas_kupries@users.sourceforge.net> * win/tclWinFCmd.c: TIP 27: Applied patch fixing CONST warnings on behalf of Don Porter <dgp@users.sourceforge.net>. behalf of Don Porter <dgp@users.sourceforge.net>. 2002-01-30 Don Porter <dgp@users.sourceforge.net> * generic/tcl.decls: * generic/tcl.h: * generic/tclInt.h: For each interface identified in the TIP 27 changes below as a POTENTIAL INCOMPATIBILITY, the source of the incompatibility has been parameterized so that it can be removed. When compiling extension code against the Tcl header files, use the compiler flag -DUSE_NON_CONST to remove the irresolvable source incompatibilities introduced by the TIP 27 changes. Resolvable changes are left for extension authors to changes below as a POTENTIAL INCOMPATIBILITY, the source of the incompatibility has been parameterized so that it can be removed. When compiling extension code against the Tcl header files, use the compiler flag -DUSE_NON_CONST to remove the irresolvable source incompatibilities introduced by the TIP 27 changes. Resolvable changes are left for extension authors to resolve. resolve. * generic/tclDecls.h: make genstubs 2002-01-30 Vince Darley <vincentdarley@users.sourceforge.net> * doc/FileSystem.3: added documentation for 3 public functions which had been overlooked. Fixes [Bug 507701]. * doc/FileSystem.3: added documentation for 3 public functions which had been overlooked. Fixes [Bug 507701] * unix/mkLinks: make mklinks 2002-01-29 Jeff Hobbs <jeffh@ActiveState.com> * tests/regexpComp.test: * generic/tclCompCmds.c (TclCompileRegexpCmd): enhanced to support -nocase and -- options. 2002-01-28 Mo DeJong <mdejong@users.sourceforge.net> * unix/tcl.m4 (SC_LOAD_TCLCONFIG): * win/tcl.m4 (SC_LOAD_TCLCONFIG): Set TCL_LIB_SPEC, TCL_STUB_LIB_SPEC, and TCL_STUB_LIB_PATH to the * win/tcl.m4 (SC_LOAD_TCLCONFIG): Set TCL_LIB_SPEC, TCL_STUB_LIB_SPEC, and TCL_STUB_LIB_PATH to the values of TCL_BUILD_LIB_SPEC, values of TCL_BUILD_LIB_SPEC, TCL_BUILD_STUB_LIB_SPEC, and TCL_BUILD_STUB_LIB_PATH when tclConfig.sh is loaded from the build directory. A Tcl extension should make use of the non-build versions of these variables TCL_BUILD_STUB_LIB_SPEC, and TCL_BUILD_STUB_LIB_PATH when tclConfig.sh is loaded from the build directory. A Tcl extension should make use of the non-build versions of these variables since they will work in both since they will work in both cases. This modification was described in TIP 34. cases. This modification was described in TIP #34. 2002-01-28 Jeff Hobbs <jeffh@ActiveState.com> * win/tclWinReg.c (regConnectRegistryProc,RecursiveDeleteKey) (DeleteKey,GetKeyNames,GetType,GetValue,OpenSubKey,SetValue): redid the CONSTification as previous changes caused failing tests.
︙
5034 5035 5036 5037 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104 5105 5106 5107 5108 5109 5110 5111 5112 5113 5114 5115 5116 5117 5118 5119	9620 9621 9622 9623 9624 9625 9626 9627 9628 9629 9630 9631 9632 9633 9634 9635 9636 9637 9638 9639 9640 9641 9642 9643 9644 9645 9646 9647 9648 9649 9650 9651 9652 9653 9654 9655 9656 9657 9658 9659 9660 9661 9662 9663 9664 9665 9666 9667 9668 9669 9670 9671 9672 9673 9674 9675 9676 9677 9678 9679 9680 9681 9682 9683 9684 9685 9686 9687 9688 9689 9690 9691 9692 9693 9694 9695 9696 9697 9698 9699 9700 9701 9702 9703 9704	- + - - - + + + - - + + - - - + + + - - - + + + - - - - - - + + + + + - - - + + + - - - - - + + + + + - - + +	* win/tclWinInit.c (TclpFindVariable): CONSTification touch-up * win/tclWinReg.c (OpenSubKey): corrected bug introduced in CONSTification that dropped pointer reference. * ChangeLog.2000 (new file): * ChangeLog: broke changes from 2000 into ChangeLog.2000 to reduce size of the main ChangeLog. size of the main ChangeLog. 2002-01-28 David Gravereaux <davygrvy@pobox.com> * generic/tclPlatDecls.h: Added preprocessor logic to force a typedef of TCHAR when __STDC__ is defined when using the uncommon -Za compiler switch with the microsoft compiler. * generic/tclPlatDecls.h: Added preprocessor logic to force a typedef of TCHAR when __STDC__ is defined when using the uncommon -Za compiler switch with the microsoft compiler. 2002-01-27 Don Porter <dgp@users.sourceforge.net> * doc/package.n: Documented global namespace context for script evaluation by [package require]. 2002-01-27 Daniel Steffen <das@users.sourceforge.net> * generic/tclInt.decls: * generic/tclIntPlatDecls.h: * mac/tclMacChan.c: * mac/tclMacFCmd.c: * mac/tclMacFile.c: * mac/tclMacInit.c: * mac/tclMacLoad.c: * mac/tclMacResource.c: * mac/tclMacSock.c: TIP 27 CONSTification induced changes * tests/event.test: * tests/main.test: added catches/constraints to test that use features that don't exist on the mac. * tests/main.test: added catches/constraints to test that use features that don't exist on the mac. 2002-01-25 Mo DeJong <mdejong@users.sourceforge.net> Make -eofchar and -translation options read only for server sockets. [Bug 496733] Make -eofchar and -translation options read only for server sockets. [Bug 496733] * generic/tclIO.c (Tcl_GetChannelOption, Tcl_SetChannelOption): Instead of returning nothing for the -translation option on a server socket, always return "auto". Return the empty string enclosed in quotes for the -eofchar option on Instead of returning nothing for the -translation option on a server socket, always return "auto". Return the empty string enclosed in quotes for the -eofchar option on a server socket. Fixup -eofchar a server socket. Fixup -eofchar usage message so that it matches the implementation. * tests/io.test: Add -eofchar tests and -translation tests to ensure options are read only on server sockets. * tests/socket.test: Update tests to account for -eofchar and -translation option changes. usage message so that it matches the implementation. * tests/io.test: Add -eofchar tests and -translation tests to ensure options are read only on server sockets. * tests/socket.test: Update tests to account for -eofchar and -translation option changes. 2002-01-25 Don Porter <dgp@users.sourceforge.net> * compat/strstr.c (strstr): * generic/tclCmdAH.c (Tcl_FormatObjCmd): * generic/tclCmdIL.c (InfoNameOfExecutableCmd): * generic/tclEnv.c (ReplaceString): * generic/tclFileName.c (ExtractWinRoot): * generic/tclIO.c (FlushChannel,Tcl_BadChannelOption): * generic/tclStringObj.c (AppendUnicodeToUtfRep): * generic/tclThreadTest.c (TclCreateThread): * generic/tclUtf.c (Tcl_UtfPrev): * mac/tclMacFCmd.c (TclpObjListVolumes): * mac/tclMacResource.c (TclMacRegisterResourceFork, BuildResourceForkList): * win/tclWinInit.c (AppendEnvironment): Sought out and eliminated * mac/tclMacResource.c (TclMacRegisterResourceFork) (BuildResourceForkList): * win/tclWinInit.c (AppendEnvironment): Sought out and eliminated instances of CONST-casting that are no longer needed after the TIP 27 effort. * Following is [Patch 501006] * generic/tclInt.decls (Tcl_AddInterpResolvers, Tcl_Export, Tcl_FindNamespace, Tcl_GetInterpResolvers, Tcl_ForgetImport, Tcl_Import, Tcl_RemoveInterpResolvers): * generic/tclNamesp.c (Tcl_Export, Tcl_Import, Tcl_ForgetImport, Tcl_FindNamespace): * generic/tclInt.decls (Tcl_AddInterpResolvers, Tcl_Export) (Tcl_FindNamespace, Tcl_GetInterpResolvers, Tcl_ForgetImport) (Tcl_Import, Tcl_RemoveInterpResolvers): * generic/tclNamesp.c (Tcl_Export, Tcl_Import, Tcl_ForgetImport) (Tcl_FindNamespace): * generic/tclResolve.c (Tcl_AddInterpResolvers,Tcl_GetInterpResolvers, Tcl_RemoveInterpResolvers): Updated APIs in generic/tclResolve.c and generic/tclNamesp.c according to the guidelines of TIP 27. (Tcl_RemoveInterpResolvers): Updated APIs in generic/tclResolve.c and generic/tclNamesp.c according to the guidelines of TIP 27. * generic/tclIntDecls.h: make genstubs * Following is [Patch 505630] * doc/AddErrorInfo.3: * generic/tcl.decls (Tcl_LogCommandInfo): * generic/tclBasic.c (Tcl_LogCommandInfo): Updated interfaces of generic/tclBasic.cc according to TIP 27.
︙
5138 5139 5140 5141 5142 5143 5144 5145 5146 5147 5148 5149 5150 5151 5152 5153 5154 5155 5156 5157 5158 5159 5160 5161 5162 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 5211 5212 5213 5214 5215 5216 5217 5218 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248 5249 5250 5251 5252 5253 5254 5255 5256 5257 5258 5259 5260 5261 5262 5263 5264 5265 5266 5267 5268 5269 5270 5271 5272 5273 5274 5275 5276 5277 5278 5279 5280 5281 5282 5283 5284 5285 5286 5287 5288 5289 5290 5291 5292 5293 5294 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 5338 5339 5340 5341 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 5359 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 5426 5427 5428 5429 5430 5431 5432 5433 5434 5435 5436 5437 5438 5439 5440 5441 5442 5443 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 5456 5457 5458 5459 5460 5461 5462 5463 5464 5465 5466 5467 5468 5469 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 5483 5484 5485 5486 5487 5488 5489 5490 5491 5492 5493 5494 5495 5496 5497 5498 5499 5500 5501 5502 5503 5504 5505 5506 5507 5508 5509 5510 5511 5512 5513 5514 5515 5516 5517 5518 5519 5520 5521 5522 5523 5524 5525 5526 5527 5528 5529 5530 5531 5532 5533 5534 5535 5536 5537 5538 5539 5540 5541 5542 5543 5544 5545 5546 5547 5548 5549 5550 5551 5552 5553 5554 5555 5556 5557 5558 5559 5560 5561 5562 5563 5564 5565 5566 5567 5568 5569 5570 5571 5572 5573 5574 5575 5576 5577 5578 5579 5580 5581 5582 5583 5584 5585 5586 5587 5588 5589 5590 5591 5592 5593 5594 5595 5596 5597 5598 5599 5600 5601 5602 5603 5604 5605 5606 5607 5608 5609 5610 5611 5612 5613 5614 5615 5616 5617 5618 5619 5620 5621 5622 5623 5624 5625 5626 5627 5628 5629 5630 5631 5632 5633 5634 5635 5636 5637 5638 5639 5640 5641 5642 5643 5644 5645 5646 5647 5648 5649 5650 5651 5652 5653 5654 5655 5656 5657 5658 5659 5660 5661 5662 5663 5664 5665 5666 5667 5668 5669 5670 5671 5672 5673 5674 5675 5676 5677 5678 5679 5680 5681 5682 5683 5684 5685 5686 5687 5688 5689 5690 5691 5692 5693 5694 5695 5696 5697 5698 5699 5700 5701 5702 5703 5704 5705 5706 5707 5708 5709 5710 5711 5712 5713 5714 5715 5716 5717 5718 5719 5720 5721 5722 5723 5724 5725 5726 5727 5728 5729 5730 5731 5732 5733 5734	9723 9724 9725 9726 9727 9728 9729 9730 9731 9732 9733 9734 9735 9736 9737 9738 9739 9740 9741 9742 9743 9744 9745 9746 9747 9748 9749 9750 9751 9752 9753 9754 9755 9756 9757 9758 9759 9760 9761 9762 9763 9764 9765 9766 9767 9768 9769 9770 9771 9772 9773 9774 9775 9776 9777 9778 9779 9780 9781 9782 9783 9784 9785 9786 9787 9788 9789 9790 9791 9792 9793 9794 9795 9796 9797 9798 9799 9800 9801 9802 9803 9804 9805 9806 9807 9808 9809 9810 9811 9812 9813 9814 9815 9816 9817 9818 9819 9820 9821 9822 9823 9824 9825 9826 9827 9828 9829 9830 9831 9832 9833 9834 9835 9836 9837 9838 9839 9840 9841 9842 9843 9844 9845 9846 9847 9848 9849 9850 9851 9852 9853 9854 9855 9856 9857 9858 9859 9860 9861 9862 9863 9864 9865 9866 9867 9868 9869 9870 9871 9872 9873 9874 9875 9876 9877 9878 9879 9880 9881 9882 9883 9884 9885 9886 9887 9888 9889 9890 9891 9892 9893 9894 9895 9896 9897 9898 9899 9900 9901 9902 9903 9904 9905 9906 9907 9908 9909 9910 9911 9912 9913 9914 9915 9916 9917 9918 9919 9920 9921 9922 9923 9924 9925 9926 9927 9928 9929 9930 9931 9932 9933 9934 9935 9936 9937 9938 9939 9940 9941 9942 9943 9944 9945 9946 9947 9948 9949 9950 9951 9952 9953 9954 9955 9956 9957 9958 9959 9960 9961 9962 9963 9964 9965 9966 9967 9968 9969 9970 9971 9972 9973 9974 9975 9976 9977 9978 9979 9980 9981 9982 9983 9984 9985 9986 9987 9988 9989 9990 9991 9992 9993 9994 9995 9996 9997 9998 9999 10000 10001 10002 10003 10004 10005 10006 10007 10008 10009 10010 10011 10012 10013 10014 10015 10016 10017 10018 10019 10020 10021 10022 10023 10024 10025 10026 10027 10028 10029 10030 10031 10032 10033 10034 10035 10036 10037 10038 10039 10040 10041 10042 10043 10044 10045 10046 10047 10048 10049 10050 10051 10052 10053 10054 10055 10056 10057 10058 10059 10060 10061 10062 10063 10064 10065 10066 10067 10068 10069 10070 10071 10072 10073 10074 10075 10076 10077 10078 10079 10080 10081 10082 10083 10084 10085 10086 10087 10088 10089 10090 10091 10092 10093 10094 10095 10096 10097 10098 10099 10100 10101 10102 10103 10104 10105 10106 10107 10108 10109 10110 10111 10112 10113 10114 10115 10116 10117 10118 10119 10120 10121 10122 10123 10124 10125 10126 10127 10128 10129 10130 10131 10132 10133 10134 10135 10136 10137 10138 10139 10140 10141 10142 10143 10144 10145 10146 10147 10148 10149 10150 10151 10152 10153 10154 10155 10156 10157 10158 10159 10160 10161 10162 10163 10164 10165 10166 10167 10168 10169 10170 10171 10172 10173 10174 10175 10176 10177 10178 10179 10180 10181 10182 10183 10184 10185 10186 10187 10188 10189 10190 10191 10192 10193 10194 10195 10196 10197 10198 10199 10200 10201 10202 10203 10204 10205 10206 10207 10208 10209 10210 10211 10212 10213 10214 10215 10216 10217 10218 10219 10220 10221 10222 10223 10224 10225 10226 10227 10228 10229 10230 10231 10232 10233 10234 10235 10236 10237 10238 10239 10240 10241 10242 10243 10244 10245 10246 10247 10248 10249 10250 10251 10252 10253 10254 10255 10256 10257 10258 10259 10260 10261 10262 10263 10264 10265 10266 10267 10268 10269 10270 10271 10272 10273 10274 10275 10276 10277 10278 10279 10280 10281 10282 10283 10284 10285 10286 10287 10288 10289 10290 10291 10292 10293 10294 10295 10296 10297 10298 10299 10300 10301 10302 10303 10304 10305 10306 10307 10308 10309 10310 10311 10312 10313 10314	- - + + - - + + - - - - - + + + + + - + - - - - + + + + - + - - + + - + - + - + - + - - - + + + - + - + - + - + - + - + - - - - + + + + - + - - + + - + - + - + - + - - + + - - - - - - - - + + + + + + + - - - - - + + + + - + - + - - + + - - + + - - - - - + + + + + - - - - - - - + + + + + + - - - + + - - + - - + + - - + + - - - - + + + + - - + + - + - - + + - + - + - - + + - + - + - - + + - - + + - - + + - + - + - + - - + + - - + + - - - + + + - - + + - + - + - + - + - - + + - + - + - - + + - + - - + + - - - + + + - - - - + + + + - + - - + - - - - - - + + + + + + - - + + - - + - + - - - - + + + + - - - + + + - - - + + + - + + - + - - - - + + + + - - + + - + + - - + + - - - - + + + + - - - - - + + + + + - + - - - + + + - - + + - - + +	* doc/Encoding.3: * generic/tcl.decls (Tcl_WinUtfToTChar,Tcl_WinTCharToUtf): * win/tclWin32Dll.c (Tcl_WinUtfToTChar,Tcl_WinTCharToUtf): Updated interfaces in win/tclWin32Dll.c according to TIP 27. * generic/tclPlatDecls.h: make genstubs * generic/tclIOUtil.c (TclpNativeToNormalized): * win/tclWinFCmd.c (TclpObjNormalizePath): * win/tclWinFile.c (TclpFindExecutable,TclpMatchInDirectory, NativeIsExec,NativeStat): * win/tclWinFile.c (TclpFindExecutable,TclpMatchInDirectory) (NativeIsExec,NativeStat): * win/tclWinLoad.c (TclpLoadFile): * win/tclWinPipe.c (TclpOpenFile,ApplicationType): * win/tclWinReg.c (regConnectRegistryProc,RecursiveDeleteKey,DeleteKey, GetKeyNames,GetType,GetValue,OpenSubKey,SetValue): * win/tclWinReg.c (regConnectRegistryProc,RecursiveDeleteKey,DeleteKey) (GetKeyNames,GetType,GetValue,OpenSubKey,SetValue): * win/tclWinSerial.c (SerialSetOptionProc): Update callers. * Following is [Patch 505072] * doc/Concat.3: * doc/Encoding.3: * doc/Filesystem.3: * doc/Macintosh.3: * doc/OpenFileChnl.3 * doc/SetResult.3: * doc/SetVar.3: * doc/SplitList.3: * doc/SplitPath.3: * doc/Translate.3: * generic/tcl.h (Tcl_FSMatchInDirectoryProc): * generic/tclInt.h (TclpMatchInDirectory): * generic/tcl.decls (Tcl_Concat,Tcl_GetStringResult,Tcl_GetVar, Tcl_GetVar2,Tcl_JoinPath,Tcl_Merge,Tcl_OpenCommandChannel,Tcl_SetVar, Tcl_SetVar2,Tcl_SplitList,Tcl_SplitPath,Tcl_TranslateFileName, Tcl_ExternalToUtfDString,Tcl_GetEncodingName,Tcl_UtfToExternalDString, Tcl_GetDefaultEncodingDir,Tcl_SetDefaultEncodingDir, Tcl_FSMatchInDirectory,Tcl_MacEvalResource,Tcl_MacFindResource): (Tcl_GetVar2,Tcl_JoinPath,Tcl_Merge,Tcl_OpenCommandChannel,Tcl_SetVar) (Tcl_SetVar2,Tcl_SplitList,Tcl_SplitPath,Tcl_TranslateFileName) (Tcl_ExternalToUtfDString,Tcl_GetEncodingName,Tcl_UtfToExternalDString) (Tcl_GetDefaultEncodingDir,Tcl_SetDefaultEncodingDir) (Tcl_FSMatchInDirectory,Tcl_MacEvalResource,Tcl_MacFindResource): * generic/tclInt.decls (TclCreatePipeline,TclGetEnv,TclpGetCwd, TclpCreateProcess): (TclpCreateProcess): * mac/tclMacFile.c (TclpGetCwd): * generic/tclEncoding.c (Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir,Tcl_GetEncodingName, Tcl_ExternalToUtfDString,Tcl_UtfToExternalDString, OpenEncodingFile, LoadEscapeEncoding): * generic/tclEncoding.c (Tcl_GetDefaultEncodingDir) (Tcl_SetDefaultEncodingDir,Tcl_GetEncodingName) (Tcl_ExternalToUtfDString,Tcl_UtfToExternalDString, OpenEncodingFile) (LoadEscapeEncoding): * generic/tclFileName.c (DoTildeSubst,Tcl_JoinPath,Tcl_SplitPath, Tcl_TranslateFileName): (Tcl_TranslateFileName): * generic/tclIOUtil.c (Tcl_FSMatchInDirectory): * generic/tclPipe.c (FileForRedirect,TclCreatePipeline, Tcl_OpenCommandChannel): * generic/tclPipe.c (FileForRedirect,TclCreatePipeline) (Tcl_OpenCommandChannel): * generic/tclResult.c (Tcl_GetStringResult): * generic/tclUtil.c (Tcl_Concat,Tcl_SplitList,Tcl_Merge): * generic/tclVar.c (Tcl_GetVar,Tcl_GetVar2,Tcl_SetVar,Tcl_SetVar2): * mac/tclMacResource.c (Tcl_MacEvalResource,Tcl_MacFindResource): Updated interfaces of generic/tclEncoding, generic/tclFilename.c, generic/tclIOUtil.c, generic/tclPipe.c, generic/tclResult.c, generic/tclUtil.c, generic/tclVar.c and mac/tclMacResource.c according to TIP 27. Tcl_TranslateFileName rewritten as wrapper around VFS-aware version. ***POTENTIAL INCOMPATIBILITY*** ***POTENTIAL INCOMPATIBILITY*** Includes source incompatibilities: argv arguments of Tcl_Concat, Tcl_JoinPath, Tcl_OpenCommandChannel, Tcl_Merge; argvPtr arguments of Tcl_SplitList and Tcl_SplitPath. * generic/tclDecls.h: * generic/tclDecls.h: * generic/tclIntDecls.h: make genstubs * generic/tclCkalloc.c (MemoryCmd): * generic/tclClock.c (FormatClock): * generic/tclCmdAH.c (Tcl_CaseObjCmd,Tcl_EncodingObjCmd,Tcl_FileObjCmd): * generic/tclCmdIL.c (InfoLibraryCmd,InfoPatchLevelCmd, InfoTclVersionCmd): (InfoTclVersionCmd): * generic/tclCompCmds.c (TclCompileForeachCmd): * generic/tclCompCmds.h (TclCompileForeachCmd): * generic/tclCompile.c (TclFindCompiledLocal): * generic/tclEnv.c (TclSetupEnv,TclSetEnv,Tcl_PutEnv,TclGetEnv, EnvTraceProc): (EnvTraceProc): * generic/tclEvent.c (Tcl_BackgroundError): * generic/tclIO.c (Tcl_BadChannelOption,Tcl_SetChannelOption): * generic/tclIOCmd.c (Tcl_ExecObjCmd,Tcl_OpenObjCmd): * generic/tclIOSock.c (TclSockGetPort): * generic/tclIOUtil.c (SetFsPathFromAny): * generic/tclLink.c (LinkTraceProc): * generic/tclMain.c (Tcl_Main): * generic/tclNamesp.c (TclTeardownNamespace): * generic/tclProc.c (TclCreateProc): * generic/tclTest.c (TestregexpObjCmd,TesttranslatefilenameCmd, TestchmodCmd,GetTimesCmd,TestsetCmd,TestOpenFileChannelProc1, TestOpenFileChannelProc2,TestOpenFileChannelProc3,AsyncHandlerProc, TestpanicCmd): (TestchmodCmd,GetTimesCmd,TestsetCmd,TestOpenFileChannelProc1, (TestOpenFileChannelProc2,TestOpenFileChannelProc3,AsyncHandlerProc, (TestpanicCmd): * generic/tclThreadTest.c (ThreadErrorProc,ThreadEventProc): * generic/tclUtil.c (TclPrecTraceProc): * mac/tclMacFCmd.c (GetFileSpecs): * mac/tclMacFile.c (TclpMatchInDirectory): * mac/tclMacInit.c (TclpInitLibraryPath,Tcl_SourceRCFile): * mac/tclMacOSA.c (tclOSAStore,tclOSALoad): * mac/tclMacResource.c (Tcl_MacEvalResource): * unix/tclUnixFCmd.c (TclpObjNormalizePath): * unix/tclUnixFile.c (TclpMatchInDirectory,TclpGetUserHome,TclpGetCwd, TclpReadLink): (TclpReadLink): * unix/tclUnixInit.c (TclpInitLibraryPath,TclpSetVariables, Tcl_SourceRCFile): (Tcl_SourceRCFile): * unix/tclUnixPipe.c (TclpOpenFile,TclpCreateTempFile, TclpCreateProcess): (TclpCreateProcess): * win/tclWinFile.c (TclpGetCwd,TclpMatchInDirectory): * win/tclWinInit.c (TclpInitLibraryPath,Tcl_SourceRCFile, TclpSetVariables): (TclpSetVariables): * win/tclWinPipe.c (TclpCreateProcess): Updated callers. 2002-01-24 Don Porter <dgp@users.sourceforge.net> * generic/tclIOUtil.c (SetFsPathFromAny): Corrected tilde-substitution of pathnames where > 1 separator follows the ~. [Bug 504950] of pathnames where > 1 separator follows the ~. [Bug 504950] 2002-01-24 Jeff Hobbs <jeffh@ActiveState.com> * library/http/pkgIndex.tcl: * library/http/http.tcl: don't add port in default case to handle broken servers. http bumped to 2.4.1 [Bug #504508] broken servers. http bumped to 2.4.1 [Bug 504508] 2002-01-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> * unix/mkLinks: Regenerated. * doc/CrtChannel.3: * doc/ChnlStack.3: Moved documentation for 'Tcl_GetTopChannel' from 'CrtChannel' to 'ChnlStack'. Added documentation of 'Tcl_GetStackedChannel'. Bug #506147 reported by Mark Patton <msp@users.sourceforge.net>. * doc/ChnlStack.3: Moved documentation for 'Tcl_GetTopChannel' from 'CrtChannel' to 'ChnlStack'. Added documentation of 'Tcl_GetStackedChannel'. [Bug 506147] reported by Mark Patton <msp@users.sourceforge.net> 2002-01-23 Don Porter <dgp@users.sourceforge.net> * win/tclWinFile.c (NativeAccess,NativeStat,NativeIsExec, TclpGetUserHome): (TclpGetUserHome): * win/tclWinPort.h (TclWinSerialReopen): * win/tclWinSerial.c (TclWinSerialReopen): * win/tclWinSock.c (Tcl_OpenTcpServer): Corrections to earlier TIP 27 changes. Thanks to Andreas Kupries for the feedback. * win/tclWinSock.c (Tcl_OpenTcpServer): Corrections to earlier TIP #27 changes. Thanks to Andreas Kupries for the feedback. * generic/tclPlatDecls.h: make genstubs * doc/GetHostName.3: * doc/GetOpnFl.3: * doc/OpenTcp.3: * tcl.decls (Tcl_GetHostName,Tcl_GetOpenFile,Tcl_OpenTcpClient, Tcl_OpenTclServer): (Tcl_OpenTclServer): * mac/tclMacSock.c (CreateSocket,Tcl_OpenTcpClient,Tcl_OpenTcpServer, Tcl_GetHostName,GetHostFromString): (Tcl_GetHostName,GetHostFromString): * unix/tclUnixChan.c (CreateSocket,CreateSocketAddress, Tcl_OpenTcpClient,Tcl_OpenTcpServer,Tcl_GetOpenFile): (Tcl_OpenTcpClient,Tcl_OpenTcpServer,Tcl_GetOpenFile): * unix/tclUnixSock.c (Tcl_GetHostName): * win/tclWinSock.c (CreateSocket,CreateSocketAddress, Tcl_OpenTcpClient,Tcl_OpenTcpServer,Tcl_GetHostName): (Tcl_OpenTcpClient,Tcl_OpenTcpServer,Tcl_GetHostName): Updated socket interfaces according to TIP 27. * generic/tclCmdIL.c (InfoHostnameCmd): Updated callers. * generic/tclDecls.h: make genstubs 2002-01-21 David Gravereaux <davygrvy@pobox.com> * generic/tclLoadNone.c: TclpLoadFile() didn't match proto of typedef Tcl_FSLoadFileProc. OK'd by vincentdarley. * generic/tclLoadNone.c: TclpLoadFile() didn't match proto of typedef Tcl_FSLoadFileProc. OK'd by vincentdarley. [Patch 502488] [Patch #502488] 2002-01-21 Andreas Kupries <andreas_kupries@users.sourceforge.net> * generic/tclIO.c (WriteChars): Fix for SF #506297, reported by Martin Forssen <ruric@users.sourceforge.net>. The encoding chosen in the script exposing the bug writes out three intro characters when TCL_ENCODING_START is set, but does not consume any input as TCL_ENCODING_END is cleared. As some output was generated the enclosing loop calls UtfToExternal again, again with START set. Three more characters in the out and still no * generic/tclIO.c (WriteChars): Fix for [Bug 506297], reported by Martin Forssen <ruric@users.sourceforge.net>. The encoding chosen in the script exposing the bug writes out three intro characters when TCL_ENCODING_START is set, but does not consume any input as TCL_ENCODING_END is cleared. As some output was generated the enclosing loop calls UtfToExternal again, again with START set. Three more characters in the out and still no use of input ... To break this use of input ... To break this infinite loop we remove TCL_ENCODING_START from the set of flags after the first call (no condition is required, the later calls remove an unset flag, which is a no-op). This causes the subsequent calls to UtfToExternal to consume and convert the actual input. infinite loop we remove TCL_ENCODING_START from the set of flags after the first call (no condition is required, the later calls remove an unset flag, which is a no-op). This causes the subsequent calls to UtfToExternal to consume and convert the actual input. 2002-01-21 Don Porter <dgp@users.sourceforge.net> * generic/tclTest.c: Converted declarations of TestReport file system to more portable form. [Bug 501417]. to more portable form. [Bug 501417]. * generic/tcl.decls (Tcl_TraceCommand,Tcl_UntraceCommand, Tcl_CommandTraceInfo): (Tcl_CommandTraceInfo): * generic/tclCmdMZ.c (Tcl_TraceCommand,Tcl_UntraceCommand, Tcl_CommandTraceInfo): Updated APIs in generic/tclCmdMZ.c according to the guidelines of TIP 27. (Tcl_CommandTraceInfo): Updated APIs in generic/tclCmdMZ.c according to the guidelines of TIP 27. * generic/tclDecls.h: make genstubs 2002-01-18 Don Porter <dgp@users.sourceforge.net> * win/tclWinChan.c: * win/tclWinFCmd.c: * win/tclWinFile.c: Overlooked callers of Tcl_FSGetNativePath * win/tclWinDde.c: * win/tclWinReg.c: Overlooked callers of Tcl_GetIndexFromObj 2002-01-18 Daniel Steffen <das@users.sourceforge.net> * generic/tclThreadTest.c: * mac/tclMacChan.c: * mac/tclMacFCmd.c: * mac/tclMacFile.c: * mac/tclMacLoad.c: * mac/tclMacResource.c: TIP 27 CONSTification broke the mac build in a number of places. * mac/tclMacResource.c: TIP 27 CONSTification broke the mac build in a number of places. 2002-01-17 Andreas Kupries <andreas_kupries@users.sourceforge.net> * generic/tclIOCmd.c (Tcl_GetsObjCmd): Fixed bug #504642 as reported by Brian Griffin <bgriffin@users.sourceforge.net>, using his patch. Before the patch the generic I/O layer held an unannounced reference to the interp result to store the read line into. This unfortunately has disastrous results if the * generic/tclIOCmd.c (Tcl_GetsObjCmd): Fixed [Bug 504642] as reported by Brian Griffin <bgriffin@users.sourceforge.net>, using his patch. Before the patch the generic I/O layer held an unannounced reference to the interp result to store the read line into. This unfortunately has disastrous results if the channel driver executes a Tcl script to channel driver executes a tcl script to perform its operation, this freeing the interp result. In that case we are dereferencing essentially a dangling reference. It is not truly dangling because the object is in the free list, but this only causes us to smash the free list and have the error occur later somewhere else. The patch simply creates a new object for the line and later sets it into the interp result when we are done perform its operation, this freeing the interp result. In that case we are dereferencing essentially a dangling reference. It is not truly dangling because the object is in the free list, but this only causes us to smash the free list and have the error occur later somewhere else. The patch simply creates a new object for the line and later sets it into the interp result when we are done with reading. with reading. 2002-01-16 Mo DeJong <mdejong@users.sourceforge.net> * unix/tcl.m4 (SC_LOAD_TCLCONFIG): * win/tcl.m4 (SC_LOAD_TCLCONFIG): Subst TCL_DBGX into TCL_STUB_LIB_FILE and TCL_STUB_LIB_FLAG * win/tcl.m4 (SC_LOAD_TCLCONFIG): Subst TCL_DBGX into TCL_STUB_LIB_FILE and TCL_STUB_LIB_FLAG variables so that an extension variables so that an extension does not need to subst TCL_DBGX into its makefile. [Tk Bug 504356] does not need to subst TCL_DBGX into its makefile. [Tk Bug 504356] 2002-01-16 Don Porter <dgp@users.sourceforge.net> * doc/FileSystem.3: * doc/GetCwd.3: * doc/GetIndex.3: * generic/tcl.decls (Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct, Tcl_GetCwd, Tcl_FSFileAttrStrings, Tcl_FSGetNativePath, Tcl_FSGetTranslatedStringPath): (Tcl_GetCwd, Tcl_FSFileAttrStrings, Tcl_FSGetNativePath, (Tcl_FSGetTranslatedStringPath): * generic/tcl.h (Tcl_FSFileAttrStringsProc): * generic/tclFCmd.c (TclFileAttrsCmd): * generic/tclIOUtil.c (Tcl_GetCwd,NativeFileAttrStrings, Tcl_FSFileAttrStrings,Tcl_FSGetTranslatedStringPath, Tcl_FSGetNativePath): (Tcl_FSFileAttrStrings,Tcl_FSGetTranslatedStringPath, (Tcl_FSGetNativePath): * generic/tclIndexObj.c (Tcl_GetIndexFromObj,Tcl_GetIndexFromObjStruct): More TIP 27 updates in tclIOUtil.c and tclIndexObj.c that were overlooked before. [Patch 504671] ***POTENTIAL INCOMPATIBILITY*** Includes a source incompatibility in the tablePtr arguments of the Tcl_GetIndexFromObj* routines. overlooked before. [Patch 504671] ***POTENTIAL INCOMPATIBILITY*** Includes a source incompatibility in the tablePtr arguments of the Tcl_GetIndexFromObj* routines. * generic/tclDecls.h: make genstubs * generic/tclBinary.c (Tcl_BinaryObjCmd): * generic/tclClock.c (Tcl_ClockObjCmd): * generic/tclCmdAH.c (Tcl_EncodingObjCmd, Tcl_FileObjCmd): * generic/tclCmdIL.c (Tcl_InfoObjCmd,Tcl_LsearchObjCmd,Tcl_LsortObjCmd): * generic/tclCmdMZ.c (Tcl_TraceObjCmd,Tcl_RegexpObjCmd,Tcl_RegsubObjCmd, Tcl_StringObjCmd,Tcl_SubstObjCmd,Tcl_SwitchObjCmd, TclTraceCommandObjCmd,TclTraceVariableObjCmd): (Tcl_StringObjCmd,Tcl_SubstObjCmd,Tcl_SwitchObjCmd, (TclTraceCommandObjCmd,TclTraceVariableObjCmd): * generic/tclCompCmds.c (TclCompileStringCmd): * generic/tclEvent.c (Tcl_UpdateObjCmd): * generic/tclFileName.c (Tcl_GlobObjCmd): * generic/tclIO.c (Tcl_FileEventObjCmd): * generic/tclIOCmd.c (Tcl_SeekObjCmd,Tcl_ExecObjCmd,Tcl_SocketObjCmd, Tcl_FcopyObjCmd): (Tcl_FcopyObjCmd): * generic/tclInterp.c (Tcl_InterpObjCmd,SlaveObjCmd): * generic/tclNamesp.c (Tcl_NamespaceObjCmd): * generic/tclPkg.c (Tcl_PackageObjCmd): * generic/tclTest.c (Tcltest_Init,TestencodingObjCmd,TestgetplatformCmd, TestlocaleCmd,TestregexpObjCmd,TestsaveresultCmd, TestGetIndexFromObjStructObjCmd,TestReportFileAttrStrings): (TestlocaleCmd,TestregexpObjCmd,TestsaveresultCmd, (TestGetIndexFromObjStructObjCmd,TestReportFileAttrStrings): * generic/tclTestObj.c (TestindexObjCmd,TeststringObjCmd): * generic/tclTimer.c (Tcl_AfterObjCmd): * generic/tclVar.c (Tcl_ArrayObjCmd): * mac/tclMacFCmd.c (SetFileFinderAttributes): * unix/tclUnixChan.c (TclpOpenFileChannel): * unix/tclUnixFCmd.c (tclpFileAttrStrings): * unix/tclUnixFile.c (TclpObjAccess,TclpObjChdir,TclpObjStat, TclpObjLstat): (TclpObjLstat): * win/tclWinFCmd.c (tclpFileAttrStrings): Updated callers. * doc/RegExp.3: * doc/Utf.3: * generic/tcl.decls: * generic/tclInt.decls: * generic/tclRegexp.c: * generic/tclUtf.c: Updated APIs in generic/tclUtf.c and generic/tclRegexp.c according to the guidelines of TIP 27. [Patch 471509] * generic/regc_locale.c (element,cclass): * generic/tclCmdMZ.c (Tcl_StringObjCmd): * generic/tclFileName.c (TclpGetNativePathType,SplitMacPath): * generic/tclIO.c (ReadChars): * mac/tclMacLoad.c (TclpLoadFile): * win/tclWinFile.c (TclpGetUserHome): Updated callers. * generic/tclDecls.h: * generic/tclDecls.h: * generic/tclIntDecls.h: make genstubs * doc/ParseCmd.3 (Tcl_ParseVar): * generic/tcl.decls (Tcl_ParseVar): * generic/tclParse.c (Tcl_ParseVar): * generic/tclTest.c (TestparsevarObjCmd): Updated APIs in generic/tclParse.c according to the guidelines of TIP 27. Updated callers. [Patch 501046] generic/tclParse.c according to the guidelines of TIP 27. Updated callers. [Patch 501046] * generic/tclDecls.h: make genstubs * generic/tcl.decls (Tcl_RecordAndEval): * generic/tclDecls.h: make genstubs * generic/tclHistory.c (Tcl_RecordAndEval): Updated APIs in generic/tclHistory.c according to the guidelines of TIP 27. [Patch 504091] * doc/CrtSlave.3: * generic/tcl.decls (Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_CreateSlave, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_GetSlave): (Tcl_CreateSlave, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_GetSlave): * generic/tclInterp.c (Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_CreateSlave, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_GetSlave): (Tcl_CreateSlave, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_GetSlave): Updated APIs in the file generic/tclInterp.c according to the guidelines of TIP 27. [Patch 501371] ***POTENTIAL INCOMPATIBILITY*** guidelines of TIP 27. [Patch 501371] ***POTENTIAL INCOMPATIBILITY*** Includes a source incompatibility in the targetCmdPtr arguments of the Tcl_GetAlias* routines. * generic/tclDecls.h: make genstubs 2002-01-15 Don Porter <dgp@users.sourceforge.net> * doc/SetErrno.3 (Tcl_ErrnoMsg): Corrected documentation for Tcl_ErrnoMsg; it takes an integer argument. Thanks to Georgios Petasis. [Bug 468183] Tcl_ErrnoMsg; it takes an integer argument. Thanks to Georgios Petasis. [Bug 468183] * doc/AddErrInfo.3 (Tcl_PosixError): * doc/Eval.3 (Tcl_EvalFile): * doc/FileSystem.c (Tcl_FSOpenFileChannel,Tcl_FSOpenFileChannelProc): * doc/OpenFileChnl.3 (Tcl_OpenFileChannel): * doc/SetErrno.3 (Tcl_ErrnoId,Tcl_ErrnoMsg): * doc/Signal.3 (Tcl_SignalId,Tcl_SignalMsg): * generic/tcl.decls (Tcl_ErrnoId,TclErrnoMsg,Tcl_EvalFile, Tcl_OpenFileChannel,Tcl_PosixError,Tcl_SignalId,Tcl_SignalMsg, Tcl_FSOpenFileChannel): (Tcl_OpenFileChannel,Tcl_PosixError,Tcl_SignalId,Tcl_SignalMsg, (Tcl_FSOpenFileChannel): * generic/tcl.h (Tcl_FSOpenFileChannelProc): * generic/tclIO.c (FlushChannel): * generic/tclIOUtil.c (Tcl_OpenFileChannel,Tcl_EvalFile,TclGetOpenMode, Tcl_PosixError,Tcl_FSOpenFileChannel): (Tcl_PosixError,Tcl_FSOpenFileChannel): * generic/tclInt.decls (TclGetOpenMode): * generic/tclInt.h (TclOpenFileChannelProc_,TclGetOpenMode, TclpOpenFileChannel): (TclpOpenFileChannel): * generic/tclPipe.c (TclCleanupChildren): * generic/tclPosixStr.c (Tcl_ErrnoId,Tcl_ErrnoMsg,Tcl_SignalId, Tcl_SignalMsg): (Tcl_SignalMsg): * generic.tclTest.c (PretendTclpOpenFileChannel, TestOpenFileChannelProc1,TestOpenFileChannelProc2, TestOpenFileChannelProc3,TestReportOpenFileChannel): (TestOpenFileChannelProc1,TestOpenFileChannelProc2, (TestOpenFileChannelProc3,TestReportOpenFileChannel): * mac/tclMacChan.c (TclpOpenFileChannel): * unix/tclUnixChan.c (TclpOpenFileChannel): * win/tclWinChan.c (TclpOpenFileChannel): Updated APIs in generic/tclIOUtil.c and generic/tclPosixStr.c according to the guidelines of TIP 27. Updated callers. [Patch 499196] generic/tclIOUtil.c and generic/tclPosixStr.c according to the guidelines of TIP 27. Updated callers. [Patch 499196] * generic/tclDecls.h: * generic/tclIntDecls.h: make genstubs * doc/CrtChannel.3: * doc/OpenFileChnl.3: * generic/tcl.decls: * generic/tclIO.h: * generic/tclIO.c (DoWrite, Tcl_RegisterChannel, Tcl_GetChannel, Tcl_CreateChannel, Tcl_GetChannelName, CloseChannel, Tcl_Write, Tcl_WriteRaw, Tcl_Ungets, Tcl_BadChannelOption, Tcl_GetChannelOption, Tcl_SetChannelOption, Tcl_GetChannelNamesEx, Tcl_ChannelName): (Tcl_CreateChannel, Tcl_GetChannelName, CloseChannel, Tcl_Write, (Tcl_WriteRaw, Tcl_Ungets, Tcl_BadChannelOption, Tcl_GetChannelOption, (Tcl_SetChannelOption, Tcl_GetChannelNamesEx, Tcl_ChannelName): Updated APIs in the file generic/tclIO.c according to the guidelines of TIP 27. Several minor documentation corrections as well. [Patch 503565] of TIP 27. Several minor documentation corrections as well. [Patch 503565] * generic/tclDecls.h: make genstubs * generic/tcl.h (Tcl_DriverOutputProc, Tcl_DriverGetOptionProc, Tcl_DriverSetOptionProc): (Tcl_DriverSetOptionProc): * generic/tclIOGT.c (TransformOutputProc, TransformGetOptionProc, TransformSetOptionProc): (TransformSetOptionProc): * mac/tclMacChan.c (FileOutput, StdIOOutput): * man/tclMacSock.c (TcpGetOptionProc, TcpOutput): * unix/tclUnixChan.c (FileOutputProc, TcpGetOptionProc, TcpOutputProc, TtyGetOptionProc, TtySetOptionProc): (TtyGetOptionProc, TtySetOptionProc): * unix/tclUnixPipe.c (PipeOuputProc): * win/tclWinChan.c (FileOutputProc): * win/tclWinConsole.c (ConsleOutputProc): * win/tclWinPipe.c (PipeOuputProc): * win/tclWinSerial.c (SerialOutputProc, SerialGetOptionProc, SerialSetOptionProc): (SerialSetOptionProc): * win/tclWinSock.c (TcpGetOptionProc, TcpOutput): Updated channel driver interface according to the guidelines of TIP 27. See also [Bug 500348]. driver interface according to the guidelines of TIP 27. See also [Bug 500348]. * doc/CrtChannel.3: * generic/tcl.h: * generic/tclIO.c: * generic/tclIO.h: * generic/tclInt.h: * tools/checkLibraryDoc.tcl: Moved Tcl_EolTranslation enum declaration from generic/tcl.h to generic/tclInt.h (renamed to TclEolTranslation). It is not used generic/tclInt.h (renamed to TclEolTranslation). It is not used anywhere in Tcl's public interface. 2002-01-14 Don Porter <dgp@users.sourceforge.net> * doc/GetIndex.3: * doc/WrongNumArgs.3: * generic/tcl.decls (Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct, Tcl_WrongNumArgs): (Tcl_WrongNumArgs): * generic/tclIndexObj.c (Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct, Tcl_WrongNumArgs): Updated APIs in the file generic/tclIndexObj.c according to the guidelines of TIP 27. [Patch 501491] (Tcl_WrongNumArgs): Updated APIs in the file generic/tclIndexObj.c according to the guidelines of TIP 27. [Patch 501491] * generic/tclDecls.h: make genstubs 2002-01-11 Mo DeJong <mdejong@users.sourceforge.net> * unix/configure: Regen. * unix/configure.in: * win/configure: Regen. * win/configure.in: Use ${libdir} instead of ${exec_prefix}/lib to properly support the --libdir option to configure. [Bug 489370] 2002-01-11 Andreas Kupries <andreas_kupries@users.sourceforge.net> 2002-01-11 Andreas Kupries <andreas_kupries@users.sourceforge.net> * win/tclWinSerial.c (SerialSetOptionProc): Applied patch for SF bug #500348 supplied by Rolf Schroedter * win/tclWinSerial.c (SerialSetOptionProc): Applied patch for [Bug 500348] supplied by Rolf Schroedter <schroedter@users.sf.net>. The <schroedter@users.sourceforge.net>. The function modified the contents of the the 'value' string and now does not do this anymore. This is a followup to the change made on 2001-12-17. function modified the contents of the the 'value' string and now does not do this anymore. This is a followup to the change made on 2001-12-17. 2002-01-11 David Gravereaux <davygrvy@pobox.com> * win/makefile.vc: Removed -GD compiler option. It was intended for future use, but MS is again changing the future at their whim. The D4002 warning was harmless though, but someone using VC .NET logged it as a concern. [Bug #501565] * win/makefile.vc: Removed -GD compiler option. It was intended for future use, but MS is again changing the future at their whim. The D4002 warning was harmless though, but someone using VC .NET logged it as a concern. [Bug 501565] 2002-01-11 Mo DeJong <mdejong@users.sourceforge.net> * unix/Makefile.in: Burn Tcl build directory * unix/Makefile.in: Burn Tcl build directory into tcltest executable into tcltest executable to avoid crashes caused by ld loading a previously installed version to avoid crashes caused by ld loading a previously installed version of the tcl shared library. [Bug 218110] 2002-01-10 Don Porter <dgp@users.sourceforge.net>, Kevin Kenny <kennykb@users.sourceforge.net> * unix/tclLoadDld.c (TclpLoadFile): syntax error: unbalanced parens. Kevin notes that it's far from clear that this file is ever included in an actual build; Linux without dlopen appears to be a nonexistent configuration. * unix/tclLoadDld.c (TclpLoadFile): syntax error: unbalanced parens. Kevin notes that it's far from clear that this file is ever included in an actual build; Linux without dlopen appears to be a nonexistent configuration. 2002-01-08 Don Porter <dgp@users.sourceforge.net>, Kevin Kenny <kennykb@users.sourceforge.net> * doc/StaticPkg.3 (Tcl_StaticPackage): * generic/tcl.decls (Tcl_StaticPackage): * generic/tclDecls.h (Tcl_StaticPackage): * generic/tclInt.decls (TclGuessPackageName): * generic/tclInt.h (TclGuessPackageName): * generic/tclLoad.c (Tcl_StaticPackage): * generic/tclLoadNone.c (TclGuessPackageName): * mac/tclMacLoad.c (TclGuessPackageName): * unix/tclLoadAout.c (TclGuessPackageName): * unix/tclLoadDl.c (TclGuessPackageName): * unix/tclLoadDld.c (TclGuessPackageName): * unix/tclLoadDyld.c (TclGuessPackageName): * unix/tclLoadNext.c (TclGuessPackageName): * unix/tclLoadOSF.c (TclGuessPackageName): * unix/tclLoadShl.c (TclGuessPackageName): * win/tclWinLoad.c (TclGuessPackageName): Updated APIs in the files */tcl*Load*.c according to the guidelines of TIP 27. * win/tclWinLoad.c (TclGuessPackageName): Updated APIs in the files */tcl*Load*.c according to the guidelines of TIP 27. [Patch 501096] [Patch 501096] 2002-01-09 Don Porter <dgp@users.sourceforge.net> * generic/tclTest.c (MainLoop): * tests/main.test (Tcl_Main-1.{3,4,5,6}): Corrected some non-portable tests from the new Tcl_Main changes. Thanks to Kevin Kenny. 2002-01-07 Don Porter <dgp@users.sourceforge.net> * generic/tclEvent.c (TclInExit): * generic/tclIOUtil.c (SetFsPathFromAbsoluteNormalized, SetFsPathFromAny,Tcl_FSNewNativePath,DupFsPathInternalRep): (SetFsPathFromAny,Tcl_FSNewNativePath,DupFsPathInternalRep): * generic/tclListObj.c (TclLsetList,TclLsetFlat): Added some type casts to satisfy picky compilers. * generic/tclMain.c: Bug fix: neglected the NULL case in TclGetStartupScriptFileName(). Broke Tk/wish. TclGetStartupScriptFileName(). Broke Tk/wish. 2002-01-05 Don Porter <dgp@users.sourceforge.net> * doc/Tcl_Main.3: * generic/tclMain.c: Substantial rewrite and expanded documentation of Tcl_Main to correct a number of bugs and flaws: * Interactive Tcl_Main can now enter a main loop, exit that loop and continue interactive operations. The loop may even exit in the midst of interactive command typing without loss of the partial command. [Bugs 486453, 474131] * Interactive Tcl_Main can now enter a main loop, exit that loop and continue interactive operations. The loop may even exit in the midst of interactive command typing without loss of the partial command. [Bugs 486453, 474131] * Tcl_Main now gracefully handles deletion of its master interpreter. * Interactive Tcl_Main can now operate with non-blocking stdin * Interactive Tcl_Main can now detect EOF on stdin even in mid-command. [Bug 491341] * Added VFS-aware internal routines for managing the startup script selection. mid-command. [Bug 491341] * Added VFS-aware internal routines for managing the startup script selection. * Tcl variable 'tcl_interactive' is now linked to C variable 'tty' so that one can disable/enable interactive prompts at the script level when there is no startup script. This is meant for use by the test suite. 'tty' so that one can disable/enable interactive prompts at the script level when there is no startup script. This is meant for use by the test suite. * Consistent use of the Tcl libraries standard channels as returned by Tcl_GetStdChannel(); as opposed to the channels named 'stdin', 'stdout', and 'stderr' in the master interp, which can be different or unavailable. * Tcl_Main now calls Tcl_Exit() if evaluation of [exit] in the master interpreter returns, assuring Tcl_Main does not return. master interpreter returns, assuring Tcl_Main does not return. * Documented Tcl_Main's absence from public stub table * Documented that Tcl_Main does not return. * Documented Tcl variables set by Tcl_Main. * All prompts are done from a single procedure, Prompt. * Use of Tcl_Obj-enabled interfaces everywhere. * generic/tclInt.decls (TclGetStartupScriptPath, TclSetStartupScriptPath): New internal VFS-aware routines for (TclSetStartupScriptPath): New internal VFS-aware routines for managing the startup script of Tcl_Main. * generic/tclIntDecls.h: * generic/tclStubInit.c: make genstubs * generic/tclTest.c (TestsetmainloopCmd,TestexitmainloopCmd, Tcltest_Init,TestinterpdeleteCmd): * tests/main.test (new): Added new file to test suite that thoroughly tests generic/tclMain.c; added some new test commands for testing Tcl_SetMainLoop(). (Tcltest_Init,TestinterpdeleteCmd): * tests/main.test (new): Added new file to test suite that thoroughly tests generic/tclMain.c; added some new test commands for testing Tcl_SetMainLoop(). 2002-01-04 Don Porter <dgp@users.sourceforge.net> * doc/Alloc.3: * doc/Concat.3: * doc/CrtMathFnc.3: * doc/Hash.3: * doc/Interp.3: * doc/LinkVar.3: * doc/ObjectType.3: * doc/PkgRequire.3: * doc/Preserve.3: * doc/SetResult.3: * doc/SplitList.3: * doc/SplitPath.3: * doc/TCL_MEM_DEBUG.3: Updated documentation to describe the ckalloc, ckfree, ckrealloc, attemptckalloc, and attemptckrealloc macros, and to accurately describe when and how they are used. [Bug 497459] ckfree, ckrealloc, attemptckalloc, and attemptckrealloc macros, and to accurately describe when and how they are used. [Bug 497459] * generic/tclThreadJoin.c (TclRememberJoinableThread,TclJoinThread): Replaced Tcl_Alloc and Tcl_Free calls with ckalloc and ckfree so that memory debugging is supported. 2002-01-04 Daniel Steffen <das@users.sourceforge.net> * mac/tclMacTime.c (TclpGetTZName): fix for daylight savings TZName bug * mac/tclMacTime.c (TclpGetTZName): fix for daylight savings TZName bug 2002-01-03 Don Porter <dgp@users.sourceforge.net> * doc/FileSystem.3: * generic/tclIOUtil.c: Updated some old uses of "fileName" to new VFS terminology, "pathPtr". * generic/tclIOUtil.c: Updated some old uses of "fileName" to new VFS terminology, "pathPtr". 2002-01-03 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tests/basic.test (basic-39.4): Greatly simplified test while still leaving it so that it crashes when run without the fix to the [foreach] implementation. * generic/tclCmdAH.c (Tcl_ForeachObjCmd): Stopped Bug #494348 from * tests/basic.test (basic-39.4): Greatly simplified test while still leaving it so that it crashes when run without the fix to the [foreach] implementation. * generic/tclCmdAH.c (Tcl_ForeachObjCmd): Stopped [Bug 494348] from happening by not trying to be so clever with cacheing; if nothing untoward is happening anyway, the less efficient technique will only add a few instruction cycles (one function call and a few derefs/assigns per list per iteration, with no change in the number of tests) and if something odd *is* going on, the code is now far more robust. untoward is happening anyway, the less efficient technique will only add a few instruction cycles (one function call and a few derefs/assigns per list per iteration, with no change in the number of tests) and if something odd *is* going on, the code is now far more robust. * tests/basic.test (basic-39.4): Reproducable script from Bug #494348 * tests/basic.test (basic-39.4): Reproducable script from [Bug 494348] 2002-01-02 Donal K. Fellows <fellowsd@cs.man.ac.uk> * tests/util.test (Wrapper_Tcl_StringMatch,util-5.*): Rewrote so the test is performed with the right internal function since [string match] no longer uses Tcl_StringCaseMatch internally. * tests/util.test (Wrapper_Tcl_StringMatch,util-5.*): Rewrote so the test is performed with the right internal function since [string match] no longer uses Tcl_StringCaseMatch internally. * tests/string.test (string-11.51): * generic/tclUtf.c (Tcl_UniCharCaseMatch): * generic/tclUtil.c (Tcl_StringCaseMatch): Fault with matching case-insensitive non-ASCII patterns containing upper case characters. [Bug #233257] case-insensitive non-ASCII patterns containing upper case characters. [Bug 233257] ****************************************************************** *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" *** *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" *** *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" *** *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" *** *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" *** ******************************************************************

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- + - +	README: Tcl This is the Tcl 8.4.2 source distribution. This is the Tcl 8.4.16 source distribution. Tcl/Tk is also available through NetCVS: http://tcl.sourceforge.net/ You can get any source release of Tcl from the file distributions link at the above URL. RCS: @(#) $Id: README,v 1.49 2003/02/15 02:16:28 hobbs Exp $ RCS: @(#) $Id: README,v 1.49.2.19 2007/05/30 14:05:17 dgp Exp $ Contents -------- 1. Introduction 2. Documentation 3. Compiling and installing Tcl 4. Development tools
︙
51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68	51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68	- + - - + +	http://www.tcl.tk/software/tcltk/8.4.html Detailed release notes can be found at the file distributions page by clicking on the relevant version. http://sourceforge.net/project/showfiles.php?group_id=10894 Information about Tcl itself can be found at http://www.tcl.tk/scripting/ http://www.tcl.tk/about/ There have been many Tcl books on the market. Most are listed at http://www.tcl.tk/resource/doc/books/ There have been many Tcl books on the market. Many are mentioned in the Wiki: http://wiki.tcl.tk/book 2a. Unix Documentation ---------------------- The "doc" subdirectory in this release contains a complete set of reference manual entries for Tcl. Files with extension ".1" are for programs (for example, tclsh.1); files with extension ".3" are for C
︙
88 89 90 91 92 93 94 95 96 97 98 99 100 101 102	88 89 90 91 92 93 94 95 96 97 98 99 100 101 102	- +	Windows help Tcl documentation will appear in the "Start" menu: Start | Programs | Tcl | Tcl Help 3. Compiling and installing Tcl ------------------------------- There are brief notes in the unix/README, win/README, and mac/README about There are brief notes in the unix/README, win/README, and macosx/README about compiling on these different platforms. There is additional information about building Tcl from sources at http://www.tcl.tk/doc/howto/compile.html 4. TclPro Development tools ---------------------------
︙
131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153	131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152	- - + + - - - - - + + + + + -	and/or Tk and made them freely available to the Tcl community. An archive of these contributions is kept on the machine ftp://archives.tcl.tk/pub/tcl (aka ftp://ftp.procplace.com/pub/tcl). You can access the archive using anonymous FTP. The archive also contains several FAQ ("frequently asked questions") documents that provide solutions to problems that are commonly encountered by Tcl newcomers. 7. Tcl Resource Center ---------------------- 7. The Tcler's Wiki ------------------- Visit http://www.tcl.tk/resource/ to see an annotated index of many Tcl resources available on the World Wide Web. This includes papers, books, and FAQs, as well as development tools, extensions, applications, binary releases, and patches. You can also recommend additional URLs for the resource center using the forms labeled "Add a A Wiki-based open community site covering all aspects of Tcl/Tk is at: http://wiki.tcl.tk/ A wealth of useful information can be found there. Resource". 8. Mailing lists ---------------- Several mailing lists are hosted at SourceForge to discuss development or use issues (like Macintosh and Windows topics). For more information and to subscribe, visit:
︙
177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194	176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193	- + - +	difficult to make incompatible changes to Tcl/Tk at this point, due to the size of the installed base. The Tcl community is too large for us to provide much individual support for users. If you need help we suggest that you post questions to comp.lang.tcl. We read the newsgroup and will attempt to answer esoteric questions for which no one else is likely to know the answer. In addition, see the following Web site for links to other organizations that offer see the following page on the Wiki for links to other organizations that offer Tcl/Tk training: http://www.tcl.tk/resource/community/commercial/training http://wiki.tcl.tk/training 10. Thank You ------------- We'd like to express our thanks to the Tcl community for all the helpful suggestions, bug reports, and patches we have received. Tcl/Tk has improved vastly and will continue to do so with your help.

1 2 3 4 5 6 7 8 9 10	1 2 3 4 5 6 7 8 9 10	- +	Recent user-visible changes to Tcl: RCS: @(#) $Id: changes,v 1.79 2003/03/03 20:04:50 hobbs Exp $ RCS: @(#) $Id: changes,v 1.79.2.50 2007/05/16 22:13:07 das Exp $ 1. No more [command1] [command2] construct for grouping multiple commands on a single command line. 2. Semi-colon now available for grouping commands on a line. 3. For a command to span multiple lines, must now use backslash-return
︙
4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228	4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228	- +	serial devices so that non-blocking channels do not block on partial input lines. (redman) 3/23/99 (bug fix) Added a new Tcl_ServiceModeHook interface. This is used on Windows to avoid the various problems that people have been seeing where the system hangs when tclsh is running outside of the event loop. As part of this, renamed TclpAlertNotifier back to Tcl_AlertNotifier since it is public. TcapAlertNotifier back to Tcl_AlertNotifier since it is public. (stanton) 3/23/99 (feature change) Test suite now uses "tcltest" namespace to define the test procedure and other auxiliary procedures as well as global variables. The previously chosen "test" namespace was thought to be too generic and likely to create conflits. (hirschl)
︙
5753 5754 5755 5756 5757 5758 5759	5753 5754 5755 5756 5757 5758 5759 5760 5761 5762 5763 5764 5765 5766 5767 5768 5769 5770 5771 5772 5773 5774 5775 5776 5777 5778 5779 5780 5781 5782 5783 5784 5785 5786 5787 5788 5789 5790 5791 5792 5793 5794 5795 5796 5797 5798 5799 5800 5801 5802 5803 5804 5805 5806 5807 5808 5809 5810 5811 5812 5813 5814 5815 5816 5817 5818 5819 5820 5821 5822 5823 5824 5825 5826 5827 5828 5829 5830 5831 5832 5833 5834 5835 5836 5837 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 5859 5860 5861 5862 5863 5864 5865 5866 5867 5868 5869 5870 5871 5872 5873 5874 5875 5876 5877 5878 5879 5880 5881 5882 5883 5884 5885 5886 5887 5888 5889 5890 5891 5892 5893 5894 5895 5896 5897 5898 5899 5900 5901 5902 5903 5904 5905 5906 5907 5908 5909 5910 5911 5912 5913 5914 5915 5916 5917 5918 5919 5920 5921 5922 5923 5924 5925 5926 5927 5928 5929 5930 5931 5932 5933 5934 5935 5936 5937 5938 5939 5940 5941 5942 5943 5944 5945 5946 5947 5948 5949 5950 5951 5952 5953 5954 5955 5956 5957 5958 5959 5960 5961 5962 5963 5964 5965 5966 5967 5968 5969 5970 5971 5972 5973 5974 5975 5976 5977 5978 5979 5980 5981 5982 5983 5984 5985 5986 5987 5988 5989 5990 5991 5992 5993 5994 5995 5996 5997 5998 5999 6000 6001 6002 6003 6004 6005 6006 6007 6008 6009 6010 6011 6012 6013 6014 6015 6016 6017 6018 6019 6020 6021 6022 6023 6024 6025 6026 6027 6028 6029 6030 6031 6032 6033 6034 6035 6036 6037 6038 6039 6040 6041 6042 6043 6044 6045 6046 6047 6048 6049 6050 6051 6052 6053 6054 6055 6056 6057 6058 6059 6060 6061 6062 6063 6064 6065 6066 6067 6068 6069 6070 6071 6072 6073 6074 6075 6076 6077 6078 6079 6080 6081 6082 6083 6084 6085 6086 6087 6088 6089 6090 6091 6092 6093 6094 6095 6096 6097 6098 6099 6100 6101 6102 6103 6104 6105 6106 6107 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 6118 6119 6120 6121 6122 6123 6124 6125 6126 6127 6128 6129 6130 6131 6132 6133 6134 6135 6136 6137 6138 6139 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 6157 6158 6159 6160 6161 6162 6163 6164 6165 6166 6167 6168 6169 6170 6171 6172 6173 6174 6175 6176 6177 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 6215 6216 6217 6218 6219 6220 6221 6222 6223 6224 6225 6226 6227 6228 6229 6230 6231 6232 6233 6234 6235 6236 6237 6238 6239 6240 6241 6242 6243 6244 6245 6246 6247 6248 6249 6250 6251 6252 6253 6254 6255 6256 6257 6258 6259 6260 6261 6262 6263 6264 6265 6266 6267 6268 6269 6270 6271 6272 6273 6274 6275 6276 6277 6278 6279 6280 6281 6282 6283 6284 6285 6286 6287 6288 6289 6290 6291 6292 6293 6294 6295 6296 6297 6298 6299 6300 6301 6302 6303 6304 6305 6306 6307 6308 6309 6310 6311 6312 6313 6314 6315 6316 6317 6318 6319 6320 6321 6322 6323 6324 6325 6326 6327 6328 6329 6330 6331 6332 6333 6334 6335 6336 6337 6338 6339 6340 6341 6342 6343 6344 6345 6346 6347 6348 6349 6350 6351 6352 6353 6354 6355 6356 6357 6358 6359 6360 6361 6362 6363 6364 6365 6366 6367 6368 6369 6370 6371 6372 6373 6374 6375 6376 6377 6378 6379 6380 6381 6382 6383 6384 6385 6386 6387 6388 6389 6390 6391 6392 6393 6394 6395 6396 6397 6398 6399 6400 6401 6402 6403 6404 6405 6406 6407 6408 6409 6410 6411 6412 6413 6414 6415 6416 6417 6418 6419 6420 6421 6422 6423 6424 6425 6426 6427 6428 6429 6430 6431 6432 6433 6434 6435 6436 6437 6438 6439 6440 6441 6442 6443 6444 6445 6446 6447 6448 6449 6450 6451	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	2003-02-25 (feature change) [pkg_mkIndex -load]: case-insensitive match *** POTENTIAL INCOMPATIBILITY *** 2003-02-27 (bug fix)[694232] stop [lsearch -start 0 {} x] segfault --- Released 8.4.2, March 3, 2003 --- See ChangeLog for details --- 2003-03-06 (bug fix)[699042] Correct case-insensitive unicode string comparison in Tcl_UniCharNcasecmp 2003-03-11 (bug fix) Corrected loading of tclpip8x.dll on Win9x 2003-03-12 (bug fix)[702383] Corrected parsing of interp create -- 2003-03-12 (bug fix)[685106] Correct Tcl_SubstObj handling of \x00 bytes 2003-03-14 (bug fix)[702622 699060] Correct wide int issues in 'format' 2003-03-14 (bug fix)[698146] Remove assumption that file times and longs are the same size. 2003-03-18 (bug fix)[697862] Allow Tcl to differentiate between reparse points which are symlinks and mounted drives on Windows 2003-03-19 (bug fix)[705406] Bad command count on TCL_OUT_LINE_COMPILE 2003-03-20 (bug fix)[707174] Store pointers to notifier funcs in a struct to work around some platform linker issues 2003-03-22 (bug fix)[708218] Load correct (non-)debug dll for dde or registry 2003-03-24 (bug fix)[631741 696893] Fixing ObjMakeUpvar's lookup algorithm for the created local variable 2003-04-07 (bug fix)[713562] Make sure that tclWideIntType is defined and somewhat sensible everywhere 2003-04-07 (bug fix)[711371] Corrected string limits of arguments interpolated in error messages for 'if' 2003-04-11 (bug fix)[718878] Corrected inconsistent results of [string is integer] observed on systems where sizeof(long) != sizeof(int) 2003-04-12 (bug fix) Substantial changes to the Windows clock synch phase-locked loop in a quest for improved loop stability 2003-04-16 [713562] Made changes so that the "wideInt" Tcl_ObjType is defined on all platforms, even those where TCL_WIDE_INT_IS_LONG is defined. Also made the Tcl_Value struct have a wideValue field on all platforms. Potential incompatibility for TCL_WIDE_INT_IS_LONG platforms because that struct changes size. *** POTENTIAL INCOMPATIBILITY *** 2003-04-25 (bug fix)[727271] Catch any errors returned by the Windows functions handling TLS ASAP instead of waiting to get some mysterious crash later on due to bogus pointers. 2003-04-29 (bug fix) Correct 'glob -path {[tcl]} *', where leading special character instead lists files in '/'. Bug only occurs on Windows where '\' is also a directory separator. 2003-05-09 (bug fix)[731754] Fixed memory leak in threaded allocator on Windows caused by treating cachePtr as a TLS index 2003-05-10 (bug fix)[710642] Ensure cd is thread-safe 2003-05-10 (bug fix)[718002] Correct mem leak on closing a Windows serial port 2003-05-10 (bug fix)[714106] Prevent string repeat crash when overflow sizes were given (throws error). 2003-05-13 (feature enhancement)[736774] Use new versioned bundle resource API to get tcl runtime library for TCL_VERSION on Mac OS X. 2003-05-13 (bug fix)[711232] Worked around the issue of realpath() not being thread-safe on Mac OS X by defining NO_REALPATH for threaded builds on Mac OS X. 2003-05-14 (bug fix)[557030] Correct handling of the gb2312 encoding by making it an alias of the euc-cn encoding and creating a gb2312-raw encoding for the original. Most uses of gb2312 really mean euc-cn. 2003-05-14 (bug fix)[736421] Corrected another putenv() copy behavior problem when compiling on Windows and using Microsoft's runtime. --- Released 8.4.3, May 20, 2003 --- See ChangeLog for details --- 2003-05-23 (bug fix)[726018] reverted internals change to the 'cmdName' Tcl_ObjType that broke several extensions (TclBlend, e4graph...) in the 8.4.3 release. 2003-06-10 (bug fix)[495830] stop eval of bytecode in deleted interp. 2003-06-17 (bug fix) corrections to regexp when matching emtpy string. 2003-06-25 (bug fix)[748957] -*ieee compiler flags for Tru64 builds. 2003-07-11 (bug fix) [pkg_mkIndex] indexes provided packages, not indexed ones. 2003-07-15 (feature enhancement) MacOSX build system rewrite. 2003-07-15 (bug fix)[771613] corrected segfault in [if] (buffer overflow) 2003-07-16 (bug fix)[756791] corrected assumption that Tcl_Free == free 2003-07-16 (feature enhancement) -DTCL_UTF_MAX=6 compile option forces internal UCS-4 representation of Unicode (default is recommended UCS-2). 2003-07-16 (bug fix)[767578] 64-bit corrections in thread notifier. 2003-07-16 (bug fix)[759607] Safe Base tests normalized paths. 2003-07-16 (feature enhancement)[Patch 679315] improved Cygwin path support 2003-07-18 (bug fix)[706359] corrected broken -output option of [tcltest::test] => tcltest 2.4.4 2003-07-18 (bug fix)[753315] MT-safety of VFS records. 2003-07-18 (bug fix)[759888] support for user:pass in URL by [http::geturl] => http 2.4.4 Improved documentation, new tests, and some code cleanup. [655300, 720634, 735364, 748700, 756112, 756744, 756951, 758488, 760768, 763312, 769895, 771539, 771840, 771947, 771949, 772333] --- Released 8.4.4, July 22, 2003 --- See ChangeLog for details --- 2003-07-23 (bug fix)[775976] fix registry compilation for VC7. 2003-08-05 (enhancement)[781585] Use Tcl_ResetResult in bytecodes to prevent potential costly Tcl_Obj duplication. 2003-08-06 (bug fix)[781609] prevent non-Windows platforms from trying to use the registry package inside msgcat. 2003-08-27 (bug fix)[411825] Fix TclNeedSpace to handle non-breaking space (\u00A0) and backslash escapes correctly. 2003-09-01 (bug fix)[788780] Fix thread-safety issues in filesystem records. 2003-09-19 (bug fix)[804681] Protect ::errorInfo and ::errorCode traces from corrupting stack. 2003-09-23 (bug fix)[218871] Fix handling of glob-sensitive chars in auto_load and auto_import. 2003-10-03 (bug fix)[811483] Fixed refcount management for command and execution traces. 2003-10-04 (bug fix)[789040] Fixed exec command.com error for Win9x. 2003-10-06 (bug fix)[767834, 813273] Fixed volumerelative file normalization and 'file join' inconsistencies. 2003-10-08 (bug fix)[769812] Fix Tcl_NumUtfChars string length calculation when negative parameter is given. 2003-10-22 (bug fix)[800106] Handle VFS mountpoints inside glob'd dirs. 2003-10-22 (bug fix)[599468] Watch for FD_CLOSE too on Windows when asked for writable events by the generic layer. 2003-10-23 (bug fix)[813606] Detect OS X pipes correctly. 2003-11-05 (bug fix)[832657] Allow .. in libpath initialization. 2003-11-11 (bug fix) Improve AIX-64 build configuration. 2003-11-17 (bug fix)[230589, 504785, 505048, 703709, 840258] fixes to various odd regexp "can't happen" bugs. --- Released 8.4.5, November 20, 2003 --- See ChangeLog for details --- 2003-12-02 (bug fix)[851747] object sharing fix in [binary scan] 2003-12-09 (platform support)[852369] update errno usage for recent glibc 2003-12-12 (bug fix)[858937] fix for [file normalize ~nobody] 2003-12-17 (bug fix)[839519] fixed two memory leaks (vasiljevic) 2004-01-09 (bug fix)[873311] fixed infinite loop in TclFinalizeFilesystem 2004-02-02 (bug fix)[405995] Tcl_Ungets buffer filling fix 2004-02-04 (bug fix)[833910] tcltest command line option parsing error => tcltest 2.4.5 2004-02-04 (bug fix)[833637] code error in tcltest -preservecore operation 2004-02-12 (feature enhancement) update HP-11 build libs setup 2004-02-17 (bug fix)[849514,859251] corrected [file normailze] of $link/.. 2004-02-17 (bug fix)[772288] Unix std channels forced to exist at startup. 2004-02-17 (new default) tcltest::configure -verbose {body error} 2004-02-19 (bug fix) init.tcl search path with unusual --libdir (samson) 2004-02-25 (bug fix)[554068] stopped broken [exec] quoting of { (gravereaux) 2004-02-25 (bug fix)[888777] plugged memory leak with long host names (cassoff) 2004-03-01 (bug fix)[462580] corrected level interpretation of Tcl_CreateTrace 2004-03-01 (platform support)[218561] Allow 64-bit configure on IRIX64-6.5* --- Released 8.4.6, March 1, 2004 --- See ChangeLog for details --- 2004-03-08 (bug fix)[910525] [glob -path] in root directory (darley) 2004-03-15 (bug fix)[916795] syntax error -> compiler segfault (sofer,porter) 2004-03-29 (bug fix)[920667] install into any Unicode path on Win (hobbs) 2004-03-31 (bug fix)[811457] support translation to "" (porter) 2004-03-31 (bug fix)[811461] ignore locales with no "language" part (porter) => msgcat 1.3.2 2004-04-07 (platform support) properly substitute more values in Windows tclConfig.sh (hobbs) 2004-04-23 (bug fix)[930851] reset channel EOF when eofchar changes (kupries) 2004-05-03 (bug fix)[947070] stack overflow prevention on Win (kenny) 2004-05-03 (bug fix)[868853] fix leak in [fconfigure $serial -xchar] (cassoff) 2004-04-05 (bug fix)[928353,929892,928808,947440,948177] test fixes: OSX (abner) 2004-05-04 (bug fix) crash: [cd] w/ volumerelative $HOME (hobbs) 2004-05-05 (bug fix)[794839] socket connect error -> r/w fileevents (gravereaux) 2004-05-14 (bug fix)[940278,922848] [clock] notices $::env(TZ) changes, gmt works on all platforms. (kenny, welton, glessner) 2004-05-18 (bug fix)[500285,500389,852944] [clock %G %V] ISO8601 week numbers (kenny) 2004-05-22 (bug fix)[735335,736729] variable name resolution error (sofer) 2004-05-24 (bug fix) support for non-WIDE_INT aware math functions (hobbs) 2004-05-25 (new feature) [http::config -urlencoding] (hobbs) => http 2.5.0 2004-05-26 (bug fix)[960926] file count doubled when -singleproc 1 (porter) => tcltest 2.2.6 2004-05-27 (bug fix)[949905] corrected utf-8 encoding of \u0000 on I/O (max) 2004-06-05 (bug fix)[976722] hi-res clock fixes: Win (godfrey, suchenwirth, kenny) 2004-06-10 (bug fix)[932314] bad return values from Tcl_FSChdir() (vasiljevic) 2004-06-14 (bug fix) correct dde hangs w/non-responsive apps (thoyts) => dde 1.2.3 2004-06-21 (platform support) exceptions w/ gcc -O3 on Win (dejong) 2004-06-29 (bug fix)[981733] SafeBase global pollution (fellows) 2004-07-02 (new feature)[TIP 202] pipe redirection 2>@1 (hobbs) 2004-07-03 (bug fix)[908375] round() wide integer support (lavana, sofer) 2004-07-15 (bug fix)[770053] crash in thread finalize of notifier (vasiljevic) 2004-07-15 (bug fix)[990453] plug mutex leaks on reinit (mistachkin, vasiljevic) 2004-07-16 (bug fix)[990500] clean exit of notifier thread (mistachkin, kupries) 2004-07-19 (bug fix)[987967] improved self-init of mutexes on Win (vasiljevic) 2004-07-19 (bug fix)[874058] improved build configuration on 64-bit systems. Corrects Tcl_StatBuf definition issues. (hobbs) 2004-07-20 (bug fix) pure Darwin/CFLite support (steffen) 2004-07-20 (bug fix)[736426] plug leaky allocator reinit (mistachkin, kenny) --- Released 8.4.7, July 26, 2004 --- See ChangeLog for details --- 2004-07-28 (bug fix)[999084] no deadlock in re-entrant Tcl_Finalize (porter) 2004-08-10 (bug fix) thread IDs on 64-bit systems (ratcliff,vasiljevic) 2004-08-13 (bug fix) avoid malicious code acceptance by [mclocale] (porter) => msgcat 1.3.3 2004-08-16 (bug fix)[1008314] Tcl_SetVar TCL_LIST_ELEMENT (sofer,porter) 2004-08-19 (bug fix)[1011860] [scan %ld] fix on LP64 (fellows,porter) 2004-08-30 (bug fix) [string map $x $x] crash (fellows) 2004-09-01 (bug fix)[1020445] WIN64 support (hobbs) 2004-09-07 (bug fix)[1016167] [after] overwrites its imports (kenny) 2004-09-08 (bug fix) fixed [clock format 0 -format %k] (kenny) 2004-09-09 (bug fix)[560297] fixed broken [namespace forget] logic (porter) 2004-09-09 (bug fix)[1017299] fixed [namespace import] cycle prevention (porter) 2004-09-10 (performance) $x[set x {}] is now fast [K $x [set x {}]] (sofer) 2004-09-10 (bug fix)[868489] better control over int <-> wideInt (fellows,kenny) 2004-09-10 (bug fix)[1025359] POSIX errorCode from wide seeks (kupries,fellows) 2004-09-18 (bug fix)[868467] fix [expr 5>>32] => 0, not 5 (hintermayer,fellows) 2004-09-23 (bug fix)[1016726] fix `make clean` in static config (leitgeb,dejong) 2004-09-29 (bug fix)[1036649] syntax error in [subst] => buffer overflow (sofer) 2004-09-30 (bug fix)[1038021] save/restore error state: var traces (porter) 2004-10-08 (bug fix)[954263] case insensitive [file exec] for Win (hobbs,darley) 2004-10-14 (performance) [info commands/globals/procs/vars $pattern] faster when $pattern is trivial (fellows) 2004-10-28 (bug fix)[1030548] restore the --enable-symbols --enable-threads build on Win (mistachkin,kenny,kupries) 2004-10-29 (bug fix)[1055673] fix command line syntax error message (porter) => tcltest 2.2.7 2004-10-31 (bug fix)[1057461] fix [info globals ::varName] (fellows) 2004-11-02 (bug fix)[761471] fix [expr {NaN == NaN}] (sofer) 2004-11-02 (bug fix)[1017151] misleading errorInfo after tests (seeger,porter) 2004-11-11 (bug fix)[1034337] recursive file delete, MacOSX (steffen) 2004-11-12 (bug fix)[1004065] stop crash when TCL_UTF_MAX==6 (hobbs,porter) 2004-11-15 (bug fix)[10653678] [trace variable],[trace remove] interop (porter) 2004-11-16 (bug fix)[695441] [tcl_findLibrary] search $::auto_path too (porter) 2004-11-16 (bug fix)[1067709] crash in [fconfigure -ttycontrol] (hobbs) 2004-11-18 (new feature) configure options --enable-man-suffix (max) Documentation improvements [759545,1058446,1062647,1065732,etc.] Test suite expansion [1036649,1001997,etc.] --- Released 8.4.8, November 18, 2004 --- See ChangeLog for details --- 2004-11-22 (bug fix)[1030465] Improve HAVE_TYPE_OFF64_T check (dejong) 2004-11-23 (bug fix)[1072654] Fixed segfault in info vars trivial matching branch (new in 8.4.8) (porter) 2004-11-23 (bug fix)[1043129] Fixed the treatment of backslashes in file join on Windows (darley) 2004-11-24 (bug fix)[1001325, 1071701] Fixed readdir_r detection and usage (dejong, kenny, porter) 2004-11-24 (bug fix)[1071807] Fixed all uses of 'select' to use standard macros rather than older bit-whacking style (kenny) 2004-11-26 (bug fix)[1072136] Remove file normalize on tcl_findLibrary search path uniqification added in 8.4.8 (porter) 2004-12-02 (bug fix)[1074671] Ensure tilde paths are not returned specially by 'glob' (darley) --- Released 8.4.9, December 6, 2004 --- See ChangeLog for details --- 2004-12-29 (platform support)[1092952,1091967] MSVC7, gcc OPT compiles (hobbs) 2005-01-05 (bug fix)[1084595] encoding maps for some Chinese locales (fellows) 2005-01-06 (performance)[1020491] [http::mapReply] (fellows) => http 2.5.1 2005-01-25 (bug fix)[1101670] [auto_reset] update for [namespace] (porter) 2005-01-27 (new feature)[TIP 218] Tcl_Channel API update for threads (kupries) 2005-01-27 (bug fix)[1109484] Tcl_Expr* updates for Tcl_WideInt (hobbs) 2005-01-28 (platform support)[1021871] Solaris gcc 64-bit support (hobbs) 2005-02-10 (bug fix)[1119369] Tcl_EvalObjEx: avoid shimmer loss of List intrep (sofer,macdonald) 2005-02-10 (platform support) correct gcc builds for AIX-4+, HP-UX-11 (hobbs) 2005-02-24 (bug fix)[1119798] prevent [source $directory] (porter,mpettigr) => tcltest 2.2.8 2005-03-10 (bug fix)[1153871] bad ClientData cast (porter,victorovich) 2005-03-15 (platform support) OpenBSD ports patch (thoyts) 2005-03-15 (platform support)[1163422] time_t wider than long (kenny) 2005-03-18 (bug fix)[1115904] restore recursion limit in direct eval (porter) 2005-03-29 (platform support) allow msys builds without cygwin (hobbs) 2005-04-06 (bug fix)[1178445] fix memory waste at thread exit (vasiljevic) 2005-04-13 (bug fix) min buffer size dropped from 10 to 1 byte (gravereaux) 2005-04-19 (bug fix)[947693] Windows pipes honor -blocking during close (gravereaux) ***POTENTIAL INCOMPATIBILITY*** async pipes on windows, set -blocking 1 before [close] to receive exit status 2005-04-20 (bug fix)[1090869] Tcl_GetInt accept 0x80000000, 64-bit (porter,singh) 2005-04-22 (bug fix)[1187123] [string is boolean] respect EIAS (porter) 2005-04-25 (platform support) builds on Mac OS X 10.1 (steffen) 2005-05-06 (platform support) x86_64 Solarix cc and Solaris 10 builds (hobbs) 2005-05-14 (platform support) Mac OSX: configurable CoreFoundation API (steffen) 2005-05-14 (platform support) Mac OSX: use realpath when threadsafe (steffen) 2005-05-20 (bug fix)[1201589] boolean literal prefix in expressions (porter) 2005-05-24 (platform support) Darwin build support merged into unix (steffen) 2005-05-24 (new feature)[1202209] Mac OSX: support [load] of .bundle binaries Can support [load] from memory as well (steffen) 2005-05-24 (new feature)[1202178] [time] returns non-integer result (steffen) 2005-05-31 (bug fix)[1082283] Unix: notifier thread now joinable (vasiljevic) Documentation improvements [1075433,1085127,1117017,1124160,1149605,etc.] --- Released 8.4.10, June 4, 2005 --- See ChangeLog for details --- 2005-06-06 (bug fix)[1213678] Windows/gcc: crash in stack.test (kenny) 2005-06-07 (bug fix) Unix: --enable-threads compile failure (fellows) 2005-06-18 (bug fix)[1154163] [format %h] on 64-bit OS's (kraft,fellows) 2005-06-21 (bug fix)[1201035,1224585] execution trace crashes (porter) 2005-06-21 (bug fix)[1194458] Windows: [file split] (kenny,porter) 2005-06-22 (bug fix)[1225727] Windows: pipe finalization crash (kenny) 2005-06-22 (bug fix)[1225571] Windows: [file pathtype] buffer overflow (thoyts) 2005-06-22 (bug fix)[1225044] Windows: UMR in pipe close (kenny) 2005-06-23 (bug fix)[1225957] Windows/gcc: crashes in assembler code (kenny) 2005-06-27 (revert)[1101670] [auto_reset] disabled in non-global namespace. Restores Tcl 8.4.9 behavior (porter) --- Released 8.4.11, June 28, 2005 --- See ChangeLog for details --- 2005-07-01 (bug fix)[1222872] notifier spurious wake-up protection (vasiljevic) 2005-07-05 (bug fix)[1077262] improved Tcl_Encoding lifetimes (porter) 2005-07-05 (bug fix)[1230597] allow idempotent [namespace import] (porter) 2005-07-07 (bug fix)[1095909] readdir_r usage purged (hobbs) 2005-07-22 (enhancement)[1237755] 8.4 features in script library (fradin,porter) 2005-07-24 (new feature) configure macros SC_PROG_TCLSH, SC_BUILD_TCLSH (dejong) 2005-07-26 (bug fix)[1047286] cmd delete traces during namespace delete (porter) 2005-07-26 (new unix feature)[1231015] ${prefix}/share on ::tcl_pkgPath (dejong) 2005-07-28 (unix bug fix)[1245953] O_APPEND for >> redirection (fellows) 2005-07-29 (bug fix)[1247135] [info globals] return only existing vars (fellows) 2005-07-30 (new Darwin feature) TCL_LOAD_FROM_MEMORY configuration (steffen) 2005-08-05 (bug fix)[1241572] correct [expr abs($LONG_MIN)] (kenny) 2005-08-05 (Solaris bug fix)[1252475] recognize cp1251 encoding (wagner,fellows) 2005-08-17 (bug fix)[1217375] [file mkdir] race (diekhans,darley) 2005-08-25 (bug fix)[1267380] [lrepeat] buffer overflow prevention (fellows) 2005-08-29 (bug fix)[1275043] restore round() away from zero (kenny) 2005-09-07 (bug fix)[1283976] invalid [format %c -1] result (porter) 2005-09-15 (RHEL bug fix)[1287638] support open >2GB files RHEL 3 (palan) 2005-09-30 (bug fix)[1306162] $argv encoding and list formatting (porter) 2005-10-04 (bug fix)[1067708] [fconfigure -ttycontrol] leak (hobbs) 2005-10-04 (bug fix)[1182373] [http::mapReply] update to RFC 3986 (aho,hobbs) => http 2.5.2 2005-10-04 (HPUX bug fix)[1204237] shl_load() and DYNAMIC_PATH (collins,hobbs) 2005-10-05 (bug fix)[979640] buffer overrun mixing putenv(), ::env (bold,hobbs) 2005-10-13 (bug fix)[1284178] [format] accept all integer values (porter) 2005-10-22 (bug fix)[1251791] optimization exposed wide/int difference(sofer) 2005-10-23 (bug fix)[1334947] value refcount error in var setting (sofer) 2005-11-01 (bug fix)[1337941] Tcl_TraceCommand() -> crash (devilliers,porter) 2005-11-03 (new Win NT/XP feature) Unicode console support (kovalenko,thoyts) 2005-11-03 (bug fix)[1201171] [encoding system] in Tclkit (schekin,porter) 2005-11-04 (bug fix)[1337229,1338280] [namespace delete] / unset traces (porter) 2005-11-04 (enhancement) Korean timezone abbreviations (kenny) 2005-11-04 (bug fix)[1317477] double encoding of time zone (kenny) 2005-11-04 (Win enhancement)[1267871] extended exit codes (newman,thoyts) 2005-11-04 (platform support)[1163896] LynxOS [load] (heidibr) 2005-11-08 (bug fix)[1348775] unset trace memory leak (sofer) 2005-11-08 (bug fix)[1162286] [package ifneeded] warns reported (lavana,porter) *** POTENTIAL INCOMPATIBILITY *** 2005-11-09 (bug fix)[1350293] [after $negative $script] fixed (kenny) 2005-11-15 (Win bug fix)[926016,1353840] correct [file mtime] (kenny) 2005-11-18 (bug fix)[1358369] URL parsing standards compliance (wu,fellows) 2005-11-18 (bug fix)[1359094] Tclkit crash (thoyts, kupries) 2005-11-18 (bug fix)[1355942,1355342] cmd delete trace/ namespace delete (sofer) 2005-11-20 (bug fix)[1091431] Tcl_InitStubs failure crashes wish (english) 2005-11-29 (bug fix)[1366683] [lsearch -regexp] backrefs (cleverly,fellows) 2005-11-29 (enhancement)[1369597] Win 64: --enable-64bit=amd64|ia64 (hobbs) 2005-12-05 (Darwin bug fix)[1034337] NFS recursive file delete (steffen) --- Released 8.4.12, December 3, 2005 --- See ChangeLog for details --- 2005-12-09 (bug fix)[1374778] [lsearch -start $pastEnd] => -1 (fellows) 2005-12-12 (bug fix)[1241572] correct [expr abs($LONG_MIN)] again (max) 2005-12-12 (bug fix)[1377619] configure syntax error exposed in bash-3.1 (hobbs) 2006-01-09 (bug fix)[1400572] [info level $l] => "namespace inscope" (porter) 2006-01-23 (bug fix)[1410553] Tcl_GetRange Unicode confusion (twylite,spjuth) 2006-03-06 (bug fix)[1439836,1444291] fix TCL_EVAL_{GLOBAL,INVOKE} handling when auto-loading or exec traces are present (porter) 2006-03-10 (bug fix)[1437595] Win socket finalize with threads (vasiljevic) 2005-03-13 (revert 2005-07-26 change) ${prefix}/share on ::tcl_pkgPath (porter) 2006-03-14 (bug fix)[1381436,859820] threadsafe Tcl_WaitPid (gravereaux,kupries) 2006-03-14 (bug fix)[768659] pipeline error when last command missing (kupries) 2006-03-18 (bug fix)[1193497] Win porting of [file writable] (darley,vogel) 2006-03-28 (bug fix)[1064247] BSD: path normalization with realpath() (steffen) 2006-03-28 (revert 2005-11-03 feature) Unicode console support (hobbs) *** POTENTIAL INCOMPATIBILITY *** 2006-04-03 (bug fix)[1462248] crash reading utf-8 chars spanning multiple buffers at end of file (kraft,kupries) 2006-04-04 (revert 2005-11-08)[1162286] [package ifneeded] warns (porter) *** POTENTIAL INCOMPATIBILITY *** 2006-04-05 (bug fix)[1464039] Tcl_GetIndexFromObj: empty key (fellows) 2006-04-05 (bug fix) overdue dde, registry patchelevel increments (porter) => dde 1.2.4 => registry 1.1.4 2006-04-06 (bug fix)[1457515] TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING removed (steffen) 2006-04-11 (bug fix)[1458266] enter/enterstep trace interference (leunissen) --- Released 8.4.13, April 19, 2006 --- See ChangeLog for details --- 2006-05-04 (bug fix)[1480509] srand() accept wide input (porter,afredd) 2006-05-05 (bug fix)[1481986] interactive Tcl_Main blocks main loop (porter,lin) 2006-05-13 (bug fix)[1482718] proc re-compile: preserve the previous bytecode while references still on the stack (porter,ryazanov) 2006-05-13 (bug fix)[943995] fixed [glob] on VFS (porter) 2006-05-27 (bug fix)[923072] Darwin: made unthreaded CoreFoundation notifier naked-fork safe on Tiger (steffen) 2006-05-31 (revert 2006-01-09)[1400572] namespace inscope & info level (porter) *** POTENTIAL INCOMPATIBILITY *** 2006-06-14 (platform support)[1424909] MS VS2005 support (thoyts) 2006-07-20 (platform support) Mac OS X weak linking (steffen) 2006-07-20 (bug fix) Darwin: execve() works iff event loop not yet run (steffen) 2006-08-18 (bug fix) intermittent failures in TclUnixWaitForFile() (steffen) 2006-08-18 (platform support) Darwin x86_64 (steffen) 2006-08-21 (bug fix)[1457797] Darwin 64-bit notifier hang (steffen) 2006-08-21 (bug fix) Darwin: recursively called event loop (steffen) 2006-08-30 (bug fix)[1548263] filesystem segfaults (hobbs,mccormack) 2006-09-06 (bug fix)[999544] use of MT-safe system calls (vasiljevic) 2006-09-10 (platform support) Darwin: msgcat use CFLocale (steffen) => msgcat 1.3.4 2006-09-22 (bug fix)[1562528] NULL terminates variadic calls (fellows,ryazanov) 2006-09-26 (platform support) MSVC8 AMD64 support (thoyts) 2006-10-05 (bug fix)[1570718] make [lappend $nonList] complain (sofer,virden) 2006-10-05 (bug fix)[1122671] alignment fixes in unicode encoding routines (hobbs,staplin) 2006-10-05 (new feature) [set ::http::strict 1] (default value is 0) to enable URL validity checking against RFC 2986 (hobbs) => http 2.5.3 --- Released 8.4.14, October 19, 2006 --- See ChangeLog for details --- 2006-10-31 (platform support)[1582769] Fix build with VC2003 (thoyts) 2006-11-07 (bug fix)[1586470] [file copy] on afs (kupries,dionizio) 2006-11-26 (platform support)[1230558] --enable-64bit on more systems (steffen) 2006-11-27 (bug fix)[1602208] use > 32 async sockets on 64bit system (fontaine) 2007-01-25 (configure change) ensure CPPFLAGS env var used when set (steffen) 2007-01-30 (enhancement) new target: `install-private-headers` (hobbs, steffen) 2007-02-12 (bug fix)[1516109] escape encodings crossing chan buffers (dejong) 2007-03-01 (bug fix)[1671138] compiled [foreach {} x {}] hangs (fellows) 2007-03-10 (bug fix)[1675116] list shimmer crash in [lsort] (fellows) 2007-03-13 (bug fix)[1671087] list shimmer crash in [foreach] (porter) 2007-03-13 (bug fix)[1669489] list shimmer crash in [array set] (porter) 2007-03-17 (bug fix)[1682211] buffer overflow in [registry keys] (kenny) => registry 1.1.5 2007-04-29 (bug fix) fts_open() crash on 64bit Darwin 8 or earlier (steffen) --- Released 8.4.15, May 25, 2007 --- See ChangeLog for details ---

︙
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61	44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62	- + + - - - + + +	int memcmp(s1, s2, n) CONST VOID *s1; /* First string. */ CONST VOID *s2; /* Second string. */ size_t n; /* Length to compare. */ { unsigned char u1, u2; CONST unsigned char *ptr1 = (CONST unsigned char *) s1; CONST unsigned char *ptr2 = (CONST unsigned char *) s2; for ( ; n-- ; s1++, s2++) { u1 = * (unsigned char *) s1; u2 = * (unsigned char *) s2; for ( ; n-- ; ptr1++, ptr2++) { unsigned char u1 = *s1, u2 = *s2; if ( u1 != u2) { return (u1-u2); } } return 0; }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * strftime.c -- * * This file contains a modified version of the BSD 4.4 strftime * function. * * This file is a modified version of the strftime.c file from the BSD 4.4 * source. See the copyright notice below for details on redistribution * restrictions. The "license.terms" file does not apply to this file. * * Changes 2002 Copyright (c) 2002 ActiveState Corporation. * * RCS: @(#) $Id: strftime.c,v 1.10 2002/05/29 00:19:39 hobbs Exp $ * RCS: @(#) $Id: strftime.c,v 1.10.2.3 2005/11/04 18:18:04 kennykb Exp $ */ /* * Copyright (c) 1989 The Regents of the University of California. * All rights reserved. * * Redistribution and use in source and binary forms, with or without
︙
43 44 45 46 47 48 49 50 51 52 53 54 55 56 57	43 44 45 46 47 48 49 50 51 52 53 54 55 56 57	- +	* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #if defined(LIBC_SCCS) static char *rcsid = "$Id: strftime.c,v 1.10 2002/05/29 00:19:39 hobbs Exp $"; static char *rcsid = "$Id: strftime.c,v 1.10.2.3 2005/11/04 18:18:04 kennykb Exp $"; #endif /* LIBC_SCCS */ #include <time.h> #include <string.h> #include <locale.h> #include "tclInt.h" #include "tclPort.h"
︙
109 110 111 112 113 114 115 116 117 118 119 120 121 122	109 110 111 112 113 114 115 116 117 118 119 120 121 122 123	+	static size_t gsize; static char *pt; static int _add _ANSI_ARGS_((const char* str)); static int _conv _ANSI_ARGS_((int n, int digits, int pad)); static int _secs _ANSI_ARGS_((const struct tm *t)); static size_t _fmt _ANSI_ARGS_((const char *format, const struct tm *t)); static int ISO8601Week _ANSI_ARGS_((CONST struct tm* t, int *year )); size_t TclpStrftime(s, maxsize, format, t, useGMT) char *s; size_t maxsize; const char *format; const struct tm *t;
︙
225 226 227 228 229 230 231 232 233 234 235 236 237 238	226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257	+ + + + + + + + + + + + + + + + + +	if (!_conv(t->tm_mday, 2, '0')) return(0); continue; case 'e': if (!_conv(t->tm_mday, 2, ' ')) return(0); continue; case 'g': { int year; ISO8601Week( t, &year ); if ( !_conv( year%100, 2, '0' ) ) { return( 0 ); } continue; } case 'G': { int year; ISO8601Week( t, &year ); if ( !_conv( year, 4, '0' ) ) { return( 0 ); } continue; } case 'H': if (!_conv(t->tm_hour, 2, '0')) return(0); continue; case 'I': if (!_conv(t->tm_hour % 12 ? t->tm_hour % 12 : 12, 2, '0'))
︙
297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 355 356 357 358 359 360 361 362 363 364 365	316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372	- - - - - - - - + - - - - - - - - - - - - - - + + + + + - - + + + + - - + + + +	continue; case 'u': if (!_conv(t->tm_wday ? t->tm_wday : 7, 1, '0')) return(0); continue; case 'V': { /* ISO 8601 Week Of Year: If the week (Monday - Sunday) containing January 1 has four or more days in the new year, then it is week 1; otherwise it is week 53 of the previous year and the next week is week one. */ int week = MON_WEEK(t); int week = ISO8601Week( t, NULL ); int days = (((t)->tm_yday + 7 - \ ((t)->tm_wday ? (t)->tm_wday - 1 : 6)) % 7); if (days >= 4) { week++; } else if (week == 0) { week = 53; } if (!_conv(week, 2, '0')) return(0); continue; } case 'W': if (!_conv(MON_WEEK(t), 2, '0')) return(0); continue; case 'w': if (!_conv(t->tm_wday, 1, '0')) return(0); continue; #ifdef WIN32 /* * To properly handle the localized time routines on Windows, * we must make use of the special localized calls. */ case 'c': if (!GetDateFormat(LOCALE_USER_DEFAULT, DATE_LONGDATE, &syst, NULL, buf, BUF_SIZ) || !_add(buf) || !_add(" ")) { if (!GetDateFormat(LOCALE_USER_DEFAULT, DATE_LONGDATE | LOCALE_USE_CP_ACP, &syst, NULL, buf, BUF_SIZ) || !_add(buf) || !_add(" ")) { return(0); } /* * %c is created with LONGDATE + " " + TIME on Windows, * so continue to %X case here. */ case 'X': if (!GetTimeFormat(LOCALE_USER_DEFAULT, 0, &syst, NULL, buf, BUF_SIZ) || !_add(buf)) { if (!GetTimeFormat(LOCALE_USER_DEFAULT, LOCALE_USE_CP_ACP, &syst, NULL, buf, BUF_SIZ) || !_add(buf)) { return(0); } continue; case 'x': if (!GetDateFormat(LOCALE_USER_DEFAULT, DATE_SHORTDATE, &syst, NULL, buf, BUF_SIZ) || !_add(buf)) { if (!GetDateFormat(LOCALE_USER_DEFAULT, DATE_SHORTDATE | LOCALE_USE_CP_ACP, &syst, NULL, buf, BUF_SIZ) || !_add(buf)) { return(0); } continue; #else case 'c': if (!_fmt(_CurrentTimeLocale->d_t_fmt, t)) return(0);
︙
380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396	387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405	+ - - + + + - +	continue; case 'Y': if (!_conv((t->tm_year + TM_YEAR_BASE), 4, '0')) return(0); continue; case 'Z': { char *name = (isGMT ? "GMT" : TclpGetTZName(t->tm_isdst)); int wrote; if (name && !_add(name)) { return 0; Tcl_UtfToExternal(NULL, NULL, name, -1, 0, NULL, pt, gsize, NULL, &wrote, NULL); pt += wrote; } gsize -= wrote; continue; } case '%': /* * X311J/88-090 (4.12.3.5): if conversion char is * undefined, behavior is undefined. Print out the * character itself as printf(3) does.
︙
427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451	436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521	+ + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	_conv(n, digits, pad) int n, digits; int pad; { static char buf[10]; register char *p; p = buf + sizeof( buf ) - 1; *p-- = '\0'; if ( n == 0 ) { *p-- = '0'; --digits; } else { for (p = buf + sizeof(buf) - 2; n > 0 && p > buf; n /= 10, --digits) *p-- = (char)(n % 10 + '0'); for (; n > 0 && p > buf; n /= 10, --digits) *p-- = (char)(n % 10 + '0'); } while (p > buf && digits-- > 0) *p-- = (char) pad; return(_add(++p)); } static int _add(str) const char *str; { for (;; ++pt, --gsize) { if (!gsize) return(0); if (!(*pt = *str++)) return(1); } } static int ISO8601Week( t, year ) CONST struct tm* t; int* year; { /* Find the day-of-year of the Thursday in * the week in question. */ int ydayThursday; int week; if ( t->tm_wday == 0 ) { ydayThursday = t->tm_yday - 3; } else { ydayThursday = t->tm_yday - t->tm_wday + 4; } if ( ydayThursday < 0 ) { /* This is the last week of the previous year. */ if ( IsLeapYear(( t->tm_year + TM_YEAR_BASE - 1 )) ) { ydayThursday += 366; } else { ydayThursday += 365; } week = ydayThursday / 7 + 1; if ( year != NULL ) { *year = t->tm_year + 1899; } } else if ( ( IsLeapYear(( t -> tm_year + TM_YEAR_BASE )) && ydayThursday >= 366 ) || ( !IsLeapYear(( t -> tm_year + TM_YEAR_BASE )) && ydayThursday >= 365 ) ) { /* This is week 1 of the following year */ week = 1; if ( year != NULL ) { *year = t->tm_year + 1901; } } else { week = ydayThursday / 7 + 1; if ( year != NULL ) { *year = t->tm_year + 1900; } } return week; }

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	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	- + + + + +	/* * string.h -- * * Declarations of ANSI C library procedures for string handling. * * Copyright (c) 1991-1993 The Regents of the University of California. * Copyright (c) 1994-1996 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: string.h,v 1.4 2000/07/18 18:16:17 ericm Exp $ * RCS: @(#) $Id: string.h,v 1.4.18.1 2005/04/26 00:46:02 das Exp $ */ #ifndef _STRING #define _STRING #include <tcl.h> /* * The following #include is needed to define size_t. (This used to * include sys/stdtypes.h but that doesn't exist on older versions * of SunOS, e.g. 4.0.2, so I'm trying sys/types.h now.... hopefully * it exists everywhere) */ #ifndef MAC_TCL #include <sys/types.h> #endif #ifdef __APPLE__ extern VOID * memchr _ANSI_ARGS_((CONST VOID *s, int c, size_t n)); #else extern char * memchr _ANSI_ARGS_((CONST VOID *s, int c, size_t n)); #endif extern int memcmp _ANSI_ARGS_((CONST VOID *s1, CONST VOID *s2, size_t n)); extern char * memcpy _ANSI_ARGS_((VOID *t, CONST VOID *f, size_t n)); #ifdef NO_MEMMOVE #define memmove(d, s, n) bcopy ((s), (d), (n)) #else extern char * memmove _ANSI_ARGS_((VOID *t, CONST VOID *f,
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	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	- + + + + + +	/* * strstr.c -- * * Source code for the "strstr" library routine. * * Copyright (c) 1988-1993 The Regents of the University of California. * Copyright (c) 1994 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: strstr.c,v 1.3 2002/01/26 01:10:08 dgp Exp $ * RCS: @(#) $Id: strstr.c,v 1.3.2.1 2005/04/12 18:28:56 kennykb Exp $ */ #include <tcl.h> #ifndef NULL #define NULL 0 #endif /* *---------------------------------------------------------------------- * * strstr -- * * Locate the first instance of a substring in a string.
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-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. '\" '\" RCS: @(#) $Id: AddErrInfo.3,v 1.8 2002/07/01 18:24:38 jenglish Exp $ '\" RCS: @(#) $Id: AddErrInfo.3,v 1.8.2.1 2003/07/18 16:56:24 dgp Exp $ '\" .so man.macros .TH Tcl_AddErrorInfo 3 8.0 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_AddObjErrorInfo, Tcl_AddErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorCodeVA, Tcl_PosixError, Tcl_LogCommandInfo \- record information about errors .SH SYNOPSIS
︙
56 57 58 59 60 61 62 63 64 65 66 67 68 69 70	56 57 58 59 60 61 62 63 64 65 66 67 68 69 70	- +	An argument list which must have been initialized using \fBTCL_VARARGS_START\fR, and cleared using \fBva_end\fR. .AP "CONST char" *script in Pointer to first character in script containing command (must be <= command) .AP "CONST char" *command in Pointer to first character in command that generated the error .AP int commandLength in Number of bytes in command; -1 means use all bytes up to first NULL byte Number of bytes in command; -1 means use all bytes up to first null byte .BE .SH DESCRIPTION .PP These procedures are used to manipulate two Tcl global variables that hold information about errors. The variable \fBerrorInfo\fR holds a stack trace of the
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: AppInit.3,v 1.3 2000/04/14 23:01:48 hobbs Exp $ '\" RCS: @(#) $Id: AppInit.3,v 1.3.24.1 2006/07/30 16:18:41 jenglish Exp $ '\" .so man.macros .TH Tcl_AppInit 3 7.0 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_AppInit \- perform application-specific initialization .SH SYNOPSIS
︙
30 31 32 33 34 35 36 37 38 39 40 41 42 43 44	30 31 32 33 34 35 36 37 38 39 40 41 42 43 44	- +	the main programs for Tcl applications such as \fBtclsh\fR and \fBwish\fR. Its purpose is to allow new Tcl applications to be created without modifying the main programs provided as part of Tcl and Tk. To create a new application you write a new version of \fBTcl_AppInit\fR to replace the default version provided by Tcl, then link your new \fBTcl_AppInit\fR with the Tcl library. .PP \fBTcl_AppInit\fR is invoked after by \fBTcl_Main\fR and \fBTk_Main\fR \fBTcl_AppInit\fR is invoked by \fBTcl_Main\fR and \fBTk_Main\fR after their own initialization and before entering the main loop to process commands. Here are some examples of things that \fBTcl_AppInit\fR might do: .IP [1] Call initialization procedures for various packages used by the application. Each initialization procedure adds new commands to \fIinterp\fR
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: Async.3,v 1.5 2000/07/26 01:29:00 davidg Exp $ '\" RCS: @(#) $Id: Async.3,v 1.5.18.1 2004/12/09 09:24:54 dkf Exp $ '\" .so man.macros .TH Tcl_AsyncCreate 3 7.0 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_AsyncCreate, Tcl_AsyncMark, Tcl_AsyncInvoke, Tcl_AsyncDelete, Tcl_AsyncReady \- handle asynchronous events .SH SYNOPSIS
︙
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	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	- - - - - + + + + + - - - + + +	allocation could have been in progress when the event occurred. The only safe approach is to set a flag indicating that the event occurred, then handle the event later when the world has returned to a clean state, such as after the current Tcl command completes. .PP \fBTcl_AsyncCreate\fR, \fBTcl_AsyncDelete\fR, and \fBTcl_AsyncReady\fR are thread sensitive. They access and/or set a thread-specific data structure in the event of an --enable-thread built core. The token created by Tcl_AsyncCreate contains the needed thread information it was called from so that calling Tcl_AsyncMark(token) will only yield the origin thread into the AsyncProc. .PP structure in the event of a core built with \fI\-\-enable\-threads\fR. The token created by \fBTcl_AsyncCreate\fR contains the needed thread information it was called from so that calling \fBTcl_AsyncMark\fR(\fItoken\fR) will only yield the origin thread into the asynchronous handler. .PP \fBTcl_AsyncCreate\fR creates an asynchronous handler and returns a token for it. The asynchronous handler must be created before any occurrences of the asynchronous event that it is intended to handle (it is not safe to create a handler at the time of an event). When an asynchronous event occurs the code that detects the event (such as a signal handler) should call \fBTcl_AsyncMark\fR with the token for the handler. \fBTcl_AsyncMark\fR will mark the handler as ready to execute, but it will not invoke the handler immediately. Tcl will call the \fIproc\fR associated with the handler later, when the world is in a safe state, and \fIproc\fR can then carry out the actions associated with the asynchronous event. \fIProc\fR should have arguments and result that match the type \fBTcl_AsyncProc\fR: .CS typedef int Tcl_AsyncProc( ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR, int \fIcode\fR); ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR, int \fIcode\fR); .CE The \fIclientData\fR will be the same as the \fIclientData\fR argument passed to \fBTcl_AsyncCreate\fR when the handler was created. If \fIproc\fR is invoked just after a command has completed execution in an interpreter, then \fIinterp\fR will identify the interpreter in which the command was evaluated and
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1999-2000 Ajuba Solutions. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: ChnlStack.3,v 1.4 2002/01/23 21:22:06 andreas_kupries Exp $ '\" RCS: @(#) $Id: ChnlStack.3,v 1.4.4.1 2004/07/16 20:10:58 andreas_kupries Exp $ .so man.macros .TH Tcl_StackChannel 3 8.3 Tcl "Tcl Library Procedures" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME Tcl_StackChannel, Tcl_UnstackChannel, Tcl_GetStackedChannel, Tcl_GetTopChannel \- stack an I/O channel on top of another, and undo it .SH SYNOPSIS
︙
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41	27 28 29 30 31 32 33 34 35 36 37 38 39 40 41	- +	.sp Tcl_Channel \fBTcl_GetTopChannel\fR(\fIchannel\fR) .sp .SH ARGUMENTS .AS Tcl_ChannelType .AP Tcl_Interp *interp in Interpreter for error reporting - can be NULL. Interpreter for error reporting. .AP Tcl_ChannelType *typePtr in The new channel I/O procedures to use for \fIchannel\fP. .AP ClientData clientData in Arbitrary one-word value to pass to channel I/O procedures. .AP int mask in Conditions under which \fIchannel\fR will be used: OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR and \fBTCL_EXCEPTION\fR.
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- + - + - +	'\" '\" Copyright (c) 1996-1997 Sun Microsystems, Inc. '\" Copyright (c) 1997-2000 Ajuba Solutions. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: CrtChannel.3,v 1.16 2002/07/01 18:24:39 jenglish Exp $ '\" RCS: @(#) $Id: CrtChannel.3,v 1.16.2.5 2005/10/05 20:35:45 andreas_kupries Exp $ .so man.macros .TH Tcl_CreateChannel 3 8.3 Tcl "Tcl Library Procedures" .TH Tcl_CreateChannel 3 8.4 Tcl "Tcl Library Procedures" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption, Tcl_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelCloseProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc, Tcl_ChannelSeekProc, Tcl_ChannelWideSeekProc, Tcl_ChannelSetOptionProc, Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc, Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, Tcl_ChannelHandlerProc, Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, Tcl_ClearChannelHandlers, Tcl_GetChannelThread, Tcl_ChannelBuffered \- procedures for creating and manipulating channels Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption, Tcl_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelCloseProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc, Tcl_ChannelSeekProc, Tcl_ChannelWideSeekProc, Tcl_ChannelSetOptionProc, Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc, Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, Tcl_ChannelHandlerProc, Tcl_ChannelThreadActionProc, Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, Tcl_ClearChannelHandlers, Tcl_GetChannelThread, Tcl_ChannelBuffered \- procedures for creating and manipulating channels .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp Tcl_Channel \fBTcl_CreateChannel\fR(\fItypePtr, channelName, instanceData, mask\fR) .sp
︙
32 33 34 35 36 37 38 39 40 41 42 43 44 45	32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48	+ + +	\fBTcl_GetChannelHandle\fR(\fIchannel, direction, handlePtr\fR) .sp .VS 8.4 Tcl_ThreadId \fBTcl_GetChannelThread\fR(\fIchannel\fR) .VE 8.4 .sp int \fBTcl_GetChannelMode\fR(\fIchannel\fR) .sp int \fBTcl_GetChannelBufferSize\fR(\fIchannel\fR) .sp \fBTcl_SetChannelBufferSize\fR(\fIchannel, size\fR) .sp \fBTcl_NotifyChannel\fR(\fIchannel, mask\fR) .sp
︙
92 93 94 95 96 97 98 99 100 101 102 103 104 105	95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111	+ + +	.sp Tcl_DriverSeekProc * \fBTcl_ChannelSeekProc\fR(\fItypePtr\fR) .sp .VS 8.4 Tcl_DriverWideSeekProc * \fBTcl_ChannelWideSeekProc\fR(\fItypePtr\fR) .sp Tcl_DriverThreadActionProc * \fBTcl_ChannelThreadActionProc\fR(\fItypePtr\fR) .VE 8.4 .sp Tcl_DriverSetOptionProc * \fBTcl_ChannelSetOptionProc\fR(\fItypePtr\fR) .sp Tcl_DriverGetOptionProc * \fBTcl_ChannelGetOptionProc\fR(\fItypePtr\fR)
︙
228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243	234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249	- +	\fBTcl_GetChannelHandle\fR places the OS-specific device handle associated with \fIchannel\fR for the given \fIdirection\fR in the location specified by \fIhandlePtr\fR and returns \fBTCL_OK\fR. If the channel does not have a device handle for the specified direction, then \fBTCL_ERROR\fR is returned instead. Different channel drivers will return different types of handle. Refer to the manual entries for each driver to determine what type of handle is returned. .VS 8.4 .PP .VS 8.4 \fBTcl_GetChannelThread\fR returns the id of the thread currently managing the specified \fIchannel\fR. This allows channel drivers to send their file events to the correct event queue even for a multi-threaded core. .VE 8.4 .PP \fBTcl_GetChannelMode\fR returns an OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR, indicating whether the channel is open for input
︙
282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299	288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315	+ + + + + + + + + +	name is registered in the (thread)-global list of all channels (result == 1) or not (result == 0). .PP \fBTcl_CutChannel\fR removes the specified \fIchannel\fR from the (thread)global list of all channels (of the current thread). Application to a channel still registered in some interpreter is not allowed. .VS 8.4 Also notifies the driver if the \fBTcl_ChannelType\fR version is \fBTCL_CHANNEL_VERSION_4\fR (or higher), and \fBTcl_DriverThreadActionProc\fR is defined for it. .VE 8.4 .PP \fBTcl_SpliceChannel\fR adds the specified \fIchannel\fR to the (thread)global list of all channels (of the current thread). Application to a channel registered in some interpreter is not allowed. .VS 8.4 Also notifies the driver if the \fBTcl_ChannelType\fR version is \fBTCL_CHANNEL_VERSION_4\fR (or higher), and \fBTcl_DriverThreadActionProc\fR is defined for it. .VE 8.4 .PP \fBTcl_ClearChannelHandlers\fR removes all channelhandlers and event scripts associated with the specified \fIchannel\fR, thus shutting down all event processing for this channel. .VE 8.4 .SH TCL_CHANNELTYPE
︙
319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352	335 336 337 338 339 340 341 342 343 344 345 346 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	+ - - - - - - - + + + + + + + + + +	Tcl_DriverWatchProc *\fIwatchProc\fR; Tcl_DriverGetHandleProc *\fIgetHandleProc\fR; Tcl_DriverClose2Proc *\fIclose2Proc\fR; Tcl_DriverBlockModeProc *\fIblockModeProc\fR; Tcl_DriverFlushProc *\fIflushProc\fR; Tcl_DriverHandlerProc *\fIhandlerProc\fR; Tcl_DriverWideSeekProc *\fIwideSeekProc\fR; Tcl_DriverThreadActionProc *\fIthreadActionProc\fR; } Tcl_ChannelType; .CE .PP The driver must provide implementations for all functions except \fIblockModeProc\fR, \fIseekProc\fR, \fIsetOptionProc\fR, \fIgetOptionProc\fR, and \fIclose2Proc\fR, which may be specified as NULL. Other functions that can not be implemented for this type of device should return \fBEINVAL\fR when invoked to indicate that they are not implemented, except in the case of \fIflushProc\fR and \fIhandlerProc\fR, which should specified as NULL if not otherwise defined. It is not necessary to provide implementations for all channel operations. Those which are not necessary may be set to NULL in the struct: \fIblockModeProc\fR, \fIseekProc\fR, \fIsetOptionProc\fR, \fIgetOptionProc\fR, and \fIclose2Proc\fR, in addition to \fIflushProc\fR, \fIhandlerProc\fR, and \fIthreadActionProc\fR. Other functions that cannot be implemented in a meaningful way should return \fBEINVAL\fR when called, to indicate that the operations they represent are not available. Also note that \fIwideSeekProc\fR can be NULL if \fIseekProc\fR is. .PP The user should only use the above structure for \fBTcl_ChannelType\fR instantiation. When referencing fields in a \fBTcl_ChannelType\fR structure, the following functions should be used to obtain the values: \fBTcl_ChannelName\fR, \fBTcl_ChannelVersion\fR, \fBTcl_ChannelBlockModeProc\fR, \fBTcl_ChannelCloseProc\fR, \fBTcl_ChannelClose2Proc\fR, \fBTcl_ChannelInputProc\fR, \fBTcl_ChannelOutputProc\fR, \fBTcl_ChannelSeekProc\fR, .VS 8.4 \fBTcl_ChannelWideSeekProc\fR, \fBTcl_ChannelThreadActionProc\fR, .VE 8.4 \fBTcl_ChannelSetOptionProc\fR, \fBTcl_ChannelGetOptionProc\fR, \fBTcl_ChannelWatchProc\fR, \fBTcl_ChannelGetHandleProc\fR, \fBTcl_ChannelFlushProc\fR, or \fBTcl_ChannelHandlerProc\fR. .PP The change to the structures was made in such a way that standard channel types are binary compatible. However, channel types that use stacked
︙
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	380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414	+ - - - + + + + + + + + + + + - + - + - +	\fBfile\fR or \fBsocket\fR. .PP This value can be retrieved with \fBTcl_ChannelName\fR, which returns a pointer to the string. .SH VERSION .PP The \fIversion\fR field should be set to \fBTCL_CHANNEL_VERSION_2\fR. If it is not set to this value \fBTCL_CHANNEL_VERSION_3\fR, then this \fBTcl_ChannelType\fR is assumed to have the older structure. See The \fIversion\fR field should be set to the version of the structure that you require. \fBTCL_CHANNEL_VERSION_2\fR is the minimum recommended. .VS 8.4 \fBTCL_CHANNEL_VERSION_3\fR must be set to specifiy the \fIwideSeekProc\fR member. .VE 8.4 .VS 8.4 \fBTCL_CHANNEL_VERSION_4\fR must be set to specifiy the \fIthreadActionProc\fR member (includes \fIwideSeekProc\fR). .VE 8.4 If it is not set to any of these, then this \fBTcl_ChannelType\fR is assumed to have the original structure. See \fBOLD CHANNEL TYPES\fR for more details. While Tcl will recognize and function with either structure, stacked channels must be of at and function with either structures, stacked channels must be of at least \fBTCL_CHANNEL_VERSION_2\fR to function correctly. .PP This value can be retrieved with \fBTcl_ChannelVersion\fR, which returns .VS 8.4 one of \fBTCL_CHANNEL_VERSION_3\fR, one of \fBTCL_CHANNEL_VERSION_4\fR, \fBTCL_CHANNEL_VERSION_3\fR, .VE 8.4 \fBTCL_CHANNEL_VERSION_2\fR or \fBTCL_CHANNEL_VERSION_1\fR. \fBTCL_CHANNEL_VERSION_2\fR, or \fBTCL_CHANNEL_VERSION_1\fR. .SH BLOCKMODEPROC .PP The \fIblockModeProc\fR field contains the address of a function called by the generic layer to set blocking and nonblocking mode on the device. \fIBlockModeProc\fR should match the following prototype: .PP
︙
401 402 403 404 405 406 407 408 409 410 411 412 413 414	430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451	+ + + + + + + +	nonblocking mode and to implement the blocking or nonblocking behavior. For some device types, the blocking and nonblocking behavior can be implemented by the underlying operating system; for other device types, the behavior must be emulated in the channel driver. .PP This value can be retrieved with \fBTcl_ChannelBlockModeProc\fR, which returns a pointer to the function. .PP A channel driver \fBnot\fR supplying a \fIblockModeProc\fR has to be very, very careful. It has to tell the generic layer exactly which blocking mode is acceptable to it, and should this also document for the user so that the blocking mode of the channel is not changed to an inacceptable value. Any confusion here may lead the interpreter into a (spurious and difficult to find) deadlock. .SH "CLOSEPROC AND CLOSE2PROC" .PP The \fIcloseProc\fR field contains the address of a function called by the generic layer to clean up driver-related information when the channel is closed. \fICloseProc\fR must match the following prototype: .PP
︙
774 775 776 777 778 779 780 781 782 783 784 785 786 787	811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +	\fIInstanceData\fR is the same as the value passed to \fBTcl_CreateChannel\fR when this channel was created. The \fIinterestMask\fR is an OR-ed combination of \fBTCL_READABLE\fR or \fBTCL_WRITABLE\fR; it indicates what type of event occurred on this channel. .PP This value can be retrieved with \fBTcl_ChannelHandlerProc\fR, which returns a pointer to the function. .VS 8.4 .SH "THREADACTIONPROC" .PP The \fIthreadActionProc\fR field contains the address of the function called by the generic layer when a channel is created, closed, or going to move to a different thread, i.e. whenever thread-specific driver state might have to initialized or updated. It can be NULL. The action \fITCL_CHANNEL_THREAD_REMOVE\fR is used to notify the driver that it should update or remove any thread-specific data it might be maintaining for the channel. .PP The action \fITCL_CHANNEL_THREAD_INSERT\fR is used to notify the driver that it should update or initialize any thread-specific data it might be maintaining using the calling thread as the associate. See \fBTcl_CutChannel\fR and \fBTcl_SpliceChannel\fR for more detail. .PP .CS typedef void Tcl_DriverThreadActionProc( ClientData \fIinstanceData\fR, int \fIaction\fR); .CE .PP \fIInstanceData\fR is the same as the value passed to \fBTcl_CreateChannel\fR when this channel was created. .PP These values can be retrieved with \fBTcl_ChannelThreadActionProc\fR, which returns a pointer to the function. .VE 8.4 .SH TCL_BADCHANNELOPTION .PP This procedure generates a "bad option" error message in an (optional) interpreter. It is used by channel drivers when a invalid Set/Get option is requested. Its purpose is to concatenate the generic options list to the specific ones and factorize
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-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. '\" '\" RCS: @(#) $Id: CrtCommand.3,v 1.5 2002/08/05 03:24:39 dgp Exp $ '\" RCS: @(#) $Id: CrtCommand.3,v 1.5.2.1 2004/07/16 20:46:52 andreas_kupries Exp $ '\" .so man.macros .TH Tcl_CreateCommand 3 "" Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_CreateCommand \- implement new commands in C .SH SYNOPSIS
︙
98 99 100 101 102 103 104 105 106 107 108 109 110 111	98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116	+ + + + +	the first \fIargc\fR values point to the argument strings, and the last value is NULL. .VS Note that the argument strings should not be modified as they may point to constant strings or may be shared with other parts of the interpreter. .VE .PP .VS Note that the argument strings are encoded in normalized UTF-8 since version 8.1 of Tcl. .VE .PP \fIProc\fR must return an integer code that is either \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR. See the Tcl overview man page for details on what these codes mean. Most normal commands will only return \fBTCL_OK\fR or \fBTCL_ERROR\fR. In addition, \fIproc\fR must set the interpreter result to point to a string value; in the case of a \fBTCL_OK\fR return code this gives the result
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: CrtMathFnc.3,v 1.5 2001/05/30 08:57:05 dkf Exp $ '\" RCS: @(#) $Id: CrtMathFnc.3,v 1.5.14.2 2003/04/16 22:26:16 dkf Exp $ '\" .so man.macros .TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions .SH SYNOPSIS
︙
42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60	42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60	- + - +	.AP Tcl_MathProc *proc in Procedure that implements the function. .AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR when it is invoked. .AP int *numArgsPtr out Points to a variable that will be set to contain the number of arguments to the function. .AP Tcl_ValueType *argTypesPtr out .AP Tcl_ValueType **argTypesPtr out Points to a variable that will be set to contain a pointer to an array giving the permissible types for each argument to the function which will need to be freed up using \fITcl_Free\fR. .AP Tcl_MathProc *procPtr out .AP Tcl_MathProc **procPtr out Points to a variable that will be set to contain a pointer to the implementation code for the function (or NULL if the function is implemented directly in bytecode.) .AP ClientData *clientDataPtr out Points to a variable that will be set to contain the clientData argument passed to \fITcl_CreateMathFunc\fR when the function was created if the function is not implemented directly in bytecode.
︙
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 116 117 118 119 120 121 122	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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135	- + + + - + + + + + - + + - - + + + + + - + + + +	expressions, such as \fBsin\fR, \fBcos\fR, and \fBhypot\fR. \fBTcl_CreateMathFunc\fR allows applications to add additional functions to those already provided by Tcl or to replace existing functions. \fIName\fR is the name of the function as it will appear in expressions. If \fIname\fR doesn't already exist as a function then a new function is created. If it does exist, then the existing function is replaced. \fINumArgs\fR and \fIargTypes\fR describe the arguments to the function. Each entry in the \fIargTypes\fR array must be either TCL_INT, TCL_DOUBLE, Each entry in the \fIargTypes\fR array must be .VS 8.4 one of TCL_INT, TCL_DOUBLE, TCL_WIDE_INT, or TCL_EITHER to indicate whether the corresponding argument must be an integer, a double-precision floating value, or either, respectively. integer, a double-precision floating value, a wide (64-bit) integer, or any, respectively. .VE 8.4 .PP Whenever the function is invoked in an expression Tcl will invoke \fIproc\fR. \fIProc\fR should have arguments and result that match the type \fBTcl_MathProc\fR: .CS typedef int Tcl_MathProc( ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR, Tcl_Value *\fIargs\fR, Tcl_Value *\fIresultPtr\fR); .CE .PP When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR arguments will be the same as those passed to \fBTcl_CreateMathFunc\fR. \fIArgs\fR will point to an array of \fInumArgs\fR Tcl_Value structures, which describe the actual arguments to the function: .VS 8.4 .CS typedef struct Tcl_Value { Tcl_ValueType \fItype\fR; long \fIintValue\fR; double \fIdoubleValue\fR; Tcl_WideInt \fIwideValue\fR; } Tcl_Value; .CE .PP The \fItype\fR field indicates the type of the argument and is either TCL_INT or TCL_DOUBLE. one of TCL_INT, TCL_DOUBLE or TCL_WIDE_INT. .VE 8.4 It will match the \fIargTypes\fR value specified for the function unless the \fIargTypes\fR value was TCL_EITHER. Tcl converts the argument supplied in the expression to the type requested in \fIargTypes\fR, if that is necessary. Depending on the value of the \fItype\fR field, the \fIintValue\fR or \fIdoubleValue\fR field will contain the actual value of the argument. Depending on the value of the \fItype\fR field, the \fIintValue\fR, .VS 8.4 \fIdoubleValue\fR or \fIwideValue\fR .VE 8.4 field will contain the actual value of the argument. .PP \fIProc\fR should compute its result and store it either as an integer in \fIresultPtr->intValue\fR or as a floating value in \fIresultPtr->doubleValue\fR. It should set also \fIresultPtr->type\fR to either TCL_INT or TCL_DOUBLE It should set also \fIresultPtr->type\fR to one of .VS 8.4 TCL_INT, TCL_DOUBLE or TCL_WIDE_INT .VE 8.4 to indicate which value was set. Under normal circumstances \fIproc\fR should return TCL_OK. If an error occurs while executing the function, \fIproc\fR should return TCL_ERROR and leave an error message in the interpreter's result. .PP .VS 8.4 \fBTcl_GetMathFuncInfo\fR retrieves the values associated with
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1996-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. '\" '\" RCS: @(#) $Id: CrtObjCmd.3,v 1.7 2002/05/17 00:26:53 jenglish Exp $ '\" RCS: @(#) $Id: CrtObjCmd.3,v 1.7.2.1 2004/05/05 20:54:47 dkf Exp $ '\" .so man.macros .TH Tcl_CreateObjCommand 3 8.0 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj \- implement new commands in C .SH SYNOPSIS
︙
271 272 273 274 275 276 277 278 279 280 281 282 283 284 285	271 272 273 274 275 276 277 278 279 280 281 282 283 284 285	- +	Note that \fBTcl_SetCommandInfo\fR and \fBTcl_SetCommandInfoFromToken\fR both allow the ClientData for a command's deletion procedure to be given a different value than the ClientData for its command procedure. .PP Note that neither \fBTcl_SetCommandInfo\fR nor \fBTcl_SetCommandInfoFromToken\fR will change a command's namespace. You must use \fBTcl_RenameCommand\fR to do that. Use \fBTcl_Eval\fR to call the \fBrename\fR command to do that. .PP \fBTcl_GetCommandName\fR provides a mechanism for tracking commands that have been renamed. Given a token returned by \fBTcl_CreateObjCommand\fR when the command was created, \fBTcl_GetCommandName\fR returns the string name of the command. If the command has been renamed since it was created, then \fBTcl_GetCommandName\fR returns the current name.
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1995-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: CrtSlave.3,v 1.8 2002/08/05 03:24:39 dgp Exp $ '\" RCS: @(#) $Id: CrtSlave.3,v 1.8.2.2 2003/07/18 15:20:51 dgp Exp $ '\" .so man.macros .TH Tcl_CreateSlave 3 7.6 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateSlave, Tcl_GetSlave, Tcl_GetMaster, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands. .SH SYNOPSIS
︙
136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153	136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158	- - - - + + + + + + + + +	manual entry for the Tcl \fBinterp\fR command for details. If the creation of the new slave interpreter failed, \fBNULL\fR is returned. .PP \fBTcl_IsSafe\fR returns \fB1\fR if \fIinterp\fR is ``safe'' (was created with the \fBTCL_SAFE_INTERPRETER\fR flag specified), \fB0\fR otherwise. .PP \fBTcl_MakeSafe\fR makes \fIinterp\fR ``safe'' by removing all non-core and core unsafe functionality. Note that if you call this after adding some extension to an interpreter, all traces of that extension will be removed from the interpreter. \fBTcl_MakeSafe\fR marks \fIinterp\fR as ``safe'', so that future calls to \fBTcl_IsSafe\fR will return 1. It also removes all known potentially-unsafe core functionality (both commands and variables) from \fIinterp\fR. However, it cannot know what parts of an extension or application are safe and does not make any attempt to remove those parts, so safety is not guaranteed after calling \fBTcl_MakeSafe\fR. Callers will want to take care with their use of \fBTcl_MakeSafe\fR to avoid false claims of safety. For many situations, \fBTcl_CreateSlave\fR may be a better choice, since it creates interpreters in a known-safe state. .PP \fBTcl_GetSlave\fR returns a pointer to a slave interpreter of \fIinterp\fR. The slave interpreter is identified by \fIslaveName\fR. If no such slave interpreter exists, \fBNULL\fR is returned. .PP \fBTcl_GetMaster\fR returns a pointer to the master interpreter of \fIinterp\fR. If \fIinterp\fR has no master (it is a
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- +	'\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" Copyright (c) 2002 by Kevin B. Kenny. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: CrtTrace.3,v 1.6 2002/08/05 03:24:39 dgp Exp $ '\" RCS: @(#) $Id: CrtTrace.3,v 1.6.2.1 2003/07/18 15:20:51 dgp Exp $ '\" .so man.macros .TH Tcl_CreateTrace 3 "" Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_CreateTrace, Tcl_CreateObjTrace, Tcl_DeleteTrace \- arrange for command execution to be traced .SH SYNOPSIS
︙
43 44 45 46 47 48 49 50 51 52 53 54 55 56 57	43 44 45 46 47 48 49 50 51 52 53 54 55 56 57	- +	.AP Tcl_CmdTraceProc *proc in Procedure to call for each command that's executed. See below for details on the calling sequence. .AP ClientData clientData in Arbitrary one-word value to pass to \fIobjProc\fR or \fIproc\fR. .AP Tcl_CmdObjTraceDeleteProc *deleteProc Procedure to call when the trace is deleted. See below for details of the calling sequence. A null pointer is permissible and results in no the calling sequence. A NULL pointer is permissible and results in no callback when the trace is deleted. .AP Tcl_Trace trace in Token for trace to be removed (return value from previous call to \fBTcl_CreateTrace\fR). .BE .SH DESCRIPTION .PP
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1997-1998 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: Encoding.3,v 1.11 2002/07/01 18:24:39 jenglish Exp $ '\" RCS: @(#) $Id: Encoding.3,v 1.11.2.1 2003/07/18 16:56:24 dgp Exp $ '\" .so man.macros .TH Tcl_GetEncoding 3 "8.1" Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir \- procedures for creating and using encodings. .SH SYNOPSIS
︙
170 171 172 173 174 175 176 177 178 179 180 181 182 183 184	170 171 172 173 174 175 176 177 178 179 180 181 182 183 184	- +	should be called to release it. When an \fIencoding\fR is no longer in use anywhere (i.e., it has been freed as many times as it has been gotten) \fBTcl_FreeEncoding\fR will release all storage the encoding was using and delete it from the database. .PP \fBTcl_ExternalToUtfDString\fR converts a source buffer \fIsrc\fR from the specified \fIencoding\fR into UTF-8. The converted bytes are stored in \fIdstPtr\fR, which is then NULL terminated. The caller should eventually \fIdstPtr\fR, which is then null-terminated. The caller should eventually call \fBTcl_DStringFree\fR to free any information stored in \fIdstPtr\fR. When converting, if any of the characters in the source buffer cannot be represented in the target encoding, a default fallback character will be used. The return value is a pointer to the value stored in the DString. .PP \fBTcl_ExternalToUtf\fR converts a source buffer \fIsrc\fR from the specified \fIencoding\fR into UTF-8. Up to \fIsrcLen\fR bytes are converted from the
︙
208 209 210 211 212 213 214 215 216 217 218 219 220 221 222	208 209 210 211 212 213 214 215 216 217 218 219 220 221 222	- +	The source buffer contained a character that could not be represented in the target encoding and TCL_ENCODING_STOPONERROR was specified. .RE .LP \fBTcl_UtfToExternalDString\fR converts a source buffer \fIsrc\fR from UTF-8 into the specified \fIencoding\fR. The converted bytes are stored in \fIdstPtr\fR, which is then terminated with the appropriate encoding-specific NULL. The caller should eventually call \fBTcl_DStringFree\fR to free any null. The caller should eventually call \fBTcl_DStringFree\fR to free any information stored in \fIdstPtr\fR. When converting, if any of the characters in the source buffer cannot be represented in the target encoding, a default fallback character will be used. The return value is a pointer to the value stored in the DString. .PP \fBTcl_UtfToExternal\fR converts a source buffer \fIsrc\fR from UTF-8 into the specified \fIencoding\fR. Up to \fIsrcLen\fR bytes are converted from
︙

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

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

- + - - + +

'\" '\" Copyright (c) 1997-1998 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: Environment.3,v 1.1 2001/04/04 21:32:18 andreas_kupries Exp $ '\" RCS: @(#) $Id: Environment.3,v 1.1.18.1 2005/05/03 17:53:41 dgp Exp $ '\" .so man.macros .TH Tcl_PutEnv 3 "7.5" Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_PutEnv \- procedures to manipulate the environment .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp int \fBTcl_PutEnv\fR(\fIstring\fR) .SH ARGUMENTS .AP "CONST char" *string in Info about environment variable in the form NAME=value. The string is in native format. Info about environment variable in the form NAME=value. The \fIstring\fR argument is in the system encoding. .BE .SH DESCRIPTION .PP \fBTcl_PutEnv\fR sets an environment variable. The information is passed in a single string of the form NAME=value. This procedure is intended to be a stand-in for the UNIX \fBputenv\fR system call. All tcl-based applications using \fBputenv\fR should redefine it to \fBTcl_PutEnv\fR so that they will interface properly to the Tcl runtime. .SH KEYWORDS environment, variable

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- +	'\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-1997 Sun Microsystems, Inc. '\" Copyright (c) 2000 Scriptics Corporation. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: Eval.3,v 1.12 2002/08/05 03:24:39 dgp Exp $ '\" RCS: @(#) $Id: Eval.3,v 1.12.2.3 2003/07/18 16:56:24 dgp Exp $ '\" .so man.macros .TH Tcl_Eval 3 8.1 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts .SH SYNOPSIS
︙
33 34 35 36 37 38 39 40 41 42 43 44 45 46 47	33 34 35 36 37 38 39 40 41 42 43 44 45 46 47	- +	int \fBTcl_EvalEx\fR(\fIinterp, script, numBytes, flags\fR) .sp int \fBTcl_GlobalEval\fR(\fIinterp, script\fR) .sp int \fBTcl_GlobalEvalObj\fR(\fIinterp, objPtr, flags\fR) \fBTcl_GlobalEvalObj\fR(\fIinterp, objPtr\fR) .sp int \fBTcl_VarEval\fR(\fIinterp, string, string, ... \fB(char *) NULL\fR) .sp int \fBTcl_VarEvalVA\fR(\fIinterp, argList\fR) .SH ARGUMENTS
︙
63 64 65 66 67 68 69 70 71 72 73 74 75 76 77	63 64 65 66 67 68 69 70 71 72 73 74 75 76 77	- +	Points to an array of pointers to objects; each object holds the value of a single word in the command to execute. .AP int numBytes in The number of bytes in \fIscript\fR, not including any null terminating character. If \-1, then all characters up to the first null byte are used. .AP "CONST char" *script in Points to first byte of script to execute (NULL terminated and UTF-8). Points to first byte of script to execute (null-terminated and UTF-8). .AP char *string in String forming part of a Tcl script. .AP va_list argList in An argument list which must have been initialised using \fBTCL_VARARGS_START\fR, and cleared using \fBva_end\fR. .BE
︙
87 88 89 90 91 92 93 94 95 96 97 98 99 100 101	87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102	- + +	which are then executed. The bytecodes are saved in \fIobjPtr\fR so that the compilation step can be skipped if the object is evaluated again in the future. .PP The return value from \fBTcl_EvalObjEx\fR (and all the other procedures described here) is a Tcl completion code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR. \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR, or possibly some other integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. .PP \fBTcl_EvalFile\fR reads the file given by \fIfileName\fR and evaluates its contents as a Tcl script. It returns the same information as \fBTcl_EvalObjEx\fR. If the file couldn't be read then a Tcl error is returned to describe
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-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. '\" '\" RCS: @(#) $Id: ExprLong.3,v 1.6 2002/08/05 03:24:39 dgp Exp $ '\" RCS: @(#) $Id: ExprLong.3,v 1.6.2.1 2005/05/03 17:53:41 dgp Exp $ '\" .so man.macros .TH Tcl_ExprLong 3 7.0 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean, Tcl_ExprString \- evaluate an expression .SH SYNOPSIS
︙
26 27 28 29 30 31 32 33 34 35 36 37 38 39 40	26 27 28 29 30 31 32 33 34 35 36 37 38 39 40	- +	\fBTcl_ExprBoolean\fR(\fIinterp, string, booleanPtr\fR) .sp int \fBTcl_ExprString\fR(\fIinterp, string\fR) .SH ARGUMENTS .AS Tcl_Interp *booleanPtr .AP Tcl_Interp *interp in Interpreter in whose context to evaluate \fIstring\fR or \fIobjPtr\fR. Interpreter in whose context to evaluate \fIstring\fR. .VS 8.4 .AP "CONST char" *string in .VE Expression to be evaluated. .AP long *longPtr out Pointer to location in which to store the integer value of the expression.
︙
94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112	94 95 96 97 98 99 100 101 102 103 104 105 106	- - - - - -	the value was zero and 1 otherwise. If the expression's actual value is a non-numeric string then it must be one of the values accepted by \fBTcl_GetBoolean\fR such as ``yes'' or ``no'', or else an error occurs. .PP \fBTcl_ExprString\fR returns the value of the expression as a string stored in the interpreter's result. If the expression's actual value is an integer then \fBTcl_ExprString\fR converts it to a string using \fBsprintf\fR with a ``%d'' converter. If the expression's actual value is a floating-point number, then \fBTcl_ExprString\fR calls \fBTcl_PrintDouble\fR to convert it to a string. .SH "SEE ALSO" Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj, Tcl_ExprObj .SH KEYWORDS boolean, double, evaluate, expression, integer, object, string

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1996-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. '\" '\" RCS: @(#) $Id: ExprLongObj.3,v 1.3 2001/09/03 09:38:50 dkf Exp $ '\" RCS: @(#) $Id: ExprLongObj.3,v 1.3.12.1 2005/05/03 17:53:41 dgp Exp $ '\" .so man.macros .TH Tcl_ExprLongObj 3 8.0 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj, Tcl_ExprObj \- evaluate an expression .SH SYNOPSIS
︙
25 26 27 28 29 30 31 32 33 34 35 36 37 38 39	25 26 27 28 29 30 31 32 33 34 35 36 37 38 39	- +	\fBTcl_ExprBooleanObj\fR(\fIinterp, objPtr, booleanPtr\fR) .sp int \fBTcl_ExprObj\fR(\fIinterp, objPtr, resultPtrPtr\fR) .SH ARGUMENTS .AS Tcl_Interp **resultPtrPtr out .AP Tcl_Interp *interp in Interpreter in whose context to evaluate \fIstring\fR or \fIobjPtr\fR. Interpreter in whose context to evaluate \fIobjPtr\fR. .AP Tcl_Obj *objPtr in Pointer to an object containing the expression to evaluate. .AP long *longPtr out Pointer to location in which to store the integer value of the expression. .AP int *doublePtr out Pointer to location in which to store the floating-point value of the
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 2001 Vincent Darley '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: FileSystem.3,v 1.32 2003/02/10 12:50:31 vincentdarley Exp $ '\" RCS: @(#) $Id: FileSystem.3,v 1.32.2.4 2005/06/20 16:57:43 dgp Exp $ '\" .so man.macros .TH Filesystem 3 8.4 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_FSRegister, Tcl_FSUnregister, Tcl_FSData, Tcl_FSMountsChanged, Tcl_FSGetFileSystemForPath, Tcl_FSGetPathType, Tcl_FSCopyFile, Tcl_FSCopyDirectory, Tcl_FSCreateDirectory, Tcl_FSDeleteFile, Tcl_FSRemoveDirectory, Tcl_FSRenameFile, Tcl_FSListVolumes, Tcl_FSEvalFile, Tcl_FSLoadFile, Tcl_FSMatchInDirectory, Tcl_FSLink, Tcl_FSLstat, Tcl_FSUtime, Tcl_FSFileAttrsGet, Tcl_FSFileAttrsSet, Tcl_FSFileAttrStrings, Tcl_FSStat, Tcl_FSAccess, Tcl_FSOpenFileChannel, Tcl_FSGetCwd, Tcl_FSChdir, Tcl_FSPathSeparator, Tcl_FSJoinPath, Tcl_FSSplitPath, Tcl_FSEqualPaths, Tcl_FSGetNormalizedPath, Tcl_FSJoinToPath, Tcl_FSConvertToPathType, Tcl_FSGetInternalRep, Tcl_FSGetTranslatedPath, Tcl_FSGetTranslatedStringPath, Tcl_FSNewNativePath, Tcl_FSGetNativePath, Tcl_FSFileSystemInfo, Tcl_AllocStatBuf \- procedures to interact with any filesystem .SH SYNOPSIS
︙
54 55 56 57 58 59 60 61 62 63 64 65 66 67 68	54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69	- + +	Tcl_Obj* \fBTcl_FSListVolumes\fR(\fIvoid\fR) .sp int \fBTcl_FSEvalFile\fR(\fIinterp, pathPtr\fR) .sp int \fBTcl_FSLoadFile\fR(\fIinterp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, handlePtr, unloadProcPtr\fR) \fBTcl_FSLoadFile\fR(\fIinterp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, handlePtr, unloadProcPtr\fR) .sp int \fBTcl_FSMatchInDirectory\fR(\fIinterp, result, pathPtr, pattern, types\fR) .sp Tcl_Obj* \fBTcl_FSLink\fR(\fIlinkNamePtr, toPtr, linkAction\fR) .sp
︙
196 197 198 199 200 201 202 203 204 205 206 207 208 209	197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212	+ +	Name of a procedure to look up in the file's symbol table .AP "CONST char" *sym2 in Name of a procedure to look up in the file's symbol table .AP Tcl_PackageInitProc **proc1Ptr out Filled with the init function for this code. .AP Tcl_PackageInitProc **proc2Ptr out Filled with the safe-init function for this code. .AP Tcl_LoadHandle *handlePtr out Filled with an abstract token representing the loaded file. .AP ClientData *clientDataPtr out Filled with the clientData value to pass to this code's unload function when it is called. .AP TclfsUnloadFileProc_ **unloadProcPtr out Filled with the function to use to unload this piece of code. .AP utimbuf *tval in The access and modification times in this structure are read and
︙
542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563	545 546 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	- - - - - + + + + + + + + + - + + + + +	Returns NULL or a valid internal path representation. This internal representation is cached, so that repeated calls to this function will not require additional conversions. .PP \fBTcl_FSGetTranslatedPath\fR attempts to extract the translated path from the given Tcl_Obj. .PP If the translation succeeds (i.e. the object is a valid path), then it is returned. Otherwise NULL will be returned, and an error message may be left in the interpreter. A "translated" path is one which contains no "~" or "~user" sequences (these have been expanded to their current representation in the filesystem). If the translation succeeds (i.e. the object is a valid path), then it is returned. Otherwise NULL will be returned, and an error message may be left in the interpreter. A "translated" path is one which contains no "~" or "~user" sequences (these have been expanded to their current representation in the filesystem). The object returned is owned by the caller, which must store it or call Tcl_DecrRefCount to ensure memory is freed. This function is of little practical use, and \fBTcl_FSGetNormalizedPath\fR or \fBTcl_GetNativePath\fR are usually better functions to use for most purposes. .PP \fBTcl_FSGetTranslatedStringPath\fR does the same as \fBTcl_FSGetTranslatedStringPath\fR does the same as \fBTcl_FSGetTranslatedPath\fR, but returns a character string or NULL. The string returned is dynamically allocated and owned by the caller, which must store it or call ckfree to ensure it is freed. Again, \fBTcl_FSGetNormalizedPath\fR or \fBTcl_GetNativePath\fR are usually better functions to use for most purposes. .PP \fBTcl_FSNewNativePath\fR performs something like that reverse of the usual obj->path->nativerep conversions. If some code retrieves a path in native form (from, e.g. readlink or a native dialog), and that path is to be used at the Tcl level, then calling this function is an efficient way of creating the appropriate path object type. .PP
︙
775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800	786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811	- - - - - - - - - - - - + + + + + + + + + + + +	These fields contain addresses of functions which are used to associate a particular filesystem with a file path, and deal with the internal handling of path representations, for example copying and freeing such representations. .SH PATHINFILESYSTEMPROC .PP The \fIpathInFilesystemProc\fR field contains the address of a function which is called to determine whether a given path object belongs to this filesystem or not. Tcl will only call the rest of the filesystem functions with a path for which this function has returned \fBTCL_OK\fR. If the path does not belong, \fBTCL_ERROR\fR should be returned. If \fBTCL_OK\fR is returned, then the optional \fBclientDataPtr\fR output parameter can be used to return an internal (filesystem specific) representation of the path, which will be cached inside the path object, and may be retrieved efficiently by the other filesystem functions. Tcl will simultaneously cache the fact that this path belongs to this filesystem. Such caches are invalidated when filesystem structures are added or removed from Tcl's internal list of known filesystems. which is called to determine whether a given path object belongs to this filesystem or not. Tcl will only call the rest of the filesystem functions with a path for which this function has returned \fBTCL_OK\fR. If the path does not belong, -1 should be returned (the behaviour of Tcl for any other return value is not defined). If \fBTCL_OK\fR is returned, then the optional \fBclientDataPtr\fR output parameter can be used to return an internal (filesystem specific) representation of the path, which will be cached inside the path object, and may be retrieved efficiently by the other filesystem functions. Tcl will simultaneously cache the fact that this path belongs to this filesystem. Such caches are invalidated when filesystem structures are added or removed from Tcl's internal list of known filesystems. .PP .CS typedef int Tcl_FSPathInFilesystemProc( Tcl_Obj *\fIpathPtr\fR, ClientData *\fIclientDataPtr\fR); .CE .SH DUPINTERNALREPPROC
︙
1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034	1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073	- - - - + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	contents of which the function should search for files or directories which have the correct type. In either case, \fIpathPtr\fR can be assumed to be both non-NULL and non-empty. It is not currently documented whether \fIpathPtr\fR will have a file separator at its end of not, so code should be flexible to both possibilities. .PP The return value is a standard Tcl result indicating whether an error occurred in the matching process. Error messages are placed in interp, but on a TCL_OK result, the interpreter should not be modified, but rather results should be added to the \fIresult\fR object given (which can be assumed to be a valid Tcl list). The matches added occurred in the matching process. Error messages are placed in \fIinterp\fR; on a \fBTCL_OK\fR result, results should be added to the \fIresult\fR object given (which can be assumed to be a valid unshared Tcl list). The matches added to \fIresult\fR should include any path prefix given in \fIpathPtr\fR (this usually means they will be absolute path specifications). Note that if no matches are found, that simply leads to an empty result --- errors are only signaled for actual file or filesystem result; errors are only signaled for actual file or filesystem problems which may occur during the matching process. .PP The \fBTcl_GlobTypeData\fR structure passed in the \fItypes\fR parameter contains the following fields: .CS typedef struct Tcl_GlobTypeData { /* Corresponds to bcdpfls as in 'find -t' */ int \fItype\fR; /* Corresponds to file permissions */ int \fIperm\fR; /* Acceptable mac type */ Tcl_Obj *\fImacType\fR; /* Acceptable mac creator */ Tcl_Obj *\fImacCreator\fR; } Tcl_GlobTypeData; .CE .PP There are two specific cases which it is important to handle correctly, both when \fItypes\fR is non-NULL. The two cases are when \fItypes->types & TCL_GLOB_TYPE_DIR\fR or \fItypes->types & TCL_GLOB_TYPE_MOUNT\fR are true (and in particular when the other flags are false). In the first of these cases, the function must list the contained directories. Tcl uses this to implement recursive globbing, so it is critical that filesystems implement directory matching correctly. In the second of these cases, with \fBTCL_GLOB_TYPE_MOUNT\fR, the filesystem must list the mount points which lie within the given \fIpathPtr\fR (and in this case, \fIpathPtr\fR need not lie within the same filesystem - different to all other cases in which this function is called). Support for this is critical if Tcl is to have seamless transitions between from one filesystem to another. .SH UTIMEPROC .PP Function to process a \fBTcl_FSUtime()\fR call. Required to allow setting (not reading) of times with 'file mtime', 'file atime' and the open-r/open-w/fcopy implementation of 'file copy'. .PP .CS
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 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. '\" '\" RCS: @(#) $Id: GetIndex.3,v 1.10 2002/02/28 05:11:25 dgp Exp $ '\" RCS: @(#) $Id: GetIndex.3,v 1.10.2.2 2006/04/06 18:57:24 dgp Exp $ '\" .so man.macros .TH Tcl_GetIndexFromObj 3 8.1 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct \- lookup string in table of keywords .SH SYNOPSIS
︙
30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48	30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48	- + - +	Interpreter to use for error reporting; if NULL, then no message is provided on errors. .AP Tcl_Obj *objPtr in/out The string value of this object is used to search through \fItablePtr\fR. The internal representation is modified to hold the index of the matching table entry. .AP "CONST char" **tablePtr in An array of null-terminated ASCII strings. The end of the array is marked An array of null-terminated strings. The end of the array is marked by a NULL string pointer. .AP "CONST VOID" *structTablePtr in An array of arbitrary type, typically some \fBstruct\fP type. The first member of the structure must be a null-terminated ASCII string. The first member of the structure must be a null-terminated string. The size of the structure is given by \fIoffset\fP. .VS .AP int offset in The offset to add to structTablePtr to get to the next entry. The end of the array is marked by a NULL string pointer. .VE .AP "CONST char" *msg in
︙
60 61 62 63 64 65 66 67 68 69 70 71 72 73 74	60 61 62 63 64 65 66 67 68 69 70 71 72 73 74	- +	.PP This procedure provides an efficient way for looking up keywords, switch names, option names, and similar things where the value of an object must be one of a predefined set of values. \fIObjPtr\fR is compared against each of the strings in \fItablePtr\fR to find a match. A match occurs if \fIobjPtr\fR's string value is identical to one of the strings in \fItablePtr\fR, or if it is a unique abbreviation \fItablePtr\fR, or if it is a non-empty unique abbreviation for exactly one of the strings in \fItablePtr\fR and the \fBTCL_EXACT\fR flag was not specified; in either case the index of the matching entry is stored at \fI*indexPtr\fR and TCL_OK is returned. .PP If there is no matching entry, TCL_ERROR is returned and an error message is left in \fIinterp\fR's
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1996 by Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: GetStdChan.3,v 1.4 2001/12/10 15:50:46 dgp Exp $ '\" RCS: @(#) $Id: GetStdChan.3,v 1.4.4.1 2006/06/06 20:07:36 dgp Exp $ '\" .so man.macros .TH Tcl_GetStdChannel 3 7.5 Tcl "Tcl Library Procedures" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME Tcl_GetStdChannel, Tcl_SetStdChannel \- procedures for retrieving and replacing the standard channels
︙
48 49 50 51 52 53 54 55 56 57 58 59 60 61	48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71	+ + + + + + + + + +	return value will be a valid channel, or NULL. .PP A new channel can be set for the standard channel specified by \fItype\fR by calling \fBTcl_SetStdChannel\fR with a new channel or NULL in the \fIchannel\fR argument. If the specified channel is closed by a later call to \fBTcl_Close\fR, then the corresponding standard channel will automatically be set to NULL. .PP If a non-NULL value for \fIchannel\fR is passed to \fBTcl_SetStdChannel\fR, then that same value should be passed to \fBTcl_RegisterChannel\fR, like so: .CS Tcl_RegisterChannel(NULL, channel); .CE This is a workaround for a misfeature in \fBTcl_SetStdChannel\fR that it fails to do some reference counting housekeeping. This misfeature cannot be corrected without contradicting the assumptions of some existing code that calls \fBTcl_SetStdChannel\fR. .PP If \fBTcl_GetStdChannel\fR is called before \fBTcl_SetStdChannel\fR, Tcl will construct a new channel to wrap the appropriate platform-specific standard file handle. If \fBTcl_SetStdChannel\fR is called before \fBTcl_GetStdChannel\fR, then the default channel will not be created. .PP If one of the standard channels is set to NULL, either by calling
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: Hash.3,v 1.10 2002/07/11 15:40:19 dgp Exp $ '\" RCS: @(#) $Id: Hash.3,v 1.10.2.1 2003/07/18 16:56:24 dgp Exp $ '\" .so man.macros .TH Tcl_Hash 3 "" Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_InitHashTable, Tcl_InitCustomHashTable, Tcl_InitObjHashTable, Tcl_DeleteHashTable, Tcl_CreateHashEntry, Tcl_DeleteHashEntry, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_SetHashValue, Tcl_GetHashKey, Tcl_FirstHashEntry, Tcl_NextHashEntry, Tcl_HashStats \- procedures to manage hash tables .SH SYNOPSIS
︙
115 116 117 118 119 120 121 122 123 124 125 126 127 128 129	115 116 117 118 119 120 121 122 123 124 125 126 127 128 129	- +	.PP \fBTcl_InitCustomHashTable\fR initializes a structure that describes a new hash table. The space for the structure is provided by the caller, not by the hash module. The value of \fIkeyType\fR indicates what kinds of keys will be used for all entries in the table. \fIKeyType\fR must have one of the following values: .IP \fBTCL_STRING_KEYS\fR 25 Keys are null-terminated ASCII strings. Keys are null-terminated strings. They are passed to hashing routines using the address of the first character of the string. .IP \fBTCL_ONE_WORD_KEYS\fR 25 Keys are single-word values; they are passed to hashing routines and stored in hash table entries as ``char *'' values. The pointer value is the key; it need not (and usually doesn't) actually point to a string.
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: LinkVar.3,v 1.6 2002/08/05 03:24:39 dgp Exp $ '\" RCS: @(#) $Id: LinkVar.3,v 1.6.2.1 2003/07/18 16:56:24 dgp Exp $ '\" .so man.macros .TH Tcl_LinkVar 3 7.5 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_LinkVar, Tcl_UnlinkVar, Tcl_UpdateLinkedVar \- link Tcl variable to C variable .SH SYNOPSIS
︙
91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111	91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111	- + - +	form acceptable to \fBTcl_GetBooleanFromObj\fR; attempts to write non-boolean values into \fIvarName\fR will be rejected with Tcl errors. .TP \fBTCL_LINK_STRING\fR The C variable is of type \fBchar *\fR. .VS If its value is not null then it must be a pointer to a string If its value is not NULL then it must be a pointer to a string allocated with \fBTcl_Alloc\fR or \fBckalloc\fR. .VE Whenever the Tcl variable is modified the current C string will be freed and new memory will be allocated to hold a copy of the variable's new value. If the C variable contains a null pointer then the Tcl variable If the C variable contains a NULL pointer then the Tcl variable will read as ``NULL''. .PP If the TCL_LINK_READ_ONLY flag is present in \fItype\fR then the variable will be read-only from Tcl, so that its value can only be changed by modifying the C variable. Attempts to write the variable from Tcl will be rejected with errors. .PP
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1997-1998 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: Macintosh.3,v 1.4 2002/01/25 20:40:55 dgp Exp $ '\" RCS: @(#) $Id: Macintosh.3,v 1.4.2.1 2003/07/18 16:56:24 dgp Exp $ '\" .so man.macros .TH Tcl_MacSetEventProc 3 "8.1" Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_MacSetEventProc, Tcl_MacConvertTextResource, Tcl_MacEvalResource, Tcl_MacFindResource, Tcl_GetOSTypeFromObj, Tcl_SetOSTypeObj, Tcl_NewOSTypeObj \- procedures to handle Macintosh resources and other Macintosh specifics .SH SYNOPSIS
︙
75 76 77 78 79 80 81 82 83 84 85 86 87 88 89	75 76 77 78 79 80 81 82 83 84 85 86 87 88 89	- +	\fBTcl_MacEvalResource\fR extends the \fBsource\fR command to Macintosh resources. It sources Tcl code from a Text resource. Currently only sources the resource by name, file IDs may be supported at a later date. .PP \fBTcl_MacConvertTextResource\fR converts a TEXT resource into a Tcl suitable string. It mallocs the returned memory, converts ``\\r'' to ``\\n'', and appends a NULL. The caller has the responsibility for ``\\n'', and appends a null. The caller has the responsibility for freeing the memory. .PP \fBTcl_MacFindResource\fR provides a higher level interface for loading resources. It is used by \fBresource read\fR. .PP \fBTcl_NewOSTypeObj\fR is used to create a new resource name type object. The object type is "ostype".
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1998-1999 Scriptics Corporation '\" Copyright (c) 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. '\" '\" RCS: @(#) $Id: Notifier.3,v 1.9 2002/07/01 18:24:39 jenglish Exp $ '\" RCS: @(#) $Id: Notifier.3,v 1.9.2.1 2004/11/25 15:28:37 vasiljevic Exp $ '\" .so man.macros .TH Notifier 3 8.1 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_CreateEventSource, Tcl_DeleteEventSource, Tcl_SetMaxBlockTime, Tcl_QueueEvent, Tcl_ThreadQueueEvent, Tcl_ThreadAlert, Tcl_GetCurrentThread, Tcl_DeleteEvents, Tcl_InitNotifier, Tcl_FinalizeNotifier, Tcl_WaitForEvent, Tcl_AlertNotifier, Tcl_SetTimer, Tcl_ServiceAll, Tcl_ServiceEvent, Tcl_GetServiceMode, Tcl_SetServiceMode \- the event queue and notifier interfaces .SH SYNOPSIS
︙
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43	29 30 31 32 33 34 35 36 37 38 39 40 41 42 43	- +	\fBTcl_QueueEvent\fR(\fIevPtr, position\fR) .VS 8.1 .sp void \fBTcl_ThreadQueueEvent\fR(\fIthreadId, evPtr, position\fR) .sp void \fBTcl_ThreadAlert\fR(\fIthreadId, clientData\fR) \fBTcl_ThreadAlert\fR(\fIthreadId\fR) .sp Tcl_ThreadId \fBTcl_GetCurrentThread\fR() .sp void \fBTcl_DeleteEvents\fR(\fIdeleteProc, clientData\fR) .sp
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1996-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. '\" '\" RCS: @(#) $Id: OpenFileChnl.3,v 1.20 2002/07/23 18:17:12 jenglish Exp $ '\" RCS: @(#) $Id: OpenFileChnl.3,v 1.20.2.4 2004/07/16 22:22:15 andreas_kupries Exp $ .so man.macros .TH Tcl_OpenFileChannel 3 8.3 Tcl "Tcl Library Procedures" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME Tcl_OpenFileChannel, Tcl_OpenCommandChannel, Tcl_MakeFileChannel, Tcl_GetChannel, Tcl_GetChannelNames, Tcl_GetChannelNamesEx, Tcl_RegisterChannel, Tcl_UnregisterChannel, Tcl_DetachChannel, Tcl_IsStandardChannel, Tcl_Close, Tcl_ReadChars, Tcl_Read, Tcl_GetsObj, Tcl_Gets, Tcl_WriteObj, Tcl_WriteChars, Tcl_Write, Tcl_Flush, Tcl_Seek, Tcl_Tell, Tcl_GetChannelOption, Tcl_SetChannelOption, Tcl_Eof, Tcl_InputBlocked, Tcl_InputBuffered, Tcl_OutputBuffered, Tcl_Ungets, Tcl_ReadRaw, Tcl_WriteRaw \- buffered I/O facilities using channels .SH SYNOPSIS
︙
97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115	97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117	+ - + - + +	\fBTcl_InputBuffered\fR(\fIchannel\fR) .VS 8.4 .sp int \fBTcl_OutputBuffered\fR(\fIchannel\fR) .VE .sp .VS 8.4 int Tcl_WideInt \fBTcl_Seek\fR(\fIchannel, offset, seekMode\fR) .sp int Tcl_WideInt \fBTcl_Tell\fR(\fIchannel\fR) .VE 8.4 .sp int \fBTcl_GetChannelOption\fR(\fIinterp, channel, optionName, optionValue\fR) .sp int \fBTcl_SetChannelOption\fR(\fIinterp, channel, optionName, newValue\fR) .sp
︙
198 199 200 201 202 203 204 205 206 207 208 209 210 211 212	200 201 202 203 204 205 206 207 208 209 210 211 212 213 214	- +	A buffer containing the characters to output to the channel. .AP "CONST char" *byteBuf in A buffer containing the bytes to output to the channel. .AP int bytesToWrite in The number of bytes to consume from \fIcharBuf\fR or \fIbyteBuf\fR and output to the channel. .VE .AP int offset in .AP Tcl_WideInt offset in How far to move the access point in the channel at which the next input or output operation will be applied, measured in bytes from the position given by \fIseekMode\fR. May be either positive or negative. .AP int seekMode in Relative to which point to seek; used with \fIoffset\fR to calculate the new access point for the channel. Legal values are \fBSEEK_SET\fR, \fBSEEK_CUR\fR, and \fBSEEK_END\fR.
︙
428 429 430 431 432 433 434 435 436 437 438 439 440 441	430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447	+ + + +	\fBTcl_ReadChars\fR consumes bytes from \fIchannel\fR, converting the bytes to UTF-8 based on the channel's encoding and storing the produced data in \fIreadObjPtr\fR's string representation. The return value of \fBTcl_ReadChars\fR is the number of characters, up to \fIcharsToRead\fR, that were stored in \fIreadObjPtr\fR. If an error occurs while reading, the return value is \-1 and \fBTcl_ReadChars\fR records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR. .PP Setting \fIcharsToRead\fR to \fB-1\fR will cause the command to read all characters currently available (non-blocking) or everything until eof (blocking mode). .PP The return value may be smaller than the value to read, indicating that less data than requested was available. This is called a \fIshort read\fR. In blocking mode, this can only happen on an end-of-file. In nonblocking mode, a short read can also occur if there is not enough input currently available: \fBTcl_ReadChars\fR returns a short count rather than waiting for more data.
︙
464 465 466 467 468 469 470 471 472 473 474 475 476 477 478	470 471 472 473 474 475 476 477 478 479 480 481 482 483 484	- +	.PP \fBTcl_Read\fR is similar to \fBTcl_ReadChars\fR, except that it doesn't do encoding conversions, regardless of the channel's encoding. It is deprecated and exists for backwards compatibility with non-internationalized Tcl extensions. It consumes bytes from \fIchannel\fR and stores them in \fIreadBuf\fR, performing end-of-line translations on the way. The return value of \fBTcl_Read\fR is the number of bytes, up to \fIbytesToRead\fR, written in \fIreadBuf\fR. The buffer produced by \fBTcl_Read\fR is not NULL terminated. \fIreadBuf\fR. The buffer produced by \fBTcl_Read\fR is not null-terminated. Its contents are valid from the zeroth position up to and excluding the position indicated by the return value. .PP \fBTcl_ReadRaw\fR is the same as \fBTcl_Read\fR but does not compensate for stacking. While \fBTcl_Read\fR (and the other functions in the API) always get their data from the topmost channel in the stack the supplied channel is part of, \fBTcl_ReadRaw\fR does
︙
520 521 522 523 524 525 526 527 528 529 530 531 532 533 534	526 527 528 529 530 531 532 533 534 535 536 537 538 539 540	- +	.SH "TCL_WRITECHARS, TCL_WRITEOBJ, AND TCL_WRITE" .PP \fBTcl_WriteChars\fR accepts \fIbytesToWrite\fR bytes of character data at \fIcharBuf\fR. The UTF-8 characters in the buffer are converted to the channel's encoding and queued for output to \fIchannel\fR. If \fIbytesToWrite\fR is negative, \fBTcl_WriteChars\fR expects \fIcharBuf\fR to be NULL terminated and it outputs everything up to the NULL. to be null-terminated and it outputs everything up to the null. .PP Data queued for output may not appear on the output device immediately, due to internal buffering. If the data should appear immediately, call \fBTcl_Flush\fR after the call to \fBTcl_WriteChars\fR, or set the \fB\-buffering\fR option on the channel to \fBnone\fR. If you wish the data to appear as soon as a complete line is accepted for output, set the \fB\-buffering\fR option on the channel to \fBline\fR mode.
︙
558 559 560 561 562 563 564 565 566 567 568 569 570 571 572	564 565 566 567 568 569 570 571 572 573 574 575 576 577 578	- +	.PP \fBTcl_Write\fR is similar to \fBTcl_WriteChars\fR except that it doesn't do encoding conversions, regardless of the channel's encoding. It is deprecated and exists for backwards compatibility with non-internationalized Tcl extensions. It accepts \fIbytesToWrite\fR bytes of data at \fIbyteBuf\fR and queues them for output to \fIchannel\fR. If \fIbytesToWrite\fR is negative, \fBTcl_Write\fR expects \fIbyteBuf\fR to be NULL terminated and it outputs everything up to the NULL. null-terminated and it outputs everything up to the null. .PP \fBTcl_WriteRaw\fR is the same as \fBTcl_Write\fR but does not compensate for stacking. While \fBTcl_Write\fR (and the other functions in the API) always feed their input to the topmost channel in the stack the supplied channel is part of, \fBTcl_WriteRaw\fR does not. Thus this function is \fBonly\fR usable for transformational channel drivers, i.e. drivers used in the middle of a stack of
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 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. '\" '\" RCS: @(#) $Id: ParseCmd.3,v 1.10 2002/08/05 03:24:39 dgp Exp $ '\" RCS: @(#) $Id: ParseCmd.3,v 1.10.2.2 2005/09/15 23:21:37 msofer Exp $ '\" .so man.macros .TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions .SH SYNOPSIS
︙
34 35 36 37 38 39 40 41 42 43 44 45 46 47 48	34 35 36 37 38 39 40 41 42 43 44 45 46 47 48	- +	\fBTcl_ParseVar\fR(\fIinterp, string, termPtr\fR) .sp \fBTcl_FreeParse\fR(\fIusedParsePtr\fR) .sp Tcl_Obj * \fBTcl_EvalTokens\fR(\fIinterp, tokenPtr, numTokens\fR) .sp Tcl_Obj * int \fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR) .SH ARGUMENTS .AS Tcl_Interp *usedParsePtr .AP Tcl_Interp *interp out For procedures other than \fBTcl_FreeParse\fR, \fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR, used only for error reporting; if NULL, then no error messages are left after errors.
︙
104 105 106 107 108 109 110 111 112 113 114 115 116 117 118	104 105 106 107 108 109 110 111 112 113 114 115 116 117 118	- +	structure of the command (see below for details). If an error occurred in parsing the command then \fBTCL_ERROR\fR is returned, an error message is left in \fIinterp\fR's result, and no information is left at \fI*parsePtr\fR. .PP \fBTcl_ParseExpr\fR parses Tcl expressions. Given a pointer to a script containing an expression, \fBTcl_ParseCommand\fR parses the expression. \fBTcl_ParseExpr\fR parses the expression. If the expression was parsed successfully, \fBTcl_ParseExpr\fR returns \fBTCL_OK\fR and fills in the structure pointed to by \fIparsePtr\fR with information about the structure of the expression (see below for details). If an error occurred in parsing the command then \fBTCL_ERROR\fR is returned, an error message is left in \fIinterp\fR's result, and no information is left at \fI*parsePtr\fR.
︙
186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233	186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234	- + + - + - + - +	a Tcl_Parse structure. The tokens typically consist of all the tokens in a word or all the tokens that make up the index for a reference to an array variable. \fBTcl_EvalTokensStandard\fR performs the substitutions requested by the tokens and concatenates the resulting values. The return value from \fBTcl_EvalTokensStandard\fR is a Tcl completion code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR. \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR, or possibly some other integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. .PP \fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in the return convention used: it returns the result in a new Tcl_Obj. The reference count of the object returned as result has been incremented, so the caller must invoke \fBTcl_DecrRefCount\fR when it is finished with the object. If an error or other exception occurs while evaluating the tokens (such as a reference to a non-existent variable) then the return value is NULL and an error message is left in \fIinterp\fR's result. The use of \fBTcl_EvalTokens\fR is deprecated. .SH "TCL_PARSE STRUCTURE" .PP \fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR, \fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR return parse information in two data structures, Tcl_Parse and Tcl_Token: .CS typedef struct Tcl_Parse { char *\fIcommentStart\fR; CONST char *\fIcommentStart\fR; int \fIcommentSize\fR; char *\fIcommandStart\fR; CONST char *\fIcommandStart\fR; int \fIcommandSize\fR; int \fInumWords\fR; Tcl_Token *\fItokenPtr\fR; int \fInumTokens\fR; ... } Tcl_Parse; typedef struct Tcl_Token { int \fItype\fR; char *\fIstart\fR; CONST char *\fIstart\fR; int \fIsize\fR; int \fInumComponents\fR; } Tcl_Token; .CE .PP The first five fields of a Tcl_Parse structure are filled in only by \fBTcl_ParseCommand\fR.
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: PkgRequire.3,v 1.6 2002/02/26 02:22:20 hobbs Exp $ '\" RCS: @(#) $Id: PkgRequire.3,v 1.6.2.1 2006/09/22 01:26:22 andreas_kupries Exp $ '\" .so man.macros .TH Tcl_PkgRequire 3 7.5 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_PkgRequire, Tcl_PkgRequireEx, Tcl_PkgPresent, Tcl_PkgPresentEx, Tcl_PkgProvide, Tcl_PkgProvideEx \- package version control .SH SYNOPSIS
︙
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64	50 51 52 53 54 55 56 57 58 59 60 61 62 63	-	.AP ClientData clientData in Arbitrary value to be associated with the package. .AP ClientData *clientDataPtr out Pointer to place to store the value associated with the matching package. It is only changed if the pointer is not NULL and the function completed successfully. .BE .SH DESCRIPTION .PP These procedures provide C-level interfaces to Tcl's package and version management facilities. .PP \fBTcl_PkgRequire\fR is equivalent to the \fBpackage require\fR command, \fBTcl_PkgPresent\fR is equivalent to the \fBpackage present\fR
︙
78 79 80 81 82 83 84 85 86 87	77 78 79 80 81 82 83 84 85	-	if an error occurs it returns TCL_ERROR and leaves an error message in the interpreter's result. .PP \fBTcl_PkgProvideEx\fR, \fBTcl_PkgPresentEx\fR and \fBTcl_PkgRequireEx\fR allow the setting and retrieving of the client data associated with the package. In all other respects they are equivalent to the matching functions. .SH KEYWORDS package, present, provide, require, version

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1989-1993 The Regents of the University of California. '\" Copyright (c) 1994-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. '\" '\" RCS: @(#) $Id: SetVar.3,v 1.7 2002/08/05 03:24:39 dgp Exp $ '\" RCS: @(#) $Id: SetVar.3,v 1.7.2.2 2004/08/16 14:18:25 msofer Exp $ '\" .so man.macros .TH Tcl_SetVar 3 8.1 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_SetVar2Ex, Tcl_SetVar, Tcl_SetVar2, Tcl_ObjSetVar2, Tcl_GetVar2Ex, Tcl_GetVar, Tcl_GetVar2, Tcl_ObjGetVar2, Tcl_UnsetVar, Tcl_UnsetVar2 \- manipulate Tcl variables .SH SYNOPSIS
︙
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86	72 73 74 75 76 77 78 79 80 81 82 83 84 85 86	- +	.AP "CONST char" *varName in Name of variable. May include \fB::\fR namespace qualifiers to specify a variable in a particular namespace. May refer to a scalar variable or an element of an array. .AP "CONST char" *newValue in New value for variable, specified as a NULL-terminated string. New value for variable, specified as a null-terminated string. A copy of this value is stored in the variable. .AP Tcl_Obj *part1Ptr in Points to a Tcl object containing the variable's name. The name may include a series of \fB::\fR namespace qualifiers to specify a variable in a particular namespace. May refer to a scalar variable or an element of an array variable. .AP Tcl_Obj *part2Ptr in
︙
217 218 219 220 221 222 223 224 225 226 227 228 229 230	217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233	+ + +	\fBTCL_LIST_ELEMENT\fR If this bit is set, then \fInewValue\fR is converted to a valid Tcl list element before setting (or appending to) the variable. A separator space is appended before the new list element unless the list element is going to be the first element in a list or sublist (i.e. the variable's current value is empty, or contains the single character ``{'', or ends in `` }''). When appending, the original value of the variable must also be a valid list, so that the operation is the appending of a new list element onto a list. .PP \fBTcl_GetVar\fR and \fBTcl_GetVar2\fR return the current value of a variable. The arguments to these procedures are treated in the same way as the arguments to \fBTcl_SetVar\fR and \fBTcl_SetVar2\fR. Under normal circumstances, the return value is a pointer to the variable's value (which is stored in Tcl's variable
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1994-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. '\" '\" RCS: @(#) $Id: StringObj.3,v 1.13 2002/10/22 12:16:53 dkf Exp $ '\" RCS: @(#) $Id: StringObj.3,v 1.13.2.1 2003/07/18 16:56:24 dgp Exp $ '\" .so man.macros .TH Tcl_StringObj 3 8.1 Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendObjToObj, Tcl_SetObjLength, Tcl_ConcatObj, Tcl_AttemptSetObjLength \- manipulate Tcl objects as strings .SH SYNOPSIS
︙
114 115 116 117 118 119 120 121 122 123 124 125 126 127 128	114 115 116 117 118 119 120 121 122 123 124 125 126 127 128	- +	.AP "CONST char" *string in Null-terminated string value to append to \fIobjPtr\fR. .AP va_list argList in An argument list which must have been initialised using \fBTCL_VARARGS_START\fR, and cleared using \fBva_end\fR. .AP int newLength in New length for the string value of \fIobjPtr\fR, not including the final NULL character. final null character. .AP int objc in The number of elements to concatenate. .AP Tcl_Obj *objv[] in The array of objects to concatenate. .BE .SH DESCRIPTION
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: Tcl.n,v 1.9 2003/02/01 19:48:23 kennykb Exp $ '\" RCS: @(#) $Id: Tcl.n,v 1.9.2.1 2005/12/19 10:09:50 dkf Exp $ '\" .so man.macros .TH Tcl n "8.1" Tcl "Tcl Built-In Commands" .BS .SH NAME Tcl \- Tool Command Language .SH SYNOPSIS
︙
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86	72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87	- + +	by a close bracket (``]''). The result of the script (i.e. the result of its last command) is substituted into the word in place of the brackets and all of the characters between them. There may be any number of command substitutions in a single word. Command substitution is not performed on words enclosed in braces. .IP "[7] \fBVariable substitution.\fR" If a word contains a dollar-sign (``$'') then Tcl performs \fIvariable If a word contains a dollar-sign (``$'') followed by one of the forms described below, then Tcl performs \fIvariable substitution\fR: the dollar-sign and the following characters are replaced in the word by the value of a variable. Variable substitution may take any of the following forms: .RS .TP 15 \fB$\fIname\fR \fIName\fR is the name of a scalar variable; the name is a sequence
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1999 Scriptics Corporation '\" Copyright (c) 1998 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: Thread.3,v 1.14 2002/07/01 18:24:39 jenglish Exp $ '\" RCS: @(#) $Id: Thread.3,v 1.14.2.2 2004/11/25 15:48:52 vasiljevic Exp $ '\" .so man.macros .TH Threads 3 "8.1" Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_ConditionNotify, Tcl_ConditionWait, Tcl_ConditionFinalize, Tcl_GetThreadData, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_MutexFinalize, Tcl_CreateThread, Tcl_JoinThread \- Tcl thread support. .SH SYNOPSIS
︙
42 43 44 45 46 47 48 49 50 51 52 53 54 55 56	42 43 44 45 46 47 48 49 50 51 52 53 54 55 56	- +	.sp int \fBTcl_JoinThread\fR(\fIid, result\fR) .SH ARGUMENTS .AS Tcl_ThreadDataKey *keyPtr .AP Tcl_Condition *condPtr in A condition variable, which must be associated with a mutex lock. .AP Tcl_Condition *mutexPtr in .AP Tcl_Mutex *mutexPtr in A mutex lock. .AP Tcl_Time *timePtr in A time limit on the condition wait. NULL to wait forever. Note that a polling value of 0 seconds doesn't make much sense. .AP Tcl_ThreadDataKey *keyPtr in This identifies a block of thread local storage. The key should be static and process-wide, yet each thread will end up associating
︙
136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164	136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168	- - + + + + + +	the \fBNotifier\fR manual page for more information on these procedures. .PP In this release, the Tcl language itself provides no support for creating multithreaded scripts (for example, scripts that could spawn a Tcl interpreter in a separate thread). If you need to add this feature at this time, see the \fItclThreadTest.c\fR file in the Tcl source distribution for an experimental implementation of a Tcl "Thread" package implementing thread creation and management commands at the script level. or use the Tcl "Threading Extension" package implementing thread creation and management commands at the script level. .SH DESCRIPTION A mutex is a lock that is used to serialize all threads through a piece of code by calling \fBTcl_MutexLock\fR and \fBTcl_MutexUnlock\fR. If one thread holds a mutex, any other thread calling \fBTcl_MutexLock\fR will block until \fBTcl_MutexUnlock\fR is called. .VS A mutex can be destroyed after its use by calling \fBTcl_MutexFinalize\fR. The result of locking a mutex twice from the same thread is undefined. On some platforms it will result in a deadlock. .VE The \fBTcl_MutexLock\fR, \fBTcl_MutexUnlock\fR and \fBTcl_MutexFinalize\fR procedures are defined as empty macros if not compiling with threads enabled. For declaration of mutexes the \fBTCL_DECLARE_MUTEX\fR macro should be used. This macro assures correct mutex handling even when the core is compiled without threads enabled. .PP A condition variable is used as a signaling mechanism: a thread can lock a mutex and then wait on a condition variable with \fBTcl_ConditionWait\fR. This atomically releases the mutex lock and blocks the waiting thread until another thread calls \fBTcl_ConditionNotify\fR. The caller of \fBTcl_ConditionNotify\fR should have the associated mutex held by previously calling \fBTcl_MutexLock\fR,
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 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. '\" '\" RCS: @(#) $Id: Utf.3,v 1.13 2002/07/01 18:24:39 jenglish Exp $ '\" RCS: @(#) $Id: Utf.3,v 1.13.2.2 2003/07/18 22:15:45 dkf Exp $ '\" .so man.macros .TH Utf 3 "8.1" Tcl "Tcl Library Procedures" .BS .SH NAME Tcl_UniChar, Tcl_UniCharCaseMatch, Tcl_UniCharNcasecmp, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings. .SH SYNOPSIS
︙
89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105	89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105	- + - +	.AP int ch in The Tcl_UniChar to be converted or examined. .AP Tcl_UniChar *chPtr out Filled with the Tcl_UniChar represented by the head of the UTF-8 string. .AP "CONST char" *src in Pointer to a UTF-8 string. .AP "CONST Tcl_UniChar" *uniStr in A NULL-terminated Unicode string. A null-terminated Unicode string. .AP "CONST Tcl_UniChar" *uniPattern in A NULL-terminated Unicode string. A null-terminated Unicode string. .AP int len in The length of the UTF-8 string in bytes (not UTF-8 characters). If negative, all bytes up to the first null byte are used. .AP int numChars in The length of the Unicode string in characters. Must be greater than or equal to 0. .AP "Tcl_DString" *dstPtr in/out
︙
139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196	139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196	- + - + - + - + - + - +	in \fIbuf\fR. .PP \fBTcl_UtfToUniChar\fR reads one UTF-8 character starting at \fIsrc\fR and stores it as a Tcl_UniChar in \fI*chPtr\fR. The return value is the number of bytes read from \fIsrc\fR.. The caller must ensure that the source buffer is long enough such that this routine does not run off the end and dereference non-existent or random memory; if the source buffer is known to be null terminated, this will not happen. If the input is is known to be null-terminated, this will not happen. If the input is not in proper UTF-8 format, \fBTcl_UtfToUniChar\fR will store the first byte of \fIsrc\fR in \fI*chPtr\fR as a Tcl_UniChar between 0x0000 and 0x00ff and return 1. .PP \fBTcl_UniCharToUtfDString\fR converts the given Unicode string to UTF-8, storing the result in a previously-initialized \fBTcl_DString\fR. You must specify the length of the given Unicode string. The return value is a pointer to the UTF-8 representation of the Unicode string. Storage for the return value is appended to the end of the \fBTcl_DString\fR. .PP \fBTcl_UtfToUniCharDString\fR converts the given UTF-8 string to Unicode, storing the result in the previously-initialized \fBTcl_DString\fR. you may either specify the length of the given UTF-8 string or "-1", in which case \fBTcl_UtfToUniCharDString\fR uses \fBstrlen\fR to calculate the length. The return value is a pointer to the Unicode representation of the UTF-8 string. Storage for the return value is appended to the end of the \fBTcl_DString\fR. The Unicode string is terminated with a Unicode NULL character. is terminated with a Unicode null character. .PP \fBTcl_UniCharLen\fR corresponds to \fBstrlen\fR for Unicode characters. It accepts a NULL-terminated Unicode string and returns characters. It accepts a null-terminated Unicode string and returns the number of Unicode characters (not bytes) in that string. .PP \fBTcl_UniCharNcmp\fR and \fBTcl_UniCharNcasecmp\fR correspond to \fBstrncmp\fR and \fBstrncasecmp\fR, respectively, for Unicode characters. They accepts two NULL-terminated Unicode strings and the number of characters They accepts two null-terminated Unicode strings and the number of characters to compare. Both strings are assumed to be at least \fIlen\fR characters long. \fBTcl_UniCharNcmp\fR compares the two strings character-by-character according to the Unicode character ordering. It returns an integer greater than, equal to, or less than 0 if the first string is greater than, equal to, or less than the second string respectively. \fBTcl_UniCharNcasecmp\fR is the Unicode case insensitive version. .PP .VS 8.4 \fBTcl_UniCharCaseMatch\fR is the Unicode equivalent to \fBTcl_StringCaseMatch\fR. It accepts a NULL-terminated Unicode string, \fBTcl_StringCaseMatch\fR. It accepts a null-terminated Unicode string, a Unicode pattern, and a boolean value specifying whether the match should be case sensitive and returns whether the string matches the pattern. .VE 8.4 .PP \fBTcl_UtfNcmp\fR corresponds to \fBstrncmp\fR for UTF-8 strings. It accepts two NULL-terminated UTF-8 strings and the number of characters accepts two null-terminated UTF-8 strings and the number of characters to compare. (Both strings are assumed to be at least \fIlen\fR characters long.) \fBTcl_UtfNcmp\fR compares the two strings character-by-character according to the Unicode character ordering. It returns an integer greater than, equal to, or less than 0 if the first string is greater than, equal to, or less than the second string respectively. .PP
︙
205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238	205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241	- + - + - + - + + - - - + + + + +	that the UTF-8 string is properly formed. This routine is used by procedures that are operating on a byte at a time and need to know if a full Tcl_UniChar has been seen. .PP \fBTcl_NumUtfChars\fR corresponds to \fBstrlen\fR for UTF-8 strings. It returns the number of Tcl_UniChars that are represented by the UTF-8 string \fIsrc\fR. The length of the source string is \fIlen\fR bytes. If the length is negative, all bytes up to the first NULL byte are used. length is negative, all bytes up to the first null byte are used. .PP \fBTcl_UtfFindFirst\fR corresponds to \fBstrchr\fR for UTF-8 strings. It returns a pointer to the first occurrence of the Tcl_UniChar \fIch\fR in the NULL-terminated UTF-8 string \fIsrc\fR. The NULL terminator is in the null-terminated UTF-8 string \fIsrc\fR. The null terminator is considered part of the UTF-8 string. .PP \fBTcl_UtfFindLast\fR corresponds to \fBstrrchr\fR for UTF-8 strings. It returns a pointer to the last occurrence of the Tcl_UniChar \fIch\fR in the NULL terminated UTF-8 string \fIsrc\fR. The NULL terminator is in the null-terminated UTF-8 string \fIsrc\fR. The null terminator is considered part of the UTF-8 string. .PP Given \fIsrc\fR, a pointer to some location in a UTF-8 string, \fBTcl_UtfNext\fR returns a pointer to the next UTF-8 character in the string. The caller must not ask for the next character after the last character in the string. character in the string if the string is not terminated by a null character. .PP Given \fIsrc\fR, a pointer to some location in a UTF-8 string, \fBTcl_UtfPrev\fR returns a pointer to the previous UTF-8 character in the string. This function will not back up to a position before \fIstart\fR, Given \fIsrc\fR, a pointer to some location in a UTF-8 string (or to a null byte immediately following such a string), \fBTcl_UtfPrev\fR returns a pointer to the closest preceding byte that starts a UTF-8 character. This function will not back up to a position before \fIstart\fR, the start of the UTF-8 string. If \fIsrc\fR was already at \fIstart\fR, the return value will be \fIstart\fR. .PP \fBTcl_UniCharAtIndex\fR corresponds to a C string array dereference or the Pascal Ord() function. It returns the Tcl_UniChar represented at the specified character (not byte) \fIindex\fR in the UTF-8 string \fIsrc\fR. The source string must contain at least \fIindex\fR
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1990-1994 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: after.n,v 1.3 2000/09/07 14:27:45 poenitz Exp $ '\" RCS: @(#) $Id: after.n,v 1.3.18.2 2004/10/27 14:23:41 dkf Exp $ '\" .so man.macros .TH after n 7.5 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME after \- Execute a command after a time delay
︙
97 98 99 100 101 102 103 104 105 106 107 108 109	97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	.LP The \fBafter \fIms\fR and \fBafter idle\fR forms of the command assume that the application is event driven: the delayed commands will not be executed unless the application enters the event loop. In applications that are not normally event-driven, such as \fBtclsh\fR, the event loop can be entered with the \fBvwait\fR and \fBupdate\fR commands. .SH "EXAMPLES" This defines a command to make Tcl do nothing at all for \fIN\fR seconds: .CS proc sleep {N} { \fBafter\fR [expr {int($N * 1000)}] } .CE .PP This arranges for the command \fIwake_up\fR to be run in eight hours (providing the event loop is active at that time): .CS \fBafter\fR [expr {1000 * 60 * 60 * 8}] wake_up .CE .PP The following command can be used to do long-running calculations (as represented here by \fI::my_calc::one_step\fR, which is assumed to return a boolean indicating whether another step should be performed) in a step-by-step fashion, though the calculation itself needs to be arranged so it can work step-wise. This technique is extra careful to ensure that the event loop is not starved by the rescheduling of processing steps (arranging for the next step to be done using an already-triggered timer event only when the event queue has been drained) and is useful when you want to ensure that a Tk GUI remains responsive during a slow task. .CS proc doOneStep {} { if {[::my_calc::one_step]} { \fBafter idle\fR [list \fBafter\fR 0 doOneStep] } } doOneStep .CE .SH "SEE ALSO" bgerror(n), concat(n), update(n), vwait(n) .SH KEYWORDS cancel, delay, idle callback, sleep, time

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: append.n,v 1.4 2003/02/10 13:32:22 dkf Exp $ '\" RCS: @(#) $Id: append.n,v 1.4.2.1 2004/10/27 09:35:38 dkf Exp $ '\" .so man.macros .TH append n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME append \- Append to variable
︙
25 26 27 28 29 30 31 32 33 34 35 36 37	25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47	+ + + + + + + + + +	\fIvalue\fR arguments. The result of this command is the new value stored in variable \fIvarName\fR. This command provides an efficient way to build up long variables incrementally. For example, ``\fBappend a $b\fR'' is much more efficient than ``\fBset a $a$b\fR'' if \fB$a\fR is long. .SH EXAMPLE Building a string of comma-separated numbers piecemeal using a loop. .CS set var 0 for {set i 1} {$i<=10} {incr i} { \fBappend\fR var "," $i } puts $var # Prints 0,1,2,3,4,5,6,7,8,9,10 .CE .SH "SEE ALSO" concat(n), lappend(n) .SH KEYWORDS append, variable

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993-1994 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: array.n,v 1.8 2000/09/07 14:27:45 poenitz Exp $ '\" RCS: @(#) $Id: array.n,v 1.8.18.3 2004/10/27 14:23:41 dkf Exp $ '\" .so man.macros .TH array n 8.3 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME array \- Manipulate array variables
︙
111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141	111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193	+ + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - +	individual elements in the array. When the search has been completed, the \fBarray donesearch\fR command should be invoked. The return value is a search identifier that must be used in \fBarray nextelement\fR and \fBarray donesearch\fR commands; it allows multiple searches to be underway simultaneously for the same array. It is currently more efficient and easier to use either the \fBarray get\fR or \fBarray names\fR, together with \fBforeach\fR, to iterate over all but very large arrays. See the examples below for how to do this. .VS 8.4 .TP \fBarray statistics \fIarrayName\fR Returns statistics about the distribution of data within the hashtable that represents the array. This information includes the number of entries in the table, the number of buckets, and the utilization of the buckets. .VE 8.4 .VS 8.3 .TP \fBarray unset \fIarrayName\fR ?\fIpattern\fR? Unsets all of the elements in the array that match \fIpattern\fR (using the matching rules of \fBstring match\fR). If \fIarrayName\fR isn't the name of an array variable or there are no matching elements in the array, no error will be raised. If \fIpattern\fR is omitted and \fIarrayName\fR is an array variable, then the command unsets the entire array. The command always returns an empty string. .VE 8.3 .SH EXAMPLES .CS \fBarray set\fR colorcount { red 1 green 5 blue 4 white 9 } foreach {color count} [\fBarray get\fR colorcount] { puts "Color: $color Count: $count" } => Color: blue Count: 4 Color: white Count: 9 Color: green Count: 5 Color: red Count: 1 foreach color [\fBarray names\fR colorcount] { puts "Color: $color Count: $colorcount($color)" } => Color: blue Count: 4 Color: white Count: 9 Color: green Count: 5 Color: red Count: 1 foreach color [lsort [array names colorcount]] { puts "Color: $color Count: $colorcount($color)" } => Color: blue Count: 4 Color: green Count: 5 Color: red Count: 1 Color: white Count: 9 \fBarray statistics\fR colorcount => 4 entries in table, 4 buckets number of buckets with 0 entries: 1 number of buckets with 1 entries: 2 number of buckets with 2 entries: 1 number of buckets with 3 entries: 0 number of buckets with 4 entries: 0 number of buckets with 5 entries: 0 number of buckets with 6 entries: 0 number of buckets with 7 entries: 0 number of buckets with 8 entries: 0 number of buckets with 9 entries: 0 number of buckets with 10 or more entries: 0 average search distance for entry: 1.2 .CE .SH "SEE ALSO" list(n), string(n), variable(n), trace(n) list(n), string(n), variable(n), trace(n), foreach(n) .SH KEYWORDS array, element names, search

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1990-1994 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: bgerror.n,v 1.4 2000/09/07 14:27:45 poenitz Exp $ '\" RCS: @(#) $Id: bgerror.n,v 1.4.18.1 2004/10/27 09:35:38 dkf Exp $ '\" .so man.macros .TH bgerror n 7.5 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME bgerror \- Command invoked to process background errors
︙
67 68 69 70 71 72 73 74 75 76 77 78 79	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	+ + + + + + + + + + + + + + + +	be redefined by setting the option database values \fB*ErrorDialog.function.text\fR, to specify the caption for the function button, and \fB*ErrorDialog.function.command\fR, to specify the command to be run. The text of the stack trace is appended to the command when it is evaluated. If either of these options is set to the empty string, then the additional button will not be displayed in the dialog. .PP If you are writing code that will be used by others as part of a package or other kind of library, consider avoiding \fBbgerror\fR. The reason for this is that the application programmer may also want to define a \fBbgerror\fR, or use other code that does and thus will have trouble integrating your code. .SH "EXAMPLE" This \fBbgerror\fR procedure appends errors to a file, with a timestamp. .CS proc bgerror {message} { set timestamp [clock format [clock seconds]] set fl [open mylog.txt {WRONLY CREAT APPEND}] puts $fl "$timestamp: bgerror in $::argv '$message'" close $fl } .CE .SH "SEE ALSO" after(n), tclvars(n) .SH KEYWORDS background error, reporting

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1997 by Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: binary.n,v 1.11 2002/10/09 14:07:43 dkf Exp $ '\" RCS: @(#) $Id: binary.n,v 1.11.2.8 2005/02/10 10:28:21 dkf Exp $ '\" .so man.macros .TH binary n 8.0 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME binary \- Insert and extract fields from binary strings
︙
51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74	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	- + + + + + + +	.CS \fBbinary format d3d {1.0 2.0 3.0 4.0} 0.1\fR .CE .PP The first argument is a list of four numbers, but because of the count of 3 for the associated field specifier, only the first three will be used. The second argument is associated with the second field specifier. The resulting binary string contains the four numbers 10, specifier. The resulting binary string contains the four numbers 1.0, 2.0, 3.0 and 0.1. .PP Each type-count pair moves an imaginary cursor through the binary data, storing bytes at the current position and advancing the cursor to just after the last byte stored. The cursor is initially at position 0 at the beginning of the data. The type may be any one of the following characters: .IP \fBa\fR 5 Stores a character string of length \fIcount\fR in the output string. Every character is taken as modulo 256 (i.e. the low byte of every character is used, and the high byte discarded) so when storing character strings not wholly expressible using the characters \\u0000-\\u00ff, the \fBencoding convertto\fR command should be used first if this truncation is not desired (i.e. if the characters are not part of the ISO 8859-1 character set.) If \fIarg\fR has fewer than \fIcount\fR bytes, then additional zero bytes are used to pad out the field. If \fIarg\fR is longer than the specified length, the extra characters will be ignored. If \fIcount\fR is \fB*\fR, then all of the bytes in \fIarg\fR will be formatted. If \fIcount\fR is omitted, then one character will be formatted. For example, .RS
︙
209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240	215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246	- + - +	\fBbinary format I3 {3 -3 65536 1}\fR .CE will return a string equivalent to \fB\\x00\\x00\\x00\\x03\\xff\\xff\\xff\\xfd\\x00\\x01\\x00\\x00\fR .RE .IP \fBw\fR 5 .VS 8.4 This form is the same as \fBw\fR except that it stores one or more This form is the same as \fBc\fR except that it stores one or more 64-bit integers in little-endian byte order in the output string. The low-order 64-bits of each integer are stored as an eight-byte value at the cursor position with the least significant byte stored first. For example, .RS .CS \fBbinary format w 7810179016327718216\fR .CE will return the string \fBHelloTcl\fR .RE .IP \fBW\fR 5 This form is the same as \fBw\fR except that it stores one or more one or more 64-bit integers in big-endian byte order in the output string. For example, .RS .CS \fBbinary format W 4785469626960341345\fR \fBbinary format Wc 4785469626960341345 110\fR .CE will return the string \fBBigEndian\fR .VE .RE .IP \fBf\fR 5 This form is the same as \fBc\fR except that it stores one or more one or more single-precision floating in the machine's native
︙
379 380 381 382 383 384 385 386 387 388 389 390 391 392 393	385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403	- + + + + +	reading bytes from the current position. The cursor is initially at position 0 at the beginning of the data. The type may be any one of the following characters: .IP \fBa\fR 5 The data is a character string of length \fIcount\fR. If \fIcount\fR is \fB*\fR, then all of the remaining bytes in \fIstring\fR will be scanned into the variable. If \fIcount\fR is omitted, then one character will be scanned. For example, character will be scanned. All characters scanned will be interpreted as being in the range \\u0000-\\u00ff so the \fBencoding convertfrom\fR command might be needed if the string is not an ISO 8859\-1 string. For example, .RS .CS \fBbinary scan abcde\\000fghi a6a10 var1 var2\fR .CE will return \fB1\fR with the string equivalent to \fBabcde\\000\fR stored in \fBvar1\fR and \fBvar2\fR left unmodified. .RE
︙
462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495	472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505	- + - +	\fBbinary scan \\x07\\x86\\x05 c2c* var1 var2\fR .CE will return \fB2\fR with \fB7 -122\fR stored in \fBvar1\fR and \fB5\fR stored in \fBvar2\fR. Note that the integers returned are signed, but they can be converted to unsigned 8-bit quantities using an expression like: .CS \fBexpr ( $num + 0x100 ) % 0x100\fR \fBexpr { $num & 0xff }\fR .CE .RE .IP \fBs\fR 5 The data is interpreted as \fIcount\fR 16-bit signed integers represented in little-endian byte order. The integers are stored in the corresponding variable as a list. If \fIcount\fR is \fB*\fR, then all of the remaining bytes in \fBstring\fR will be scanned. If \fIcount\fR is omitted, then one 16-bit integer will be scanned. For example, .RS .CS \fBbinary scan \\x05\\x00\\x07\\x00\\xf0\\xff s2s* var1 var2\fR .CE will return \fB2\fR with \fB5 7\fR stored in \fBvar1\fR and \fB-16\fR stored in \fBvar2\fR. Note that the integers returned are signed, but they can be converted to unsigned 16-bit quantities using an expression like: .CS \fBexpr ( $num + 0x10000 ) % 0x10000\fR \fBexpr { $num & 0xffff }\fR .CE .RE .IP \fBS\fR 5 This form is the same as \fBs\fR except that the data is interpreted as \fIcount\fR 16-bit signed integers represented in big-endian byte order. For example, .RS
︙
507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522	517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536	- - + + + + + +	\fIcount\fR is omitted, then one 32-bit integer will be scanned. For example, .RS .CS \fBbinary scan \\x05\\x00\\x00\\x00\\x07\\x00\\x00\\x00\\xf0\\xff\\xff\\xff i2i* var1 var2\fR .CE will return \fB2\fR with \fB5 7\fR stored in \fBvar1\fR and \fB-16\fR stored in \fBvar2\fR. Note that the integers returned are signed and cannot be represented by Tcl as unsigned values. stored in \fBvar2\fR. Note that the integers returned are signed, but they can be converted to unsigned 32-bit quantities using an expression like: .CS \fBexpr { $num & 0xffffffff }\fR .CE .RE .IP \fBI\fR 5 This form is the same as \fBI\fR except that the data is interpreted as \fIcount\fR 32-bit signed integers represented in big-endian byte order. For example, .RS .CS
︙
620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638	634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673	- + + + + + + + + + + + + + + + + + + + + + +	.RS .CS \fBbinary scan \\x01\\x02\\x03\\x04 c2@1H* var1 var2\fR .CE will return \fB2\fR with \fB1 2\fR stored in \fBvar1\fR and \fB020304\fR stored in \fBvar2\fR. .RE .SH "PLATFORM ISSUES" Sometimes it is desirable to format or scan integer values in the native byte order for the machine. Refer to the \fBbyteOrder\fR element of the \fBtcl_platform\fR array to decide which type character to use when formatting or scanning integers. .SH EXAMPLES This is a procedure to write a Tcl string to a binary-encoded channel as UTF-8 data preceded by a length word: .CS proc writeString {channel string} { set data [encoding convertto utf-8 $string] puts -nonewline [\fBbinary format\fR Ia* \e [string length $data] $data] } .CE .PP This procedure reads a string from a channel that was written by the previously presented \fBwriteString\fR procedure: .CS proc readString {channel} { if {![\fBbinary scan\fR [read $channel 4] I length]} { error "missing length" } set data [read $channel $length] return [encoding convertfrom utf-8 $data] } .CE .SH "SEE ALSO" format(n), scan(n), tclvars(n) .SH KEYWORDS binary, format, scan

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

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

- + - + + + + + + + - + + + + + - +

'\" '\" Copyright (c) 1993-1994 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: break.n,v 1.3 2000/09/07 14:27:46 poenitz Exp $ '\" RCS: @(#) $Id: break.n,v 1.3.18.1 2004/10/27 09:35:38 dkf Exp $ '\" .so man.macros .TH break n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME break \- Abort looping command .SH SYNOPSIS \fBbreak\fR .BE .SH DESCRIPTION .PP This command is typically invoked inside the body of a looping command such as \fBfor\fR or \fBforeach\fR or \fBwhile\fR. It returns a TCL_BREAK code, which causes a break exception It returns a \fBTCL_BREAK\fR code, which causes a break exception to occur. The exception causes the current script to be aborted out to the innermost containing loop command, which then aborts its execution and returns normally. Break exceptions are also handled in a few other situations, such as the \fBcatch\fR command, Tk event bindings, and the outermost scripts of procedure bodies. .SH EXAMPLE Print a line for each of the integers from 0 to 5: .CS for {set x 0} {$x<10} {incr x} { if {$x > 5} { \fBbreak\fR } puts "x is $x" } .CE .SH "SEE ALSO" catch(n), continue(n), for(n), foreach(n), while(n) catch(n), continue(n), for(n), foreach(n), return(n), while(n) .SH KEYWORDS abort, break, loop

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

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

- + - + - - - - + + + + + + + + + + + + + + + + + - + - - - + + - - + - +

'\" '\" Copyright (c) 1993-1994 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: catch.n,v 1.5 2000/09/07 14:27:46 poenitz Exp $ '\" RCS: @(#) $Id: catch.n,v 1.5.18.2 2004/11/09 10:25:23 dkf Exp $ '\" .so man.macros .TH catch n "8.0" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME catch \- Evaluate script and trap exceptional returns .SH SYNOPSIS \fBcatch\fI script \fR?\fIvarName\fR? .BE .SH DESCRIPTION .PP The \fBcatch\fR command may be used to prevent errors from aborting command interpretation. \fBCatch\fR calls the Tcl interpreter recursively to interpretation. The \fBcatch\fR command calls the Tcl interpreter recursively to execute \fIscript\fR, and always returns without raising an error, regardless of any errors that might occur while executing \fIscript\fR. .PP If \fIscript\fR raises an error, \fBcatch\fR will return a non-zero integer value corresponding to one of the exceptional return codes (see tcl.h for the definitions of code values). If the \fIvarName\fR argument is given, then the variable it names is set to the error message from interpreting \fIscript\fR. value corresponding to the exceptional return code returned by evaluation of \fIscript\fR. Tcl defines the normal return code from script evaluation to be zero (0), or \fBTCL_OK\fR. Tcl also defines four exceptional return codes: 1 (\fBTCL_ERROR\fR), 2 (\fBTCL_RETURN\fR), 3 (\fBTCL_BREAK\fR), and 4 (\fBTCL_CONTINUE\fR). Errors during evaluation of a script are indicated by a return code of \fBTCL_ERROR\fR. The other exceptional return codes are returned by the \fBreturn\fR, \fBbreak\fR, and \fBcontinue\fR commands and in other special situations as documented. Tcl packages can define new commands that return other integer values as return codes as well, and scripts that make use of the \fBreturn -code\fR command can also have return codes other than the five defined by Tcl. .PP If the \fIvarName\fR argument is given, then the variable it names is set to the result of the script evaluation. When the return code from the script is 1 (\fBTCL_ERROR\fR), the value stored in \fIvarName\fR is an error message. When the return code from the script is 0 (\fBTCL_OK\fR), the value stored in \fIresultVarName\fR is the value returned from \fIscript\fR. .PP If \fIscript\fR does not raise an error, \fBcatch\fR will return 0 (TCL_OK) and set the variable to the value returned from \fIscript\fR. (\fBTCL_OK\fR) and set the variable to the value returned from \fIscript\fR. .PP Note that \fBcatch\fR catches all exceptions, including those generated by \fBbreak\fR and \fBcontinue\fR as well as errors. The only errors that are not caught are syntax errors found when the script is compiled. This is because the catch command only catches errors during runtime. When the catch statement is compiled, the script is compiled as well and any syntax errors will generate a Tcl error. .SH EXAMPLES The \fBcatch\fR command may be used in an \fBif\fR to branch based on the success of a script. .CS if { [catch {open $someFile w} fid] } { if { [\fBcatch\fR {open $someFile w} fid] } { puts stderr "Could not open $someFile for writing\\n$fid" exit 1 } .CE .PP The \fBcatch\fR command will not catch compiled syntax errors. The first time proc \fBfoo\fR is called, the body will be compiled and a Tcl error will be generated. .CS proc foo {} { catch {expr {1 +- }} \fBcatch\fR {expr {1 +- }} } .CE .SH "SEE ALSO" error(n), break(n), continue(n) break(n), continue(n), error(n), return(n), tclvars(n) .SH KEYWORDS catch, error

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

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

- + + + + + + + + + + + + + + +

'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: cd.n,v 1.3 2000/09/07 14:27:46 poenitz Exp $ '\" RCS: @(#) $Id: cd.n,v 1.3.18.1 2004/10/27 09:35:38 dkf Exp $ '\" .so man.macros .TH cd n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME cd \- Change working directory .SH SYNOPSIS \fBcd \fR?\fIdirName\fR? .BE .SH DESCRIPTION .PP Change the current working directory to \fIdirName\fR, or to the home directory (as specified in the HOME environment variable) if \fIdirName\fR is not given. Returns an empty string. Note that the current working directory is a per-process resource; the \fBcd\fR command changes the working directory for all interpreters and (in a threaded environment) all threads. .SH EXAMPLES Change to the home directory of the user \fBfred\fR: .CS \fBcd\fR ~fred .CE .PP Change to the directory \fBlib\fR that is a sibling directory of the current one: .CS \fBcd\fR ../lib .CE .SH "SEE ALSO" filename(n), glob(n), pwd(n) .SH KEYWORDS working directory

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	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	- + - + - - + +	'\" '\" Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans. '\" Copyright (c) 1995-1997 Sun Microsystems, Inc. '\" Copyright (c) 1998-1999 Scriptics Corporation '\" Copyright (c) 2002 ActiveState Corporation '\" '\" This documentation is derived from the time and date facilities of '\" TclX, by Mark Diekhans and Karl Lehenbauer. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: clock.n,v 1.11 2002/04/22 22:41:46 hobbs Exp $ '\" RCS: @(#) $Id: clock.n,v 1.11.2.6 2004/12/13 15:52:21 kennykb Exp $ '\" .so man.macros .TH clock n 8.4 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME clock \- Obtain and manipulate time .SH SYNOPSIS \fBclock \fIoption\fR ?\fIarg arg ...\fR? .BE .SH DESCRIPTION .PP This command performs one of several operations that may obtain or manipulate strings or values that represent some notion of time. The \fIoption\fR argument determines what action is carried out by the command. The legal \fIoptions\fR (which may be abbreviated) are: .TP .VS 8.3 .TP \fBclock clicks\fR ?\fB\-milliseconds\fR? Return a high-resolution time value as a system-dependent integer value. The unit of the value is system-dependent but should be the highest resolution clock available on the system such as a CPU cycle counter. If \fB\-milliseconds\fR is specified, then the value is guaranteed to be of millisecond granularity. This value should only be used for the relative measurement of elapsed time. .VE 8.3 .TP \fBclock format \fIclockValue\fR ?\fB\-format \fIstring\fR? ?\fB\-gmt \fIboolean\fR? Converts an integer time value, typically returned by \fBclock seconds\fR, \fBclock scan\fR, or the \fBatime\fR, \fBmtime\fR, or \fBctime\fR options of the \fBfile\fR command, to human-readable \fBclock seconds\fR, \fBclock scan\fR, or the \fBatime\fR or \fBmtime\fR options of the \fBfile\fR command, to human-readable form. If the \fB\-format\fR argument is present the next argument is a string that describes how the date and time are to be formatted. Field descriptors consist of a \fB%\fR followed by a field descriptor character. All other characters are copied into the result. Valid field descriptors are: .RS .IP \fB%%\fR
︙
75 76 77 78 79 80 81 82 83 84 85 86 87 88	75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94	+ + + + + +	.VS 8.4 '\" Since the inclusion of compat/strftime.c, %D, %e, %h should work on all '\" platforms. .IP \fB%D\fR Date as %m/%d/%y. .IP \fB%e\fR Day of month (1 - 31), no leading zeros. .IP \fB%g\fR The ISO8601 year number corresponding to the ISO8601 week (%V), expressed as a two-digit year-of-the-century, with leading zero if necessary. .IP \fB%G\fR The ISO8601 year number corresponding to the ISO8601 week (%V), expressed as a four-digit number. .IP \fB%h\fR Abbreviated month name. .VE 8.4 .IP \fB%H\fR Hour in 24-hour format (00 - 23). .VS 8.4 .IP \fB%I\fR
︙
228 229 230 231 232 233 234 235 236 237 238 239 240 241 242	234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252	- + + + + +	as 1969-1999. Not all platforms can represent the years 38-70, so an error may result if these years are used. .VE .TP \fIISO 8601 point-in-time\fR An ISO 8601 point-in-time specification, such as \fICCyymmddThhmmss\fR, where T is the literal T, \fICCyymmdd hhmmss\fR, or \fICCyymmddThh:mm:ss\fR. \fICCyymmddThh:mm:ss\fR. Note that only these three formats are accepted. The command does \fInot\fR accept the full range of point-in-time specifications specified in ISO8601. Other formats can be recognized by using commands such as \fBregexp\fR to extract their fields and reorganize them into a form accepted by the \fBclock scan\fR command. .TP \fIrelative time\fR A specification relative to the current time. The format is \fInumber unit\fR acceptable units are \fByear\fR, \fBfortnight\fR, \fBmonth\fR, \fBweek\fR, \fBday\fR, \fBhour\fR, \fBminute\fR (or \fBmin\fR), and \fBsecond\fR (or \fBsec\fR). The unit can be specified as a singular or plural, as in \fB3 weeks\fR. These modifiers may also be specified:
︙
258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275	268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285	- + - - + +	Daylight savings time correction is applied only when the relative time is specified in units of days or more, ie, days, weeks, fortnights, months or years. This means that when crossing the daylight savings time boundary, different results will be given for \fBclock scan "1 day"\fR and \fBclock scan "24 hours"\fR: .CS .ta 6c \fB% clock scan "1 day" -base [clock scan 1999-10-31] % \fBclock scan\fR "1 day" -base [\fBclock scan\fR 1999-10-31] 941443200 % clock scan "24 hours" -base [clock scan 1999-10-31] 941439600\fR % \fBclock scan\fR "24 hours" -base [\fBclock scan\fR 1999-10-31] 941439600 .CE .RE .TP \fBclock seconds\fR Return the current date and time as a system-dependent integer value. The unit of the value is seconds, allowing it to be used for relative time calculations. The value is usually defined as total elapsed time from
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: close.n,v 1.4 2001/09/14 19:20:40 andreas_kupries Exp $ '\" RCS: @(#) $Id: close.n,v 1.4.8.1 2004/10/27 09:35:38 dkf Exp $ '\" .so man.macros .TH close n 7.5 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME close \- Close an open channel.
︙
55 56 57 58 59 60 61 62 63 64 65 66 67 68	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	- + + + + + + + + + + + + + + + + + +	.PP Channels are automatically closed when an interpreter is destroyed and when the process exits. Channels are switched to blocking mode, to ensure that all output is correctly flushed before the process exits. .VE .PP The command returns an empty string, and may generate an error if an error occurs while flushing output. an error occurs while flushing output. If a command in a command pipeline created with \fBopen\fR returns an error, \fBclose\fR generates an error (similar to the \fBexec\fR command.) .SH EXAMPLE This illustrates how you can use Tcl to ensure that files get closed even when errors happen by combining \fBcatch\fR, \fBclose\fR and \fBreturn\fR: .CS proc withOpenFile {filename channelVar script} { upvar 1 $channelVar chan set chan [open $filename] catch { uplevel 1 $script } result options \fBclose\fR $chan return -options $options $result } .CE .SH "SEE ALSO" file(n), open(n), socket(n), eof(n), Tcl_StandardChannels(3) .SH KEYWORDS blocking, channel, close, nonblocking

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

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

- + - + - + + + + - + - - - + - - + - + - + + + + - + - - - + +

'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: concat.n,v 1.4 2002/07/01 10:50:21 dkf Exp $ '\" RCS: @(#) $Id: concat.n,v 1.4.2.1 2004/10/27 09:35:38 dkf Exp $ '\" .so man.macros .TH concat n 8.3 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME concat \- Join lists together .SH SYNOPSIS \fBconcat\fI \fR?\fIarg arg ...\fR? .BE .SH DESCRIPTION .PP This command joins each of its arguments together with spaces after trimming leading and trailing spaces from each of them. If all the trimming leading and trailing white-space from each of them. If all the arguments are lists, this has the same effect as concatenating them into a single list. It permits any number of arguments. For example, the command It permits any number of arguments; if no \fIarg\fRs are supplied, the result is an empty string. .SH EXAMPLES Although \fBconcat\fR will concatenate lists (so the command: .CS \fBconcat a b {c d e} {f {g h}}\fR \fBconcat\fR a b {c d e} {f {g h}} .CE will return .CS \fBa b c d e f {g h}\fR will return "\fBa b c d e f {g h}\fR" as its result), it will also .CE as its result, and concatenate things that are not lists, and hence the command: .CS \fBconcat " a b {c " d " e} f"\fR \fBconcat\fR " a b {c " d " e} f" .CE will return will return "\fBa b {c d e} f\fR" as its result. .PP Note that the concatenation does not remove spaces from the middle of its arguments, so the command: .CS \fBa b {c d e} f\fR \fBconcat\fR "a b c" { d e f } .CE as its result. .PP If no \fIarg\fRs are supplied, the result is an empty string. will return "\fBa b c d e f\fR" (i.e. with three spaces between the \fBa\fR, the \fBb\fR and the \fBc\fR). .SH "SEE ALSO" append(n), eval(n) .SH KEYWORDS concatenate, join, lists

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

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

- + - + + + + + + + - + + + + + - +

'\" '\" Copyright (c) 1993-1994 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: continue.n,v 1.3 2000/09/07 14:27:46 poenitz Exp $ '\" RCS: @(#) $Id: continue.n,v 1.3.18.1 2004/10/27 09:35:38 dkf Exp $ '\" .so man.macros .TH continue n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME continue \- Skip to the next iteration of a loop .SH SYNOPSIS \fBcontinue\fR .BE .SH DESCRIPTION .PP This command is typically invoked inside the body of a looping command such as \fBfor\fR or \fBforeach\fR or \fBwhile\fR. It returns a TCL_CONTINUE code, which causes a continue exception It returns a \fBTCL_CONTINUE\fR code, which causes a continue exception to occur. The exception causes the current script to be aborted out to the innermost containing loop command, which then continues with the next iteration of the loop. Catch exceptions are also handled in a few other situations, such as the \fBcatch\fR command and the outermost scripts of procedure bodies. .SH EXAMPLE Print a line for each of the integers from 0 to 10 \fIexcept\fR 5: .CS for {set x 0} {$x<10} {incr x} { if {$x == 5} { \fBcontinue\fR } puts "x is $x" } .CE .SH "SEE ALSO" break(n), for(n), foreach(n), while(n) break(n), for(n), foreach(n), return(n), while(n) .SH KEYWORDS continue, iteration, loop

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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113	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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112	- + - + - + - + - + - + - + - + - - + - + - + - + - + - + - +	'\" '\" Copyright (c) 1997 Sun Microsystems, Inc. '\" Copyright (c) 2001 ActiveState Corporation. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: dde.n,v 1.8 2002/06/27 22:29:08 dgp Exp $ '\" RCS: @(#) $Id: dde.n,v 1.8.2.4 2004/12/03 00:37:21 hobbs Exp $ '\" .so man.macros .TH dde n 1.2 dde "Tcl Bundled Packages" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME dde \- Execute a Dynamic Data Exchange command .SH SYNOPSIS .sp \fBpackage require dde 1.2\fR .sp \fBdde \fIservername\fR ?\fItopic\fR? \fBdde eval\fR ?\fB\-async\fR? \fIservice cmd\fR ?\fIarg ...\fR? .sp \fBdde \fIexecute\fR ?\fI\-async\fR? \fIservice topic \fR?\fIdata\fR? \fBdde execute\fR ?\fB\-async\fR? \fIservice topic data\fR .sp \fBdde \fIpoke\fR \fIservice topic item data\fR \fBdde poke \fIservice topic item data\fR .sp \fBdde \fIrequest\fR ?\fI\-binary\fR? \fIservice topic \fR?\fIdata\fR? \fBdde request\fR ?\fB\-binary\fR? \fIservice topic data\fR .sp \fBdde \fIservices\fR \fIservice topic \fR?\fIdata\fR? \fBdde servername\fR ?\fItopic\fR? .sp \fBdde \fIeval\fR ?\fI\-async\fR? \fIservice topic \fR?\fIdata\fR? \fBdde services \fIservice topic\fR .BE .SH DESCRIPTION .PP This command allows an application to send Dynamic Data Exchange (DDE) command when running under Microsoft Windows. Dynamic Data Exchange is a mechanism where applications can exchange raw data. Each DDE transaction needs a \fIservice name\fR and a \fItopic\fR. Both the \fIservice name\fR and \fItopic\fR are application defined; Tcl uses the service name \fBTclEval\fR, while the topic name is the name of the interpreter given by \fBdde servername\fR. Other applications have their own \fIservice names\fR and \fItopics\fR. For instance, Microsoft Excel own \fIservice name\fRs and \fItopic\fRs. For instance, Microsoft Excel has the service name \fBExcel\fR. .PP The \fBeval\fR and \fBexecute\fR commands accept the option \fB\-async\fR: .TP .SH "DDE COMMANDS" .PP The following commands are a subset of the full Dynamic Data Exchange set of commands. .TP \fBdde servername \fR?\fItopic\fR? \fBdde servername\fR registers the interpreter as a DDE server with the service name \fBTclEval\fR and the topic name specified by \fItopic\fR. If no \fItopic\fR is given, \fBdde servername\fR returns the name of the current topic or the empty string if it is not registered as a service. .TP \fBdde execute\fR ?\fI\-async\fR? \fIservice topic data\fR \fBdde execute\fR ?\fB\-async\fR? \fIservice topic data\fR \fBdde execute\fR takes the \fIdata\fR and sends it to the server indicated by \fIservice\fR with the topic indicated by \fItopic\fR. Typically, \fIservice\fR is the name of an application, and \fItopic\fR is a file to work on. The \fIdata\fR field is given to the remote application. Typically, the application treats the \fIdata\fR field as a script, and the script is run in the application. The \fI\-async\fR option requests script is run in the application. The \fB\-async\fR option requests asynchronous invocation. The command returns an error message if the script did not run, unless the \fB\-async\fR flag was used, in which case the command returns immediately with no error. .TP \fBdde poke \fIservice topic item data\fR \fBdde poke\fR passes the \fIdata\fR to the server indicated by \fIservice\fR using the \fItopic\fR and \fIitem\fR specified. Typically, \fIservice\fR is the name of an application. \fItopic\fR is application specific but can be a command to the server or the name of a file to work on. The \fIitem\fR is also application specific and is often not used, but it must always be non-null. The \fIdata\fR field is given to the remote application. .TP \fBdde request\fR ?\fI\-binary\fR? \fIservice topic item\fR \fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR \fBdde request\fR is typically used to get the value of something; the value of a cell in Microsoft Excel or the text of a selection in Microsoft Word. \fIservice\fR is typically the name of an application, \fItopic\fR is typically the name of the file, and \fIitem\fR is application-specific. The command returns the value of \fIitem\fR as defined in the application. Normally this is interpreted to be a string with terminating null. If \fI\-binary\fR is specified, the string with terminating null. If \fB\-binary\fR is specified, the result is returned as a byte array. .TP \fBdde services \fIservice topic\fR \fBdde services\fR returns a list of service-topic pairs that currently exist on the machine. If \fIservice\fR and \fItopic\fR are both null strings ({}), then all service-topic pairs currently available on the system are returned. If \fIservice\fR is null and \fItopic\fR is not, then all services with the specified topic are returned. If \fIservice\fR is not null and \fItopic\fR is, all topics for a given service are returned. If both are not null, if that service-topic pair currently exists, it is returned; otherwise, null is returned. .TP \fBdde eval\fR ?\fI\-async\fR? \fItopic cmd \fR?\fIarg arg ...\fR? \fBdde eval\fR ?\fB\-async\fR? \fItopic cmd \fR?\fIarg arg ...\fR? \fBdde eval\fR evaluates a command and its arguments using the interpreter specified by \fItopic\fR. The DDE service must be the \fBTclEval\fR service. The \fI\-async\fR option requests asynchronous invocation. The service. The \fB\-async\fR option requests asynchronous invocation. The command returns an error message if the script did not run, unless the \fB\-async\fR flag was used, in which case the command returns immediately with no error. This command can be used to replace send on Windows. with no error. This command can be used to replace \fBsend\fR on Windows. .SH "DDE AND TCL" A Tcl interpreter always has a service name of \fBTclEval\fR. Each different interpreter of all running Tcl applications must be given a unique name specified by \fBdde servername\fR. Each interp is available as a DDE topic only if the \fBdde servername\fR command was used to set the
︙
133 134 135 136 137 138 139 140 141 142 143 144 145	132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152	+ + + + + + + +	When using DDE, be careful to ensure that the event queue is flushed using either \fBupdate\fR or \fBvwait\fR. This happens by default when using \fBwish\fR unless a blocking command is called (such as \fBexec\fR without adding the \fB&\fR to place the process in the background). If for any reason the event queue is not flushed, DDE commands may hang until the event queue is flushed. This can create a deadlock situation. .SH EXAMPLE This asks Internet Explorer (which must already be running) to go to a particularly important website: .CS package require dde \fBdde execute\fR iexplore WWW_OpenURL http://www.tcl.tk/ .CE .SH "SEE ALSO" tk(n), winfo(n), send(n) .SH KEYWORDS application, dde, name, remote execution

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

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

- + - - + - + - + + + + - - - + + + - - - - + + + + - +

'\" '\" Copyright (c) 1998 by Scriptics Corporation. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: encoding.n,v 1.3 2000/09/07 14:27:47 poenitz Exp $ '\" RCS: @(#) $Id: encoding.n,v 1.3.18.3 2004/10/27 14:23:56 dkf Exp $ '\" .so man.macros .TH encoding n "8.1" Tcl "Tcl Built-In Commands" .BS .SH NAME encoding \- Manipulate encodings .SH SYNOPSIS \fBencoding \fIoption\fR ?\fIarg arg ...\fR? .BE .SH INTRODUCTION .PP Strings in Tcl are encoded using 16-bit Unicode characters. Different operating system interfaces or applications may generate strings in other encodings such as Shift-JIS. The \fBencoding\fR command helps to bridge the gap between Unicode and these other formats. .SH DESCRIPTION .PP Performs one of several encoding related operations, depending on \fIoption\fR. The legal \fIoption\fRs are: .TP \fBencoding convertfrom ?\fIencoding\fR? \fIdata\fR \fBencoding convertfrom\fR ?\fIencoding\fR? \fIdata\fR Convert \fIdata\fR to Unicode from the specified \fIencoding\fR. The characters in \fIdata\fR are treated as binary data where the lower 8-bits of each character is taken as a single byte. The resulting sequence of bytes is treated as a string in the specified \fIencoding\fR. If \fIencoding\fR is not specified, the current system encoding is used. .TP \fBencoding convertto ?\fIencoding\fR? \fIstring\fR \fBencoding convertto\fR ?\fIencoding\fR? \fIstring\fR Convert \fIstring\fR from Unicode to the specified \fIencoding\fR. The result is a sequence of bytes that represents the converted string. Each byte is stored in the lower 8-bits of a Unicode character. If \fIencoding\fR is not specified, the current system encoding is used. .TP \fBencoding names\fR Returns a list containing the names of all of the encodings that are currently available. .TP \fBencoding system\fR ?\fIencoding\fR? Set the system encoding to \fIencoding\fR. If \fIencoding\fR is omitted then the command returns the current system encoding. The system encoding is used whenever Tcl passes strings to system calls. .SH EXAMPLE .PP It is common practice to write script files using a text editor that produces output in the euc-jp encoding, which represents the ASCII characters as singe bytes and Japanese characters as two bytes. This makes it easy to embed literal strings that correspond to non-ASCII characters by simply typing the strings in place in the script. However, because the \fBsource\fR command always reads files using the current system encoding, Tcl will only source such files correctly when the encoding used to write the file is the same. This tends not to be true in an internationalized setting. For example, if such a file was sourced in North America (where the ISO8859-1 is normally ISO8859-1 encoding, Tcl will treat each byte in the file as a separate character that maps to the 00 page in Unicode. The resulting Tcl strings will not contain the expected Japanese used), each byte in the file would be treated as a separate character that maps to the 00 page in Unicode. The resulting Tcl strings will not contain the expected Japanese characters. Instead, they will characters. Instead, they will contain a sequence of Latin-1 characters that correspond to the bytes of the original string. The \fBencoding\fR command can be used to convert this string to the expected Japanese Unicode characters. For example, contain a sequence of Latin-1 characters that correspond to the bytes of the original string. The \fBencoding\fR command can be used to convert this string to the expected Japanese Unicode characters. For example, .CS set s [encoding convertfrom euc-jp "\\xA4\\xCF"] set s [\fBencoding convertfrom\fR euc-jp "\\xA4\\xCF"] .CE would return the Unicode string "\\u306F", which is the Hiragana letter HA. .SH "SEE ALSO" Tcl_GetEncoding(3) .SH KEYWORDS encoding

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

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

- + - + + - + + + + + + + + + + + + + + + + + + + + + + + + + +

'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: eof.n,v 1.4 2001/09/14 19:20:40 andreas_kupries Exp $ '\" RCS: @(#) $Id: eof.n,v 1.4.8.1 2004/10/27 09:35:38 dkf Exp $ '\" .so man.macros .TH eof n 7.5 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME eof \- Check for end of file condition on channel .SH SYNOPSIS \fBeof \fIchannelId\fR .BE .SH DESCRIPTION .PP Returns 1 if an end of file condition occurred during the most recent input operation on \fIchannelId\fR (such as \fBgets\fR), 0 otherwise. .PP .VS \fIChannelId\fR must be an identifier for an open channel such as a Tcl standard channel (\fBstdin\fR, \fBstdout\fR, or \fBstderr\fR), the return value from an invocation of \fBopen\fR or \fBsocket\fR, or the result of a channel creation command provided by a Tcl extension. .SH EXAMPLES Read and print out the contents of a file line-by-line: .VE .CS set f [open somefile.txt] while {1} { set line [gets $f] if {[\fBeof\fR $f]} { close $f break } puts "Read line: $line" } .CE .PP Read and print out the contents of a file by fixed-size records: .CS set f [open somefile.dat] fconfigure $f -translation binary set recordSize 40 while {1} { set record [read $f $recordSize] if {[\fBeof\fR $f]} { close $f break } puts "Read record: $record" } .CE .SH "SEE ALSO" file(n), open(n), close(n), fblocked(n), Tcl_StandardChannels(3) .SH KEYWORDS channel, end of file

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	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	- + - +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: error.n,v 1.3 2000/09/07 14:27:47 poenitz Exp $ '\" RCS: @(#) $Id: error.n,v 1.3.18.1 2004/10/27 09:35:38 dkf Exp $ '\" .so man.macros .TH error n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME error \- Generate an error .SH SYNOPSIS \fBerror \fImessage\fR ?\fIinfo\fR? ?\fIcode\fR? .BE .SH DESCRIPTION .PP Returns a TCL_ERROR code, which causes command interpretation to be Returns a \fBTCL_ERROR\fR code, which causes command interpretation to be unwound. \fIMessage\fR is a string that is returned to the application to indicate what went wrong. .PP If the \fIinfo\fR argument is provided and is non-empty, it is used to initialize the global variable \fBerrorInfo\fR. \fBerrorInfo\fR is used to accumulate a stack trace of what was in progress when an error occurred; as nested commands unwind,
︙
49 50 51 52 53 54 55 56 57 58 59 60 61	49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68	+ + + + + - + + + - +	to hold a machine-readable description of the error in cases where such information is available; see the \fBtclvars\fR manual page for information on the proper format for the variable. If the \fIcode\fR argument is not present, then \fBerrorCode\fR is automatically reset to ``NONE'' by the Tcl interpreter as part of processing the error generated by the command. .SH EXAMPLE Generate an error if a basic mathematical operation fails: .CS if {1+2 != 3} { \fBerror\fR "something is very wrong with addition" } .CE .SH "SEE ALSO" catch(n), tclvars(n) catch(n), return(n), tclvars(n) .SH KEYWORDS error, errorCode, errorInfo

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: eval.n,v 1.4 2002/08/28 14:46:50 dkf Exp $ '\" RCS: @(#) $Id: eval.n,v 1.4.2.1 2004/10/27 09:35:38 dkf Exp $ '\" .so man.macros .TH eval n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME eval \- Evaluate a Tcl script
︙
23 24 25 26 27 28 29 30 31 32 33 34 35	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	+ + + + + + + + + + + + +	script containing one or more commands. \fBEval\fR concatenates all its arguments in the same fashion as the \fBconcat\fR command, passes the concatenated string to the Tcl interpreter recursively, and returns the result of that evaluation (or any error generated by it). Note that the \fBlist\fR command quotes sequences of words in such a way that they are not further expanded by the \fBeval\fR command. .SH EXAMPLE This procedure acts in a way that is analogous to the \fBlappend\fR command, except it inserts the argument values at the start of the list in the variable: .CS proc lprepend {varName args} { upvar 1 $varName var # Ensure that the variable exists and contains a list lappend var # Now we insert all the arguments in one go set var [\fBeval\fR [list linsert $var 0] $args] } .CE .SH KEYWORDS concatenate, evaluate, script .SH "SEE ALSO" catch(n), concat(n), error(n), list(n), subst(n), tclvars(n)

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	- + - +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: exec.n,v 1.6 2002/04/23 19:06:10 hobbs Exp $ '\" RCS: @(#) $Id: exec.n,v 1.6.2.1 2004/10/27 09:35:38 dkf Exp $ '\" .so man.macros .TH exec n 7.6 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME exec \- Invoke subprocess(es) exec \- Invoke subprocesses .SH SYNOPSIS \fBexec \fR?\fIswitches\fR? \fIarg \fR?\fIarg ...\fR? .BE .SH DESCRIPTION .PP This command treats its arguments as the specification
︙
34 35 36 37 38 39 40 41 42 43 44 45 46 47 48	34 35 36 37 38 39 40 41 42 43 44 45 46 47 48	- +	Retains a trailing newline in the pipeline's output. Normally a trailing newline will be deleted. .TP 13 \fB\-\|\-\fR Marks the end of switches. The argument following this one will be treated as the first \fIarg\fR even if it starts with a \fB\-\fR. .PP If an \fIarg\fR (or pair of \fIarg\fR's) has one of the forms If an \fIarg\fR (or pair of \fIarg\fRs) has one of the forms described below then it is used by \fBexec\fR to control the flow of input and output among the subprocess(es). Such arguments will not be passed to the subprocess(es). In forms such as ``< \fIfileName\fR'' \fIfileName\fR may either be in a separate argument from ``<'' or in the same argument with no intervening space (i.e. ``<\fIfileName\fR''). .TP 15
︙
213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236	213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235	- + - + -	Note that there are two general types of Win32 console applications: .RS 1) CLI -- CommandLine Interface, simple stdio exchange. \fBnetstat.exe\fR for example. .br 2) TUI -- Textmode User Interface, any application that accesses the console API for doing such things as cursor movement, setting text color, detecting key presses and mouse movement, etc... An example would be \fBtelnet.exe\fR key presses and mouse movement, etc. An example would be \fBtelnet.exe\fR from Windows 2000. These types of applications are not common in a windows environment, but do exist. .RE \fBexec\fR will not work well with TUI applications when a console is not present, as is done when launching applications under wish. It is desirable to have console applications hidden and detached. This is a designed-in limitation as \fBexec\fR wants to communicate over pipes. The Expect extension addresses this issue when communication between a TUI application extension addresses this issue when communicating with a TUI application. is desired. .sp .RE .TP \fBWindows NT\fR . When attempting to execute an application, \fBexec\fR first searches for the name as it was specified. Then, in order, \fB.com\fR, \fB.exe\fR, and
︙
250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292	249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293	- - + + + - + - + - + - - + + +	The Windows NT 16-bit system directory. .br The Windows NT home directory. .br The directories listed in the path. .RE .sp In order to execute the shell builtin commands like \fBdir\fR and \fBcopy\fR, the caller must prepend ``\fBcmd.exe /c\0\fR'' to the desired command. In order to execute shell built-in commands like \fBdir\fR and \fBcopy\fR, the caller must prepend the desired command with ``\fBcmd.exe /c\0\fR'' because built-in commands are not implemented using executables. .sp .RE .TP \fBWindows 95\fR \fBWindows 9x\fR . When attempting to execute an application, \fBexec\fR first searches for the name as it was specified. Then, in order, \fB.com\fR, \fB.exe\fR, and \fB.bat\fR are appended to the end of the specified name and it searches for the longer name. If a directory name was not specified as part of the application name, the following directories are automatically searched in order when attempting to locate the application: .sp .RS .RS The directory from which the Tcl executable was loaded. .br The current directory. .br The Windows 95 system directory. The Windows 9x system directory. .br The Windows 95 home directory. The Windows 9x home directory. .br The directories listed in the path. .RE .sp In order to execute the shell builtin commands like \fBdir\fR and \fBcopy\fR, the caller must prepend ``\fBcommand.com /c\0\fR'' to the desired command. In order to execute shell built-in commands like \fBdir\fR and \fBcopy\fR, the caller must prepend the desired command with ``\fBcommand.com /c\0\fR'' because built-in commands are not implemented using executables. .sp Once a 16-bit DOS application has read standard input from a console and then quit, all subsequently run 16-bit DOS applications will see the standard input as already closed. 32-bit applications do not have this problem and will run correctly, even after a 16-bit DOS application thinks that standard input is closed. There is no known workaround for this bug at this time.
︙
317 318 319 320 321 322 323 324 325 326 327 328 329	318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	.RE .TP \fBMacintosh\fR The \fBexec\fR command is not implemented and does not exist under Macintosh. .TP \fBUnix\fR\0\0\0\0\0\0\0 The \fBexec\fR command is fully functional and works as described. .SH "UNIX EXAMPLES" Here are some examples of the use of the \fBexec\fR command on Unix. .PP To execute a simple program and get its result: .CS \fBexec\fR uname -a .CE .PP To execute a program that can return a non-zero result, you should wrap the call to \fBexec\fR in \fBcatch\fR and check what the contents of the global \fBerrorCode\fR variable is if you have an error: .CS set status 0 if {[catch {\fBexec\fR grep foo bar.txt} results]} { if {[lindex $::errorCode 0] eq "CHILDSTATUS"} { set status [lindex $::errorCode 2] } else { # Some kind of unexpected failure } } .CE .PP When translating a command from a Unix shell invocation, care should be taken over the fact that single quote characters have no special significance to Tcl. Thus: .CS awk '{sum += $1} END {print sum}' numbers.list .CE would be translated into something like: .CS \fBexec\fR awk {{sum += $1} END {print sum}} numbers.list .CE .PP If you are converting invocations involving shell globbing, you should remember that Tcl does not handle globbing or expand things into multiple arguments by default. Instead you should write things like this: .CS eval [list \fBexec\fR ls -l] [glob *.tcl] .CE .PP .SH "WINDOWS EXAMPLES" Here are some examples of the use of the \fBexec\fR command on Windows. .PP To start an instance of \fInotepad\fR editing a file without waiting for the user to finish editing the file: .CS \fBexec\fR notepad myfile.txt & .CE .PP To print a text file using \fInotepad\fR: .CS \fBexec\fR notepad /p myfile.txt .CE .PP If a program calls other programs, such as is common with compilers, then you may need to resort to batch files to hide the console windows that sometimes pop up: .CS \fBexec\fR cmp.bat somefile.c -o somefile .CE With the file \fIcmp.bat\fR looking something like: .CS @gcc %1 %2 %3 %4 %5 %6 %7 %8 %9 .CE .PP Sometimes you need to be careful, as different programs may have the same name and be in the path. It can then happen that typing a command at the DOS prompt finds \fIa different program\fR than the same command run via \fBexec\fR. This is because of the (documented) differences in behaviour between \fBexec\fR and DOS batch files. .PP When in doubt, use the command \fBauto_execok\fR: it will return the complete path to the program as seen by the \fBexec\fR command. This applies especially when you want to run "internal" commands like \fIdir\fR from a Tcl script (if you just want to list filenames, use the \fBglob\fR command.) To do that, use this: .CS eval [list \fBexec\fR] [auto_execok dir] [list *.tcl] .CE .SH "SEE ALSO" error(n), open(n) .SH KEYWORDS execute, pipeline, redirection, subprocess

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

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

- + + + + + + + + + + + + + + + + + + + + + + +

'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: exit.n,v 1.3 2000/09/07 14:27:47 poenitz Exp $ '\" RCS: @(#) $Id: exit.n,v 1.3.18.1 2004/10/27 09:35:38 dkf Exp $ '\" .so man.macros .TH exit n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME exit \- End the application .SH SYNOPSIS \fBexit \fR?\fIreturnCode\fR? .BE .SH DESCRIPTION .PP Terminate the process, returning \fIreturnCode\fR to the system as the exit status. If \fIreturnCode\fR isn't specified then it defaults to 0. .SH EXAMPLE Since non-zero exit codes are usually interpreted as error cases by the calling process, the \fBexit\fR command is an important part of signalling that something fatal has gone wrong. This code fragment is useful in scripts to act as a general problem trap: .CS proc main {} { # ... put the real main code in here ... } if {[catch {main} msg]} { puts stderr "unexpected script error: $msg" if {[info exist env(DEBUG)]} { puts stderr "---- BEGIN TRACE ----" puts stderr $errorInfo puts stderr "---- END TRACE ----" } # Reserve code 1 for "expected" error exits... \fBexit\fR 2 } .CE .SH "SEE ALSO" exec(n), tclvars(n) .SH KEYWORDS exit, process

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	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	- + - +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-2000 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: expr.n,v 1.10 2003/01/03 23:03:22 dgp Exp $ '\" RCS: @(#) $Id: expr.n,v 1.10.2.2 2004/10/27 09:35:38 dkf Exp $ '\" .so man.macros .TH expr n 8.4 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME expr \- Evaluate an expression .SH SYNOPSIS \fBexpr \fIarg \fR?\fIarg arg ...\fR? .BE .SH DESCRIPTION .PP Concatenates \fIarg\fR's (adding separator spaces between them), Concatenates \fIarg\fRs (adding separator spaces between them), evaluates the result as a Tcl expression, and returns the value. The operators permitted in Tcl expressions are a subset of the operators permitted in C expressions, and they have the same meaning and precedence as the corresponding C operators. Expressions almost always yield numeric results (integer or floating-point values). For example, the expression
︙
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	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	- - + + + + - - + + + - + - + - + - + - + - - - + +	If an operand does not have one of the integer formats given above, then it is treated as a floating-point number if that is possible. Floating-point numbers may be specified in any of the ways accepted by an ANSI-compliant C compiler (except that the \fBf\fR, \fBF\fR, \fBl\fR, and \fBL\fR suffixes will not be permitted in most installations). For example, all of the following are valid floating-point numbers: 2.1, 3., 6e4, 7.91e+16. If no numeric interpretation is possible, then an operand is left as a string (and only a limited set of operators may be applied to If no numeric interpretation is possible (note that all literal operands that are not numeric or boolean must be quoted with either braces or with double quotes), then an operand is left as a string (and only a limited set of operators may be applied to it). it). .PP .VS 8.4 On 32-bit systems, integer values MAX_INT (0x7FFFFFFF) and MIN_INT (-0x80000000) will be represented as 32-bit values, and integer values outside that range will be represented as 64-bit values (if that is possible at all.) .VE 8.4 .PP Operands may be specified in any of the following ways: .IP [1] As an numeric value, either integer or floating-point. As a numeric value, either integer or floating-point. .IP [2] As a boolean value, using any form understood by \fBstring is boolean\fR. .IP [3] As a Tcl variable, using standard \fB$\fR notation. The variable's value will be used as the operand. .IP [3] .IP [4] As a string enclosed in double-quotes. The expression parser will perform backslash, variable, and command substitutions on the information between the quotes, and use the resulting value as the operand .IP [4] .IP [5] As a string enclosed in braces. The characters between the open brace and matching close brace will be used as the operand without any substitutions. .IP [5] .IP [6] As a Tcl command enclosed in brackets. The command will be executed and its result will be used as the operand. .IP [6] .IP [7] As a mathematical function whose arguments have any of the above forms for operands, such as \fBsin($x)\fR. See below for a list of defined functions. .LP Where substitutions occur above (e.g. inside quoted strings), they Where the above substitutions occur (e.g. inside quoted strings), they are performed by the expression's instructions. However, an additional layer of substitution may already have been performed by the command parser before the expression processor was called. However, the command parser may already have performed one round of substitution before the expression processor was called. As discussed below, it is usually best to enclose expressions in braces to prevent the command parser from performing substitutions on the contents. .PP For some examples of simple expressions, suppose the variable \fBa\fR has the value 3 and the variable \fBb\fR has the value 6.
︙
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128	111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130	- + - +	.CE .SH OPERATORS .PP The valid operators are listed below, grouped in decreasing order of precedence: .TP 20 \fB\-\0\0+\0\0~\0\0!\fR Unary minus, unary plus, bit-wise NOT, logical NOT. None of these operands Unary minus, unary plus, bit-wise NOT, logical NOT. None of these operators may be applied to string operands, and bit-wise NOT may be applied only to integers. .TP 20 \fB*\0\0/\0\0%\fR Multiply, divide, remainder. None of these operands may be Multiply, divide, remainder. None of these operators may be applied to string operands, and remainder may be applied only to integers. The remainder will always have the same sign as the divisor and an absolute value smaller than the divisor. .TP 20 \fB+\0\0\-\fR Add and subtract. Valid for any numeric operands.
︙
165 166 167 168 169 170 171 172 173 174 175 176 177 178 179	167 168 169 170 171 172 173 174 175 176 177 178 179 180 181	- +	Logical OR. Produces a 0 result if both operands are zero, 1 otherwise. Valid for boolean and numeric (integers or floating-point) operands only. .TP 20 \fIx\fB?\fIy\fB:\fIz\fR If-then-else, as in C. If \fIx\fR evaluates to non-zero, then the result is the value of \fIy\fR. Otherwise the result is the value of \fIz\fR. The \fIx\fR operand must have a numeric value. The \fIx\fR operand must have a boolean or numeric value. .LP See the C manual for more details on the results produced by each operator. All of the binary operators group left-to-right within the same precedence level. For example, the command .CS \fBexpr 4*2 < 7\fR
︙
190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211	192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214	- + + - +	only one of \fB[a]\fR or \fB[b]\fR will actually be evaluated, depending on the value of \fB$v\fR. Note, however, that this is only true if the entire expression is enclosed in braces; otherwise the Tcl parser will evaluate both \fB[a]\fR and \fB[b]\fR before invoking the \fBexpr\fR command. .SH "MATH FUNCTIONS" .PP Tcl supports the following mathematical functions in expressions: Tcl supports the following mathematical functions in expressions, all of which work solely with floating-point numbers unless otherwise noted: .DS .ta 3c 6c 9c \fBabs\fR \fBcosh\fR \fBlog\fR \fBsqrt\fR \fBacos\fR \fBdouble\fR \fBlog10\fR \fBsrand\fR \fBasin\fR \fBexp\fR \fBpow\fR \fBtan\fR \fBatan\fR \fBfloor\fR \fBrand\fR \fBtanh\fR \fBatan2\fR \fBfmod\fR \fBround\fR \fBatan2\fR \fBfmod\fR \fBround\fR \fBwide\fR \fBceil\fR \fBhypot\fR \fBsin\fR \fBcos\fR \fBint\fR \fBsinh\fR .DE .PP .TP \fBabs(\fIarg\fB)\fR Returns the absolute value of \fIarg\fR. \fIArg\fR may be either
︙
225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290	228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294	- + - - + + - + - + + - +	.TP \fBatan2(\fIy, x\fB)\fR Returns the arc tangent of \fIy\fR/\fIx\fR, in the range [\fI-pi\fR,\fIpi\fR] radians. \fIx\fR and \fIy\fR cannot both be 0. If \fIx\fR is greater than \fI0\fR, this is equivalent to \fBatan(\fIy/x\fB)\fR. .TP \fBceil(\fIarg\fB)\fR Returns the smallest integral floating point value (i.e. with a zero Returns the smallest integral floating-point value (i.e. with a zero fractional part) not less than \fIarg\fR. .TP \fBcos(\fIarg\fB)\fR Returns the cosine of \fIarg\fR, measured in radians. .TP \fBcosh(\fIarg\fB)\fR Returns the hyperbolic cosine of \fIarg\fR. If the result would cause an overflow, an error is returned. .TP \fBdouble(\fIarg\fB)\fR If \fIarg\fR is a floating value, returns \fIarg\fR, otherwise converts \fIarg\fR to floating and returns the converted value. If \fIarg\fR is a floating-point value, returns \fIarg\fR, otherwise converts \fIarg\fR to floating-point and returns the converted value. .TP \fBexp(\fIarg\fB)\fR Returns the exponential of \fIarg\fR, defined as \fIe\fR**\fIarg\fR. If the result would cause an overflow, an error is returned. .TP \fBfloor(\fIarg\fB)\fR Returns the largest integral floating point value (i.e. with a zero Returns the largest integral floating-point value (i.e. with a zero fractional part) not greater than \fIarg\fR. .TP \fBfmod(\fIx, y\fB)\fR Returns the floating-point remainder of the division of \fIx\fR by \fIy\fR. If \fIy\fR is 0, an error is returned. .TP \fBhypot(\fIx, y\fB)\fR Computes the length of the hypotenuse of a right-angled triangle \fBsqrt(\fIx\fR*\fIx\fR+\fIy\fR*\fIy\fB)\fR. .TP \fBint(\fIarg\fB)\fR .VS 8.4 If \fIarg\fR is an integer value, returns \fIarg\fR, otherwise If \fIarg\fR is an integer value of the same width as the machine word, returns \fIarg\fR, otherwise converts \fIarg\fR to an integer (of the same size as a machine word, i.e. 32-bits on 32-bit systems, and 64-bits on 64-bit systems) by truncation and returns the converted value. .VE 8.4 .TP \fBlog(\fIarg\fB)\fR Returns the natural logarithm of \fIarg\fR. \fIArg\fR must be a positive value. .TP \fBlog10(\fIarg\fB)\fR Returns the base 10 logarithm of \fIarg\fR. \fIArg\fR must be a positive value. .TP \fBpow(\fIx, y\fB)\fR Computes the value of \fIx\fR raised to the power \fIy\fR. If \fIx\fR is negative, \fIy\fR must be an integer value. .TP \fBrand()\fR Returns a pseudo-random floating point value in the range (\fI0\fR,\fI1\fR). Returns a pseudo-random floating-point value in the range (\fI0\fR,\fI1\fR). The generator algorithm is a simple linear congruential generator that is not cryptographically secure. Each result from \fBrand\fR completely determines all future results from subsequent calls to \fBrand\fR, so \fBrand\fR should not be used to generate a sequence of secrets, such as one-time passwords. The seed of the generator is initialized from the internal clock of the machine or may be set with the \fBsrand\fR function. .TP
︙
301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326	305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330	- + - - + +	.TP \fBsqrt(\fIarg\fB)\fR Returns the square root of \fIarg\fR. \fIArg\fR must be non-negative. .TP \fBsrand(\fIarg\fB)\fR The \fIarg\fR, which must be an integer, is used to reset the seed for the random number generator of \fBrand\fR. Returns the first random number from that seed. Each interpreter has its own seed. number (see \fBrand()\fR) from that seed. Each interpreter has its own seed. .TP \fBtan(\fIarg\fB)\fR Returns the tangent of \fIarg\fR, measured in radians. .TP \fBtanh(\fIarg\fB)\fR Returns the hyperbolic tangent of \fIarg\fR. .TP \fBwide(\fIarg\fB)\fR .VS 8.4 Converts \fIarg\fR to a value at least 64-bits wide (by sign-extension if \fIarg\fR is a 32-bit number.) Converts \fIarg\fR to an integer value at least 64-bits wide (by sign-extension if \fIarg\fR is a 32-bit number) if it is not one already. .VE 8.4 .PP In addition to these predefined functions, applications may define additional functions using \fBTcl_CreateMathFunc\fR(). .SH "TYPES, OVERFLOW, AND PRECISION" .PP All internal computations involving integers are done with the C type
︙
353 354 355 356 357 358 359 360 361 362 363 364 365 366 367	357 358 359 360 361 362 363 364 365 366 367 368 369 370	-	Floating-point values are always returned with a ``\fB.\fR'' or an \fBe\fR so that they will not look like integer values. For example, .CS \fBexpr 20.0/5.0\fR .CE returns \fB4.0\fR, not \fB4\fR. .SH "STRING OPERATIONS" .PP String values may be used as operands of the comparison operators, although the expression evaluator tries to do comparisons as integer or floating-point when it can, .VS 8.4 except in the case of the \fBeq\fR and \fBne\fR operators.
︙
414 415 416 417 418 419 420 421 422 423 424 425 426	417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471	+ + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - +	need two rounds of substitutions, the bytecode compiler must emit additional instructions to handle this situation. The most expensive code is required for unbraced expressions that contain command substitutions. These expressions must be implemented by generating new code each time the expression is executed. .SH EXAMPLES Define a procedure that computes an "interesting" mathematical function: .CS proc calc {x y} { \fBexpr\fR { ($x*$x - $y*$y) / exp($x*$x + $y*$y) } } .CE .PP Convert polar coordinates into cartesian coordinates: .CS # convert from ($radius,$angle) set x [\fBexpr\fR { $radius * cos($angle) }] set y [\fBexpr\fR { $radius * sin($angle) }] .CE .PP Convert cartesian coordinates into polar coordinates: .CS # convert from ($x,$y) set radius [\fBexpr\fR { hypot($y, $x) }] set angle [\fBexpr\fR { atan2($y, $x) }] .CE .PP Print a message describing the relationship of two string values to each other: .CS puts "a and b are [\fBexpr\fR {$a eq $b ? {equal} : {different}}]" .CE .PP Set a variable to whether an environment variable is both defined at all and also set to a true boolean value: .CS set isTrue [\fBexpr\fR { [info exists ::env(SOME_ENV_VAR)] && [string is true -strict $::env(SOME_ENV_VAR)] }] .CE .PP Generate a random integer in the range 0..99 inclusive: .CS set randNum [\fBexpr\fR { int(100 * rand()) }] .CE .SH "SEE ALSO" array(n), string(n), Tcl(n) array(n), for(n), if(n), string(n), Tcl(n), while(n) .SH KEYWORDS arithmetic, boolean, compare, expression, fuzzy comparison

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: fblocked.n,v 1.4 2001/09/14 19:20:40 andreas_kupries Exp $ '\" RCS: @(#) $Id: fblocked.n,v 1.4.8.1 2004/10/27 12:52:39 dkf Exp $ .so man.macros .TH fblocked n 7.5 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME fblocked \- Test whether the last input operation exhausted all available input .SH SYNOPSIS
︙
27 28 29 30 31 32 33 34 35 36 37 38 39	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	+ + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + - +	.PP .VS \fIChannelId\fR must be an identifier for an open channel such as a Tcl standard channel (\fBstdin\fR, \fBstdout\fR, or \fBstderr\fR), the return value from an invocation of \fBopen\fR or \fBsocket\fR, or the result of a channel creation command provided by a Tcl extension. .VE .SH EXAMPLE The \fBfblocked\fR command is particularly useful when writing network servers, as it allows you to write your code in a line-by-line style without preventing the servicing of other connections. This can be seen in this simple echo-service: .PP .CS # This is called whenever a new client connects to the server proc connect {chan host port} { set clientName [format <%s:%d> $host $port] puts "connection from $clientName" fconfigure $chan -blocking 0 -buffering line fileevent $chan readable [list echoLine $chan $clientName] } # This is called whenever either at least one byte of input # data is available, or the channel was closed by the client. proc echoLine {chan clientName} { gets $chan line if {[eof $chan]} { puts "finishing connection from $clientName" close $chan } elseif {![\fBfblocked\fR $chan]} { # Didn't block waiting for end-of-line puts "$clientName - $line" puts $chan $line } } # Create the server socket and enter the event-loop to wait # for incoming connections... socket -server connect 12345 vwait forever .CE .SH "SEE ALSO" gets(n), open(n), read(n), Tcl_StandardChannels(3) gets(n), open(n), read(n), socket(n), Tcl_StandardChannels(3) .SH KEYWORDS blocking, nonblocking

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1995-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: fconfigure.n,v 1.7 2002/07/01 18:24:39 jenglish Exp $ '\" RCS: @(#) $Id: fconfigure.n,v 1.7.2.3 2006/03/14 22:51:13 andreas_kupries Exp $ '\" .so man.macros .TH fconfigure n 8.3 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME fconfigure \- Set and get options on a channel
︙
161 162 163 164 165 166 167 168 169 170 171 172 173 174	161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181	+ + + + + + +	\fBbinary\fR . No end-of-line translations are performed. This is nearly identical to \fBlf\fP mode, except that in addition \fBbinary\fP mode also sets the end-of-file character to the empty string (which disables it) and sets the encoding to \fBbinary\fR (which disables encoding filtering). See the description of \fB\-eofchar\fR and \fB\-encoding\fR for more information. .PP .RS Internally, i.e. when it comes to the actual behaviour of the translator this value \fBis\fR identical to \fBlf\fR and is therefore reported as such when queried. Even if \fBbinary\fR was used to set the translation. .RE .TP \fBcr\fR . The end of a line in the underlying file or device is represented by a single carriage return character. As the input translation mode, \fBcr\fP mode converts carriage returns to newline characters. As the output translation mode, \fBcr\fP mode translates newline characters to
︙
188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407	195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279	- - - + + - - - - - - + - - - + - - - - - - - - - - + + - - + - - - - + - - - - - - - - - - + - - - + - - - - + - - - - + + - - - - - + - - + - - - - - - - - - - + - - + + - - + - - - - - - + + + + - - - - + + - - - - - - - - - + + - - + - - - - - - - - - - - - - - - + + + + + + + + + - - - + - - - - - - + + + + + + + + - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + - - - - - - - - - - - - - - + - - - - + + - - - - - - - - - - - - + + + - - - - - - + - - - - - - - + - - +	. The end of a line in the underlying file or device is represented by a single newline (linefeed) character. In this mode no translations occur during either input or output. This mode is typically used on UNIX platforms. .RE .PP .SH "STANDARD CHANNELS" .PP The Tcl standard channels (\fBstdin\fR, \fBstdout\fR, and \fBstderr\fR) can be configured through this command like every other channel opened by the Tcl library. Beyond the standard options described above they will also support any special option according to their current type. If, for example, a Tcl application is started by the \fBinet\fR super-server common on Unix system its Tcl standard channels will be sockets and thus support the socket options. .VS 8.4 .SH EXAMPLES Instruct Tcl to always send output to \fBstdout\fR immediately, .SH "SERIAL PORT CONFIGURATION OPTIONS" .PP If \fIchannelId\fR refers to a serial port, then the following additional configuration options are available on Windows and Unix systems with a POSIX serial interface: whether or not it is to a terminal: .TP \fB\-mode\fR \fIbaud\fB,\fIparity\fB,\fIdata\fB,\fIstop\fR . .CS This option is a set of 4 comma-separated values: the baud rate, parity, number of data bits, and number of stop bits for this serial port. The \fIbaud\fR rate is a simple integer that specifies the connection speed. \fIParity\fR is one of the following letters: \fBn\fR, \fBo\fR, \fBe\fR, \fBm\fR, \fBs\fR; respectively signifying the parity options of ``none'', ``odd'', ``even'', ``mark'', or ``space''. \fIData\fR is the number of data bits and should be an integer from 5 to 8, while \fIstop\fR is the number of stop bits and should be the integer 1 or 2. .TP \fBfconfigure\fR stdout -buffering none .CE \fB\-handshake\fR \fItype\fR . .PP (Windows and Unix). This option is used to setup automatic handshake control. Note that not all handshake types maybe supported by your operating system. The \fItype\fR parameter is case-independent. Open a socket and read lines from it without ever blocking the If \fItype\fR is \fBnone\fR then any handshake is switched off. \fBrtscts\fR activates hardware handshake. Hardware handshake signals are described below. For software handshake \fBxonxoff\fR the handshake characters can be redefined with \fB-xchar\fR. An additional hardware handshake \fBdtrdsr\fR is available only under Windows. There is no default handshake configuration, the initial value depends on your operating system settings. The \fB-handshake\fR option cannot be queried. processing of other events: .TP \fB\-queue\fR . .CS (Windows and Unix). The \fB-queue\fR option can only be queried. It returns a list of two integers representing the current number of bytes in the input and output queue respectively. set s [socket some.where.com 12345] .TP \fB\-timeout\fR \fImsec\fR . (Windows and Unix). This option is used to set the timeout for blocking \fBfconfigure\fR $s -blocking 0 fileevent $s readable "readMe $s" read operations. It specifies the maximum interval between the reception of two bytes in milliseconds. For Unix systems the granularity is 100 milliseconds. The \fB-timeout\fR option does not affect write operations or nonblocking reads. proc readMe chan { This option cannot be queried. if {[gets $chan line] < 0} { .TP \fB\-ttycontrol\fR \fI{signal boolean signal boolean ...}\fR . (Windows and Unix). This option is used to setup the handshake output lines (see below) permanently or to send a BREAK over the serial line. The \fIsignal\fR names are case-independent. \fB{RTS 1 DTR 0}\fR sets the RTS output to high and the DTR output to low. The BREAK condition (see below) is enabled and disabled with \fB{BREAK 1}\fR and \fB{BREAK 0}\fR respectively. It's not a good idea to change the \fBRTS\fR (or \fBDTR\fR) signal if {[eof $chan]} { with active hardware handshake \fBrtscts\fR (or \fBdtrdsr\fR). The result is unpredictable. close $chan return The \fB-ttycontrol\fR option cannot be queried. } .TP \fB\-ttystatus\fR . (Windows and Unix). The \fB-ttystatus\fR option can only be queried. It returns the current modem status and handshake input signals (see below). # Could not read a complete line this time; Tcl's # internal buffering will hold the partial line for us # until some more data is available over the socket. } else { The result is a list of signal,value pairs with a fixed order, e.g. \fB{CTS 1 DSR 0 RING 1 DCD 0}\fR. The \fIsignal\fR names are returned upper case. puts stdout $line } .TP \fB\-xchar\fR \fI{xonChar xoffChar}\fR . (Windows and Unix). This option is used to query or change the software handshake characters. Normally the operating system default should be DC1 (0x11) and DC3 (0x13) representing the ASCII standard XON and XOFF characters. .TP } .CE \fB\-pollinterval\fR \fImsec\fR . .PP (Windows only). This option is used to set the maximum time between polling for fileevents. This affects the time interval between checking for events throughout the Tcl interpreter (the smallest value always wins). Use this option only if you want to poll the serial port more or less often than 10 msec (the default). .TP \fB\-sysbuffer\fR \fIinSize\fR .TP \fB\-sysbuffer\fR \fI{inSize outSize}\fR . (Windows only). This option is used to change the size of Windows system buffers for a serial channel. Especially at higher communication rates the default input buffer size of 4096 bytes can overrun Read a PPM-format image from a file: .CS # Open the file and put it into Unix ASCII mode set f [open teapot.ppm] \fBfconfigure\fR $f \-encoding ascii \-translation lf # Get the header if {[gets $f] ne "P6"} { error "not a raw\-bits PPM" for latent systems. The first form specifies the input buffer size, in the second form both input and output buffers are defined. } .TP \fB\-lasterror\fR . (Windows only). This option is query only. In case of a serial communication error, \fBread\fR or \fBputs\fR returns a general Tcl file I/O error. # Read lines until we have got non-comment lines # that supply us with three decimal values. set words {} while {[llength $words] < 3} { gets $f line if {[string match "#*" $line]} continue lappend words [eval concat [scan $line %d%d%d]] \fBfconfigure -lasterror\fR can be called to get a list of error details. See below for an explanation of the various error codes. } .SH "SERIAL PORT SIGNALS" .PP RS-232 is the most commonly used standard electrical interface for serial communications. A negative voltage (-3V..-12V) define a mark (on=1) bit and a positive voltage (+3..+12V) define a space (off=0) bit (RS-232C). The following signals are specified for incoming and outgoing data, status lines and handshaking. Here we are using the terms \fIworkstation\fR for your computer and \fImodem\fR for the external device, because some signal names (DCD, RI) come from modems. Of course your external device may use these signal lines for other purposes. .RS .IP \fBTXD(output)\fR \fBTransmitted Data:\fR Outgoing serial data. .IP \fBRXD(input)\fR \fBReceived Data:\fRIncoming serial data. .IP \fBRTS(output)\fR \fBRequest To Send:\fR This hardware handshake line informs the modem that your workstation is ready to receive data. Your workstation may automatically reset this signal to indicate that the input buffer is full. .IP \fBCTS(input)\fR \fBClear To Send:\fR The complement to RTS. Indicates that the modem is ready to receive data. .IP \fBDTR(output)\fR \fBData Terminal Ready:\fR This signal tells the modem that the workstation is ready to establish a link. DTR is often enabled automatically whenever a serial port is opened. .IP \fBDSR(input)\fR \fBData Set Ready:\fR The complement to DTR. Tells the workstation that the modem is ready to establish a link. .IP \fBDCD(input)\fR \fBData Carrier Detect:\fR This line becomes active when a modem detects a "Carrier" signal. # Those words supply the size of the image and its # overall depth per channel. Assign to variables. foreach {xSize ySize depth} $words {break} .IP \fBRI(input)\fR \fBRing Indicator:\fR Goes active when the modem detects an incoming call. .IP \fBBREAK\fR A BREAK condition is not a hardware signal line, but a logical zero on the TXD or RXD lines for a long period of time, usually 250 to 500 milliseconds. Normally a receive or transmit data signal stays at the mark (on=1) voltage until the next character is transferred. A BREAK is sometimes used to reset the communications line or change the operating mode of communications hardware. .RE .SH "ERROR CODES (Windows only)" .PP A lot of different errors may occur during serial read operations or during event polling in background. The external device may have been switched # Now switch to binary mode to pull in the data, off, the data lines may be noisy, system buffers may overrun or your mode settings may be wrong. That's why a reliable software should always \fBcatch\fR serial read operations. In cases of an error Tcl returns a general file I/O error. Then \fBfconfigure -lasterror\fR may help to # one byte per channel (red,green,blue) per pixel. \fBfconfigure\fR $f \-translation binary locate the problem. The following error codes may be returned. .RS .IP \fBRXOVER:\fR Windows input buffer overrun. The data comes faster than your scripts reads it or your system is overloaded. Use \fBfconfigure -sysbuffer\fR to avoid a temporary bottleneck and/or make your script faster. .IP \fBTXFULL\fR Windows output buffer overrun. Complement to RXOVER. This error should practically not happen, because Tcl cares about the output buffer status. .IP \fBOVERRUN\fR UART buffer overrun (hardware) with data lost. The data comes faster than the system driver receives it. set numDataBytes [expr {3 * $xSize * $ySize}] set data [read $f $numDataBytes] Check your advanced serial port settings to enable the FIFO (16550) buffer and/or setup a lower(1) interrupt threshold value. .IP \fBRXPARITY\fR A parity error has been detected by your UART. Wrong parity settings with \fBfconfigure -mode\fR or a noisy data line (RXD) may cause this error. close $f .IP \fBFRAME\fR A stop-bit error has been detected by your UART. Wrong mode settings with \fBfconfigure -mode\fR or a noisy data line (RXD) may cause this error. .IP \fBBREAK\fR A BREAK condition has been detected by your UART (see above). .RE .CE .VE .SH "SEE ALSO" close(n), flush(n), gets(n), puts(n), read(n), socket(n), close(n), flush(n), gets(n), open(n), puts(n), read(n), socket(n), Tcl_StandardChannels(3) .SH KEYWORDS blocking, buffering, carriage return, end of line, flushing, linemode, newline, nonblocking, platform, translation, encoding, filter, byte array, binary

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-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. '\" '\" RCS: @(#) $Id: fcopy.n,v 1.3 2001/05/19 16:59:04 andreas_kupries Exp $ '\" RCS: @(#) $Id: fcopy.n,v 1.3.14.1 2007/01/29 16:50:35 dgp Exp $ '\" .so man.macros .TH fcopy n 8.0 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME fcopy \- Copy data from one channel to another.
︙
111 112 113 114 115 116 117 118 119 120 121 122 123 124 125	111 112 113 114 115 116 117 118 119 120 121 122 123 124 125	- +	.PP The second example copies in chunks and tests for end of file in the command callback .DS proc CopyMore {in out chunk bytes {error {}}} { global total done incr total $bytes if {([string length $error] != 0) || [eof $in] { if {([string length $error] != 0) || [eof $in]} { set done $total close $in close $out } else { fcopy $in $out -command [list CopyMore $in $out $chunk] \\ -size $chunk }
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: file.n,v 1.23 2003/02/28 12:11:49 vincentdarley Exp $ '\" RCS: @(#) $Id: file.n,v 1.23.2.3 2006/12/04 09:12:02 dkf Exp $ '\" .so man.macros .TH file n 8.3 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME file \- Manipulate file names and attributes
︙
97 98 99 100 101 102 103 104 105 106 107 108 109 110 111	97 98 99 100 101 102 103 104 105 106 107 108 109 110 111	- +	\fItargetDir\fR of each \fIsource\fR file listed. If a directory is specified as a \fIsource\fR, then the contents of the directory will be recursively copied into \fItargetDir\fR. Existing files will not be overwritten unless the \fB\-force\fR option is specified. When copying within a single filesystem, \fIfile copy\fR will copy soft links (i.e. the links themselves are copied, not the things they point to). Trying to overwrite a non-empty directory, overwrite a directory with a file, or a file with a directory will all result in errors even if or overwrite a file with a directory will all result in errors even if \fI\-force\fR was specified. Arguments are processed in the order specified, halting at the first error, if any. A \fB\-\|\-\fR marks the end of switches; the argument following the \fB\-\|\-\fR will be treated as a \fIsource\fR even if it starts with a \fB\-\fR. .RE .TP \fBfile delete \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIpathname\fR ?\fIpathname\fR ... ?
︙
196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211	196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211	- - + +	If only one argument is given, that argument is assumed to be \fIlinkName\fR, and this command returns the value of the link given by \fIlinkName\fR (i.e. the name of the file it points to). If \fIlinkName\fR isn't a link or its value cannot be read (as, for example, seems to be the case with hard links, which look just like ordinary files), then an error is returned. . If 2 arguments are given, then these are assumed to be \fIlinkName\fR and \fItarget\fR. If \fIlinkName\fR already exists, or if \fItarget\fR If 2 arguments are given, then these are assumed to be \fIlinkName\fR and \fItarget\fR. If \fIlinkName\fR already exists, or if \fItarget\fR doesn't exist, an error will be returned. Otherwise, Tcl creates a new link called \fIlinkName\fR which points to the existing filesystem object at \fItarget\fR, where the type of the link is platform-specific (on Unix a symbolic link will be the default). This is useful for the case where the user wishes to create a link in a cross-platform way, and doesn't care what type of link is created. .
︙
254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296	254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296	- + - + - +	Returns the platform-specific name of the file. This is useful if the filename is needed to pass to a platform-specific call, such as exec under Windows or AppleScript on the Macintosh. .TP \fBfile normalize \fIname\fR . .RS Returns a unique normalised path representation for the file-system Returns a unique normalized path representation for the file-system object (file, directory, link, etc), whose string value can be used as a unique identifier for it. A normalized path is an absolute path which has all '../', './' removed. Also it is one which is in the ``standard'' format for the native platform. On MacOS, Unix, this means the segments leading up to the path must be free of symbolic links/aliases (but the very last path component may be a symbolic link), and on Windows it also means means we want the long form with that form's case-dependence (which means we want the long form with that form's case-dependence (which gives us a unique, case-dependent path). The one exception concerning the last link in the path is necessary, because Tcl or the user may wish to operate on the actual symbolic link itself (for example 'file delete', 'file rename', 'file copy' are defined to operate on symbolic links, not on the things that they point to). .RE .TP \fBfile owned \fIname\fR . Returns \fB1\fR if file \fIname\fR is owned by the current user, \fB0\fR otherwise. .TP \fBfile pathtype \fIname\fR . Returns one of \fBabsolute\fR, \fBrelative\fR, \fBvolumerelative\fR. If \fIname\fR refers to a specific file on a specific volume, the path type will be \fBabsolute\fR. If \fIname\fR refers to a file relative to the current working directory, then the path type will be \fBrelative\fR. If \fIname\fR refers to a file relative to the current working directory on a specified volume, or to a specific file on the current working volume, then the file type is \fBvolumerelative\fR. the path type is \fBvolumerelative\fR. .TP \fBfile readable \fIname\fR . Returns \fB1\fR if file \fIname\fR is readable by the current user, \fB0\fR otherwise. .TP \fBfile readlink \fIname\fR
︙
414 415 416 417 418 419 420 421 422 423 424 425 426 427	414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	\fB0\fR otherwise. .SH "PORTABILITY ISSUES" .TP \fBUnix\fR\0\0\0\0\0\0\0 . These commands always operate using the real user and group identifiers, not the effective ones. .SH EXAMPLES This procedure shows how to search for C files in a given directory that have a correspondingly-named object file in the current directory: .CS proc findMatchingCFiles {dir} { set files {} switch $::tcl_platform(platform) { windows { set ext .obj } unix { set ext .o } } foreach file [glob -nocomplain -directory $dir *.c] { set objectFile [\fBfile tail\fR [\fBfile rootname\fR $file]]$ext if {[\fBfile exists\fR $objectFile]} { lappend files $file } } return $files } .CE .PP Rename a file and leave a symbolic link pointing from the old location to the new place: .CS set oldName foobar.txt set newName foo/bar.txt # Make sure that where we're going to move to exists... if {![\fBfile isdirectory\fR [\fBfile dirname\fR $newName]]} { \fBfile mkdir\fR [\fBfile dirname\fR $newName] } \fBfile rename\fR $oldName $newName \fBfile link\fR -symbolic $oldName $newName .CE .SH "SEE ALSO" filename(n), open(n), close(n), eof(n), gets(n), tell(n), seek(n), fblocked(n), flush(n) .SH KEYWORDS attributes, copy files, delete files, directory, file, move files, name, rename files, stat

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1994 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: fileevent.n,v 1.5 2001/09/27 05:50:56 andreas_kupries Exp $ '\" RCS: @(#) $Id: fileevent.n,v 1.5.6.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH fileevent n 7.5 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME fileevent \- Execute a script when a channel becomes readable or writable
︙
96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129	96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126	- - + + - + - + - + - - -	context of any Tcl procedure) in the interpreter in which the \fBfileevent\fR command was invoked. If an error occurs while executing the script then the \fBbgerror\fR mechanism is used to report the error. In addition, the file event handler is deleted if it ever returns an error; this is done in order to prevent infinite loops due to buggy handlers. .SH EXAMPLE .PP In this setup \fBGetData\fR will be called with the channel as an argument whenever $chan becomes readable. .CS proc GetData {chan} { proc GetData {chan} { if {![eof $chan]} { puts [gets $chan] } } } fileevent $chan readable [list GetData $chan] \fBfileevent\fR $chan readable [list GetData $chan] .CE In this setup \fBGetData\fR will be called with the channel as an argument whenever $chan becomes readable. .SH CREDITS .PP \fBfileevent\fR is based on the \fBaddinput\fR command created by Mark Diekhans. .SH "SEE ALSO" bgerror(n), fconfigure(n), gets(n), puts(n), read(n), Tcl_StandardChannels(3) .SH KEYWORDS asynchronous I/O, blocking, channel, event handler, nonblocking, readable, script, writable.

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1995-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: filename.n,v 1.7 2001/09/04 18:06:34 vincentdarley Exp $ '\" RCS: @(#) $Id: filename.n,v 1.7.12.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH filename n 7.5 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME filename \- File name conventions supported by Tcl commands
︙
204 205 206 207 208 209 210 211 212 213 214 215 216 217	204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224	- + + + + + + + +	alphanumeric characters only. Also Windows 3.1 only supports file names with a root of no more than 8 characters and an extension of no more than 3 characters. .PP On Windows platforms there are file and path length restrictions. Complete paths or filenames longer than about 260 characters will lead to errors in most file operations. .PP Another Windows peculiarity is that any number of trailing dots '.' in filenames are totally ignored, so, for example, attempts to create a file or directory with a name "foo." will result in the creation of a file/directory with name "foo". This fact is reflected in the results of 'file normalize'. Furthermore, a file name consisting only of dots '.........' or dots with trailing characters '.....abc' is illegal. .SH KEYWORDS current directory, absolute file name, relative file name, volume-relative file name, portability .SH "SEE ALSO" file(n), glob(n)

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: flush.n,v 1.4 2001/09/14 19:20:40 andreas_kupries Exp $ '\" RCS: @(#) $Id: flush.n,v 1.4.8.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH flush n 7.5 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME flush \- Flush buffered output for a channel
︙
30 31 32 33 34 35 36 37 38 39 40 41 42	30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50	+ + + + + + + +	.VE .PP If the channel is in blocking mode the command does not return until all the buffered output has been flushed to the channel. If the channel is in nonblocking mode, the command may return before all buffered output has been flushed; the remainder will be flushed in the background as fast as the underlying file or device is able to absorb it. .SH EXAMPLE Prompt for the user to type some information in on the console: .CS puts -nonewline "Please type your name: " \fBflush\fR stdout gets stdin name puts "Hello there, $name!" .CE .SH "SEE ALSO" file(n), open(n), socket(n), Tcl_StandardChannels(3) .SH KEYWORDS blocking, buffer, channel, flush, nonblocking, output

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-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. '\" '\" RCS: @(#) $Id: for.n,v 1.3 2000/09/07 14:27:48 poenitz Exp $ '\" RCS: @(#) $Id: for.n,v 1.3.18.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH for n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME for \- ``For'' loop
︙
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63	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	- - + + + - + + + + + + + + + + + + + + + + + + + + +	variable substitutions will be made before the \fBfor\fR command starts executing, which means that variable changes made by the loop body will not be considered in the expression. This is likely to result in an infinite loop. If \fItest\fR is enclosed in braces, variable substitutions are delayed until the expression is evaluated (before each loop iteration), so changes in the variables will be visible. For an example, try the following script with and without the braces around \fB$x<10\fR: See below for an example: .SH EXAMPLES Print a line for each of the integers from 0 to 10: .CS for {set x 0} {$x<10} {incr x} { puts "x is $x" puts "x is $x" } .CE .PP Either loop infinitely or not at all because the expression being evaluated is actually the constant, or even generate an error! The actual behaviour will depend on whether the variable \fIx\fR exists before the \fBfor\fR command is run and whether its value is a value that is less than or greater than/equal to ten, and this is because the expression will be substituted before the \fBfor\fR command is executed. .CS for {set x 0} $x<10 {incr x} { puts "x is $x" } .CE .PP Print out the powers of two from 1 to 1024: .CS for {set x 1} {$x<=1024} {set x [expr {$x * 2}]} { puts "x is $x" } .CE .SH "SEE ALSO" break, continue, foreach, while .SH KEYWORDS for, iteration, looping

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: foreach.n,v 1.3 2000/09/07 14:27:48 poenitz Exp $ '\" RCS: @(#) $Id: foreach.n,v 1.3.18.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH foreach n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME foreach \- Iterate over all elements in one or more lists
︙
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	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	- + - + - +	command. \fBForeach\fR returns an empty string. .SH EXAMPLES .PP The following loop uses i and j as loop variables to iterate over pairs of elements of a single list. .DS set x {} foreach {i j} {a b c d e f} { \fBforeach\fR {i j} {a b c d e f} { lappend x $j $i } # The value of x is "b a d c f e" # There are 3 iterations of the loop. .DE .PP The next loop uses i and j to iterate over two lists in parallel. .DS set x {} foreach i {a b c} j {d e f g} { \fBforeach\fR i {a b c} j {d e f g} { lappend x $i $j } # The value of x is "a d b e c f {} g" # There are 4 iterations of the loop. .DE .PP The two forms are combined in the following example. .DS set x {} foreach i {a b c} {j k} {d e f g} { \fBforeach\fR i {a b c} {j k} {d e f g} { lappend x $i $j $k } # The value of x is "a d e b f g c {} {}" # There are 3 iterations of the loop. .DE .SH "SEE ALSO" for(n), while(n), break(n), continue(n) .SH KEYWORDS foreach, iteration, list, looping

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	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	- + -	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: format.n,v 1.7 2002/02/19 10:26:24 dkf Exp $ '\" RCS: @(#) $Id: format.n,v 1.7.2.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH format n 8.1 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME format \- Format a string in the style of sprintf .SH SYNOPSIS \fBformat \fIformatString \fR?\fIarg arg ...\fR? .BE .SH INTRODUCTION .PP This command generates a formatted string in the same way as the ANSI C \fBsprintf\fR procedure (it uses \fBsprintf\fR in its implementation). \fIFormatString\fR indicates how to format the result, using \fB%\fR conversion specifiers as in \fBsprintf\fR, and the additional arguments, if any, provide values to be substituted into the result. The return value from \fBformat\fR is the formatted string. .SH "DETAILS ON FORMATTING" .PP The command operates by scanning \fIformatString\fR from left to right. Each character from the format string is appended to the result string unless it is a percent sign. If the character is a \fB%\fR then it is not copied to the result string. Instead, the characters following the \fB%\fR character are treated as
︙
129 130 131 132 133 134 135 136 137 138 139 140 141 142 143	128 129 130 131 132 133 134 135 136 137 138 139 140 141 142	- +	The fifth part of a conversion specifier is a length modifier, which must be \fBh\fR or \fBl\fR. If it is \fBh\fR it specifies that the numeric value should be truncated to a 16-bit value before converting. This option is rarely useful. .VS 8.4 If it is \fBl\fR it specifies that the numeric value should be (at least) a 64-bit value. If neither \fBh\fR or \fBl\fR are present, least) a 64-bit value. If neither \fBh\fR nor \fBl\fR are present, numeric values are interpreted as being values of the width of the native machine word, as described by \fBtcl_platform(wordSize)\fR. .VE .PP The last thing in a conversion specifier is an alphabetic character that determines what kind of conversion to perform. The following conversion characters are currently supported:
︙
192 193 194 195 196 197 198 199 200 201 202 203 204 205 206	191 192 193 194 195 196 197 198 199 200 201 202 203 204	-	\fB%\fR No conversion: just insert \fB%\fR. .LP For the numerical conversions the argument being converted must be an integer or floating-point string; format converts the argument to binary and then converts it back to a string according to the conversion specifier. .SH "DIFFERENCES FROM ANSI SPRINTF" .PP The behavior of the format command is the same as the ANSI C \fBsprintf\fR procedure except for the following differences: .IP [1] \fB%p\fR and \fB%n\fR specifiers are not currently supported.
︙
214 215 216 217 218 219 220 221 222 223 224 225 226	212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - +	converted as if the \fBl\fR modifier were present (i.e. the types \fBdouble\fR and \fBlong\fR are used for the internal representation of real and integer values, respectively). .VE 8.4 If the \fBh\fR modifier is specified then integer values are truncated to \fBshort\fR before conversion. Both \fBh\fR and \fBl\fR modifiers are ignored on all other conversions. .SH EXAMPLES Convert the output of \fBtime\fR into seconds to an accuracy of hundredths of a second: .CS set us [lindex [time $someTclCode] 0] puts [\fBformat\fR "%.2f seconds to execute" [expr {$us / 1e6}]] .CE .PP Create a packed X11 literal color specification: .CS # Each color-component should be in range (0..255) set color [\fBformat\fR "#%02x%02x%02x" $r $g $b] .CE .PP Use XPG3 format codes to allow reordering of fields (a technique that is often used in localized message catalogs; see \fBmsgcat\fR) without reordering the data values passed to \fBformat\fR: .CS set fmt1 "Today, %d shares in %s were bought at $%.2f each" puts [\fBformat\fR $fmt1 123 "Global BigCorp" 19.37] set fmt2 "Bought %2\\$s equity ($%3$.2f x %1\\$d) today" puts [\fBformat\fR $fmt2 123 "Global BigCorp" 19.37] .CE .PP Print a small table of powers of three: .CS # Set up the column widths set w1 5 set w2 10 # Make a nice header (with separator) for the table first set sep +-[string repeat - $w1]-+-[string repeat - $w2]-+ puts $sep puts [\fBformat\fR "| %-*s | %-*s |" $w1 "Index" $w2 "Power"] puts $sep # Print the contents of the table set p 1 for {set i 0} {$i<=20} {incr i} { puts [\fBformat\fR "| %*d | %*ld |" $w1 $i $w2 $p] set p [expr {wide($p) * 3}] } # Finish off by printing the separator again puts $sep .CE .SH "SEE ALSO" sprintf(3), string(n) scan(n), sprintf(3), string(n) .SH KEYWORDS conversion specifier, format, sprintf, string, substitution

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: gets.n,v 1.4 2001/09/14 19:20:40 andreas_kupries Exp $ '\" RCS: @(#) $Id: gets.n,v 1.4.8.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH gets n 7.5 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME gets \- Read a line from a channel
︙
47 48 49 50 51 52 53 54 55 56 57 58 59	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	+ + + + + + + + + + + +	data in nonblocking mode, then the return count is -1. Note that if \fIvarName\fR is not specified then the end-of-file and no-full-line-available cases can produce the same results as if there were an input line consisting only of the end-of-line character(s). The \fBeof\fR and \fBfblocked\fR commands can be used to distinguish these three cases. .SH "EXAMPLE" This example reads a file one line at a time and prints it out with the current line number attached to the start of each line. .PP .CS set chan [open "some.file.txt"] set lineNumber 0 while {[\fBgets\fR $chan line] >= 0} { puts "[incr lineNumber]: $line" } close $chan .CE .SH "SEE ALSO" file(n), eof(n), fblocked(n), Tcl_StandardChannels(3) .SH KEYWORDS blocking, channel, end of file, end of line, line, nonblocking, read

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: glob.n,v 1.12 2002/07/01 18:24:39 jenglish Exp $ '\" RCS: @(#) $Id: glob.n,v 1.12.2.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH glob n 8.3 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME glob \- Return names of files that match patterns
︙
74 75 76 77 78 79 80 81 82 83 84 85 86 87	74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90	+ + +	\fIc\fR (character special file), \fId\fR (directory), \fIf\fR (plain file), \fIl\fR (symbolic link), \fIp\fR (named pipe), or \fIs\fR (socket), where multiple types may be specified in the list. \fBGlob\fR will return all files which match at least one of the types given. Note that symbolic links will be returned both if \fB\-types l\fR is given, or if the target of a link matches the requested type. So, a link to a directory will be returned if \fB\-types d\fR was specified. .RS .PP The second form specifies types where all the types given must match. These are \fIr\fR, \fIw\fR, \fIx\fR as file permissions, and \fIreadonly\fR, \fIhidden\fR as special permission cases. On the Macintosh, MacOS types and creators are also supported, where any item which is four characters long is assumed to be a MacOS type
︙
145 146 147 148 149 150 151 152 153 154 155 156 157 158 159	148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168	- + + + + + + +	.LP The \fBglob\fR command differs from csh globbing in two ways. First, it does not sort its result list (use the \fBlsort\fR command if you want the list sorted). Second, \fBglob\fR only returns the names of files that actually exist; in csh no check for existence is made unless a pattern contains a ?, *, or [] construct. .LP When the \fBglob\fR command returns relative paths whose filenames start with a tilde ``~'' (for example through \fBglob *\fR or \fBglob -tails\fR, the returned list will not quote the tilde with ``./''. This means care must be taken if those names are later to be used with \fBfile join\fR, to avoid them being interpreted as absolute paths pointing to a given user's home directory. .SH "PORTABILITY ISSUES" .PP Unlike other Tcl commands that will accept both network and native style names (see the \fBfilename\fR manual entry for details on how native and network names are specified), the \fBglob\fR command only accepts native names. .TP
︙
180 181 182 183 184 185 186 187 188 189 190 191 192	189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222	+ + + + + + + + + + + + + + + + + + + + +	.TP \fBMacintosh\fR . When using the options, \fB\-directory\fR, \fB\-join\fR or \fB\-path\fR, glob assumes the directory separator for the entire pattern is the standard ``:''. When not using these options, glob examines each pattern argument and uses ``/'' unless the pattern contains a ``:''. .SH EXAMPLES Find all the Tcl files in the current directory: .CS \fBglob\fR *.tcl .CE .PP Find all the Tcl files in the user's home directory, irrespective of what the current directory is: .CS \fBglob\fR \-directory ~ *.tcl .CE .PP Find all subdirectories of the current directory: .CS \fBglob\fR \-type d * .CE .PP Find all files whose name contains an "a", a "b" or the sequence "cde": .CS \fBglob\fR \-type f *{a,b,cde}* .CE .SH "SEE ALSO" file(n) .SH KEYWORDS exist, file, glob, pattern

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

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

- + - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + +

'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-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. '\" '\" RCS: @(#) $Id: global.n,v 1.4 2002/06/11 13:22:35 msofer Exp $ '\" RCS: @(#) $Id: global.n,v 1.4.2.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH global n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME global \- Access global variables .SH SYNOPSIS \fBglobal \fIvarname \fR?\fIvarname ...\fR? .BE .SH DESCRIPTION .PP This command is ignored unless a Tcl procedure is being interpreted. If so then it declares the given \fIvarname\fR's to be global variables rather than local ones. Global variables are variables in the global namespace. For the duration of the current procedure (and only while executing in the current procedure), any reference to any of the \fIvarname\fRs will refer to the global variable by the same name. This command has no effect unless executed in the context of a proc body. If the \fBglobal\fR command is executed in the context of a proc body, it creates local variables linked to the corresponding global variables (and therefore these variables are listed by info locals). .PP If \fIvarname\fR contains namespace qualifiers, the local variable's name is the unqualified name of the global variable, as determined by the \fBnamespace tail\fR command. .SH EXAMPLES This procedure sets the namespace variable \fI::a::x\fR .CS proc reset {} { \fBglobal\fR a::x set x 0 } .CE .PP This procedure accumulates the strings passed to it in a global buffer, separated by newlines. It is useful for situations when you want to build a message piece-by-piece (as if with \fBputs\fR) but send that full message in a single piece (e.g. over a connection opened with \fBsocket\fR or as part of a counted HTTP response). .CS proc accum {string} { \fBglobal\fR accumulator append accumulator $string \\n } .CE .SH "SEE ALSO" namespace(n), upvar(n), variable(n) .SH KEYWORDS global, namespace, procedure, variable

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-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. '\" '\" RCS: @(#) $Id: history.n,v 1.2 1998/09/14 18:39:53 stanton Exp $ '\" RCS: @(#) $Id: history.n,v 1.2.40.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH history n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME history \- Manipulate the history list
︙
78 79 80 81 82 83 84 85 86 87 88 89 90 91 92	78 79 80 81 82 83 84 85 86 87 88 89 90 91 92	- +	.TP \fBhistory nextid\fR Returns the number of the next event to be recorded in the history list. It is useful for things like printing the event number in command-line prompts. .TP \fBhistory redo \fR?\fIevent\fR? Re-executes the command indicated by \fIevent\fR and return its result. Re-executes the command indicated by \fIevent\fR and returns its result. \fIEvent\fR defaults to \fB\-1\fR. This command results in history revision: see below for details. .SH "HISTORY REVISION" .PP Pre-8.0 Tcl had a complex history revision mechanism. The current mechanism is more limited, and the old history operations \fBsubstitute\fP and \fBwords\fP have been removed.
︙

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	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	+ - + - + - + - + - +	'\" '\" Copyright (c) 1995-1997 Sun Microsystems, Inc. '\" Copyright (c) 1998-2000 by Ajuba Solutions. '\" Copyright (c) 2004 ActiveState Corporation. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: http.n,v 1.18 2002/07/23 18:17:12 jenglish Exp $ '\" RCS: @(#) $Id: http.n,v 1.18.2.3 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH "http" n 2.4 http "Tcl Bundled Packages" .TH "http" n 2.5 http "Tcl Bundled Packages" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME http \- Client-side implementation of the HTTP/1.0 protocol. .SH SYNOPSIS \fBpackage require http ?2.4?\fR \fBpackage require http ?2.5?\fR .sp \fB::http::config \fI?options?\fR .sp \fB::http::geturl \fIurl ?options?\fR .sp \fB::http::formatQuery \fIlist\fR \fB::http::formatQuery\fP \fIkey value\fP ?\fIkey value\fP ...? .sp \fB::http::reset \fItoken\fR \fB::http::reset\fP \fItoken\fP ?\fIwhy\fP? .sp \fB::http::wait \fItoken\fR .sp \fB::http::status \fItoken\fR .sp \fB::http::size \fItoken\fR .sp
︙
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64	51 52 53 54 55 56 57 58 59 60 61 62 63 64 65	- +	The \fBhttp\fR package provides the client side of the HTTP/1.0 protocol. The package implements the GET, POST, and HEAD operations of HTTP/1.0. It allows configuration of a proxy host to get through firewalls. The package is compatible with the \fBSafesock\fR security policy, so it can be used by untrusted applets to do URL fetching from a restricted set of hosts. This package can be extended to support additional HTTP transport protocols, such as HTTPS, by providing a custom \fBsocket\fR command, via \fBhttp::register\fR. a custom \fBsocket\fR command, via \fB::http::register\fR. .PP The \fB::http::geturl\fR procedure does a HTTP transaction. Its \fIoptions \fR determine whether a GET, POST, or HEAD transaction is performed. The return value of \fB::http::geturl\fR is a token for the transaction. The value is also the name of an array in the ::http namespace that contains state information about the transaction. The elements
︙
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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143	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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153	- + - + + + + + + + + + + - + - +	that setting is returned. Otherwise, the options should be a set of flags and values that define the configuration: .RS .TP \fB\-accept\fP \fImimetypes\fP The Accept header of the request. The default is */*, which means that all types of documents are accepted. Otherwise you can supply a comma separated list of mime type patterns that you are comma-separated list of mime type patterns that you are willing to receive. For example, "image/gif, image/jpeg, text/*". .TP \fB\-proxyhost\fP \fIhostname\fP The name of the proxy host, if any. If this value is the empty string, the URL host is contacted directly. .TP \fB\-proxyport\fP \fInumber\fP The proxy port number. .TP \fB\-proxyfilter\fP \fIcommand\fP The command is a callback that is made during \fB::http::geturl\fR to determine if a proxy is required for a given host. One argument, a host name, is added to \fIcommand\fR when it is invoked. If a proxy is required, the callback should return a two element list containing is required, the callback should return a two-element list containing the proxy server and proxy port. Otherwise the filter should return an empty list. The default filter returns the values of the \fB\-proxyhost\fR and \fB\-proxyport\fR settings if they are non-empty. .TP \fB\-urlencoding\fP \fIencoding\fP The \fIencoding\fR used for creating the x-url-encoded URLs with \fB::http::formatQuery\fR. The default is \fButf-8\fR, as specified by RFC 2718. Prior to http 2.5 this was unspecified, and that behavior can be returned by specifying the empty string (\fB{}\fR), although \fIiso8859-1\fR is recommended to restore similar behavior but without the \fB::http::formatQuery\fR throwing an error processing non-latin-1 characters. .TP \fB\-useragent\fP \fIstring\fP The value of the User-Agent header in the HTTP request. The default is \fB"Tcl http client package 2.4."\fR .RE .TP \fB::http::geturl\fP \fIurl\fP ?\fIoptions\fP? The \fB::http::geturl\fR command is the main procedure in the package. The \fB\-query\fR option causes a POST operation and the \fB\-validate\fR option causes a HEAD operation; otherwise, a GET operation is performed. The \fB::http::geturl\fR command returns a \fItoken\fR value that can be used to get information about the transaction. See the STATE ARRAY and ERRORS section for details. The \fB::http::geturl\fR command blocks until the operation completes, unless the \fB\-command\fR option specifies a callback that is invoked when the HTTP transaction completes. \fB::http::geturl\fR takes several options: .RS .TP \fB\-binary\fP \fIboolean\fP Specifies whether to force interpreting the url data as binary. Normally Specifies whether to force interpreting the URL data as binary. Normally this is auto-detected (anything not beginning with a \fBtext\fR content type or whose content encoding is \fBgzip\fR or \fBcompress\fR is considered binary data). .TP \fB\-blocksize\fP \fIsize\fP The blocksize used when reading the URL. The block size used when reading the URL. At most \fIsize\fR bytes are read at once. After each block, a call to the \fB\-progress\fR callback is made (if that option is specified). .TP \fB\-channel\fP \fIname\fP Copy the URL contents to channel \fIname\fR instead of saving it in \fBstate(body)\fR. .TP
︙
203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231	213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242	- + - + - + +	upvar #0 $token state } .CE .RE .TP \fB\-query\fP \fIquery\fP This flag causes \fB::http::geturl\fR to do a POST request that passes the \fIquery\fR to the server. The \fIquery\fR must be a x-url-encoding \fIquery\fR to the server. The \fIquery\fR must be an x-url-encoding formatted query. The \fB::http::formatQuery\fR procedure can be used to do the formatting. .TP \fB\-queryblocksize\fP \fIsize\fP The blocksize used when posting query data to the URL. The block size used when posting query data to the URL. At most \fIsize\fR bytes are written at once. After each block, a call to the \fB\-queryprogress\fR callback is made (if that option is specified). .TP \fB\-querychannel\fP \fIchannelID\fP This flag causes \fB::http::geturl\fR to do a POST request that passes the data contained in \fIchannelID\fR to the server. The data contained in \fIchannelID\fR must be a x-url-encoding data contained in \fIchannelID\fR to the server. The data contained in \fIchannelID\fR must be an x-url-encoding formatted query unless the \fB\-type\fP option below is used. If a Content-Length header is not specified via the \fB\-headers\fR options, \fB::http::geturl\fR attempts to determine the size of the post data in order to create that header. If it is unable to determine the size, it returns an error. .TP \fB\-queryprogress\fP \fIcallback\fP
︙
314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339	325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350	- + - + - + - +	such as HTTPS, by registering a prefix, the default port, and the command to execute to create the Tcl \fBchannel\fR. E.g.: .RS .CS package require http package require tls http::register https 443 ::tls::socket ::http::register https 443 ::tls::socket set token [http::geturl https://my.secure.site/] set token [::http::geturl https://my.secure.site/] .CE .RE .TP \fB::http::unregister\fP \fIproto\fP This procedure unregisters a protocol handler that was previously registered via \fBhttp::register\fR. registered via \fB::http::register\fR. .SH "ERRORS" The \fBhttp::geturl\fP procedure will raise errors in the following cases: The \fB::http::geturl\fP procedure will raise errors in the following cases: invalid command line options, an invalid URL, a URL on a non-existent host, or a URL at a bad port on an existing host. These errors mean that it cannot even start the network transaction. It will also raise an error if it gets an I/O error while
︙
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 402 403 404 405 406 407 408 409 410 411	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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422	- + - + - - - + + + - + - + - + - +	.PP Alternatively, if the main program flow reaches a point where it needs to know the result of the asynchronous HTTP request, it can call \fB::http::wait\fP and then check status and error, just as the callback does. .PP In any case, you must still call \fBhttp::cleanup\fP to delete the state array when you're done. \fB::http::cleanup\fP to delete the state array when you're done. .PP There are other possible results of the HTTP transaction determined by examining the status from \fBhttp::status\fP. determined by examining the status from \fB::http::status\fP. These are described below. .TP ok If the HTTP transaction completes entirely, then status will be \fBok\fP. However, you should still check the \fBhttp::code\fP value to get the HTTP status. The \fBhttp::ncode\fP procedure provides just the numeric error (e.g., 200, 404 or 500) while the \fBhttp::code\fP However, you should still check the \fB::http::code\fP value to get the HTTP status. The \fB::http::ncode\fP procedure provides just the numeric error (e.g., 200, 404 or 500) while the \fB::http::code\fP procedure returns a value like "HTTP 404 File not found". .TP eof If the server closes the socket without replying, then no error is raised, but the status of the transaction will be \fBeof\fP. .TP error The error message will also be stored in the \fBerror\fP status array element, accessible via \fB::http::error\fP. .PP Another error possibility is that \fBhttp::geturl\fP is unable to Another error possibility is that \fB::http::geturl\fP is unable to write all the post query data to the server before the server responds and closes the socket. The error message is saved in the \fBposterror\fP status array element and then \fBhttp::geturl\fP attempts to complete the element and then \fB::http::geturl\fP attempts to complete the transaction. If it can read the server's response it will end up with an \fBok\fP status, otherwise it will have an \fBeof\fP status. .SH "STATE ARRAY" The \fB::http::geturl\fR procedure returns a \fItoken\fR that can be used to get to the state of the HTTP transaction in the form of a Tcl array. Use this construct to create an easy-to-use array variable: .CS upvar #0 $token state .CE Once the data associated with the url is no longer needed, the state Once the data associated with the URL is no longer needed, the state array should be unset to free up storage. The \fBhttp::cleanup\fP procedure is provided for that purpose. The \fB::http::cleanup\fP procedure is provided for that purpose. The following elements of the array are supported: .RS .TP \fBbody\fR The contents of the URL. This will be empty if the \fB\-channel\fR option has been specified. This value is returned by the \fB::http::data\fP command.
︙
482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526	493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540	- + - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + - + - - + + + - +	\fBtype\fR A copy of the \fBContent-Type\fR meta-data value. .TP \fBurl\fR The requested URL. .RE .SH EXAMPLE .DS .CS # Copy a URL to a file and print meta-data proc ::http::copy { url file {chunk 4096} } { set out [open $file w] set token [geturl $url -channel $out -progress ::http::Progress \\ -blocksize $chunk] close $out # This ends the line started by http::Progress puts stderr "" upvar #0 $token state set max 0 foreach {name value} $state(meta) { if {[string length $name] > $max} { set max [string length $name] } if {[regexp -nocase ^location$ $name]} { # Handle URL redirects puts stderr "Location:$value" return [copy [string trim $value] $file $chunk] } } incr max foreach {name value} $state(meta) { puts [format "%-*s %s" $max $name: $value] } proc httpcopy { url file {chunk 4096} } { set out [open $file w] set token [\fB::http::geturl\fR $url -channel $out \\ -progress httpCopyProgress -blocksize $chunk] close $out # This ends the line started by httpCopyProgress puts stderr "" upvar #0 $token state set max 0 foreach {name value} $state(meta) { if {[string length $name] > $max} { set max [string length $name] } if {[regexp -nocase ^location$ $name]} { # Handle URL redirects puts stderr "Location:$value" return [httpcopy [string trim $value] $file $chunk] } } incr max foreach {name value} $state(meta) { puts [format "%-*s %s" $max $name: $value] } return $token return $token } proc ::http::Progress {args} { puts -nonewline stderr . ; flush stderr proc httpCopyProgress {args} { puts -nonewline stderr . flush stderr } .DE .CE .SH "SEE ALSO" safe(n), socket(n), safesock(n) .SH KEYWORDS security policy, socket

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: if.n,v 1.3 2000/09/07 14:27:48 poenitz Exp $ '\" RCS: @(#) $Id: if.n,v 1.3.18.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH if n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME if \- Execute scripts conditionally
︙
34 35 36 37 38 39 40 41 42 43 44 45 46	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	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	The \fBthen\fR and \fBelse\fR arguments are optional ``noise words'' to make the command easier to read. There may be any number of \fBelseif\fR clauses, including zero. \fIBodyN\fR may also be omitted as long as \fBelse\fR is omitted too. The return value from the command is the result of the body script that was executed, or an empty string if none of the expressions was non-zero and there was no \fIbodyN\fR. .SH EXAMPLES A simple conditional: .CS \fBif\fR {$vbl == 1} { puts "vbl is one" } .CE .PP With an \fBelse\fR-clause: .CS \fBif\fR {$vbl == 1} { puts "vbl is one" } \fBelse\fR { puts "vbl is not one" } .CE .PP With an \fBelseif\fR-clause too: .CS \fBif\fR {$vbl == 1} { puts "vbl is one" } \fBelseif\fR {$vbl == 2} { puts "vbl is two" } \fBelse\fR { puts "vbl is not one or two" } .CE .PP Remember, expressions can be multi-line, but in that case it can be a good idea to use the optional \fBthen\fR keyword for clarity: .CS \fBif\fR { $vbl == 1 || $vbl == 2 || $vbl == 3 } \fBthen\fR { puts "vbl is one, two or three" } .CE .SH "SEE ALSO" expr(n), for(n), foreach(n) .SH KEYWORDS boolean, conditional, else, false, if, true

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

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

- + + + + + + + + + + + + + + + + + + + + + + + +

'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: incr.n,v 1.3 2000/09/07 14:27:48 poenitz Exp $ '\" RCS: @(#) $Id: incr.n,v 1.3.18.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH incr n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME incr \- Increment the value of a variable .SH SYNOPSIS \fBincr \fIvarName \fR?\fIincrement\fR? .BE .SH DESCRIPTION .PP Increments the value stored in the variable whose name is \fIvarName\fR. The value of the variable must be an integer. If \fIincrement\fR is supplied then its value (which must be an integer) is added to the value of variable \fIvarName\fR; otherwise 1 is added to \fIvarName\fR. The new value is stored as a decimal string in variable \fIvarName\fR and also returned as result. .SH EXAMPLES Add one to the contents of the variable \fIx\fR: .CS \fBincr\fR x .CE .PP Add 42 to the contents of the variable \fIx\fR: .CS \fBincr\fR x 42 .CE .PP Add the contents of the variable \fIy\fR to the contents of the variable \fIx\fR: .CS \fBincr\fR x $y .CE .PP Add nothing at all to the variable \fIx\fR (often useful for checking whether an argument to a procedure is actually numeric and generating an error if it is not): .CS \fBincr\fR x 0 .CE .SH "SEE ALSO" expr(n) .SH KEYWORDS add, increment, variable, value

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1997 Sun Microsystems, Inc. '\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies '\" Copyright (c) 1998-2000 Ajuba Solutions '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: info.n,v 1.8 2002/06/11 13:22:35 msofer Exp $ '\" RCS: @(#) $Id: info.n,v 1.8.2.3 2004/10/27 14:23:56 dkf Exp $ '\" .so man.macros .TH info n 8.4 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME info \- Return information about the state of the Tcl interpreter
︙
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67	44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67	- + - +	including both the built-in commands written in C and the command procedures defined using the \fBproc\fR command. If \fIpattern\fR is specified, only those names matching \fIpattern\fR are returned. Matching is determined using the same rules as for \fBstring match\fR. \fIpattern\fR can be a qualified name like \fBFoo::print*\fR. That is, it may specify a particular namespace using a sequence of namespace names separated by \fB::\fRs, using a sequence of namespace names separated by double colons (\fB::\fR), and may have pattern matching special characters at the end to specify a set of commands in that namespace. If \fIpattern\fR is a qualified name, the resulting list of command names has each one qualified with the name of the specified namespace. .TP \fBinfo complete \fIcommand\fR Returns 1 if \fIcommand\fR is a complete Tcl command in the sense of having no unclosed quotes, braces, brackets or array element names, having no unclosed quotes, braces, brackets or array element names. If the command doesn't appear to be complete then 0 is returned. This command is typically used in line-oriented input environments to allow users to type in commands that span multiple lines; if the command isn't complete, the script can delay evaluating it until additional lines have been typed to complete the command. .TP \fBinfo default \fIprocname arg varname\fR
︙
159 160 161 162 163 164 165 166 167 168 169 170 171 172	159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177	+ + + + +	If \fIpattern\fR isn't specified, returns a list of all the names of Tcl command procedures in the current namespace. If \fIpattern\fR is specified, only those procedure names in the current namespace matching \fIpattern\fR are returned. Matching is determined using the same rules as for \fBstring match\fR. If \fIpattern\fR contains any namespace separators, they are used to select a namespace relative to the current namespace (or relative to the global namespace if \fIpattern\fR starts with \fB::\fR) to match within; the matching pattern is taken to be the part after the last namespace separator. .TP \fBinfo script\fR ?\fIfilename\fR? If a Tcl script file is currently being evaluated (i.e. there is a call to \fBTcl_EvalFile\fR active or there is an active invocation of the \fBsource\fR command), then this command returns the name of the innermost file being processed. If \fIfilename\fR is specified, then the return value of this command will be modified for the
︙
189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212	194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238	- + + + + + + + + + + + + + + + + + + + + + +	returns a list of all the names of currently-visible variables. This includes locals and currently-visible globals. If \fIpattern\fR is specified, only those names matching \fIpattern\fR are returned. Matching is determined using the same rules as for \fBstring match\fR. \fIpattern\fR can be a qualified name like \fBFoo::option*\fR. That is, it may specify a particular namespace using a sequence of namespace names separated by \fB::\fRs, using a sequence of namespace names separated by double colons (\fB::\fR), and may have pattern matching special characters at the end to specify a set of variables in that namespace. If \fIpattern\fR is a qualified name, the resulting list of variable names has each matching namespace variable qualified with the name of its namespace. Note that a currently-visible variable may not yet "exist" if it has not been set (e.g. a variable declared but not set by \fBvariable\fR). .SH EXAMPLE This command prints out a procedure suitable for saving in a Tcl script: .CS proc printProc {procName} { set result [list proc $procName] set formals {} foreach var [\fBinfo args\fR $procName] { if {[\fBinfo default\fR $procName $var def]} { lappend formals [list $var $def] } else { # Still need the list-quoting because variable # names may properly contain spaces. lappend formals [list $var] } } puts [lappend result $formals [\fBinfo body\fR $procName]] } .CE .SH "SEE ALSO" global(n), proc(n) .SH KEYWORDS command, information, interpreter, level, namespace, procedure, variable '\" Local Variables: '\" mode: nroff '\" End:

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1995-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: interp.n,v 1.9 2002/07/01 18:24:39 jenglish Exp $ '\" RCS: @(#) $Id: interp.n,v 1.9.2.2 2004/10/27 14:23:56 dkf Exp $ '\" .so man.macros .TH interp n 7.6 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME interp \- Create and manipulate Tcl interpreters
︙
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	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	- + - + - - + + + - - - - + - - - - + + + + - - + + - +	interpreters. A safe interpreter is a slave whose functions have been greatly restricted, so that it is safe to execute untrusted scripts without fear of them damaging other interpreters or the application's environment. For example, all IO channel creation commands and subprocess creation commands are made inaccessible to safe interpreters. .VS See SAFE INTERPRETERS below for more information on See \fBSAFE INTERPRETERS\fR below for more information on what features are present in a safe interpreter. The dangerous functionality is not removed from the safe interpreter; instead, it is \fIhidden\fR, so that only trusted interpreters can obtain access to it. For a detailed explanation of hidden commands, see HIDDEN COMMANDS, below. \fBHIDDEN COMMANDS\fR, below. The alias mechanism can be used for protected communication (analogous to a kernel call) between a slave interpreter and its master. See ALIAS INVOCATION, below, for more details on how the alias mechanism works. kernel call) between a slave interpreter and its master. See \fBALIAS INVOCATION\fR, below, for more details on how the alias mechanism works. .VE .PP A qualified interpreter name is a proper Tcl lists containing a subset of its ancestors in the interpreter hierarchy, terminated by the string naming the interpreter in its immediate master. Interpreter names are relative to the interpreter in which they are used. For example, if \fBa\fR is a slave of the current interpreter and it has a slave \fBa1\fR, which in turn has a slave \fBa11\fR, the qualified name of \fBa11\fR in \fBa\fR is the list \fBa1 a11\fR. .PP The \fBinterp\fR command, described below, accepts qualified interpreter names as arguments; the interpreter in which the command is being evaluated can always be referred to as \fB{}\fR (the empty list or string). Note that it is impossible to refer to a master (ancestor) interpreter by name in a slave interpreter except through aliases. Also, there is no global name by which one can refer to the first interpreter created in an application. Both restrictions are motivated by safety concerns. .VS .SH "THE INTERP COMMAND" .PP .VE The \fBinterp\fR command is used to create, delete, and manipulate slave interpreters, and to share or transfer channels between interpreters. It can have any of several forms, depending on the \fIoption\fR argument: .TP \fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcCmd\fR \fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcToken\fR Returns a Tcl list whose elements are the \fItargetCmd\fR and \fIarg\fRs associated with the alias named \fIsrcCmd\fR (all of these are the values specified when the alias was created; it is possible that the actual source command in the slave is different from \fIsrcCmd\fR if it was renamed). \fIarg\fRs associated with the alias represented by \fIsrcToken\fR (this is the value returned when the alias was created; it is possible that the name of the source command in the slave is different from \fIsrcToken\fR). .TP \fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcCmd\fR \fB{}\fR Deletes the alias for \fIsrcCmd\fR in the slave interpreter identified by \fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcToken\fR \fB{}\fR Deletes the alias for \fIsrcToken\fR in the slave interpreter identified by \fIsrcPath\fR. \fIsrcCmd\fR refers to the name under which the alias \fIsrcToken\fR refers to the value returned when the alias was created; if the source command has been renamed, the renamed command will be deleted. .TP \fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcCmd\fR \fItargetPath\fR \fItargetCmd \fR?\fIarg arg ...\fR? This command creates an alias between one slave and another (see the \fBalias\fR slave command below for creating aliases between a slave and its master). In this command, either of the slave interpreters
︙
115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134	113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138	- - + + + + + - - + + + + +	and command, and the \fIarg\fR arguments, if any, specify additional arguments to \fItargetCmd\fR which are prepended to any arguments specified in the invocation of \fIsrcCmd\fR. \fITargetCmd\fR may be undefined at the time of this call, or it may already exist; it is not created by this command. The alias arranges for the given target command to be invoked in the target interpreter whenever the given source command is invoked in the source interpreter. See ALIAS INVOCATION below for more details. invoked in the source interpreter. See \fBALIAS INVOCATION\fR below for more details. The command returns a token that uniquely identifies the command created \fIsrcCmd\fR, even if the command is renamed afterwards. The token may but does not have to be equal to \fIsrcCmd\fR. .TP \fBinterp\fR \fBaliases \fR?\fIpath\fR? This command returns a Tcl list of the names of all the source commands for aliases defined in the interpreter identified by \fIpath\fR. This command returns a Tcl list of the tokens of all the source commands for aliases defined in the interpreter identified by \fIpath\fR. The tokens correspond to the values returned when the aliases were created (which may not be the same as the current names of the commands). .TP \fBinterp\fR \fBcreate \fR?\fB\-safe\fR? ?\fB\-\|\-\fR? ?\fIpath\fR? Creates a slave interpreter identified by \fIpath\fR and a new command, called a \fIslave command\fR. The name of the slave command is the last component of \fIpath\fR. The new slave interpreter and the slave command are created in the interpreter identified by the path obtained by removing the last component from \fIpath\fR. For example, if \fIpath is \fBa b
︙
160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218	164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227	+ + + + + - + - + - +	\fBinterp\fR \fBeval\fR \fIpath arg \fR?\fIarg ...\fR? This command concatenates all of the \fIarg\fR arguments in the same fashion as the \fBconcat\fR command, then evaluates the resulting string as a Tcl script in the slave interpreter identified by \fIpath\fR. The result of this evaluation (including error information such as the \fBerrorInfo\fR and \fBerrorCode\fR variables, if an error occurs) is returned to the invoking interpreter. Note that the script will be executed in the current context stack frame of the \fIpath\fR interpreter; this is so that the implementations (in a master interpreter) of aliases in a slave interpreter can execute scripts in the slave that find out information about the slave's current state and stack frame. .TP \fBinterp exists \fIpath\fR Returns \fB1\fR if a slave interpreter by the specified \fIpath\fR exists in this master, \fB0\fR otherwise. If \fIpath\fR is omitted, the invoking interpreter is used. .VS "" BR .TP \fBinterp expose \fIpath\fR \fIhiddenName\fR ?\fIexposedCmdName\fR? Makes the hidden command \fIhiddenName\fR exposed, eventually bringing it back under a new \fIexposedCmdName\fR name (this name is currently accepted only if it is a valid global name space name without any ::), in the interpreter denoted by \fIpath\fR. If an exposed command with the targeted name already exists, this command fails. Hidden commands are explained in more detail in HIDDEN COMMANDS, below. Hidden commands are explained in more detail in \fBHIDDEN COMMANDS\fR, below. .TP \fBinterp\fR \fBhide\fR \fIpath\fR \fIexposedCmdName\fR ?\fIhiddenCmdName\fR? Makes the exposed command \fIexposedCmdName\fR hidden, renaming it to the hidden command \fIhiddenCmdName\fR, or keeping the same name if \fIhiddenCmdName\fR is not given, in the interpreter denoted by \fIpath\fR. If a hidden command with the targeted name already exists, this command fails. Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can not contain namespace qualifiers, or an error is raised. Commands to be hidden by \fBinterp hide\fR are looked up in the global namespace even if the current namespace is not the global one. This prevents slaves from fooling a master interpreter into hiding the wrong command, by making the current namespace be different from the global one. Hidden commands are explained in more detail in HIDDEN COMMANDS, below. Hidden commands are explained in more detail in \fBHIDDEN COMMANDS\fR, below. .TP \fBinterp\fR \fBhidden\fR \fIpath\fR Returns a list of the names of all hidden commands in the interpreter identified by \fIpath\fR. .TP \fBinterp\fR \fBinvokehidden\fR \fIpath\fR ?\fB-global\fR? \fIhiddenCmdName\fR ?\fIarg ...\fR? Invokes the hidden command \fIhiddenCmdName\fR with the arguments supplied in the interpreter denoted by \fIpath\fR. No substitutions or evaluation are applied to the arguments. If the \fB-global\fR flag is present, the hidden command is invoked at the global level in the target interpreter; otherwise it is invoked at the current call frame and can access local variables in that and outer call frames. Hidden commands are explained in more detail in HIDDEN COMMANDS, below. Hidden commands are explained in more detail in \fBHIDDEN COMMANDS\fR, below. .VE .TP \fBinterp issafe\fR ?\fIpath\fR? Returns \fB1\fR if the interpreter identified by the specified \fIpath\fR is safe, \fB0\fR otherwise. .VS "" BR .TP
︙
265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 355 356 357 358 359 360 361 362 363 364 365	274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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	- - - - - + + + + - - + - - + + - + - - - + + + - + + + + + + + + + - + - + - + - - + +	invoking interpreter or one of its descendants then an error is generated. The target command does not have to be defined at the time of this invocation. .TP \fBinterp\fR \fBtransfer\fR \fIsrcPath channelId destPath\fR Causes the IO channel identified by \fIchannelId\fR to become available in the interpreter identified by \fIdestPath\fR and unavailable in the interpreter identified by \fIsrcPath\fR. .SH "SLAVE COMMAND" .PP For each slave interpreter created with the \fBinterp\fR command, a new Tcl command is created in the master interpreter with the same name as the new interpreter. This command may be used to invoke various operations on the interpreter. It has the following general form: .CS \fIslave command \fR?\fIarg arg ...\fR? .CE \fISlave\fR is the name of the interpreter, and \fIcommand\fR and the \fIarg\fRs determine the exact behavior of the command. The valid forms of this command are: .TP \fIslave \fBaliases\fR Returns a Tcl list whose elements are the names of all the aliases in \fIslave\fR. The names returned are the \fIsrcCmd\fR values used when the aliases were created (which may not be the same as the current names of the commands, if they have been Returns a Tcl list whose elements are the tokens of all the aliases in \fIslave\fR. The tokens correspond to the values returned when the aliases were created (which may not be the same as the current names of the commands). renamed). .TP \fIslave \fBalias \fIsrcCmd\fR \fIslave \fBalias \fIsrcToken\fR Returns a Tcl list whose elements are the \fItargetCmd\fR and \fIarg\fRs associated with the alias named \fIsrcCmd\fR (all of these are the values specified when the alias was \fIarg\fRs associated with the alias represented by \fIsrcToken\fR (this is the value returned when the alias was created; it is possible that the actual source command in the slave is different from \fIsrcCmd\fR if it was renamed). slave is different from \fIsrcToken\fR). .TP \fIslave \fBalias \fIsrcCmd \fB{}\fR Deletes the alias for \fIsrcCmd\fR in the slave interpreter. \fIsrcCmd\fR refers to the name under which the alias \fIslave \fBalias \fIsrcToken \fB{}\fR Deletes the alias for \fIsrcToken\fR in the slave interpreter. \fIsrcToken\fR refers to the value returned when the alias was created; if the source command has been renamed, the renamed command will be deleted. .TP \fIslave \fBalias \fIsrcCmd targetCmd \fR?\fIarg ..\fR? Creates an alias such that whenever \fIsrcCmd\fR is invoked in \fIslave\fR, \fItargetCmd\fR is invoked in the master. The \fIarg\fR arguments will be passed to \fItargetCmd\fR as additional arguments, prepended before any arguments passed in the invocation of \fIsrcCmd\fR. See ALIAS INVOCATION below for details. See \fBALIAS INVOCATION\fR below for details. The command returns a token that uniquely identifies the command created \fIsrcCmd\fR, even if the command is renamed afterwards. The token may but does not have to be equal to \fIsrcCmd\fR. .TP \fIslave \fBeval \fIarg \fR?\fIarg ..\fR? This command concatenates all of the \fIarg\fR arguments in the same fashion as the \fBconcat\fR command, then evaluates the resulting string as a Tcl script in \fIslave\fR. The result of this evaluation (including error information such as the \fBerrorInfo\fR and \fBerrorCode\fR variables, if an error occurs) is returned to the invoking interpreter. Note that the script will be executed in the current context stack frame of \fIslave\fR; this is so that the implementations (in a master interpreter) of aliases in a slave interpreter can execute scripts in the slave that find out information about the slave's current state and stack frame. .VS "" BR .TP \fIslave \fBexpose \fIhiddenName \fR?\fIexposedCmdName\fR? This command exposes the hidden command \fIhiddenName\fR, eventually bringing it back under a new \fIexposedCmdName\fR name (this name is currently accepted only if it is a valid global name space name without any ::), in \fIslave\fR. If an exposed command with the targeted name already exists, this command fails. For more details on hidden commands, see HIDDEN COMMANDS, below. For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below. .TP \fIslave \fBhide \fIexposedCmdName\fR ?\fIhiddenCmdName\fR? This command hides the exposed command \fIexposedCmdName\fR, renaming it to the hidden command \fIhiddenCmdName\fR, or keeping the same name if the the argument is not given, in the \fIslave\fR interpreter. argument is not given, in the \fIslave\fR interpreter. If a hidden command with the targeted name already exists, this command fails. Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can not contain namespace qualifiers, or an error is raised. Commands to be hidden are looked up in the global namespace even if the current namespace is not the global one. This prevents slaves from fooling a master interpreter into hiding the wrong command, by making the current namespace be different from the global one. For more details on hidden commands, see HIDDEN COMMANDS, below. For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below. .TP \fIslave \fBhidden\fR Returns a list of the names of all hidden commands in \fIslave\fR. .TP \fIslave \fBinvokehidden\fR ?\fB-global\fR \fIhiddenName \fR?\fIarg ..\fR? This command invokes the hidden command \fIhiddenName\fR with the supplied arguments, in \fIslave\fR. No substitutions or evaluations are applied to the arguments. If the \fB-global\fR flag is given, the command is invoked at the global level in the slave; otherwise it is invoked at the current call frame and can access local variables in that or outer call frames. For more details on hidden commands, see HIDDEN COMMANDS, below. For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below. .VE .TP \fIslave \fBissafe\fR Returns \fB1\fR if the slave interpreter is safe, \fB0\fR otherwise. .VS "" BR .TP \fIslave \fBmarktrusted\fR
︙
429 430 431 432 433 434 435 436 437 438 439 440 441 442 443	444 445 446 447 448 449 450 451 452 453 454 455 456 457 458	- +	.DE .VS "" BR The following commands are hidden by \fBinterp create\fR when it creates a safe interpreter: .DS .ta 1.2i 2.4i 3.6i \fBcd encoding exec exit fconfigure file glob load fconfigure file glob load open pwd socket source\fR .DE These commands can be recreated later as Tcl procedures or aliases, or re-exposed by \fBinterp expose\fR. .PP The following commands from Tcl's library of support procedures are not present in a safe interpreter:
︙
483 484 485 486 487 488 489 490 491 492 493 494 495 496 497	498 499 500 501 502 503 504 505 506 507 508 509 510 511	-	If extensions are loaded into a safe interpreter, they may also restrict their own functionality to eliminate unsafe commands. For a discussion of management of extensions for safety see the manual entries for \fBSafe\-Tcl\fR and the \fBload\fR Tcl command. .PP A safe interpreter may not alter the recursion limit of any interpreter, including itself. .SH "ALIAS INVOCATION" .PP The alias mechanism has been carefully designed so that it can be used safely when an untrusted script is executing in a safe slave and the target of the alias is a trusted master. The most important thing in guaranteeing safety is to ensure that information passed from the slave to the master is
︙
524 525 526 527 528 529 530 531 532 533 534 535 536 537 538	538 539 540 541 542 543 544 545 546 547 548 549 550 551	-	.PP When writing the \fItargetCmd\fRs for aliases in safe interpreters, it is very important that the arguments to that command never be evaluated or substituted, since this would provide an escape mechanism whereby the slave interpreter could execute arbitrary code in the master. This in turn would compromise the security of the system. .VS .SH "HIDDEN COMMANDS" .PP Safe interpreters greatly restrict the functionality available to Tcl programs executing within them. Allowing the untrusted Tcl program to have direct access to this functionality is unsafe, because it can be used for a variety of
︙
567 568 569 570 571 572 573 574 575 576 577 578 579 580 581	580 581 582 583 584 585 586 587 588 589 590 591 592 593 594	- +	the hidden command. .PP Because a master interpreter may invoke a hidden command as part of handling an alias invocation, great care must be taken to avoid evaluating any arguments passed in through the alias invocation. Otherwise, malicious slave interpreters could cause a trusted master interpreter to execute dangerous commands on their behalf. See the section on ALIAS INVOCATION for a more complete discussion of this topic. on \fBALIAS INVOCATION\fR for a more complete discussion of this topic. To help avoid this problem, no substitutions or evaluations are applied to arguments of \fBinterp invokehidden\fR. .PP Safe interpreters are not allowed to invoke hidden commands in themselves or in their descendants. This prevents safe slaves from gaining access to hidden functionality in themselves or their descendants. .PP
︙
598 599 600 601 602 603 604 605 606 607 608 609 610	611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644	+ + + + + + + + + + + + + + + + + + + + +	prevents slaves from fooling a master interpreter into hiding the wrong command, by making the current namespace be different from the global one. .VE .SH CREDITS .PP This mechanism is based on the Safe-Tcl prototype implemented by Nathaniel Borenstein and Marshall Rose. .SH EXAMPLES Creating and using an alias for a command in the current interpreter: .CS \fBinterp alias\fR {} getIndex {} lsearch {alpha beta gamma delta} set idx [getIndex delta] .CE .PP Executing an arbitrary command in a safe interpreter where every invokation of \fBlappend\fR is logged: .CS set i [\fBinterp create\fR -safe] \fBinterp hide\fR $i lappend \fBinterp alias\fR $i lappend {} loggedLappend $i proc loggedLappend {i args} { puts "logged invokation of lappend $args" # Be extremely careful about command construction eval [linsert $args 0 \\ \fBinterp invokehidden\fR $i lappend] } \fBinterp eval\fR $i $someUntrustedScript .CE .SH "SEE ALSO" load(n), safe(n), Tcl_CreateSlave(3) .SH KEYWORDS alias, master interpreter, safe interpreter, slave interpreter

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

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

- + + + + + + + + + + + + + + + - +

'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: join.n,v 1.3 2000/09/07 14:27:48 poenitz Exp $ '\" RCS: @(#) $Id: join.n,v 1.3.18.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH join n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME join \- Create a string by joining together list elements .SH SYNOPSIS \fBjoin \fIlist \fR?\fIjoinString\fR? .BE .SH DESCRIPTION .PP The \fIlist\fR argument must be a valid Tcl list. This command returns the string formed by joining all of the elements of \fIlist\fR together with \fIjoinString\fR separating each adjacent pair of elements. The \fIjoinString\fR argument defaults to a space character. .SH EXAMPLES Making a comma-separated list: .CS set data {1 2 3 4 5} \fBjoin\fR $data ", " \fB=> 1, 2, 3, 4, 5\fR .CE .PP Using \fBjoin\fR to flatten a list by a single level: .CS set data {1 {2 3} 4 {5 {6 7} 8}} \fBjoin\fR $data \fB=> 1 2 3 4 5 {6 7} 8\fR .CE .SH "SEE ALSO" list(n), lappend(n) list(n), lappend(n), split(n) .SH KEYWORDS element, join, list, separator

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" Copyright (c) 2001 Kevin B. Kenny. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: lappend.n,v 1.6 2001/11/14 23:38:39 hobbs Exp $ '\" RCS: @(#) $Id: lappend.n,v 1.6.4.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH lappend n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME lappend \- Append list elements onto a variable
︙
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43	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	+ + + + + + + + + +	given by the \fIvalue\fR arguments. \fBLappend\fR is similar to \fBappend\fR except that the \fIvalue\fRs are appended as list elements rather than raw text. This command provides a relatively efficient way to build up large lists. For example, ``\fBlappend a $b\fR'' is much more efficient than ``\fBset a [concat $a [list $b]]\fR'' when \fB$a\fR is long. .SH EXAMPLE Using \fBlappend\fR to build up a list of numbers. .CS % set var 1 1 % \fBlappend\fR var 2 1 2 % \fBlappend\fR var 3 4 5 1 2 3 4 5 .CE .SH "SEE ALSO" list(n), lindex(n), linsert(n), llength(n), .VS 8.4 lset(n) .VE lsort(n), lrange(n) .SH KEYWORDS append, element, list, variable

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: lindex.n,v 1.7 2001/11/14 23:15:33 hobbs Exp $ '\" RCS: @(#) $Id: lindex.n,v 1.7.4.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH lindex n 8.4 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME lindex \- Retrieve an element from a list
︙
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	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	- - - - - - - - - - + + + + + + + + + +	.CE is synonymous with .CS lindex [lindex [lindex $a 1] 2] 3 .CE .SH EXAMPLES .CS lindex {a b c} => a b c lindex {a b c} {} => a b c lindex {a b c} 0 => a lindex {a b c} 2 => c lindex {a b c} end => c lindex {a b c} end-1 => b lindex {{a b c} {d e f} {g h i}} 2 1 => h lindex {{a b c} {d e f} {g h i}} {2 1} => h lindex {{{a b} {c d}} {{e f} {g h}}} 1 1 0 => g lindex {{{a b} {c d}} {{e f} {g h}}} {1 1 0} => g \fBlindex\fR {a b c} \fI=> a b c\fR \fBlindex\fR {a b c} {} \fI=> a b c\fR \fBlindex\fR {a b c} 0 \fI=> a\fR \fBlindex\fR {a b c} 2 \fI=> c\fR \fBlindex\fR {a b c} end \fI=> c\fR \fBlindex\fR {a b c} end-1 \fI=> b\fR \fBlindex\fR {{a b c} {d e f} {g h i}} 2 1 \fI=> h\fR \fBlindex\fR {{a b c} {d e f} {g h i}} {2 1} \fI=> h\fR \fBlindex\fR {{{a b} {c d}} {{e f} {g h}}} 1 1 0 \fI=> g\fR \fBlindex\fR {{{a b} {c d}} {{e f} {g h}}} {1 1 0} \fI=> g\fR .CE .VE .SH "SEE ALSO" list(n), lappend(n), linsert(n), llength(n), lsearch(n), .VS 8.4 lset(n), .VE lsort(n), lrange(n), lreplace(n) .SH KEYWORDS element, index, list

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

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

- + - + - + + + + + + + + + +

'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" Copyright (c) 2001 Kevin B. Kenny. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: linsert.n,v 1.7 2001/11/14 23:38:39 hobbs Exp $ '\" RCS: @(#) $Id: linsert.n,v 1.7.4.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH linsert n 8.2 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME linsert \- Insert elements into a list .SH SYNOPSIS \fBlinsert \fIlist index element \fR?\fIelement element ...\fR? .BE .SH DESCRIPTION .PP This command produces a new list from \fIlist\fR by inserting all of the \fIelement\fR arguments just before the \fIindex\fRth element of \fIelement\fR arguments just before the \fIindex\fR'th element of \fIlist\fR. Each \fIelement\fR argument will become a separate element of the new list. If \fIindex\fR is less than or equal to zero, then the new elements are inserted at the beginning of the list. If \fIindex\fR has the value \fBend\fR, or if it is greater than or equal to the number of elements in the list, then the new elements are appended to the list. \fBend\-\fIinteger\fR refers to the last element in the list minus the specified integer offset. .SH EXAMPLE Putting some values into a list, first indexing from the start and then indexing from the end, and then chaining them together: .CS set oldList {the fox jumps over the dog} set midList [\fBlinsert\fR $oldList 1 quick] set newList [\fBlinsert\fR $midList end-1 lazy] # The old lists still exist though... set newerList [\fBlinsert\fR [\fBlinsert\fR $oldList end-1 quick] 1 lazy] .CE .SH "SEE ALSO" .VS 8.4 list(n), lappend(n), lindex(n), llength(n), lsearch(n), lset(n), lsort(n), lrange(n), lreplace(n) .VE .SH KEYWORDS element, insert, list

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" Copyright (c) 2001 Kevin B. Kenny. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: list.n,v 1.7 2001/12/05 22:26:43 dgp Exp $ '\" RCS: @(#) $Id: list.n,v 1.7.4.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH list n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME list \- Create a list
︙
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	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	+ - + - + - + - + + - - + + -	Braces and backslashes get added as necessary, so that the \fBlindex\fR command may be used on the result to re-extract the original arguments, and also so that \fBeval\fR may be used to execute the resulting list, with \fIarg1\fR comprising the command's name and the other \fIarg\fRs comprising its arguments. \fBList\fR produces slightly different results than \fBconcat\fR: \fBconcat\fR removes one level of grouping before forming the list, while \fBlist\fR works directly from the original arguments. .SH EXAMPLE For example, the command The command .CS \fBlist a b {c d e} {f {g h}}\fR \fBlist\fR a b "c d e " " f {g h}" .CE will return .CS \fBa b {c d e} {f {g h}}\fR \fBa b {c d e } { f {g h}}\fR .CE while \fBconcat\fR with the same arguments will return .CS \fBa b c d e f {g h}\fR .CE .SH "SEE ALSO" lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), lappend(n), lindex(n), linsert(n), llength(n), lrange(n), lreplace(n), lsearch(n), .VS 8.4 lset(n), .VE lsort(n), .VE 8.4 lsort(n) lrange(n), lreplace(n) .SH KEYWORDS element, list

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

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

- + + + + + + + + + + + + + + + + + + + + + + + + + + +

'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" Copyright (c) 2001 Kevin B. Kenny. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: llength.n,v 1.6 2001/11/14 23:38:39 hobbs Exp $ '\" RCS: @(#) $Id: llength.n,v 1.6.4.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH llength n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME llength \- Count the number of elements in a list .SH SYNOPSIS \fBllength \fIlist\fR .BE .SH DESCRIPTION .PP Treats \fIlist\fR as a list and returns a decimal string giving the number of elements in it. .SH EXAMPLES The result is the number of elements: .CS % \fBllength\fR {a b c d e} 5 % \fBllength\fR {a b c} 3 % \fBllength\fR {} 0 .CE .PP Elements are not guaranteed to be exactly words in a dictionary sense of course, especially when quoting is used: .CS % \fBllength\fR {a b {c d} e} 4 % \fBllength\fR {a b { } c d e} 6 .CE .PP An empty list is not necessarily an empty string: .CS % set var { }; puts "[string length $var],[\fBllength\fR $var]" 1,0 .CE .SH "SEE ALSO" .VS 8.4 list(n), lappend(n), lindex(n), linsert(n), lsearch(n), lset(n), lsort(n), lrange(n), lreplace(n) .VE .SH KEYWORDS element, list, length

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1995-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: load.n,v 1.7 2002/07/01 18:24:39 jenglish Exp $ '\" RCS: @(#) $Id: load.n,v 1.7.2.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH load n 7.5 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME load \- Load machine code and initialize new commands.
︙
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135	101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172	- - + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	(one that has been registered by calling the \fBTcl_StaticPackage\fR procedure) by that name; if one is found, it is used. Otherwise, the \fBload\fR command searches for a dynamically loaded package by that name, and uses it if it is found. If several different files have been \fBload\fRed with different versions of the package, Tcl picks the file that was loaded first. .VE .SH "PORTABILITY ISSUES" .TP \fBWindows\fR\0\0\0\0\0 . When a load fails with "library not found" error, it is also possible that a dependent library was not found. To see the dependent libraries, type ``dumpbin -imports <dllname>'' in a DOS console to see what the library must import. When loading a DLL in the current directory, Windows will ignore ``./'' as a path specifier and use a search heuristic to find the DLL instead. To avoid this, load the DLL with To avoid this, load the DLL with: .CS load [file join [pwd] mylib.DLL] \fBload\fR [file join [pwd] mylib.DLL] .CE .SH BUGS .PP If the same file is \fBload\fRed by different \fIfileName\fRs, it will be loaded into the process's address space multiple times. The behavior of this varies from system to system (some systems may detect the redundant loads, others may not). .SH EXAMPLE The following is a minimal extension: .PP .CS #include <tcl.h> #include <stdio.h> static int fooCmd(ClientData clientData, Tcl_Interp *interp, int objc, char * CONST objv[]) { printf("called with %d arguments\\n", objc); return TCL_OK; } int Foo_Init(Tcl_Interp *interp) { if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; } printf("creating foo command"); Tcl_CreateObjCommand(interp, "foo", fooCmd, NULL, NULL); return TCL_OK; } .CE .PP When built into a shared/dynamic library with a suitable name (e.g. \fBfoo.dll\fR on Windows, \fBlibfoo.so\fR on Solaris and Linux) it can then be loaded into Tcl with the following: .PP .CS # Load the extension switch $tcl_platform(platform) { windows { \fBload\fR ./foo.dll } unix { \fBload\fR ./libfoo[info sharedlibextension] } } # Now execute the command defined by the extension foo .CE .SH "SEE ALSO" info sharedlibextension, Tcl_StaticPackage(3), safe(n) .SH KEYWORDS binary code, loading, safe interpreter, shared library

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" Copyright (c) 2001 Kevin B. Kenny. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: lrange.n,v 1.6 2001/11/14 23:38:39 hobbs Exp $ '\" RCS: @(#) $Id: lrange.n,v 1.6.4.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH lrange n 7.4 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME lrange \- Return one or more adjacent elements from a list
︙
31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46	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	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +	in the list, then it is treated as if it were \fBend\fR. If \fIfirst\fR is greater than \fIlast\fR then an empty string is returned. Note: ``\fBlrange \fIlist first first\fR'' does not always produce the same result as ``\fBlindex \fIlist first\fR'' (although it often does for simple fields that aren't enclosed in braces); it does, however, produce exactly the same results as ``\fBlist [lindex \fIlist first\fB]\fR'' .SH EXAMPLES Selecting the first two elements: .CS % \fBlrange\fR {a b c d e} 0 1 a b .CE .PP Selecting the last three elements: .CS % \fBlrange\fR {a b c d e} end-2 end c d e .CE .PP Selecting everything except the first and last element: .CS % \fBlrange\fR {a b c d e} 1 end-1 b c d .CE .PP Selecting a single element with \fBlrange\fR is not the same as doing so with \fBlindex\fR: .CS % set var {some {elements to} select} some {elements to} select % lindex $var 1 elements to % \fBlrange\fR $var 1 1 {elements to} .CE .SH "SEE ALSO" .VS 8.4 list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), lset(n), lreplace(n), lsort(n) .VE .SH KEYWORDS element, list, range, sublist

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" Copyright (c) 2001 Kevin B. Kenny. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: lreplace.n,v 1.8 2001/11/14 23:38:39 hobbs Exp $ '\" RCS: @(#) $Id: lreplace.n,v 1.8.4.1 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH lreplace n 7.4 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME lreplace \- Replace elements in a list with new elements
︙
39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54	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	+ + + + + + + + + + + + + + + + + + + +	The \fIelement\fR arguments specify zero or more new arguments to be added to the list in place of those that were deleted. Each \fIelement\fR argument will become a separate element of the list. If no \fIelement\fR arguments are specified, then the elements between \fIfirst\fR and \fIlast\fR are simply deleted. If \fIlist\fR is empty, any \fIelement\fR arguments are added to the end of the list. .SH EXAMPLES Replacing an element of a list with another: .CS % \fBlreplace\fR {a b c d e} 1 1 foo a foo c d e .CE .PP Replacing two elements of a list with three: .CS % \fBlreplace\fR {a b c d e} 1 2 three more elements a three more elements d e .CE .PP Deleting the last element from a list in a variable: .CS % set var {a b c d e} a b c d e % set var [\fBlreplace\fR $var end end] a b c d .CE .SH "SEE ALSO" .VS 8.4 list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), lset(n), lrange(n), lsort(n) .VE .SH KEYWORDS element, list, replace

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- + - +	'\" '\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" Copyright (c) 2001 Kevin B. Kenny. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: lsearch.n,v 1.13 2002/10/03 13:08:55 dkf Exp $ '\" RCS: @(#) $Id: lsearch.n,v 1.13.2.4 2005/01/05 21:53:30 dkf Exp $ '\" .so man.macros .TH lsearch n 8.4 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME lsearch \- See if a list contains a particular element
︙
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	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	- - + + + + - - + + + +	\fB\-all\fR .VS 8.4 Changes the result to be the list of all matching indices (or all matching values if \fB\-inline\fR is specified as well.) .VE 8.4 .TP \fB\-ascii\fR The list elements are to be examined as ASCII strings. This option is only meaningful when used with \fB\-exact\fR or \fB\-sorted\fR. The list elements are to be examined as Unicode strings (the name is for backward-compatability reasons.) This option is only meaningful when used with \fB\-exact\fR or \fB\-sorted\fR. .TP \fB\-decreasing\fR The list elements are sorted in decreasing order. This option is only meaningful when used with \fB\-sorted\fR. .TP \fB\-dictionary\fR The list elements are to be compared using dictionary-style comparisons (see \fBlsort\fR for a fuller description). This option comparisons. This option is only meaningful when used with \fB\-exact\fR or \fB\-sorted\fR. is only meaningful when used with \fB\-exact\fR or \fB\-sorted\fR, and it is only distinguishable from the \fB\-ascii\fR option when the \fB\-sorted\fR option is given, because values are only dictionary-equal when exactly equal. .TP \fB\-exact\fR The list element must contain exactly the same string as \fIpattern\fR. .TP \fB\-glob\fR \fIPattern\fR is a glob-style pattern which is matched against each list element using the same rules as the \fBstring match\fR command.
︙
111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135	115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143	- - - - - - - + + + + + + + + + + +	last takes precedence. If more than one of \fB\-increasing\fR and \fB\-decreasing\fR is specified, the option specified last takes precedence. .VS 8.4 .SH EXAMPLES .CS lsearch {a b c d e} c => 2 lsearch -all {a b c a b c} c => 2 5 lsearch -inline {a20 b35 c47} b* => b35 lsearch -inline -not {a20 b35 c47} b* => a20 lsearch -all -inline -not {a20 b35 c47} b* => a20 c47 lsearch -all -not {a20 b35 c47} b* => 0 2 lsearch -start 3 {a b c a b c} c => 5 \fBlsearch\fR {a b c d e} c \fI=> 2\fR \fBlsearch\fR -all {a b c a b c} c \fI=> 2 5\fR \fBlsearch\fR -inline {a20 b35 c47} b* \fI=> b35\fR \fBlsearch\fR -inline -not {a20 b35 c47} b* \fI=> a20\fR \fBlsearch\fR -all -inline -not {a20 b35 c47} b* \fI=> a20 c47\fR \fBlsearch\fR -all -not {a20 b35 c47} b* \fI=> 0 2\fR \fBlsearch\fR -start 3 {a b c a b c} c \fI=> 5\fR .CE .VE 8.4 .SH "SEE ALSO" .VS 8.4 foreach(n), list(n), lappend(n), lindex(n), linsert(n), llength(n), lset(n), lsort(n), lrange(n), lreplace(n) .VE .SH KEYWORDS list, match, pattern, regular expression, search, string '\" Local Variables: '\" mode: nroff '\" End:

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: lset.n,v 1.6 2003/01/23 14:18:33 dkf Exp $ '\" RCS: @(#) $Id: lset.n,v 1.6.2.1 2003/12/01 21:29:34 msofer Exp $ '\" .so man.macros .TH lset n 8.4 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME lset \- Change an element in a list
︙
33 34 35 36 37 38 39 40 41 42 43 44 45 46 47	33 34 35 36 37 38 39 40 41 42 43 44 45 46 47	- +	.CS lset varName {} newValue .CE In this case, \fInewValue\fR replaces the old value of the variable \fIvarName\fR. .PP When presented with a single index, the \fBlset\fR command treats the content of the \fIvarBane\fR variable as a Tcl list. treats the content of the \fIvarName\fR variable as a Tcl list. It addresses the \fIindex\fR'th element in it (0 refers to the first element of the list). When interpreting the list, \fBlset\fR observes the same rules concerning braces and quotes and backslashes as the Tcl command interpreter; however, variable substitution and command substitution do not occur. The command constructs a new list in which the designated element is
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" Copyright (c) 1999 Scriptics Corporation '\" Copyright (c) 2001 Kevin B. Kenny. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: lsort.n,v 1.12 2001/11/14 23:38:39 hobbs Exp $ '\" RCS: @(#) $Id: lsort.n,v 1.12.4.2 2004/10/27 12:52:40 dkf Exp $ '\" .so man.macros .TH lsort n 8.3 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME lsort \- Sort the elements of a list
︙
28 29 30 31 32 33 34 35 36 37 38 39 40 41 42	28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43	- + +	.PP By default ASCII sorting is used with the result returned in increasing order. However, any of the following options may be specified before \fIlist\fR to control the sorting process (unique abbreviations are accepted): .TP 20 \fB\-ascii\fR Use string comparison with ASCII collation order. This is the default. Use string comparison with Unicode code-point collation order (the name is for backward-compatibility reasons.) This is the default. .TP 20 \fB\-dictionary\fR Use dictionary-style comparison. This is the same as \fB\-ascii\fR except (a) case is ignored except as a tie-breaker and (b) if two strings contain embedded numbers, the numbers compare as integers, not characters. For example, in \fB\-dictionary\fR mode, \fBbigBoy\fR sorts between \fBbigbang\fR and \fBbigboy\fR, and \fBx10y\fR
︙
97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194	98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186	- - - - + - - + - - + - + - - + - + - - + - + - + - - + - - +	\fB\-unique\fR If this option is specified, then only the last set of duplicate elements found in the list will be retained. Note that duplicates are determined relative to the comparison used in the sort. Thus if \fI-index 0\fR is used, \fB{1 a}\fR and \fB{1 b}\fR would be considered duplicates and only the second element, \fB{1 b}\fR, would be retained. .SH "NOTES" .PP The options to \fBlsort\fR only control what sort of comparison is used, and do not necessarily constrain what the values themselves actually are. This distinction is only noticeable when the list to be sorted has fewer than two elements. .PP The \fBlsort\fR command is reentrant, meaning it is safe to use as part of the implementation of a command used in the \fB\-command\fR option. .SH "EXAMPLES" .PP Sorting a list using ASCII sorting: .CS % lsort {a10 B2 b1 a1 a2} % \fBlsort\fR {a10 B2 b1 a1 a2} B2 a1 a10 a2 b1 .CE .PP Sorting a list using Dictionary sorting: .CS % lsort -dictionary {a10 B2 b1 a1 a2} % \fBlsort\fR -dictionary {a10 B2 b1 a1 a2} a1 a2 a10 b1 B2 .CE .PP Sorting lists of integers: .CS % lsort -integer {5 3 1 2 11 4} % \fBlsort\fR -integer {5 3 1 2 11 4} 1 2 3 4 5 11 % lsort -integer {1 2 0x5 7 0 4 -1} % \fBlsort\fR -integer {1 2 0x5 7 0 4 -1} -1 0 1 2 4 0x5 7 .CE .PP Sorting lists of floating-point numbers: .CS % lsort -real {5 3 1 2 11 4} % \fBlsort\fR -real {5 3 1 2 11 4} 1 2 3 4 5 11 % lsort -real {.5 0.07e1 0.4 6e-1} % \fBlsort\fR -real {.5 0.07e1 0.4 6e-1} 0.4 .5 6e-1 0.07e1 .CE .PP Sorting using indices: .CS % # Note the space character before the c % lsort {{a 5} { c 3} {b 4} {e 1} {d 2}} % \fBlsort\fR {{a 5} { c 3} {b 4} {e 1} {d 2}} { c 3} {a 5} {b 4} {d 2} {e 1} % lsort -index 0 {{a 5} { c 3} {b 4} {e 1} {d 2}} % \fBlsort\fR -index 0 {{a 5} { c 3} {b 4} {e 1} {d 2}} {a 5} {b 4} { c 3} {d 2} {e 1} % lsort -index 1 {{a 5} { c 3} {b 4} {e 1} {d 2}} % \fBlsort\fR -index 1 {{a 5} { c 3} {b 4} {e 1} {d 2}} {e 1} {d 2} { c 3} {b 4} {a 5} .CE .PP Stripping duplicate values using sorting: .CS % lsort -unique {a b c a b c a b c} % \fBlsort\fR -unique {a b c a b c a b c} a b c .CE .PP More complex sorting using a comparison function: .CS % proc compare {a b} { set a0 [lindex $a 0] set b0 [lindex $b 0] if {$a0 < $b0} { return -1 } elseif {$a0 > $b0} { return 1 } return [string compare [lindex $a 1] [lindex $b 1]] } % lsort -command compare \\ % \fBlsort\fR -command compare \\ {{3 apple} {0x2 carrot} {1 dingo} {2 banana}} {1 dingo} {2 banana} {0x2 carrot} {3 apple} .CE .SH "SEE ALSO" .VS 8.4 list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), lset(n), lrange(n), lreplace(n) .VE .SH KEYWORDS element, list, order, sort

︙
11 12 13 14 15 16 17 18 19 20 21 22 23 24 25	11 12 13 14 15 16 17 18 19 20 21 22 23 24 25	- +	.BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME msgcat \- Tcl message catalog .SH SYNOPSIS \fBpackage require Tcl 8.2\fR .sp \fBpackage require msgcat 1.3\fR \fBpackage require msgcat 1.3.4\fR .sp \fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR? .sp \fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR? .sp \fB::msgcat::mclocale \fR?\fInewLocale\fR? .sp
︙
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66	44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65	- - +	the application source code. New languages or locales are provided by adding a new file to the message catalog. .PP Use of the message catalog is optional by any application or package, but is encouraged if the application or package wishes to be enabled for multi-lingual applications. .SH COMMANDS .TP \fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR? Returns a translation of \fIsrc-string\fR according to the user's current locale. If additional arguments past \fIsrc-string\fR are given, the \fBformat\fR command is used to substitute the additional arguments in the translation of \fIsrc-string\fR. .PP \fB::msgcat::mc\fR will search the messages defined in the current namespace for a translation of \fIsrc-string\fR; if none is found, it will search in the parent of the current namespace, and so on until it reaches the global namespace. If no translation string exists, \fB::msgcat::mcunknown\fR is called and the string returned from \fB::msgcat::mcunknown\fR is returned. .PP
︙
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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232	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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231	- + - - + + - + - - + + - - + - + - - - - - + + + + + + - - - + + + - - + + - + + - - - + + + -	below for a description of the locale string format. .TP \fB::msgcat::mcpreferences\fR Returns an ordered list of the locales preferred by the user, based on the user's language specification. The list is ordered from most specific to least preference. The list is derived from the current locale set in msgcat by \fBmsgcat::mclocale\fR, and locale set in msgcat by \fB::msgcat::mclocale\fR, and cannot be set independently. For example, if the current locale is en_US_funky, then \fBmsgcat::mcpreferences\fR returns {en_US_funky en_US en}. current locale is en_US_funky, then \fB::msgcat::mcpreferences\fR returns \fB{en_US_funky en_US en}\fR. .TP \fB::msgcat::mcload \fIdirname\fR Searches the specified directory for files that match the language specifications returned by \fB::msgcat::mcpreferences\fR (note that these are all lowercase), extended by the file extension ``.msg''. Each matching file is read in order, assuming a UTF-8 encoding. The file contents are then evaluated as a Tcl script. This means that non-Latin characters then evaluated as a Tcl script. This means that Unicode characters may be present in the message file either directly in their UTF-8 encoded form, or by use of the backslash-u quoting recognized by Tcl evaluation. The number of message files which matched the specification and were loaded is returned. .TP \fB::msgcat::mcset \fIlocale src-string \fR?\fItranslate-string\fR? Sets the translation for \fIsrc-string\fR to \fItranslate-string\fR in the specified \fIlocale\fR and the current namespace. If \fItranslate-string\fR is not specified, \fIsrc-string\fR is used for both. The function returns \fItranslate-string\fR. .TP \fB::msgcat::mcmset \fIlocale src-trans-list\fR Sets the translation for multiple source strings in \fIsrc-trans-list\fR in the specified \fIlocale\fR and the current namespace. \fIsrc-trans-list\fR must have an even number of elements and is in the form {\fIsrc-string translate-string\fR ?\fIsrc-string translate-string ...\fR?} \fBmsgcat::mcmset\fR can be significantly faster than multiple invocations of \fBmsgcat::mcset\fR. The function translate-string ...\fR?} \fB::msgcat::mcmset\fR can be significantly faster than multiple invocations of \fB::msgcat::mcset\fR. The function returns the number of translations set. .TP \fB::msgcat::mcunknown \fIlocale src-string\fR This routine is called by \fB::msgcat::mc\fR in the case when a translation for \fIsrc-string\fR is not defined in the current locale. The default action is to return \fIsrc-string\fR. This procedure can be redefined by the application, for example to log error messages for each unknown string. The \fB::msgcat::mcunknown\fR procedure is invoked at the same stack context as the call to \fB::msgcat::mc\fR. The return value of \fB::msgcat::mcunknown\fR is used as the return value for the call to \fB::msgcat::mc\fR. .SH "LOCALE SPECIFICATION" .PP The locale is specified to \fBmsgcat\fR by a locale string passed to \fB::msgcat::mclocale\fR. The locale string consists of a language code, an optional country code, and an optional system-specific code, each separated by ``_''. The country and language codes are specified in standards ISO-639 and ISO-3166. For example, the locale ``en'' specifies English and ``en_US'' specifies U.S. English. .PP When the msgcat package is first loaded, the locale is initialized according to the user's environment. The variables \fBenv(LC_ALL)\fR, \fBenv(LC_MESSAGES)\fR, and \fBenv(LANG)\fR are examined in order. The first of them to have a non-empty value is used to determine the initial locale. The value is parsed according to the XPG4 pattern .CS language[_country][.codeset][@modifier] .CE to extract its parts. The initial locale is then set by calling \fBmsgcat::mclocale\fR with the argument \fB::msgcat::mclocale\fR with the argument .CS language[_country][_modifier] .CE On Windows, if none of those environment variables is set, msgcat will attempt to extract locale information from the registry. If all these attempts to discover an initial locale from the user's environment fail, msgcat defaults to an initial locale of ``C''. .PP When a locale is specified by the user, a ``best match'' search is performed during string translation. For example, if a user specifies en_GB_Funky, the locales ``en_GB_Funky'', ``en_GB'', and ``en'' are searched in order until a matching translation string is found. If no translation string is available, then \fB::msgcat::unknown\fR is translation string is available, then \fB::msgcat::mcunknown\fR is called. .SH "NAMESPACES AND MESSAGE CATALOGS" .PP Strings stored in the message catalog are stored relative to the namespace from which they were added. This allows multiple packages to use the same strings without fear of collisions with other packages. It also allows the source string to be shorter and less prone to typographical error. .PP For example, executing the code .CS mcset en hello "hello from ::" namespace eval foo {mcset en hello "hello from ::foo"} puts [mc hello] namespace eval foo {puts [mc hello]} \fB::msgcat::mcset\fR en hello "hello from ::" namespace eval foo { \fB::msgcat::mcset\fR en hello "hello from ::foo" } puts [\fB::msgcat::mc\fR hello] namespace eval foo {puts [\fB::msgcat::mc\fR hello]} .CE will print .CS hello from :: hello from ::foo .CE .PP When searching for a translation of a message, the message catalog will search first the current namespace, then the parent of the current namespace, and so on until the global namespace is reached. This allows child namespaces to "inherit" messages from their parent namespace. .PP For example, executing (in the ``en'' locale) the code .CS mcset en m1 ":: message1" mcset en m2 ":: message2" mcset en m3 ":: message3" \fB::msgcat::mcset\fR en m1 ":: message1" \fB::msgcat::mcset\fR en m2 ":: message2" \fB::msgcat::mcset\fR en m3 ":: message3" namespace eval ::foo { mcset en m2 "::foo message2" mcset en m3 "::foo message3" \fB::msgcat::mcset\fR en m2 "::foo message2" \fB::msgcat::mcset\fR en m3 "::foo message3" } namespace eval ::foo::bar { mcset en m3 "::foo::bar message3" \fB::msgcat::mcset\fR en m3 "::foo::bar message3" } namespace import \fB::msgcat::mc\fR puts "[mc m1]; [mc m2]; [mc m3]" namespace eval ::foo {puts "[mc m1]; [mc m2]; [mc m3]"} namespace eval ::foo::bar {puts "[mc m1]; [mc m2]; [mc m3]"} puts "[\fBmc\fR m1]; [\fBmc\fR m2]; [\fBmc\fR m3]" namespace eval ::foo {puts "[\fBmc\fR m1]; [\fBmc\fR m2]; [\fBmc\fR m3]"} namespace eval ::foo::bar {puts "[\fBmc\fR m1]; [\fBmc\fR m2]; [\fBmc\fR m3]"} .CE will print .CS :: message1; :: message2; :: message3 :: message1; ::foo message2; ::foo message3 :: message1; ::foo message2; ::foo::bar message3 .CE .SH "LOCATION AND FORMAT OF MESSAGE FILES" .PP Message files can be located in any directory, subject to the following conditions: .IP [1] All message files for a package are in the same directory. .IP [2]
︙
240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275	239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272	- + - - + -	The file contains a series of calls to \fBmcset\fR and \fBmcmset\fR, setting the necessary translation strings for the language, likely enclosed in a \fBnamespace eval\fR so that all source strings are tied to the namespace of the package. For example, a short \fBes.msg\fR might contain: .CS namespace eval ::mypackage { ::msgcat::mcset es "Free Beer!" "Cerveza Gracias!" \fB::msgcat::mcset\fR es "Free Beer!" "Cerveza Gracias!" } .CE .SH "RECOMMENDED MESSAGE SETUP FOR PACKAGES" .PP If a package is installed into a subdirectory of the \fBtcl_pkgPath\fR and loaded via \fBpackage require\fR, the following procedure is recommended. .IP [1] During package installation, create a subdirectory \fBmsgs\fR under your package directory. .IP [2] Copy your *.msg files into that directory. .IP [3] Add the following command to your package initialization script: .CS # load language files, stored in msgs subdirectory ::msgcat::mcload [file join [file dirname [info script]] msgs] \fB::msgcat::mcload\fR [file join [file dirname [info script]] msgs] .CE .SH "POSITIONAL CODES FOR FORMAT AND SCAN COMMANDS" .PP It is possible that a message string used as an argument to \fBformat\fR might have positionally dependent parameters that might need to be repositioned. For example, it might be syntactically desirable to rearrange the sentence structure while translating.
︙
283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299	280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295	-	.CS format "We produced %1\\$d units in location %2\\$s" $num $city format "In location %2\\$s we produced %1\\$d units" $num $city .CE .PP Similarly, positional parameters can be used with \fBscan\fR to extract values from internationalized strings. .SH CREDITS .PP The message catalog code was developed by Mark Harrison. .SH "SEE ALSO" format(n), scan(n), namespace(n), package(n) .SH KEYWORDS internationalization, i18n, localization, l10n, message, text, translation

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	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	- + - - + + - + - + - +	'\" '\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies '\" Copyright (c) 1997 Sun Microsystems, Inc. '\" Copyright (c) 2000 Scriptics Corporation. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: namespace.n,v 1.9 2003/01/21 20:06:11 jenglish Exp $ '\" RCS: @(#) $Id: namespace.n,v 1.9.2.2 2005/05/12 16:23:11 dgp Exp $ '\" .so man.macros .TH namespace n 8.0 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME namespace \- create and manipulate contexts for commands and variables .SH SYNOPSIS \fBnamespace \fR?\fIoption\fR? ?\fIarg ...\fR? .BE .SH DESCRIPTION .PP The \fBnamespace\fR command lets you create, access, and destroy separate contexts for commands and variables. See the section \fBWHAT IS A NAMESPACE?\fR below for a brief overview of namespaces. The legal \fIoption\fR's are listed below. Note that you can abbreviate the \fIoption\fR's. The legal values of \fIoption\fR are listed below. Note that you can abbreviate the \fIoption\fRs. .TP \fBnamespace children \fR?\fInamespace\fR? ?\fIpattern\fR? Returns a list of all child namespaces that belong to the namespace \fInamespace\fR. If \fInamespace\fR is not specified, then the children are returned for the current namespace. This command returns fully-qualified names, which start with \fB::\fR. which start with a double colon (\fB::\fR). If the optional \fIpattern\fR is given, then this command returns only the names that match the glob-style pattern. The actual pattern used is determined as follows: a pattern that starts with \fB::\fR is used directly, a pattern that starts with double colon (\fB::\fR) is used directly, otherwise the namespace \fInamespace\fR (or the fully-qualified name of the current namespace) is prepended onto the the pattern. is prepended onto the pattern. .TP \fBnamespace code \fIscript\fR Captures the current namespace context for later execution of the script \fIscript\fR. It returns a new script in which \fIscript\fR has been wrapped in a \fBnamespace inscope\fR command. The new script has two important properties.
︙
62 63 64 65 66 67 68 69 70 71 72 73 74 75 76	62 63 64 65 66 67 68 69 70 71 72 73 74 75 76	- +	and will have the same effect as the command \fB::namespace eval ::a::b {foo bar x y}\fR. This command is needed because extensions like Tk normally execute callback scripts in the global namespace. A scoped command captures a command together with its namespace context in a way that allows it to be executed properly later. See the section \fBSCOPED VALUES\fR for some examples See the section \fBSCOPED SCRIPTS\fR for some examples of how this is used to create callback scripts. .TP \fBnamespace current\fR Returns the fully-qualified name for the current namespace. The actual name of the global namespace is ``'' (i.e., an empty string), but this command returns \fB::\fR for the global namespace
︙
125 126 127 128 129 130 131 132 133 134 135 136 137 138 139	125 126 127 128 129 130 131 132 133 134 135 136 137 138 139	- +	If no \fIpattern\fRs are given and the \-\fBclear\fR flag isn't given, this command returns the namespace's current export list. .TP \fBnamespace forget \fR?\fIpattern pattern ...\fR? Removes previously imported commands from a namespace. Each \fIpattern\fR is a simple or qualified name such as \fBx\fR, \fBfoo::x\fR or \fBa::b::p*\fR. Qualified names contain \fB::\fRs and qualify a name Qualified names contain double colons (\fB::\fR) and qualify a name with the name of one or more namespaces. Each \fIqualified pattern\fR is qualified with the name of an exporting namespace and may have glob-style special characters in the command name at the end of the qualified name. Glob characters may not appear in a namespace name. For each \fIsimple pattern\fR this command deletes the matching
︙
207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232	207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232	- + - +	Returns the fully-qualified name of the parent namespace for namespace \fInamespace\fR. If \fInamespace\fR is not specified, the fully-qualified name of the current namespace's parent is returned. .TP \fBnamespace qualifiers\fR \fIstring\fR Returns any leading namespace qualifiers for \fIstring\fR. Qualifiers are namespace names separated by \fB::\fRs. Qualifiers are namespace names separated by double colons (\fB::\fR). For the \fIstring\fR \fB::foo::bar::x\fR, this command returns \fB::foo::bar\fR, and for \fB::\fR it returns an empty string. This command is the complement of the \fBnamespace tail\fR command. Note that it does not check whether the namespace names are, in fact, the names of currently defined namespaces. .TP \fBnamespace tail\fR \fIstring\fR Returns the simple name at the end of a qualified string. Qualifiers are namespace names separated by \fB::\fRs. Qualifiers are namespace names separated by double colons (\fB::\fR). For the \fIstring\fR \fB::foo::bar::x\fR, this command returns \fBx\fR, and for \fB::\fR it returns an empty string. This command is the complement of the \fBnamespace qualifiers\fR command. It does not check whether the namespace names are, in fact, the names of currently defined namespaces. .TP
︙
240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274	240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273	- - - - + + + - - - - + + + + - +	this command returns an empty string. If the variable has been created but not defined, such as with the \fBvariable\fR command or through a \fBtrace\fR on the variable, this command will return the fully-qualified name of the variable. If no flag is given, \fIname\fR is treated as a command name. See the section \fBNAME RESOLUTION\fR below for an explanation of the rules regarding name resolution. .SH "WHAT IS A NAMESPACE?" .PP A namespace is a collection of commands and variables. It encapsulates the commands and variables to ensure that they won't interfere with the commands and variables of other namespaces. Tcl has always had one such collection, which we refer to as the \fIglobal namespace\fR. The global namespace holds all global variables and commands. The \fBnamespace eval\fR command lets you create new namespaces. For example, .CS \fBnamespace eval Counter { namespace export bump variable num 0 \fBnamespace eval\fR Counter { \fBnamespace export\fR bump variable num 0 proc bump {} { variable num incr num } proc bump {} { variable num incr num } }\fR } .CE creates a new namespace containing the variable \fBnum\fR and the procedure \fBbump\fR. The commands and variables in this namespace are separate from other commands and variables in the same program. If there is a command named \fBbump\fR in the global namespace, for example, it will be different from the command \fBbump\fR
︙
282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575	281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620	- - - - - - + + + + + + - - - - + + + + - + - + - - - + + - - + + - + - + - + - + - - + + - - - - + + + - + - - - + + + - - - + + + - + - + - + - + - - - + + - + - - + + - + - + - + - + - + - - - - - + + + + - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + - + - + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	Namespaces are dynamic. You can add and delete commands and variables at any time, so you can build up the contents of a namespace over time using a series of \fBnamespace eval\fR commands. For example, the following series of commands has the same effect as the namespace definition shown above: .CS \fBnamespace eval Counter { variable num 0 proc bump {} { variable num return [incr num] } \fBnamespace eval\fR Counter { variable num 0 proc bump {} { variable num return [incr num] } } namespace eval Counter { proc test {args} { return $args } \fBnamespace eval\fR Counter { proc test {args} { return $args } } namespace eval Counter { \fBnamespace eval\fR Counter { rename test "" }\fR } .CE Note that the \fBtest\fR procedure is added to the \fBCounter\fR namespace, and later removed via the \fBrename\fR command. .PP Namespaces can have other namespaces within them, so they nest hierarchically. A nested namespace is encapsulated inside its parent namespace and can not interfere with other namespaces. .SH "QUALIFIED NAMES" .PP Each namespace has a textual name such as \fBhistory\fR or \fB::safe::interp\fR. Since namespaces may nest, qualified names are used to refer to commands, variables, and child namespaces contained inside namespaces. Qualified names are similar to the hierarchical path names for Unix files or Tk widgets, except that \fB::\fR is used as the separator instead of \fB/\fR or \fB.\fR. The topmost or global namespace has the name ``'' (i.e., an empty string), although \fB::\fR is a synonym. As an example, the name \fB::safe::interp::create\fR refers to the command \fBcreate\fR in the namespace \fBinterp\fR that is a child of of namespace \fB::safe\fR, which in turn is a child of the global namespace \fB::\fR. that is a child of namespace \fB::safe\fR, which in turn is a child of the global namespace, \fB::\fR. .PP If you want to access commands and variables from another namespace, you must use some extra syntax. Names must be qualified by the namespace that contains them. From the global namespace, we might access the \fBCounter\fR procedures like this: .CS \fBCounter::bump 5 Counter::Reset\fR Counter::bump 5 Counter::Reset .CE We could access the current count like this: .CS \fBputs "count = $Counter::num"\fR puts "count = $Counter::num" .CE When one namespace contains another, you may need more than one qualifier to reach its elements. If we had a namespace \fBFoo\fR that contained the namespace \fBCounter\fR, you could invoke its \fBbump\fR procedure from the global namespace like this: .CS \fBFoo::Counter::bump 3\fR Foo::Counter::bump 3 .CE .PP You can also use qualified names when you create and rename commands. For example, you could add a procedure to the \fBFoo\fR namespace like this: .CS \fBproc Foo::Test {args} {return $args}\fR proc Foo::Test {args} {return $args} .CE And you could move the same procedure to another namespace like this: .CS \fBrename Foo::Test Bar::Test\fR rename Foo::Test Bar::Test .CE .PP There are a few remaining points about qualified names that we should cover. Namespaces have nonempty names except for the global namespace. \fB::\fR is disallowed in simple command, variable, and namespace names except as a namespace separator. Extra \fB:\fRs in a qualified name are ignored; that is, two or more \fB:\fRs are treated as a namespace separator. Extra colons in any separator part of a qualified name are ignored; i.e. two or more colons are treated as a namespace separator. A trailing \fB::\fR in a qualified variable or command name refers to the variable or command named {}. However, a trailing \fB::\fR in a qualified namespace name is ignored. .SH "NAME RESOLUTION" .PP In general, all Tcl commands that take variable and command names support qualified names. This means you can give qualified names to such commands as \fBset\fR, \fBproc\fR, \fBrename\fR, and \fBinterp alias\fR. If you provide a fully-qualified name that starts with a \fB::\fR, there is no question about what command, variable, or namespace you mean. However, if the name does not start with a \fB::\fR (i.e., is \fIrelative\fR), Tcl follows a fixed rule for looking it up: Command and variable names are always resolved by looking first in the current namespace, and then in the global namespace. Namespace names, on the other hand, are always resolved by looking in only the current namespace. .PP In the following example, .CS \fBset traceLevel 0 namespace eval Debug { printTrace $traceLevel set traceLevel 0 \fBnamespace eval\fR Debug { printTrace $traceLevel }\fR } .CE Tcl looks for \fBtraceLevel\fR in the namespace \fBDebug\fR and then in the global namespace. It looks up the command \fBprintTrace\fR in the same way. If a variable or command name is not found in either context, the name is undefined. To make this point absolutely clear, consider the following example: .CS \fBset traceLevel 0 namespace eval Foo { variable traceLevel 3 set traceLevel 0 \fBnamespace eval\fR Foo { variable traceLevel 3 namespace eval Debug { printTrace $traceLevel } \fBnamespace eval\fR Debug { printTrace $traceLevel } }\fR } .CE Here Tcl looks for \fBtraceLevel\fR first in the namespace \fBFoo::Debug\fR. Since it is not found there, Tcl then looks for it in the global namespace. The variable \fBFoo::traceLevel\fR is completely ignored during the name resolution process. .PP You can use the \fBnamespace which\fR command to clear up any question about name resolution. For example, the command: .CS \fBnamespace eval Foo::Debug {namespace which \-variable traceLevel}\fR \fBnamespace eval\fR Foo::Debug {\fBnamespace which\fR \-variable traceLevel} .CE returns \fB::traceLevel\fR. On the other hand, the command, .CS \fBnamespace eval Foo {namespace which \-variable traceLevel}\fR \fBnamespace eval\fR Foo {\fBnamespace which\fR \-variable traceLevel} .CE returns \fB::Foo::traceLevel\fR. .PP As mentioned above, namespace names are looked up differently than the names of variables and commands. Namespace names are always resolved in the current namespace. This means, for example, that a \fBnamespace eval\fR command that creates a new namespace always creates a child of the current namespace unless the new namespace name begins with a \fB::\fR. unless the new namespace name begins with \fB::\fR. .PP Tcl has no access control to limit what variables, commands, or namespaces you can reference. If you provide a qualified name that resolves to an element by the name resolution rule above, you can access the element. .PP You can access a namespace variable from a procedure in the same namespace by using the \fBvariable\fR command. Much like the \fBglobal\fR command, this creates a local link to the namespace variable. If necessary, it also creates the variable in the current namespace and initializes it. Note that the \fBglobal\fR command only creates links to variables in the global namespace. It is not necessary to use a \fBvariable\fR command if you always refer to the namespace variable using an appropriate qualified name. .SH "IMPORTING COMMANDS" .PP Namespaces are often used to represent libraries. Some library commands are used so frequently that it is a nuisance to type their qualified names. For example, suppose that all of the commands in a package like BLT are contained in a namespace called \fBBlt\fR. Then you might access these commands like this: .CS \fBBlt::graph .g \-background red Blt::table . .g 0,0\fR Blt::graph .g \-background red Blt::table . .g 0,0 .CE If you use the \fBgraph\fR and \fBtable\fR commands frequently, you may want to access them without the \fBBlt::\fR prefix. You can do this by importing the commands into the current namespace, like this: .CS \fBnamespace import Blt::*\fR \fBnamespace import\fR Blt::* .CE This adds all exported commands from the \fBBlt\fR namespace into the current namespace context, so you can write code like this: .CS \fBgraph .g \-background red table . .g 0,0\fR graph .g \-background red table . .g 0,0 .CE The \fBnamespace import\fR command only imports commands from a namespace that that namespace exported with a \fBnamespace export\fR command. .PP Importing \fIevery\fR command from a namespace is generally a bad idea since you don't know what you will get. It is better to import just the specific commands you need. For example, the command .CS \fBnamespace import Blt::graph Blt::table\fR \fBnamespace import\fR Blt::graph Blt::table .CE imports only the \fBgraph\fR and \fBtable\fR commands into the current context. .PP If you try to import a command that already exists, you will get an error. This prevents you from importing the same command from two different packages. But from time to time (perhaps when debugging), you may want to get around this restriction. You may want to reissue the \fBnamespace import\fR command to pick up new commands that have appeared in a namespace. In that case, you can use the \fB\-force\fR option, and existing commands will be silently overwritten: .CS \fBnamespace import \-force Blt::graph Blt::table\fR \fBnamespace import\fR \-force Blt::graph Blt::table .CE If for some reason, you want to stop using the imported commands, you can remove them with an \fBnamespace forget\fR command, like this: you can remove them with a \fBnamespace forget\fR command, like this: .CS \fBnamespace forget Blt::*\fR \fBnamespace forget\fR Blt::* .CE This searches the current namespace for any commands imported from \fBBlt\fR. If it finds any, it removes them. Otherwise, it does nothing. After this, the \fBBlt\fR commands must be accessed with the \fBBlt::\fR prefix. .PP When you delete a command from the exporting namespace like this: .CS \fBrename Blt::graph ""\fR rename Blt::graph "" .CE the command is automatically removed from all namespaces that import it. .SH "EXPORTING COMMANDS" You can export commands from a namespace like this: .CS \fBnamespace eval Counter { namespace export bump reset variable Num 0 variable Max 100 \fBnamespace eval\fR Counter { \fBnamespace export\fR bump reset variable Num 0 variable Max 100 proc bump {{by 1}} { variable Num incr Num $by Check return $Num } proc reset {} { variable Num set Num 0 } proc Check {} { variable Num variable Max if {$Num > $Max} { error "too high!" } } proc bump {{by 1}} { variable Num incr Num $by Check return $Num } proc reset {} { variable Num set Num 0 } proc Check {} { variable Num variable Max if {$Num > $Max} { error "too high!" } } }\fR } .CE The procedures \fBbump\fR and \fBreset\fR are exported, so they are included when you import from the \fBCounter\fR namespace, like this: .CS \fBnamespace import Counter::*\fR \fBnamespace import\fR Counter::* .CE However, the \fBCheck\fR procedure is not exported, so it is ignored by the import operation. .PP The \fBnamespace import\fR command only imports commands that were declared as exported by their namespace. The \fBnamespace export\fR command specifies what commands may be imported by other namespaces. If a \fBnamespace import\fR command specifies a command that is not exported, the command is not imported. .SH "SCOPED SCRIPTS" The \fBnamespace code\fR command is the means by which a script may be packaged for evaluation in a namespace other than the one in which it was created. It is used most often to create event handlers, Tk bindings, and traces for evaluation in the global context. For instance, the following code indicates how to direct a variable trace callback into the current namespace: .CS \fBnamespace eval\fR a { variable b proc theTraceCallback { n1 n2 op } { upvar 1 $n1 var puts "the value of $n1 has changed to $var" return } trace variable b w [\fBnamespace code\fR theTraceCallback] } set a::b c .CE When executed, it prints the message: .CS the value of a::b has changed to c .CE .SH EXAMPLES Create a namespace containing a variable and an exported command: .CS \fBnamespace eval\fR foo { variable bar 0 proc grill {} { variable bar puts "called [incr bar] times" } \fBnamespace export\fR grill } .CE .PP Call the command defined in the previous example in various ways. .CS # Direct call foo::grill # Import into current namespace, then call local alias namespace import foo::grill grill .CE .PP Look up where the command imported in the previous example came from: .CS puts "grill came from [\fBnamespace origin\fR grill]" .CE .SH "SEE ALSO" variable(n) .SH KEYWORDS exported, internal, variable

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: open.n,v 1.16 2002/07/23 18:17:12 jenglish Exp $ '\" RCS: @(#) $Id: open.n,v 1.16.2.4 2006/03/16 21:11:57 andreas_kupries Exp $ '\" .so man.macros .TH open n 8.3 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME open \- Open a file-based or command pipeline channel
︙
51 52 53 54 55 56 57 58 59 60 61 62 63 64 65	51 52 53 54 55 56 57 58 59 60 61 62 63 64 65	- +	\fBw+\fR Open the file for reading and writing. Truncate it if it exists. If it doesn't exist, create a new file. .TP 15 \fBa\fR Open the file for writing only. If the file doesn't exist, create a new empty file. Set the initial access position to the end of the file. Set the file pointer to the end of the file prior to each write. .TP 15 \fBa+\fR Open the file for reading and writing. If the file doesn't exist, create a new empty file. Set the initial access position to the end of the file. .PP In the second form, \fIaccess\fR consists of a list of any of the
︙
128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240	128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427	- + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - + - - + - - + + + + + + + + + + + + +	standard output for the pipeline is directed to the current standard output unless overridden by the command. If read-only access is used (e.g. \fIaccess\fR is \fBr\fR), standard input for the pipeline is taken from the current standard input unless overridden by the command. The id of the spawned process is accessible through the \fBpid\fR command, using the channel id returned by \fBopen\fR as argument. .PP If the command (or one of the commands) executed in the command pipeline returns an error (according to the definition in \fBexec\fR), a Tcl error is generated when \fBclose\fR is called on the channel unless the pipeline is in non-blocking mode then no exit status is returned (a silent \fBclose\fR with -blocking 0). .PP It is often useful to use the \fBfileevent\fR command with pipelines so other processing may happen at the same time as running the command in the background. .VS 8.4 .SH "SERIAL COMMUNICATIONS" .PP If \fIfileName\fR refers to a serial port, then the specified serial port is opened and initialized in a platform-dependent manner. Acceptable values for the \fIfileName\fR to use to open a serial port are described in the PORTABILITY ISSUES section. .PP The \fBfconfigure\fR command can be used to query and set additional configuration options specific to serial ports. configuration options specific to serial ports (where supported): .TP \fB\-mode\fR \fIbaud\fB,\fIparity\fB,\fIdata\fB,\fIstop\fR This option is a set of 4 comma-separated values: the baud rate, parity, number of data bits, and number of stop bits for this serial port. The \fIbaud\fR rate is a simple integer that specifies the connection speed. \fIParity\fR is one of the following letters: \fBn\fR, \fBo\fR, \fBe\fR, \fBm\fR, \fBs\fR; respectively signifying the parity options of ``none'', ``odd'', ``even'', ``mark'', or ``space''. \fIData\fR is the number of data bits and should be an integer from 5 to 8, while \fIstop\fR is the number of stop bits and should be the integer 1 or 2. .TP \fB\-handshake\fR \fItype\fR (Windows and Unix). This option is used to setup automatic handshake control. Note that not all handshake types maybe supported by your operating system. The \fItype\fR parameter is case-independent. .sp If \fItype\fR is \fBnone\fR then any handshake is switched off. \fBrtscts\fR activates hardware handshake. Hardware handshake signals are described below. For software handshake \fBxonxoff\fR the handshake characters can be redefined with \fB-xchar\fR. An additional hardware handshake \fBdtrdsr\fR is available only under Windows. There is no default handshake configuration, the initial value depends on your operating system settings. The \fB-handshake\fR option cannot be queried. .TP \fB\-queue\fR (Windows and Unix). The \fB-queue\fR option can only be queried. It returns a list of two integers representing the current number of bytes in the input and output queue respectively. .TP \fB\-timeout\fR \fImsec\fR (Windows and Unix). This option is used to set the timeout for blocking read operations. It specifies the maximum interval between the reception of two bytes in milliseconds. For Unix systems the granularity is 100 milliseconds. The \fB-timeout\fR option does not affect write operations or nonblocking reads. This option cannot be queried. .TP \fB\-ttycontrol\fR \fI{signal boolean signal boolean ...}\fR (Windows and Unix). This option is used to setup the handshake output lines (see below) permanently or to send a BREAK over the serial line. The \fIsignal\fR names are case-independent. \fB{RTS 1 DTR 0}\fR sets the RTS output to high and the DTR output to low. The BREAK condition (see below) is enabled and disabled with \fB{BREAK 1}\fR and \fB{BREAK 0}\fR respectively. It's not a good idea to change the \fBRTS\fR (or \fBDTR\fR) signal with active hardware handshake \fBrtscts\fR (or \fBdtrdsr\fR). The result is unpredictable. The \fB-ttycontrol\fR option cannot be queried. .TP \fB\-ttystatus\fR (Windows and Unix). The \fB-ttystatus\fR option can only be queried. It returns the current modem status and handshake input signals (see below). The result is a list of signal,value pairs with a fixed order, e.g. \fB{CTS 1 DSR 0 RING 1 DCD 0}\fR. The \fIsignal\fR names are returned upper case. .TP \fB\-xchar\fR \fI{xonChar xoffChar}\fR (Windows and Unix). This option is used to query or change the software handshake characters. Normally the operating system default should be DC1 (0x11) and DC3 (0x13) representing the ASCII standard XON and XOFF characters. .TP \fB\-pollinterval\fR \fImsec\fR (Windows only). This option is used to set the maximum time between polling for fileevents. This affects the time interval between checking for events throughout the Tcl interpreter (the smallest value always wins). Use this option only if you want to poll the serial port more or less often than 10 msec (the default). .TP \fB\-sysbuffer\fR \fIinSize\fR .TP \fB\-sysbuffer\fR \fI{inSize outSize}\fR (Windows only). This option is used to change the size of Windows system buffers for a serial channel. Especially at higher communication rates the default input buffer size of 4096 bytes can overrun for latent systems. The first form specifies the input buffer size, in the second form both input and output buffers are defined. .TP \fB\-lasterror\fR (Windows only). This option is query only. In case of a serial communication error, \fBread\fR or \fBputs\fR returns a general Tcl file I/O error. \fBfconfigure -lasterror\fR can be called to get a list of error details. See below for an explanation of the various error codes. .SH "SERIAL PORT SIGNALS" .PP RS-232 is the most commonly used standard electrical interface for serial communications. A negative voltage (-3V..-12V) define a mark (on=1) bit and a positive voltage (+3..+12V) define a space (off=0) bit (RS-232C). The following signals are specified for incoming and outgoing data, status lines and handshaking. Here we are using the terms \fIworkstation\fR for your computer and \fImodem\fR for the external device, because some signal names (DCD, RI) come from modems. Of course your external device may use these signal lines for other purposes. .IP \fBTXD(output)\fR \fBTransmitted Data:\fR Outgoing serial data. .IP \fBRXD(input)\fR \fBReceived Data:\fRIncoming serial data. .IP \fBRTS(output)\fR \fBRequest To Send:\fR This hardware handshake line informs the modem that your workstation is ready to receive data. Your workstation may automatically reset this signal to indicate that the input buffer is full. .IP \fBCTS(input)\fR \fBClear To Send:\fR The complement to RTS. Indicates that the modem is ready to receive data. .IP \fBDTR(output)\fR \fBData Terminal Ready:\fR This signal tells the modem that the workstation is ready to establish a link. DTR is often enabled automatically whenever a serial port is opened. .IP \fBDSR(input)\fR \fBData Set Ready:\fR The complement to DTR. Tells the workstation that the modem is ready to establish a link. .IP \fBDCD(input)\fR \fBData Carrier Detect:\fR This line becomes active when a modem detects a "Carrier" signal. .IP \fBRI(input)\fR \fBRing Indicator:\fR Goes active when the modem detects an incoming call. .IP \fBBREAK\fR A BREAK condition is not a hardware signal line, but a logical zero on the TXD or RXD lines for a long period of time, usually 250 to 500 milliseconds. Normally a receive or transmit data signal stays at the mark (on=1) voltage until the next character is transferred. A BREAK is sometimes used to reset the communications line or change the operating mode of communications hardware. .SH "ERROR CODES (Windows only)" .PP A lot of different errors may occur during serial read operations or during event polling in background. The external device may have been switched off, the data lines may be noisy, system buffers may overrun or your mode settings may be wrong. That's why a reliable software should always \fBcatch\fR serial read operations. In cases of an error Tcl returns a general file I/O error. Then \fBfconfigure -lasterror\fR may help to locate the problem. The following error codes may be returned. .TP 10 \fBRXOVER\fR Windows input buffer overrun. The data comes faster than your scripts reads it or your system is overloaded. Use \fBfconfigure -sysbuffer\fR to avoid a temporary bottleneck and/or make your script faster. .TP 10 \fBTXFULL\fR Windows output buffer overrun. Complement to RXOVER. This error should practically not happen, because Tcl cares about the output buffer status. .TP 10 \fBOVERRUN\fR UART buffer overrun (hardware) with data lost. The data comes faster than the system driver receives it. Check your advanced serial port settings to enable the FIFO (16550) buffer and/or setup a lower(1) interrupt threshold value. .TP 10 \fBRXPARITY\fR A parity error has been detected by your UART. Wrong parity settings with \fBfconfigure -mode\fR or a noisy data line (RXD) may cause this error. .TP 10 \fBFRAME\fR A stop-bit error has been detected by your UART. Wrong mode settings with \fBfconfigure -mode\fR or a noisy data line (RXD) may cause this error. .TP 10 \fBBREAK\fR A BREAK condition has been detected by your UART (see above). .VE .SH "PORTABILITY ISSUES" .TP \fBWindows \fR(all versions) . Valid values for \fIfileName\fR to open a serial port are of the form \fBcom\fIX\fB:\fR, where \fIX\fR is a number, generally from 1 to 4. This notation only works for serial ports from 1 to 9, if the system happens to have more than four. An attempt to open a serial port that does not exist or has a number greater than 9 will fail. An alternate form of opening serial ports is to use the filename \fB\e\e.\ecomX\fR, where X is any number that corresponds to a serial port; please note that this method is considerably slower on Windows 95 and Windows 98. .TP \fBWindows NT\fR . When running Tcl interactively, there may be some strange interactions between the real console, if one is present, and a command pipeline that uses standard input or output. If a command pipeline is opened for reading, some of the lines entered at the console will be sent to the command pipeline and some will be sent to the Tcl evaluator. If a command pipeline is opened for writing, keystrokes entered into the console are not visible until the the writing, keystrokes entered into the console are not visible until the pipe is closed. This behavior occurs whether the command pipeline is executing 16-bit or 32-bit applications. These problems only occur because both Tcl and the child application are competing for the console at the same time. If the command pipeline is started from a script, so that Tcl is not accessing the console, or if the command pipeline does not use standard input or output, but is redirected from or to a file, then the above problems do not occur. .TP \fBWindows 95\fR . A command pipeline that executes a 16-bit DOS application cannot be opened for both reading and writing, since 16-bit DOS applications that receive standard input from a pipe and send standard output to a pipe run synchronously. Command pipelines that do not execute 16-bit DOS applications run asynchronously and can be opened for both reading and writing. .sp When running Tcl interactively, there may be some strange interactions between the real console, if one is present, and a command pipeline that uses standard input or output. If a command pipeline is opened for reading from a 32-bit application, some of the keystrokes entered at the console will be sent to the command pipeline and some will be sent to the Tcl evaluator. If a command pipeline is opened for writing to a 32-bit application, no output is visible on the console until the the pipe is closed. These problems only is visible on the console until the pipe is closed. These problems only occur because both Tcl and the child application are competing for the console at the same time. If the command pipeline is started from a script, so that Tcl is not accessing the console, or if the command pipeline does not use standard input or output, but is redirected from or to a file, then the above problems do not occur. .sp Whether or not Tcl is running interactively, if a command pipeline is opened for reading from a 16-bit DOS application, the call to \fBopen\fR will not return until end-of-file has been received from the command pipeline's standard output. If a command pipeline is opened for writing to a 16-bit DOS application, no data will be sent to the command pipeline's standard output until the pipe is actually closed. This problem occurs because 16-bit DOS applications are run synchronously, as described above. .TP \fBMacintosh\fR . Opening a serial port is not currently implemented under Macintosh. .sp Opening a command pipeline is not supported under Macintosh, since applications do not support the concept of standard input or output. .TP \fBUnix\fR\0\0\0\0\0\0\0 . Valid values for \fIfileName\fR to open a serial port are generally of the form \fB/dev/tty\fIX\fR, where \fIX\fR is \fBa\fR or \fBb\fR, but the name of any pseudo-file that maps to a serial port may be used. .VS 8.4 Advanced configuration options are only supported for serial ports when Tcl is built to use the POSIX serial interface. .VE 8.4 .sp When running Tcl interactively, there may be some strange interactions between the console, if one is present, and a command pipeline that uses standard input. If a command pipeline is opened for reading, some of the lines entered at the console will be sent to the command pipeline and some will be sent to the Tcl evaluator. This problem only occurs because both Tcl and the child application are competing for the console at the same time. If the command pipeline is started from a script, so that Tcl is not accessing the console, or if the command pipeline does not use standard input, but is redirected from a file, then the above problem does not occur. .LP See the PORTABILITY ISSUES section of the \fBexec\fR command for additional information not specific to command pipelines about executing applications on the various platforms .SH "EXAMPLE" Open a command pipeline and catch any errors: .CS set fl [\fBopen\fR "| ls this_file_does_not_exist"] set data [read $fl] if {[catch {close $fl} err]} { puts "ls command failed: $err" } .CE .SH "SEE ALSO" file(n), close(n), filename(n), fconfigure(n), gets(n), read(n), puts(n), exec(n), pid(n), fopen(3) .SH KEYWORDS access mode, append, create, file, non-blocking, open, permissions, pipeline, process, serial

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: package.n,v 1.6 2002/01/27 17:35:06 dgp Exp $ '\" RCS: @(#) $Id: package.n,v 1.6.2.3 2006/09/04 19:35:49 hobbs Exp $ '\" .so man.macros .TH package n 7.5 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME package \- Facilities for package loading and version control
︙
86 87 88 89 90 91 92 93 94 95 96 97 98 99 100	86 87 88 89 90 91 92 93 94 95 96 97 98 99 100	- +	It is typically invoked once as part of an \fBifneeded\fR script, and again by the package itself when it is finally loaded. An error occurs if a different version of \fIpackage\fR has been provided by a previous \fBpackage provide\fR command. If the \fIversion\fR argument is omitted, then the command returns the version number that is currently provided, or an empty string if no \fBpackage provide\fR command has been invoked for \fIpackage\fR in this interpreter. invoked for \fIpackage\fR in this interpreter. .TP \fBpackage require \fR?\fB\-exact\fR? \fIpackage \fR?\fIversion\fR? This command is typically invoked by Tcl code that wishes to use a particular version of a particular package. The arguments indicate which package is wanted, and the command ensures that a suitable version of the package is loaded into the interpreter. If the command succeeds, it returns the version number that is
︙
157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198	157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215	- - + + + + + + + + + + + + + + + + + + +	commands. .TP \fBpackage vsatisfies \fIversion1 version2\fR Returns 1 if scripts written for \fIversion2\fR will work unchanged with \fIversion1\fR (i.e. \fIversion1\fR is equal to or greater than \fIversion2\fR and they both have the same major version number), 0 otherwise. .SH "VERSION NUMBERS" .PP Version numbers consist of one or more decimal numbers separated by dots, such as 2 or 1.162 or 3.1.13.1. The first number is called the major version number. Larger numbers correspond to later versions of a package, with leftmost numbers having greater significance. For example, version 2.1 is later than 1.3 and version 3.4.6 is later than 3.3.5. Missing fields are equivalent to zeroes: version 1.3 is the same as version 1.3.0 and 1.3.0.0, so it is earlier than 1.3.1 or 1.3.0.2. A later version number is assumed to be upwards compatible with an earlier version number as long as both versions have the same major version number. For example, Tcl scripts written for version 2.3 of a package should work unchanged under versions 2.3.2, 2.4, and 2.5.1. Changes in the major version number signify incompatible changes: if code is written to use version 2.1 of a package, it is not guaranteed to work unmodified with either version 1.7.3 or version 3.1. .SH "PACKAGE INDICES" .PP The recommended way to use packages in Tcl is to invoke \fBpackage require\fR and \fBpackage provide\fR commands in scripts, and use the procedure \fBpkg_mkIndex\fR to create package index files. Once you've done this, packages will be loaded automatically in response to \fBpackage require\fR commands. See the documentation for \fBpkg_mkIndex\fR for details. .SH EXAMPLES To state that a Tcl script requires the Tk and http packages, put this at the top of the script: .CS \fBpackage require\fR Tk \fBpackage require\fR http .CE .PP To test to see if the Snack package is available and load if it is (often useful for optional enhancements to programs where the loss of the functionality is not critical) do this: .CS if {[catch {\fBpackage require\fR Snack}]} { # Error thrown - package not found. # Set up a dummy interface to work around the absence } else { # We have the package, configure the app to use it } .CE .SH "SEE ALSO" msgcat(n), packagens(n), pkgMkIndex(n) .SH KEYWORDS package, version

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

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

- + - + + + + + + + + + + + + + +

'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: pid.n,v 1.3 2000/09/07 14:27:50 poenitz Exp $ '\" RCS: @(#) $Id: pid.n,v 1.3.18.1 2004/10/27 14:23:57 dkf Exp $ '\" .so man.macros .TH pid n 7.0 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME pid \- Retrieve process id(s) pid \- Retrieve process identifiers .SH SYNOPSIS \fBpid \fR?\fIfileId\fR? .BE .SH DESCRIPTION .PP If the \fIfileId\fR argument is given then it should normally refer to a process pipeline created with the \fBopen\fR command. In this case the \fBpid\fR command will return a list whose elements are the process identifiers of all the processes in the pipeline, in order. The list will be empty if \fIfileId\fR refers to an open file that isn't a process pipeline. If no \fIfileId\fR argument is given then \fBpid\fR returns the process identifier of the current process. All process identifiers are returned as decimal strings. .SH EXAMPLE Print process information about the processes in a pipeline using the SysV \fBps\fR program before reading the output of that pipeline: .PP .CS set pipeline [open "| zcat somefile.gz | grep foobar | sort -u"] # Print process information exec ps -fp [\fBpid\fR $pipeline] >@stdout # Print a separator and then the output of the pipeline puts [string repeat - 70] puts [read $pipeline] close $pipeline .CE .SH "SEE ALSO" exec(n), open(n) .SH KEYWORDS file, pipeline, process identifier

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: proc.n,v 1.3 2000/09/07 14:27:50 poenitz Exp $ '\" RCS: @(#) $Id: proc.n,v 1.3.18.1 2004/10/27 14:23:57 dkf Exp $ '\" .so man.macros .TH proc n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME proc \- Create a Tcl procedure
︙
65 66 67 68 69 70 71 72 73 74 75 76 77	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	+ + + + + + + + + + + + + + + + + + + +	The \fBproc\fR command returns an empty string. When a procedure is invoked, the procedure's return value is the value specified in a \fBreturn\fR command. If the procedure doesn't execute an explicit \fBreturn\fR, then its return value is the value of the last command executed in the procedure's body. If an error occurs while executing the procedure body, then the procedure-as-a-whole will return that same error. .SH EXAMPLES This is a procedure that accepts arbitrarily many arguments and prints them out, one by one. .CS \fBproc\fR printArguments args { foreach arg $args { puts $arg } } .CE .PP This procedure is a bit like the \fBincr\fR command, except it multiplies the contents of the named variable by the value, which defaults to \fB2\fR: .CS \fBproc\fR mult {varName {multiplier 2}} { upvar 1 $varName var set var [expr {$var * $multiplier}] } .CE .SH "SEE ALSO" info(n), unknown(n) .SH KEYWORDS argument, procedure

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: puts.n,v 1.5 2001/09/14 19:20:40 andreas_kupries Exp $ '\" RCS: @(#) $Id: puts.n,v 1.5.8.1 2004/10/27 14:23:57 dkf Exp $ '\" .so man.macros .TH puts n 7.5 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME puts \- Write to a channel
︙
64 65 66 67 68 69 70 71 72 73 74 75 76	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	+ + + + + + + + + + + + + + + + + + + + + + + + +	It is possible for an arbitrarily large amount of data to be buffered for a channel in nonblocking mode, which could consume a large amount of memory. To avoid wasting memory, nonblocking I/O should normally be used in an event-driven fashion with the \fBfileevent\fR command (don't invoke \fBputs\fR unless you have recently been notified via a file event that the channel is ready for more output data). .SH EXAMPLES Write a short message to the console (or wherever \fBstdout\fR is directed): .CS \fBputs\fR "Hello, World!" .CE .PP Print a message in several parts: .CS \fBputs\fR -nonewline "Hello, " \fBputs\fR "World!" .CE .PP Print a message to the standard error channel: .CS \fBputs\fR stderr "Hello, World!" .CE .PP Append a log message to a file: .CS set chan [open my.log a] set timestamp [clock format [clock seconds]] \fBputs\fR $chan "$timestamp - Hello, World!" close $chan .CE .SH "SEE ALSO" file(n), fileevent(n), Tcl_StandardChannels(3) .SH KEYWORDS channel, newline, output, write

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

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

- + - + - + + + + + + + + + + + + + + +

'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: pwd.n,v 1.3 2000/09/07 14:27:50 poenitz Exp $ '\" RCS: @(#) $Id: pwd.n,v 1.3.18.1 2004/10/27 14:23:57 dkf Exp $ '\" .so man.macros .TH pwd n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME pwd \- Return the current working directory pwd \- Return the absolute path of the current working directory .SH SYNOPSIS \fBpwd\fR .BE .SH DESCRIPTION .PP Returns the path name of the current working directory. Returns the absolute path name of the current working directory. .SH EXAMPLE Sometimes it is useful to change to a known directory when running some external command using \fBexec\fR, but it is important to keep the application usually running in the directory that it was started in (unless the user specifies otherwise) since that minimises user confusion. The way to do this is to save the current directory while the external command is being run: .CS set tarFile [file normalize somefile.tar] set savedDir [\fBpwd\fR] cd /tmp exec tar -xf $tarFile cd $savedDir .CE .SH "SEE ALSO" file(n), cd(n), glob(n), filename(n) .SH KEYWORDS working directory

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1998 Sun Microsystems, Inc. '\" Copyright (c) 1999 Scriptics Corporation '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: re_syntax.n,v 1.3 1999/07/14 19:09:36 jpeek Exp $ '\" RCS: @(#) $Id: re_syntax.n,v 1.3.32.1 2006/04/12 02:19:53 das Exp $ '\" .so man.macros .TH re_syntax n "8.1" Tcl "Tcl Built-In Commands" .BS .SH NAME re_syntax \- Syntax of Tcl regular expressions. .BE
︙
275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290	275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290	- +	(not all collating elements!) belonging to that class. Standard character classes are: .PP .RS .ne 5 .nf .ta 3c .nf \fBalpha\fR A letter. \fBupper\fR An upper-case letter. \fBlower\fR A lower-case letter. \fBdigit\fR A decimal digit. \fBxdigit\fR A hexadecimal digit. \fBalnum\fR An alphanumeric (letter or digit). \fBprint\fR An alphanumeric (same as alnum).
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: read.n,v 1.7 2001/09/14 19:20:40 andreas_kupries Exp $ '\" RCS: @(#) $Id: read.n,v 1.7.8.1 2004/10/27 14:23:57 dkf Exp $ '\" .so man.macros .TH read n 8.1 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME read \- Read from a channel
︙
69 70 71 72 73 74 75 76 77 78 79 80 81 82	69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90	- + + + + + + + + +	from the serial port. .TP \fBread \fIchannelId\fR In this form \fBread\fR blocks until the reception of the end-of-file character, see \fBfconfigure -eofchar\fR. If there no end-of-file character has been configured for the channel, then \fBread\fR will block forever. .SH "EXAMPLE" This example code reads a file all at once, and splits it into a list, with each line in the file corresponding to an element in the list: .CS set fl [open /proc/meminfo] set data [\fBread\fR $fl] close $fl set lines [split $data \\n] .CE .SH "SEE ALSO" file(n), eof(n), fblocked(n), fconfigure(n), Tcl_StandardChannels(3) .SH KEYWORDS blocking, channel, end of line, end of file, nonblocking, read, translation, encoding

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1998 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: regexp.n,v 1.12 2002/10/10 14:46:57 dgp Exp $ '\" RCS: @(#) $Id: regexp.n,v 1.12.2.1 2004/10/27 14:23:57 dkf Exp $ '\" .so man.macros .TH regexp n 8.3 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME regexp \- Match a regular expression against a string
︙
122 123 124 125 126 127 128 129 130 131 132 133 134	122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161	+ + + + + + + + + + + + + + + + + + + + + + + + + + +	.PP If there are more \fIsubMatchVar\fR's than parenthesized subexpressions within \fIexp\fR, or if a particular subexpression in \fIexp\fR doesn't match the string (e.g. because it was in a portion of the expression that wasn't matched), then the corresponding \fIsubMatchVar\fR will be set to ``\fB\-1 \-1\fR'' if \fB\-indices\fR has been specified or to an empty string otherwise. .SH EXAMPLES Find the first occurrence of a word starting with \fBfoo\fR in a string that is not actually an instance of \fBfoobar\fR, and get the letters following it up to the end of the word into a variable: .CS \fBregexp\fR {\\<foo(?!bar\\>)(\\w*)} $string \-> restOfWord .CE Note that the whole matched substring has been placed in the variable \fB\->\fR which is a name chosen to look nice given that we are not actually interested in its contents. .PP Find the index of the word \fBbadger\fR (in any case) within a string and store that in the variable \fBlocation\fR: .CS \fBregexp\fR \-indices {(?i)\\<badger\\>} $string location .CE .PP Count the number of octal digits in a string: .CS \fBregexp\fR \-all {[0\-7]} $string .CE .PP List all words (consisting of all sequences of non-whitespace characters) in a string: .CS \fBregexp\fR \-all \-inline {\\S+} $string .CE .SH "SEE ALSO" re_syntax(n), regsub(n) .SH KEYWORDS match, regular expression, string

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1997 Sun Microsystems, Inc. '\" Copyright (c) 2002 ActiveState Corporation. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: registry.n,v 1.8 2002/10/19 01:48:46 hobbs Exp $ '\" RCS: @(#) $Id: registry.n,v 1.8.2.2 2004/11/12 09:02:30 das Exp $ '\" .so man.macros .TH registry n 1.1 registry "Tcl Bundled Packages" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME registry \- Manipulate the Windows registry
︙
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	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	- + - +	\fBHKEY_DYN_DATA\fR. The \fIkeypath\fR can be one or more .VE registry key names separated by backslash (\fB\e\fR) characters. .PP \fIOption\fR indicates what to do with the registry key name. Any unique abbreviation for \fIoption\fR is acceptable. The valid options are: .TP .VS 8.4 .TP \fBregistry broadcast \fIkeyName\fR ?\fI-timeout milliseconds\fR? . Sends a broadcast message to the system and running programs to notify them of certain updates. This is necessary to propagate changes to key registry keys like Environment. The timeout specifies the amount of time, in milliseconds, to wait for applications to respond to the broadcast message. It defaults to 3000. The following example demonstrates how to add a path to the global Environment and notify applications of the change without reguiring a logoff/logon step (assumes admin privileges): requiring a logoff/logon step (assumes admin privileges): .CS set regPath {HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment} set curPath [registry get $regPath "Path"] registry set $regPath "Path" "$curPath;$addPath" registry broadcast "Environment" .CE .VE 8.4
︙
175 176 177 178 179 180 181 182 183 184 185 186 187	175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202	- + + + + + + + + + + + + + + + +	The registry value contains a device-driver resource list. The data is represented exactly in Tcl, including any embedded nulls. .PP In addition to the symbolically named types listed above, unknown types are identified using a 32-bit integer that corresponds to the type code returned by the system interfaces. In this case, the data is represented exactly in Tcl, including any embedded nulls. .SH "PORTABILITY ISSUES" The registry command is only available on Windows. .SH EXAMPLE Print out how double-clicking on a Tcl script file will invoke a Tcl interpreter: .CS package require registry set ext .tcl # Read the type name set type [\fBregistry get\fR HKEY_CLASSES_ROOT\e\e$ext {}] # Work out where to look for the command set path HKEY_CLASSES_ROOT\e\e$type\e\eShell\e\eOpen\e\ecommand # Read the command! set command [\fBregistry get\fR $path {}] puts "$ext opens with $command" .CE .SH KEYWORDS registry

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" Copyright (c) 2000 Scriptics Corporation. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: regsub.n,v 1.9 2003/02/20 15:33:02 dkf Exp $ '\" RCS: @(#) $Id: regsub.n,v 1.9.2.1 2004/10/27 14:23:58 dkf Exp $ '\" .so man.macros .TH regsub n 8.3 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME regsub \- Perform substitutions based on regular expression pattern matching
︙
110 111 112 113 114 115 116 117 118 119 120 121 122	110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148	+ + + + + + + + + + + + + + + + + + + + + + + + + + - +	.VS 8.4 If \fIvarName\fR is supplied, the command returns a count of the number of matching ranges that were found and replaced, otherwise the string after replacement is returned. .VE 8.4 See the manual entry for \fBregexp\fR for details on the interpretation of regular expressions. .SH EXAMPLES Replace (in the string in variable \fIstring\fR) every instance of \fBfoo\fR which is a word by itself with \fBbar\fR: .CS \fBregsub\fR -all {\e<foo\e>} $string bar string .CE .PP Insert double-quotes around the first instance of the word \fBinteresting\fR, however it is capitalised. .CS \fBregsub\fR -nocase {\e<interesting\e>} $string {"&"} string .CE .PP Convert all non-ASCII and Tcl-significant characters into \eu escape sequences by using \fBregsub\fR and \fBsubst\fR in combination: .CS # This RE is just a character class for everything "bad" set RE {[][{}\e$\es\eu0100-\euffff]} # We will substitute with a fragment of Tcl script in brackets set substitution {[format \e\e\e\eu%04x [scan "\e\e&" %c]]} # Now we apply the substitution to get a subst-string that # will perform the computational parts of the conversion. set quoted [subst [\fBregsub\fR -all $RE $string $substitution]] .CE .SH "SEE ALSO" regexp(n), re_syntax(n) regexp(n), re_syntax(n), subst(n) .SH KEYWORDS match, pattern, regular expression, substitute

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-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. '\" '\" RCS: @(#) $Id: rename.n,v 1.3 2000/09/07 14:27:51 poenitz Exp $ '\" RCS: @(#) $Id: rename.n,v 1.3.18.1 2004/10/27 14:23:58 dkf Exp $ '\" .so man.macros .TH rename n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME rename \- Rename or delete a command
︙
23 24 25 26 27 28 29 30 31 32 33 34 35	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	+ + + + + + + + + + + + +	is now called \fInewName\fR. If \fInewName\fR is an empty string then \fIoldName\fR is deleted. \fIoldName\fR and \fInewName\fR may include namespace qualifiers (names of containing namespaces). If a command is renamed into a different namespace, future invocations of it will execute in the new namespace. The \fBrename\fR command returns an empty string as result. .SH EXAMPLE The \fBrename\fR command can be used to wrap the standard Tcl commands with your own monitoring machinery. For example, you might wish to count how often the \fBsource\fR command is called: .CS \fBrename\fR ::source ::theRealSource set sourceCount 0 proc ::source args { global sourceCount puts "called source for the [incr sourceCount]'th time" uplevel 1 ::theRealSource $args } .CE .SH "SEE ALSO" namespace(n), proc(n) .SH KEYWORDS command, delete, namespace, rename

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	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	- + - - + + + + - + - - - - - - - - - - - - - + + + + + + + + + + + + + + - - - - + + + + - - - - + + + + - - + - - - + + + - +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: return.n,v 1.3 2000/09/07 14:27:51 poenitz Exp $ '\" RCS: @(#) $Id: return.n,v 1.3.18.1 2004/10/27 14:23:58 dkf Exp $ '\" .so man.macros .TH return n 7.0 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME return \- Return from a procedure .SH SYNOPSIS \fBreturn \fR?\fB\-code \fIcode\fR? ?\fB\-errorinfo \fIinfo\fR? ?\fB\-errorcode\fI code\fR? ?\fIstring\fR? .BE .SH DESCRIPTION .PP Return immediately from the current procedure (or top-level command or \fBsource\fR command), with \fIstring\fR as the return value. If \fIstring\fR is not specified then an empty string will be returned as result. .SH "EXCEPTIONAL RETURNS" .SH "EXCEPTIONAL RETURN CODES" .PP In addition to the result of a procedure, the return code of a procedure may also be set by \fBreturn\fR through use of the \fB-code\fR option. In the usual case where the \fB\-code\fR option isn't specified the procedure will return normally (its completion specified the procedure will return normally. code will be TCL_OK). However, the \fB\-code\fR option may be used to generate an exceptional return from the procedure. \fICode\fR may have any of the following values: .TP 10 \fBok\fR Normal return: same as if the option is omitted. .TP 10 \fBerror\fR Error return: same as if the \fBerror\fR command were used to terminate the procedure, except for handling of \fBerrorInfo\fR and \fBerrorCode\fR variables (see below). .TP 10 \fBreturn\fR The current procedure will return with a completion code of TCL_RETURN, so that the procedure that invoked it will return .TP 13 \fBok (or 0)\fR Normal return: same as if the option is omitted. The return code of the procedure is 0 (\fBTCL_OK\fR). .TP 13 \fBerror (1)\fR Error return: the return code of the procedure is 1 (\fBTCL_ERROR\fR). The procedure command behaves in its calling context as if it were the command \fBerror \fIresult\fR. See below for additional options. .TP 13 \fBreturn (2)\fR The return code of the procedure is 2 (\fBTCL_RETURN\fR). The procedure command behaves in its calling context as if it also. .TP 10 \fBbreak\fR The current procedure will return with a completion code of were the command \fBreturn\fR (with no arguments). .TP 13 \fBbreak (3)\fR The return code of the procedure is 3 (\fBTCL_BREAK\fR). The TCL_BREAK, which will terminate the innermost nested loop in the code that invoked the current procedure. .TP 10 \fBcontinue\fR procedure command behaves in its calling context as if it were the command \fBbreak\fR. .TP 13 \fBcontinue (4)\fR The current procedure will return with a completion code of TCL_CONTINUE, which will terminate the current iteration of The return code of the procedure is 4 (\fBTCL_CONTINUE\fR). The the innermost nested loop in the code that invoked the current procedure. .TP 10 procedure command behaves in its calling context as if it were the command \fBcontinue\fR. .TP 13 \fIvalue\fR \fIValue\fR must be an integer; it will be returned as the completion code for the current procedure. return code for the current procedure. .LP The \fB\-code\fR option is rarely used. It is provided so that procedures that implement new control structures can reflect exceptional conditions back to their callers. .PP Two additional options, \fB\-errorinfo\fR and \fB\-errorcode\fR,
︙
80 81 82 83 84 85 86 87 88 89 90 91 92	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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144	+ + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - +	in \fBerrorInfo\fR after a \fBcatch\fR command trapped an error within the procedure. .PP If the \fB\-errorcode\fR option is specified then \fIcode\fR provides a value for the \fBerrorCode\fR variable. If the option is not specified then \fBerrorCode\fR will default to \fBNONE\fR. .SH EXAMPLES First, a simple example of using \fBreturn\fR to return from a procedure, interrupting the procedure body. .CS proc printOneLine {} { puts "line 1" ;# This line will be printed. \fBreturn\fR puts "line 2" ;# This line will not be printed. } .CE .PP Next, an example of using \fBreturn\fR to set the value returned by the procedure. .CS proc returnX {} {\fBreturn\fR X} puts [returnX] ;# prints "X" .CE .PP Next, a more complete example, using \fBreturn -code error\fR to report invalid arguments. .CS proc factorial {n} { if {![string is integer $n] || ($n < 0)} { \fBreturn\fR -code error \\ "expected non-negative integer,\\ but got \\"$n\\"" } if {$n < 2} { \fBreturn\fR 1 } set m [expr {$n - 1}] set code [catch {factorial $m} factor] if {$code != 0} { \fBreturn\fR -code $code $factor } set product [expr {$n * $factor}] if {$product < 0} { \fBreturn\fR -code error \\ "overflow computing factorial of $n" } \fBreturn\fR $product } .CE .PP Next, a procedure replacement for \fBbreak\fR. .CS proc myBreak {} { \fBreturn\fR -code break } .CE .SH "SEE ALSO" break(n), continue(n), error(n), proc(n) break(n), catch(n), continue(n), error(n), proc(n), source(n), tclvars(n) .SH KEYWORDS break, continue, error, procedure, return break, catch, continue, error, procedure, return

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1995-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: safe.n,v 1.4 2002/07/01 18:24:39 jenglish Exp $ '\" RCS: @(#) $Id: safe.n,v 1.4.2.1 2004/10/27 14:23:58 dkf Exp $ '\" .so man.macros .TH "Safe Tcl" n 8.0 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME Safe\ Base \- A mechanism for creating and manipulating safe interpreters.
︙
205 206 207 208 209 210 211 212 213 214 215 216 217 218 219	205 206 207 208 209 210 211 212 213 214 215 216 217 218 219	- +	.TP \fB\-nestedLoadOk\fR This option is a convenience shortcut for \fB-nested true\fR and thus specifies the safe interpreter will be allowed to load packages into its own sub-interpreters. .TP \fB\-deleteHook\fR \fIscript\fR When this option is given an non empty \fIscript\fR, it will be When this option is given a non-empty \fIscript\fR, it will be evaluated in the master with the name of the safe interpreter as an additional argument just before actually deleting the safe interpreter. Giving an empty value removes any currently installed deletion hook script for that safe interpreter. The default value (\fB{}\fR) is not to have any deletion call back. .SH ALIASES
︙
284 285 286 287 288 289 290 291 292 293 294 295 296 297 298	284 285 286 287 288 289 290 291 292 293 294 295 296 297 298	- +	names on the local file system thus preventing safe interpreters from gaining knowledge about the structure of the file system of the host on which the interpreter is executing. The only valid file names arguments for the \fBsource\fR and \fBload\fR aliases provided to the slave are path in the form of \fB[file join \fR\fItoken filename\fR\fB]\fR (ie, when using the \fB[file join \fR\fItoken filename\fR\fB]\fR (i.e. when using the native file path formats: \fItoken\fR\fB/\fR\fIfilename\fR on Unix, \fItoken\fR\fB\\\fIfilename\fR on Windows, and \fItoken\fR\fB:\fR\fIfilename\fR on the Mac), where \fItoken\fR is representing one of the directories of the \fIaccessPath\fR list and \fIfilename\fR is one file in that directory (no sub directories access are allowed). .PP
︙
334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350	334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350	- +	also be added (if not already included) to the slave access path. You can always specify a more restrictive path for which sub directories will never be searched by explicitly specifying your directory list with the \fB\-accessPath\fR flag instead of relying on this default mechanism. .PP When the \fIaccessPath\fR is changed after the first creation or initialization (ie through \fBinterpConfigure -accessPath \fR\fIlist\fR), initialization (i.e. through \fBinterpConfigure -accessPath \fR\fIlist\fR), an \fBauto_reset\fR is automatically evaluated in the safe interpreter to synchronize its \fBauto_index\fR with the new token list. .SH "SEE ALSO" interp(n), library(n), load(n), package(n), source(n), unknown(n) .SH KEYWORDS alias, auto\-loading, auto_mkindex, load, master interpreter, safe interpreter, slave interpreter, source

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" Copyright (c) 2000 Scriptics Corporation. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: scan.n,v 1.9 2002/07/01 18:24:39 jenglish Exp $ '\" RCS: @(#) $Id: scan.n,v 1.9.2.1 2004/10/27 14:23:58 dkf Exp $ '\" .so man.macros .TH scan n 8.4 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME scan \- Parse string using conversion specifiers in the style of sscanf
︙
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43	29 30 31 32 33 34 35 36 37 38 39 40 41 42	-	name of a variable; when a field is scanned from \fIstring\fR the result is converted back into a string and assigned to the corresponding variable. If no \fIvarName\fR variables are specified, then \fBscan\fR works in an inline manner, returning the data that would otherwise be stored in the variables as a list. In the inline case, an empty string is returned when the end of the input string is reached before any conversions have been performed. .SH "DETAILS ON SCANNING" .PP \fBScan\fR operates by scanning \fIstring\fR and \fIformat\fR together. If the next character in \fIformat\fR is a blank or tab then it matches any number of white space characters in \fIstring\fR (including zero). Otherwise, if it isn't a \fB%\fR character then it
︙
184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217	183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264	- + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	as many decimal digits as possible for \fB%d\fR, as many octal digits as possible for \fB%o\fR, and so on). The input field for a given conversion terminates either when a white-space character is encountered or when the maximum field width has been reached, whichever comes first. If a \fB*\fR is present in the conversion specifier then no variable is assigned and the next scan argument is not consumed. .SH "DIFFERENCES FROM ANSI SSCANF" .PP The behavior of the \fBscan\fR command is the same as the behavior of the ANSI C \fBsscanf\fR procedure except for the following differences: .IP [1] \fB%p\fR conversion specifier is not currently supported. .IP [2] For \fB%c\fR conversions a single character value is converted to a decimal string, which is then assigned to the corresponding \fIvarName\fR; no field width may be specified for this conversion. .IP [3] .VS 8.4 The \fBh\fR modifier is always ignored and the \fBl\fR and \fBL\fR modifiers are ignored when converting real values (i.e. type \fBdouble\fR is used for the internal representation). .VE 8.4 .IP [4] If the end of the input string is reached before any conversions have been performed and no variables are given, an empty string is returned. .SH EXAMPLES Parse a simple color specification of the form \fI#RRGGBB\fR using hexadecimal conversions with field sizes: .CS set string "#08D03F" \fBscan\fR $string "#%2x%2x%2x" r g b .CE .PP Parse a \fIHH:MM\fR time string, noting that this avoids problems with octal numbers by forcing interpretation as decimals (if we did not care, we would use the \fB%i\fR conversion instead): .CS set string "08:08" ;# *Not* octal! if {[\fBscan\fR $string "%d:%d" hours minutes] != 2} { error "not a valid time string" } # We have to understand numeric ranges ourselves... if {$minutes < 0 || $minutes > 59} { error "invalid number of minutes" } .CE .PP Break a string up into sequences of non-whitespace characters (note the use of the \fB%n\fR conversion so that we get skipping over leading whitespace correct): .CS set string " a string {with braced words} + leading space " set words {} while {[\fBscan\fR $string %s%n word length] == 2} { lappend words $word set string [string range $string $length end] } .CE .PP Parse a simple coordinate string, checking that it is complete by looking for the terminating character explicitly: .CS set string "(5.2,-4e-2)" # Note that the spaces before the literal parts of # the scan pattern are significant, and that ")" is # the Unicode character \\u0029 if { [\fBscan\fR $string " (%f ,%f %c" x y last] != 3 || $last != 0x0029 } then { error "invalid coordinate string" } puts "X=$x, Y=$y" .CE .SH "SEE ALSO" format(n), sscanf(3) .SH KEYWORDS conversion specifier, parse, scan

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: seek.n,v 1.5 2001/09/14 19:20:40 andreas_kupries Exp $ '\" RCS: @(#) $Id: seek.n,v 1.5.8.1 2004/10/27 14:23:58 dkf Exp $ '\" .so man.macros .TH seek n 8.1 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME seek \- Change the access position for an open channel
︙
58 59 60 61 62 63 64 65 66 67 68 69 70	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	+ + + + + + + + + + + + + + + + + + + + +	file or device does not support seeking. .PP .VS 8.1 Note that \fIoffset\fR values are byte offsets, not character offsets. Both \fBseek\fR and \fBtell\fR operate in terms of bytes, not characters, unlike \fBread\fR. .VE 8.1 .SH EXAMPLES Read a file twice: .CS set f [open file.txt] set data1 [read $f] \fBseek\fR $f 0 set data2 [read $f] close $f # $data1 == $data2 if the file wasn't updated .CE .PP Read the last 10 bytes from a file: .CS set f [open file.data] # This is guaranteed to work with binary data but # may fail with other encodings... fconfigure $f -translation binary \fBseek\fR $f -10 end set data [read $f 10] close $f .CE .SH "SEE ALSO" file(n), open(n), close(n), gets(n), tell(n), Tcl_StandardChannels(3) .SH KEYWORDS access position, file, seek

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: set.n,v 1.3 2000/09/07 14:27:51 poenitz Exp $ '\" RCS: @(#) $Id: set.n,v 1.3.18.2 2004/10/27 14:23:58 dkf Exp $ '\" .so man.macros .TH set n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME set \- Read and write variables
︙
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	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	- - - + - + - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - +	the value of \fIvarName\fR to \fIvalue\fR, creating a new variable if one doesn't already exist, and return its value. If \fIvarName\fR contains an open parenthesis and ends with a close parenthesis, then it refers to an array element: the characters before the first open parenthesis are the name of the array, and the characters between the parentheses are the index within the array. Otherwise \fIvarName\fR refers to a scalar variable. Normally, \fIvarName\fR is unqualified (does not include the names of any containing namespaces), and the variable of that name in the current namespace is read or written. .PP If \fIvarName\fR includes namespace qualifiers (in the array name if it refers to an array element), (in the array name if it refers to an array element), or if \fIvarName\fR the variable in the specified namespace is read or written. .PP If no procedure is active, then \fIvarName\fR refers to a namespace variable (global variable if the current namespace is the global namespace). If a procedure is active, then \fIvarName\fR refers to a parameter or local variable of the procedure unless the \fBglobal\fR command was invoked to declare \fIvarName\fR to be global, or unless a \fBvariable\fR command was invoked to declare \fIvarName\fR to be a namespace variable. is unqualified (does not include the names of any containing namespaces) but no procedure is active, \fIvarName\fR refers to a namespace variable resolved according to the rules described under \fBNAME RESOLUTION\fR in the \fBnamespace\fR manual page. .PP If a procedure is active and \fIvarName\fR is unqualified, then \fIvarName\fR refers to a parameter or local variable of the procedure, unless \fIvarName\fR was declared to resolve differently through one of the \fBglobal\fR, \fBvariable\fR or \fBupvar\fR commands. .SH EXAMPLES Store a random number in the variable \fIr\fR: .CS \fBset\fR r [expr rand()] .CE .PP Store a short message in an array element: .CS \fBset\fR anAry(msg) "Hello, World!" .CE .PP Store a short message in an array element specified by a variable: .CS \fBset\fR elemName "msg" \fBset\fR anAry($elemName) "Hello, World!" .CE .PP Copy a value into the variable \fIout\fR from a variable whose name is stored in the \fIvbl\fR (note that it is often easier to use arrays in practice instead of doing double-dereferencing): .CS \fBset\fR in0 "small random" \fBset\fR in1 "large random" \fBset\fR vbl in[expr {rand() >= 0.5}] \fBset\fR out [\fBset\fR $vbl] .CE .SH "SEE ALSO" expr(n), proc(n), trace(n), unset(n) expr(n), global(n), namespace(n), proc(n), trace(n), unset(n), upvar(n), variable(n) .SH KEYWORDS read, write, variable

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1996 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. '\" '\" RCS: @(#) $Id: socket.n,v 1.7 2002/10/01 10:03:19 dkf Exp $ '\" RCS: @(#) $Id: socket.n,v 1.7.2.3 2004/10/27 14:23:58 dkf Exp $ .so man.macros .TH socket n 8.0 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME socket \- Open a TCP network connection .SH SYNOPSIS
︙
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	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	- + + + + + + + - +	identifier that may be used in future invocations of commands like \fBread\fR, \fBputs\fR and \fBflush\fR. At present only the TCP network protocol is supported; future releases may include support for additional protocols. The \fBsocket\fR command may be used to open either the client or server side of a connection, depending on whether the \fB\-server\fR switch is specified. .PP Note that the default encoding for \fIall\fR sockets is the system encoding, as returned by \fBencoding system\fR. Most of the time, you will need to use \fBfconfigure\fR to alter this to something else, such as \fIutf\-8\fR (ideal for communicating with other Tcl processes) or \fIiso8859\-1\fR (useful for many network protocols, especially the older ones). .SH "CLIENT SOCKETS" .PP If the \fB\-server\fR option is not specified, then the client side of a connection is opened and the command returns a channel identifier that can be used for both reading and writing. \fIPort\fR and \fIhost\fR specify a port to connect to; there must be a server accepting connections on this port. \fIPort\fR is an integer port number (or service name, where supported and understood by the host operating system) and \fIhost\fR is either a domain-style name such as \fBwww.sunlabs.com\fR or is either a domain-style name such as \fBwww.tcl.tk\fR or a numerical IP address such as \fB127.0.0.1\fR. Use \fIlocalhost\fR to refer to the host on which the command is invoked. .PP The following options may also be present before \fIhost\fR to specify additional information about the connection: .TP \fB\-myaddr\fI addr\fR
︙
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87	73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94	- - + + +	may not yet be connected to the server, when the call to \fBsocket\fR returns. When a \fBgets\fR or \fBflush\fR is done on the socket before the connection attempt succeeds or fails, if the socket is in blocking mode, the operation will wait until the connection is completed or fails. If the socket is in nonblocking mode and a \fBgets\fR or \fBflush\fR is done on the socket before the connection attempt succeeds or fails, the operation returns immediately and \fBfblocked\fR on the socket returns 1. .SH "SERVER SOCKETS" .PP If the \fB\-server\fR option is specified then the new socket will be a server for the port given by \fIport\fR (either an integer or a service name, where supported and understood by the host operating system). operating system; if \fIport\fR is zero, the operating system will allocate a free port to the server socket which may be discovered by using \fBfconfigure\fR to read the \fB\-sockname\fR option). Tcl will automatically accept connections to the given port. For each connection Tcl will create a new channel that may be used to communicate with the client. Tcl then invokes \fIcommand\fR with three additional arguments: the name of the new channel, the address, in network address notation, of the client's host, and the client's port number. .PP
︙
105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122	112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128	- + -	new connections are opened. If the application doesn't enter the event loop, for example by invoking the \fBvwait\fR command or calling the C procedure \fBTcl_DoOneEvent\fR, then no connections will be accepted. .PP If \fIport\fR is specified as zero, the operating system will allocate an unused port for use as a server socket. The port number actually allocated my be retrieved from the created server socket using the allocated may be retrieved from the created server socket using the \fBfconfigure\fR command to retrieve the \fB\-sockname\fR option as described below. .SH "CONFIGURATION OPTIONS" The \fBfconfigure\fR command can be used to query several readonly configuration options for socket channels: .TP \fB\-error\fR This option gets the current error status of the given socket. This is useful when you need to determine if an asynchronous connect
︙
132 133 134 135 136 137 138 139 140 141 142 143 144	138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171	+ + + + + + + - + + + + + + + + + + + + + + + - +	\fB\-peername\fR This option is not supported by server sockets. For client and accepted sockets, this option returns a list of three elements; these are the address, the host name and the port to which the peer socket is connected or bound. If the host name cannot be computed, the second element of the list is identical to the address, its first element. .PP .SH "EXAMPLES" Here is a very simple time server: .CS proc Server {channel clientaddr clientport} { puts "Connection from $clientaddr registered" puts $channel [clock format [clock seconds]] close $channel } \fBsocket\fR -server Server 9900 vwait forever .CE .PP And here is the corresponding client to talk to the server: .CS set server localhost set sockChan [\fBsocket\fR $server 9900] gets $sockChan line close $sockChan puts "The time on $server is $line" .CE .SH "SEE ALSO" flush(n), open(n), read(n) fconfigure(n), flush(n), open(n), read(n) .SH KEYWORDS bind, channel, connection, domain name, host, network address, socket, tcp

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" Copyright (c) 2000 Scriptics Corporation. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: source.n,v 1.5 2000/09/07 14:27:51 poenitz Exp $ '\" RCS: @(#) $Id: source.n,v 1.5.18.1 2004/10/27 14:23:58 dkf Exp $ '\" .so man.macros .TH source n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME source \- Evaluate a file or resource as a Tcl script
︙
46 47 48 49 50 51 52 53 54 55 56 57 58	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	+ + + + + + + + + + + - + + + - +	The \fI\-rsrc\fR and \fI\-rsrcid\fR forms of this command are only available on Macintosh computers. These versions of the command allow you to source a script from a \fBTEXT\fR resource. You may specify what \fBTEXT\fR resource to source by either name or id. By default Tcl searches all open resource files, which include the current application and any loaded C extensions. Alternatively, you may specify the \fIfileName\fR where the \fBTEXT\fR resource can be found. .SH EXAMPLE Run the script in the file \fBfoo.tcl\fR and then the script in the file \fBbar.tcl\fR: .CS \fBsource\fR foo.tcl \fBsource\fR bar.tcl .CE Alternatively: .CS foreach scriptFile {foo.tcl bar.tcl} { \fBsource\fR $scriptFile } .CE .SH "SEE ALSO" file(n), cd(n) file(n), cd(n), info(n) .SH KEYWORDS file, script

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: split.n,v 1.3 2000/09/07 14:27:51 poenitz Exp $ '\" RCS: @(#) $Id: split.n,v 1.3.18.1 2004/10/27 14:23:58 dkf Exp $ '\" .so man.macros .TH split n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME split \- Split a string into a proper Tcl list
︙
26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47	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	- + + - + + + + + - + + + + + + + + + + + + + - + + + + + + + + + + - + + + + + + + + + + + + + + + +	characters in \fIsplitChars\fR. Empty list elements will be generated if \fIstring\fR contains adjacent characters in \fIsplitChars\fR, or if the first or last character of \fIstring\fR is in \fIsplitChars\fR. If \fIsplitChars\fR is an empty string then each character of \fIstring\fR becomes a separate element of the result list. \fISplitChars\fR defaults to the standard white-space characters. For example, .SH EXAMPLES Divide up a USENET group name into its hierarchical components: .CS \fBsplit "comp.unix.misc" .\fR \fBsplit\fR "comp.lang.tcl.announce" . \fI=> comp lang tcl announce\fR .CE .PP See how the \fBsplit\fR command splits on \fIevery\fR character in \fIsplitChars\fR, which can result in information loss if you are not returns \fB"comp unix misc"\fR and careful: .CS \fBsplit\fR "alpha beta gamma" "temp" \fI=> al {ha b} {} {a ga} {} a\fR .CE .PP Extract the list words from a string that is not a well-formed list: .CS \fBsplit\fR "Example with {unbalanced brace character" \fI=> Example with \\{unbalanced brace character\fR .CE .PP Split a string into its constituent characters .CS \fBsplit "Hello world" {}\fR \fBsplit\fR "Hello world" {} \fI=> H e l l o { } w o r l d\fR .CE .SH "PARSING RECORD-ORIENTED FILES" Parse a Unix /etc/passwd file, which consists of one entry per line, with each line consisting of a colon-separated list of fields: .CS ## Read the file set fid [open /etc/passwd] set content [read $fid] close $fid returns \fB"H e l l o { } w o r l d"\fR. ## Split into records on newlines set records [\fBsplit\fR $content "\\n"] ## Iterate over the records foreach rec $records { ## Split into fields on colons set fields [\fBsplit\fR $rec ":"] ## Assign fields to variables and print some out... lassign $fields \\ userName password uid grp longName homeDir shell puts "$longName uses [file tail $shell] for a login shell" } .CE .SH "SEE ALSO" join(n), list(n), string(n) .SH KEYWORDS list, split, string

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: string.n,v 1.17 2002/07/05 07:23:45 hobbs Exp $ '\" RCS: @(#) $Id: string.n,v 1.17.2.4 2006/12/14 14:24:22 dkf Exp $ '\" .so man.macros .TH string n 8.1 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME string \- Manipulate strings
︙
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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148	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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148	- + - + - + - + - + - + - + - + - + - - + + - + - + - + - + - + - + - + - +	empty string returns 0, otherwise and empty string will return 1 on any class. If \fB\-failindex\fR is specified, then if the function returns 0, the index in the string where the class was no longer valid will be stored in the variable named \fIvarname\fR. The \fIvarname\fR will not be set if the function returns 1. The following character classes are recognized (the class name can be abbreviated): .RS .IP \fBalnum\fR 10 .IP \fBalnum\fR 12 Any Unicode alphabet or digit character. .IP \fBalpha\fR 10 .IP \fBalpha\fR 12 Any Unicode alphabet character. .IP \fBascii\fR 10 .IP \fBascii\fR 12 Any character with a value less than \\u0080 (those that are in the 7\-bit ascii range). .IP \fBboolean\fR 10 .IP \fBboolean\fR 12 Any of the forms allowed to \fBTcl_GetBoolean\fR. .IP \fBcontrol\fR 10 .IP \fBcontrol\fR 12 Any Unicode control character. .IP \fBdigit\fR 10 .IP \fBdigit\fR 12 Any Unicode digit character. Note that this includes characters outside of the [0\-9] range. .IP \fBdouble\fR 10 .IP \fBdouble\fR 12 Any of the valid forms for a double in Tcl, with optional surrounding whitespace. In case of under/overflow in the value, 0 is returned and the \fIvarname\fR will contain \-1. .IP \fBfalse\fR 10 .IP \fBfalse\fR 12 Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is false. .IP \fBgraph\fR 10 .IP \fBgraph\fR 12 Any Unicode printing character, except space. .IP \fBinteger\fR 10 Any of the valid forms for an integer in Tcl, with optional .IP \fBinteger\fR 12 Any of the valid forms for an ordinary integer in Tcl, with optional surrounding whitespace. In case of under/overflow in the value, 0 is returned and the \fIvarname\fR will contain \-1. .IP \fBlower\fR 10 .IP \fBlower\fR 12 Any Unicode lower case alphabet character. .IP \fBprint\fR 10 .IP \fBprint\fR 12 Any Unicode printing character, including space. .IP \fBpunct\fR 10 .IP \fBpunct\fR 12 Any Unicode punctuation character. .IP \fBspace\fR 10 .IP \fBspace\fR 12 Any Unicode space character. .IP \fBtrue\fR 10 .IP \fBtrue\fR 12 Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is true. .IP \fBupper\fR 10 .IP \fBupper\fR 12 Any upper case alphabet character in the Unicode character set. .IP \fBwordchar\fR 10 .IP \fBwordchar\fR 12 Any Unicode word character. That is any alphanumeric character, and any Unicode connector punctuation characters (e.g. underscore). .IP \fBxdigit\fR 10 .IP \fBxdigit\fR 12 Any hexadecimal digit character ([0\-9A\-Fa\-f]). .PP In the case of \fBboolean\fR, \fBtrue\fR and \fBfalse\fR, if the function will return 0, then the \fIvarname\fR will always be set to 0, due to the varied nature of a valid boolean value. .RE .TP
︙
168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197	168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205	- - - + + + + + + + + + + +	\fBstring length \fIstring\fR Returns a decimal string giving the number of characters in \fIstring\fR. Note that this is not necessarily the same as the number of bytes used to store the string. If the object is a ByteArray object (such as those returned from reading a binary encoded channel), then this will return the actual byte length of the object. .TP \fBstring map\fR ?\fB\-nocase\fR? \fIcharMap string\fR Replaces characters in \fIstring\fR based on the key-value pairs in \fIcharMap\fR. \fIcharMap\fR is a list of \fIkey value key value ...\fR \fBstring map\fR ?\fB\-nocase\fR? \fImapping string\fR Replaces substrings in \fIstring\fR based on the key-value pairs in \fImapping\fR. \fImapping\fR is a list of \fIkey value key value ...\fR as in the form returned by \fBarray get\fR. Each instance of a key in the string will be replaced with its corresponding value. If \fB\-nocase\fR is specified, then matching is done without regard to case differences. Both \fIkey\fR and \fIvalue\fR may be multiple characters. Replacement is done in an ordered manner, so the key appearing first in the list will be checked first, and so on. \fIstring\fR is only iterated over once, so earlier key replacements will have no affect for later key matches. For example, .RS .CS \fBstring map {abc 1 ab 2 a 3 1 0} 1abcaababcabababc\fR .CE will return the string \fB01321221\fR. .PP Note that if an earlier \fIkey\fR is a prefix of a later one, it will completely mask the later one. So if the previous example is reordered like this, .CS \fBstring map {1 0 ab 2 a 3 abc 1} 1abcaababcabababc\fR .CE it will return the string \fB02c322c222c\fR. .RE .TP \fBstring match\fR ?\fB\-nocase\fR? \fIpattern\fR \fIstring\fR See if \fIpattern\fR matches \fIstring\fR; return 1 if it does, 0 if it doesn't. If \fB\-nocase\fR is specified, then the pattern attempts to match against the string in a case insensitive manner. For the two strings to match, their contents must be identical except that the
︙
299 300 301 302 303 304 305 306 307 308 309 310 311	307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330	+ + + + + + + + + + +	\fBstring wordstart \fIstring charIndex\fR Returns the index of the first character in the word containing character \fIcharIndex\fR of \fIstring\fR. \fIcharIndex\fR may be specified as for the \fBindex\fR method. A word is considered to be any contiguous range of alphanumeric (Unicode letters or decimal digits) or underscore (Unicode connector punctuation) characters, or any single character other than these. .SH EXAMPLE Test if the string in the variable \fIstring\fR is a proper non-empty prefix of the string \fBfoobar\fR. .CS set length [\fBstring length\fR $string] if {$length == 0} { set isPrefix 0 } else { set isPrefix [\fBstring equal\fR -length $length $string "foobar"] } .CE .SH "SEE ALSO" expr(n), list(n) .SH KEYWORDS case conversion, compare, index, match, pattern, string, word, equal, ctype

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- +	'\" '\" Copyright (c) 1994 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" Copyright (c) 2001 Donal K. Fellows '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: subst.n,v 1.5 2002/04/18 16:31:40 dgp Exp $ '\" RCS: @(#) $Id: subst.n,v 1.5.2.1 2004/10/27 14:23:58 dkf Exp $ '\" .so man.macros .TH subst n 7.4 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME subst \- Perform backslash, command, and variable substitutions
︙
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 116 117 118 119 120 121 122 123 124 125	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 116 117 118 119 120 121 122 123 124 125	- - + + - - + + - - + + - + - + - + - + - + - +	.VE .SH EXAMPLES .PP When it performs its substitutions, \fIsubst\fR does not give any special treatment to double quotes or curly braces (except within command substitutions) so the script .CS \fBset a 44 subst {xyz {$a}}\fR set a 44 \fBsubst\fR {xyz {$a}} .CE returns ``\fBxyz {44}\fR'', not ``\fBxyz {$a}\fR'' .VS 8.4 and the script .CS \fBset a "p\\} q \\{r" subst {xyz {$a}}\fR set a "p\\} q \\{r" \fBsubst\fR {xyz {$a}} .CE return ``\fBxyz {p} q {r}\fR'', not ``\fBxyz {p\\} q \\{r}\fR''. .PP When command substitution is performed, it includes any variable substitution necessary to evaluate the script. .CS \fBset a 44 subst -novariables {$a [format $a]}\fR set a 44 \fBsubst\fR -novariables {$a [format $a]} .CE returns ``\fB$a 44\fR'', not ``\fB$a $a\fR''. Similarly, when variable substitution is performed, it includes any command substitution necessary to retrieve the value of the variable. .CS \fBproc b {} {return c} proc b {} {return c} array set a {c c [b] tricky} subst -nocommands {[b] $a([b])}\fR \fBsubst\fR -nocommands {[b] $a([b])} .CE returns ``\fB[b] c\fR'', not ``\fB[b] tricky\fR''. .PP The continue and break exceptions allow command substitutions to prevent substitution of the rest of the command substitution and the rest of \fIstring\fR respectively, giving script authors more options when processing text using \fIsubst\fR. For example, the script .CS \fBsubst {abc,[break],def}\fR \fBsubst\fR {abc,[break],def} .CE returns ``\fBabc,\fR'', not ``\fBabc,,def\fR'' and the script .CS \fBsubst {abc,[continue;expr 1+2],def}\fR \fBsubst\fR {abc,[continue;expr 1+2],def} .CE returns ``\fBabc,,def\fR'', not ``\fBabc,3,def\fR''. .PP Other exceptional return codes substitute the returned value .CS \fBsubst {abc,[return foo;expr 1+2],def}\fR \fBsubst\fR {abc,[return foo;expr 1+2],def} .CE returns ``\fBabc,foo,def\fR'', not ``\fBabc,3,def\fR'' and .CS \fBsubst {abc,[return -code 10 foo;expr 1+2],def}\fR \fBsubst\fR {abc,[return -code 10 foo;expr 1+2],def} .CE also returns ``\fBabc,foo,def\fR'', not ``\fBabc,3,def\fR''. .VE .SH "SEE ALSO" Tcl(n), eval(n), break(n), continue(n) .SH KEYWORDS backslash substitution, command substitution, variable substitution

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-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. '\" '\" RCS: @(#) $Id: switch.n,v 1.5 2000/09/07 14:27:51 poenitz Exp $ '\" RCS: @(#) $Id: switch.n,v 1.5.18.1 2004/10/27 14:23:58 dkf Exp $ '\" .so man.macros .TH switch n 7.0 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME switch \- Evaluate one of several scripts, depending on a given value
︙
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 116 117	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 116 117 118 119 120 121 122 123	- - + + + + - + + + + - + - - - - - + + + + + - + - + + + - + - - - + + - - - - + + + - - - - + + + + + - + + -	then the body after that is used, and so on). This feature makes it possible to share a single \fIbody\fR among several patterns. .PP Beware of how you place comments in \fBswitch\fR commands. Comments should only be placed \fBinside\fR the execution body of one of the patterns, and not intermingled with the patterns. .PP Below are some examples of \fBswitch\fR commands: .SH "EXAMPLES" The \fBswitch\fR command can match against variables and not just literals, as shown here (the result is \fI2\fR): .CS set foo "abc" \fBswitch\0abc\0a\0\-\0b\0{format 1}\0abc\0{format 2}\0default\0{format 3}\fR \fBswitch\fR abc a \- b {expr 1} $foo {expr 2} default {expr 3} .CE .PP Using glob matching and the fall-through body is an alternative to writing regular expressions with alternations, as can be seen here will return \fB2\fR, (this returns \fI1\fR): .CS \fBswitch\0\-regexp\0aaab { ^a.*b$\0\- b\0{format 1} a*\0{format 2} default\0{format 3} \fBswitch\fR \-glob aaab { a*b \- b {expr 1} a* {expr 2} default {expr 3} }\fR } .CE will return \fB1\fR, and .PP Whenever nothing matches, the \fBdefault\fR clause (which must be last) is taken. This example has a result of \fI3\fR: .CS \fBswitch\0xyz { \fBswitch\fR xyz { a \- b a \- b { { # Correct Comment Placement format 1 } # Correct Comment Placement expr 1 } a* {format 2} default {format 3} c { expr 2 } default { expr 3 }\fR } } .CE will return \fB3\fR. .SH "SEE ALSO" for(n), if(n), regexp(n) .SH KEYWORDS switch, match, regular expression

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	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	- + - + - -	'\" '\" Copyright (c) 1990-1994 The Regents of the University of California '\" Copyright (c) 1994-1997 Sun Microsystems, Inc. '\" Copyright (c) 1998-1999 Scriptics Corporation '\" Copyright (c) 2000 Ajuba Solutions '\" Contributions from Don Porter, NIST, 2002. (not subject to US copyright) '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: tcltest.n,v 1.38 2003/01/24 16:33:35 dgp Exp $ '\" RCS: @(#) $Id: tcltest.n,v 1.38.2.6 2007/02/20 17:53:18 dgp Exp $ '\" .so man.macros .TH "tcltest" n 2.2 tcltest "Tcl Bundled Packages" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME tcltest \- Test harness support code and utilities .SH SYNOPSIS .nf \fBpackage require tcltest ?2.2?\fR \fBpackage require tcltest ?2.2.5?\fR .sp \fBtcltest::test \fIname description ?option value ...?\fR \fBtcltest::test \fIname description ?constraints? body result\fR .sp \fBtcltest::loadTestedCommands\fR \fBtcltest::makeDirectory \fIname ?directory?\fR \fBtcltest::removeDirectory \fIname ?directory?\fR \fBtcltest::makeFile \fIcontents name ?directory?\fR \fBtcltest::removeFile \fIname ?directory?\fR \fBtcltest::viewFile \fIname ?directory?\fR \fBtcltest::cleanupTests \fI?runningMultipleTests?\fR \fBtcltest::runAllTests\fR .sp .VS 2.1 \fBtcltest::configure\fR \fBtcltest::configure \fIoption\fR \fBtcltest::configure \fIoption value ?option value ...?\fR \fBtcltest::customMatch \fImode command\fR .VE \fBtcltest::testConstraint \fIconstraint ?value?\fR \fBtcltest::outputChannel \fI?channelID?\fR \fBtcltest::errorChannel \fI?channelID?\fR \fBtcltest::interpreter \fI?interp?\fR .sp \fBtcltest::debug \fI?level?\fR \fBtcltest::errorFile \fI?filename?\fR
︙
196 197 198 199 200 201 202 203 204 205 206 207 208 209 210	194 195 196 197 198 199 200 201 202 203 204 205 206 207	-	\fBrunAllTests\fR This is a master command meant to run an entire suite of tests, spanning multiple files and/or directories, as governed by the configurable options of \fBtcltest\fR. See \fBRUNNING ALL TESTS\fR below for a complete description of the many variations possible with [\fBrunAllTests\fR]. .SH "CONFIGURATION COMMANDS" .VS .TP \fBconfigure\fR Returns the list of configurable options supported by \fBtcltest\fR. See \fBCONFIGURABLE OPTIONS\fR below for the full list of options, their valid values, and their effect on \fBtcltest\fR operations. .TP \fBconfigure \fIoption\fR
︙
234 235 236 237 238 239 240 241 242 243 244 245 246 247 248	231 232 233 234 235 236 237 238 239 240 241 242 243 244	-	to the expected result. To perform the match, the \fIscript\fR is completed with two additional words, the expected result, and the actual result, and the completed script is evaluated in the global namespace. The completed script is expected to return a boolean value indicating whether or not the results match. The built-in matching modes of [\fBtest\fR] are \fBexact\fR, \fBglob\fR, and \fBregexp\fR. .VE .TP \fBtestConstraint \fIconstraint ?boolean?\fR Sets or returns the boolean value associated with the named \fIconstraint\fR. See \fBTEST CONSTRAINTS\fR below for more information. .TP \fBinterpreter\fR \fI?executableName?\fR Sets or returns the name of the executable to be [\fBexec\fR]ed by
︙
378 379 380 381 382 383 384 385 386 387 388 389 390 391 392	374 375 376 377 378 379 380 381 382 383 384 385 386 387 388	- +	the expected result, and how the compare the actual result to the expected result. Some configuration options of \fBtcltest\fR also influence how [\fBtest\fR] operates. .PP The valid options for [\fBtest\fR] are summarized: .CS .ta 0.8i test \fIname\fR \fIdescription\fR \fBtest\fR \fIname\fR \fIdescription\fR ?-constraints \fIkeywordList|expression\fR? ?-setup \fIsetupScript\fR? ?-body \fItestScript\fR? ?-cleanup \fIcleanupScript\fR? ?-result \fIexpectedAnswer\fR? ?-output \fIexpectedOutput\fR? ?-errorOutput \fIexpectedError\fR?
︙
476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498	472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494	- + - +	the return value from script will be compared. The default value is an empty string. .TP \fB-output \fIexpectedValue\fR The \fB-output\fR attribute supplies the \fIexpectedValue\fR against which any output sent to \fBstdout\fR or [\fBoutputChannel\fR] during evaluation of the script(s) will be compared. Note that only output printed using [\fBputs\fR] is used for comparison. If \fB-output\fR is not specified, [\fB::puts\fR] is used for comparison. If \fB-output\fR is not specified, output sent to \fBstdout\fR and [\fBoutputChannel\fR] is not processed for comparison. .TP \fB-errorOutput \fIexpectedValue\fR The \fB-errorOutput\fR attribute supplies the \fIexpectedValue\fR against which any output sent to \fBstderr\fR or [\fBerrorChannel\fR] during evaluation of the script(s) will be compared. Note that only output printed using [\fBputs\fR] is used for comparison. If \fB-errorOutput\fR printed using [\fB::puts\fR] is used for comparison. If \fB-errorOutput\fR is not specified, output sent to \fBstderr\fR and [\fBerrorChannel\fR] is not processed for comparison. .TP \fB-returnCodes \fIexpectedCodeList\fR The optional \fB-returnCodes\fR attribute supplies \fIexpectedCodeList\fR, a list of return codes that may be accepted from evaluation of the \fB-body\fR script. If evaluation of the \fB-body\fR script returns
︙
512 513 514 515 516 517 518 519 520 521 522 523 524 525 526	508 509 510 511 512 513 514 515 516 517 518 519 520 521 522	- +	As long as [\fBtest\fR] is called with valid syntax and legal values for all attributes, it will not raise an error. Test failures are instead reported as output written to [\fBoutputChannel\fR]. In default operation, a successful test produces no output. The output messages produced by [\fBtest\fR] are controlled by the [\fBconfigure -verbose\fR] option as described in \fBCONFIGURABLE OPTIONS\fR below. Any output produced by the test scripts themselves should be produced using [\fBputs\fR] to [\fBoutputChannel\fR] or produced using [\fB::puts\fR] to [\fBoutputChannel\fR] or [\fBerrorChannel\fR], so that users of the test suite may easily capture output with the [\fBconfigure -outfile\fR] and [\fBconfigure -errfile\fR] options, and so that the \fB-output\fR and \fB-errorOutput\fR attributes work properly. .SH "TEST CONSTRAINTS" .PP Constraints are used to determine whether or not a test should be skipped.
︙
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 691 692 693 694 695 696 697	659 660 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 691 692 693	- + - +	is set, all those constraints are set to true. The effect is that when both options [\fBconfigure -constraints\fR] and [\fBconfigure -limitconstraints\fR] are in use, only those tests including only constraints from the [\fBconfigure -constraints\fR] list are run; all others are skipped. For example, one might set up a configuration with .CS configure -constraints knownBug \e \fBconfigure\fR -constraints knownBug \e -limitconstraints true \e -verbose pass .CE to run exactly those tests that exercise known bugs, and discover whether any of them pass, indicating the bug had been fixed. .SH "RUNNING ALL TESTS" .PP The single command [\fBrunAllTests\fR] is evaluated to run an entire test suite, spanning many files and directories. The configuration options of \fBtcltest\fR control the precise operations. The [\fBrunAllTests\fR] command begins by printing a summary of its configuration to [\fBoutputChannel\fR]. .PP Test files to be evaluated are sought in the directory [\fBconfigure -testdir\fR]. The list of files in that directory that match any of the patterns in [\fBconfigure -file\fR] and match none of the patterns in [\fBconfigure -notfile\fR] is generated and sorted. Then each file will be evaluated in turn. If [\fBconfigure -singleproc\fR] is true, then each file will be [\fBsource\fR]d in the caller's context. If if is false, be [\fBsource\fR]d in the caller's context. If it is false, then a copy of [\fBinterpreter\fR] will be [\fBexec\fR]d to evaluate each file. The multi-process operation is useful when testing can cause errors so severe that a process terminates. Although such an error may terminate a child process evaluating one file, the master process can continue with the rest of the test suite. In multi-process operation, the configuration of \fBtcltest\fR in the master process is
︙
750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776	746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774	+ - + +	Do not display any debug information. .IP 1 Display information regarding whether a test is skipped because it doesn't match any of the tests that were specified using by [\fBconfigure -match\fR] (userSpecifiedNonMatch) or matches any of the tests specified by [\fBconfigure -skip\fR] (userSpecifiedSkip). Also print warnings about possible lack of cleanup or balance in test files. Also print warnings about any re-use of test names. .IP 2 Display the flag array parsed by the command line processor, the contents of the ::env array, and all user-defined variables that exist in the current namespace as they are used. .IP 3 Display information regarding what individual procs in the test harness are doing. .RE .TP \fB-verbose \fIlevel\fR Sets the type of output verbosity desired to \fIlevel\fR, a list of zero or more of the elements \fBbody\fR, \fBpass\fR, \fBskip\fR, \fBstart\fR, and \fBerror\fR. Default value is \fBbody\fR. \fBskip\fR, \fBstart\fR, and \fBerror\fR. Default value is \fB{body error}\fR. Levels are defined as: .RS .IP "body (b)" Display the body of failed tests .IP "pass (p)" Print output when a test passes .IP "skip (s)"
︙
871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911	869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909	- + - + - + - +	.SH "CREATING TEST SUITES WITH TCLTEST" .PP The fundamental element of a test suite is the individual [\fBtest\fR] command. We begin with several examples. .IP [1] Test of a script that returns normally. .CS test example-1.0 {normal return} { \fBtest\fR example-1.0 {normal return} { format %s value } value .CE .IP [2] Test of a script that requires context setup and cleanup. Note the bracing and indenting style that avoids any need for line continuation. .CS test example-1.1 {test file existence} -setup { \fBtest\fR example-1.1 {test file existence} -setup { set file [makeFile {} test] } -body { file exists $file } -cleanup { removeFile test } -result 1 .CE .IP [3] Test of a script that raises an error. .CS test example-1.2 {error return} -body { \fBtest\fR example-1.2 {error return} -body { error message } -returnCodes error -result message .CE .IP [4] Test with a constraint. .CS test example-1.3 {user owns created files} -constraints { \fBtest\fR example-1.3 {user owns created files} -constraints { unix } -setup { set file [makeFile {} test] } -body { file attributes $file -owner } -cleanup { removeFile test
︙
921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936	919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934	- - + +	together, keeping tests synchronized with code changes. .PP Most of the code in the test file should be the [\fBtest\fR] commands. Use constraints to skip tests, rather than conditional evaluation of [\fBtest\fR]. That is, do this: .IP [5] .CS testConstraint X [expr $myRequirement] test goodConditionalTest {} X { \fBtestConstraint\fR X [expr $myRequirement] \fBtest\fR goodConditionalTest {} X { # body } result .CE and do not do this: .IP [6] .CS if $myRequirement {
︙
965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065	963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063	- + - + - + - + - + - + - + - - + + - + - + - + - - + + - + - +	.PP After all [\fBtest\fR]s in a test file, the command [\fBcleanupTests\fR] should be called. .IP [7] Here is a sketch of a sample test file illustrating those points: .CS package require tcltest 2.2 eval tcltest::configure $argv eval \fB::tcltest::configure\fR $argv package require example namespace eval ::example::test { namespace import ::tcltest::* testConstraint X [expr {...}] \fBtestConstraint\fR X [expr {...}] variable SETUP {#common setup code} variable CLEANUP {#common cleanup code} test example-1 {} -setup $SETUP { \fBtest\fR example-1 {} -setup $SETUP -body { # First test } -cleanup $CLEANUP -result {...} test example-2 {} -constraints X -setup $SETUP { \fBtest\fR example-2 {} -constraints X -setup $SETUP -body { # Second test; constrained } -cleanup $CLEANUP -result {...} test example-3 {} { \fBtest\fR example-3 {} { # Third test; no context required } {...} cleanupTests \fBcleanupTests\fR } namespace delete ::example::test .CE .PP The next level of organization is a full test suite, made up of several test files. One script is used to control the entire suite. The basic function of this script is to call [\fBrunAllTests\fR] after doing any necessary setup. This script is usually named \fBall.tcl\fR because that's the default name used by [\fBrunAllTests\fR] when combining multiple test suites into one testing run. .IP [8] Here is a sketch of a sample test suite master script: .CS package require Tcl 8.4 package require tcltest 2.2 package require example tcltest::configure -testdir \ \fB::tcltest::configure\fR -testdir \ [file dirname [file normalize [info script]]] eval tcltest::configure $argv tcltest::runAllTests eval \fB::tcltest::configure\fR $argv \fB::tcltest::runAllTests\fR .CE .SH COMPATIBILITY .PP A number of commands and variables in the \fB::tcltest\fR namespace provided by earlier releases of \fBtcltest\fR have not been documented here. They are no longer part of the supported public interface of \fBtcltest\fR and should not be used in new test suites. However, to continue to support existing test suites written to the older interface specifications, many of those deprecated commands and variables still work as before. For example, in many circumstances, [\fBconfigure\fR] will be automatically called shortly after [\fBpackage require tcltest 2.1\fR] succeeds with arguments from the variable \fB::argv\fR. This is to support test suites that depend on the old behavior that \fBtcltest\fR was automatically configured from command line arguments. New test files should not depend on this, but should explicitly include .CS eval tcltest::configure $::argv eval \fB::tcltest::configure\fR $::argv .CE to establish a configuration from command line arguments. .SH "KNOWN ISSUES" There are two known issues related to nested evaluations of [\fBtest\fR]. The first issue relates to the stack level in which test scripts are executed. Tests nested within other tests may be executed at the same stack level as the outermost test. For example, in the following code: .CS test level-1.1 {level 1} { \fBtest\fR level-1.1 {level 1} { -body { test level-2.1 {level 2} { \fBtest\fR level-2.1 {level 2} { } } } .CE any script executed in level-2.1 may be executed at the same stack level as the script defined for level-1.1. .PP In addition, while two [\fBtest\fR]s have been run, results will only be reported by [\fBcleanupTests\fR] for tests at the same level as test level-1.1. However, test results for all tests run prior to level-1.1 will be available when test level-2.1 runs. What this means is that if you try to access the test results for test level-2.1, it will may say that 'm' tests have run, 'n' tests have been skipped, 'o' tests have passed and 'p' tests have failed, where 'm', 'n', 'o', and 'p' refer to tests that were run at the same test level as test level-1.1. .PP Implementation of output and error comparison in the test command depends on usage of puts in your application code. Output is intercepted by redefining the puts command while the defined test depends on usage of ::puts in your application code. Output is intercepted by redefining the ::puts command while the defined test script is being run. Errors thrown by C procedures or printed directly from C applications will not be caught by the test command. Therefore, usage of the \fB-output\fR and \fB-errorOuput\fR Therefore, usage of the \fB-output\fR and \fB-errorOutput\fR options to [\fBtest\fR] is useful only for pure Tcl applications that use [\fBputs\fR] to produce output. that use [\fB::puts\fR] to produce output. .SH KEYWORDS test, test harness, test suite

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-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. '\" '\" RCS: @(#) $Id: tclvars.n,v 1.13 2002/07/01 18:24:39 jenglish Exp $ '\" RCS: @(#) $Id: tclvars.n,v 1.13.2.3 2005/07/26 21:39:22 dgp Exp $ '\" .so man.macros .TH tclvars n 8.0 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME tclvars \- Variables used by Tcl
︙
106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122	106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121	- - + + -	implementation of the env mechanisms. This file contains many #define's that allow customization of the env mechanisms to fit your applications needs. .RE .TP \fBerrorCode\fR After an error has occurred, this variable will be set to hold additional information about the error in a form that is easy to process with programs. a list value representing additional information about the error in a form that is easy to process with programs. \fBerrorCode\fR consists of a Tcl list with one or more elements. The first element of the list identifies a general class of errors, and determines the format of the rest of the list. The following formats for \fBerrorCode\fR are used by the Tcl core; individual applications may define additional formats. .RS .TP \fBARITH\fI code msg\fR
︙
243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270	242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269	- - - - - + + + + +	the platform on which the application is running, such as the name of the operating system, its current release number, and the machine's instruction set. The elements listed below will always be defined, but they may have empty strings as values if Tcl couldn't retrieve any relevant information. In addition, extensions and applications may add additional values to the array. The predefined elements are: .RS .VS .TP \fBbyteOrder\fR The native byte order of this machine: either \fBlittleEndian\fR or \fBbigEndian\fR. .VE .TP \fBdebug\fR If this variable exists, then the interpreter was compiled with debugging symbols enabled. This variable will only exist on Windows so extension writers can specify which package to load depending on the C run-time library that is loaded. If this variable exists, then the interpreter was compiled with and linked to a debug-enabled C run-time. This variable will only exist on Windows, so extension writers can specify which package to load depending on the C run-time library that is in use. This is not an indication that this core contains symbols. .TP \fBmachine\fR The instruction set executed by this machine, such as \fBintel\fR, \fBPPC\fR, \fB68k\fR, or \fBsun4m\fR. On UNIX machines, this is the value returned by \fBuname -m\fR. .TP \fBos\fR
︙
339 340 341 342 343 344 345 346 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	338 339 340 341 342 343 344 345 346 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	- - + + - + - + - + - + - + - +	application has the variable is set to \fBtclshrc\fR. .TP \fBtcl_traceCompile\fR The value of this variable can be set to control how much tracing information is displayed during bytecode compilation. By default, tcl_traceCompile is zero and no information is displayed. Setting tcl_traceCompile to 1 generates a one line summary in stdout whenever a procedure or top level command is compiled. Setting tcl_traceCompile to 1 generates a one-line summary in stdout whenever a procedure or top-level command is compiled. Setting it to 2 generates a detailed listing in stdout of the bytecode instructions emitted during every compilation. This variable is useful in tracking down suspected problems with the Tcl compiler. It is also occasionally useful when converting existing code to use Tcl8.0. .PP This variable and functionality only exist if TCL_COMPILE_DEBUG was defined during Tcl's compilation. \fBTCL_COMPILE_DEBUG\fR was defined during Tcl's compilation. .TP \fBtcl_traceExec\fR The value of this variable can be set to control how much tracing information is displayed during bytecode execution. By default, tcl_traceExec is zero and no information is displayed. Setting tcl_traceExec to 1 generates a one line trace in stdout Setting tcl_traceExec to 1 generates a one-line trace in stdout on each call to a Tcl procedure. Setting it to 2 generates a line of output whenever any Tcl command is invoked that contains the name of the command and its arguments. Setting it to 3 produces a detailed trace showing the result of executing each bytecode instruction. Note that when tcl_traceExec is 2 or 3, commands such as set and incr commands such as \fBset\fR and \fBincr\fR that have been entirely replaced by a sequence of bytecode instructions are not shown. Setting this variable is useful in tracking down suspected problems with the bytecode compiler and interpreter. It is also occasionally useful when converting code to use Tcl8.0. .PP This variable and functionality only exist if TCL_COMPILE_DEBUG was defined during Tcl's compilation. \fBTCL_COMPILE_DEBUG\fR was defined during Tcl's compilation. .TP \fBtcl_wordchars\fR The value of this variable is a regular expression that can be set to control what are considered ``word'' characters, for instances like selecting a word by double-clicking in text in Tk. It is platform dependent. On Windows, it defaults to \fB\\S\fR, meaning anything but a Unicode space character. Otherwise it defaults to \fB\\w\fR,
︙
400 401 402 403 404 405 406 407 408 409 410 411 412	399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438	+ + + + + + + + + + + + + + + + + + + + + + + + + + + - +	When an interpreter is created Tcl initializes this variable to hold the version number for this version of Tcl in the form \fIx.y\fR. Changes to \fIx\fR represent major changes with probable incompatibilities and changes to \fIy\fR represent small enhancements and bug fixes that retain backward compatibility. The value of this variable is returned by the \fBinfo tclversion\fR command. .SH "OTHER GLOBAL VARIABLES" The following variables are only guaranteed to exist in \fBtclsh\fR and \fBwish\fR executables; the Tcl library does not define them itself but many Tcl environments do. .TP 6 \fBargc\fR The number of arguments to \fBtclsh\fR or \fBwish\fR. .TP 6 \fBargv\fR Tcl list of arguments to \fBtclsh\fR or \fBwish\fR. .TP 6 \fBargv0\fR The script that \fBtclsh\fR or \fBwish\fR started executing (if it was specified) or otherwise the name by which \fBtclsh\fR or \fBwish\fR was invoked. .TP 6 \fBtcl_interactive\fR Contains 1 if \fBtclsh\fR or \fBwish\fR is running interactively (no script was specified and standard input is a terminal-like device), 0 otherwise. .PP The \fBwish\fR executably additionally specifies the following global variable: .TP 6 \fBgeometry\fR If set, contains the user-supplied geometry specification to use for the main Tk window. .SH "SEE ALSO" eval(n) eval(n), tclsh(1), wish(1) .SH KEYWORDS arithmetic, bytecode, compiler, error, environment, POSIX, precision, subprocess, variables

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: tell.n,v 1.5 2001/09/14 19:20:40 andreas_kupries Exp $ '\" RCS: @(#) $Id: tell.n,v 1.5.8.1 2004/10/27 14:43:14 dkf Exp $ '\" .so man.macros .TH tell n 8.1 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME tell \- Return current access position for an open channel
︙
30 31 32 33 34 35 36 37 38 39 40 41 42	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	+ + + + + + + + + + + + +	.PP .VS \fIChannelId\fR must be an identifier for an open channel such as a Tcl standard channel (\fBstdin\fR, \fBstdout\fR, or \fBstderr\fR), the return value from an invocation of \fBopen\fR or \fBsocket\fR, or the result of a channel creation command provided by a Tcl extension. .VE .SH EXAMPLE Read a line from a file channel only if it starts with \fBfoobar\fR: .CS # Save the offset in case we need to undo the read... set offset [\fBtell\fR $chan] if {[read $chan 6] eq "foobar"} { gets $chan line } else { set line {} # Undo the read... seek $chan $offset } .CE .SH "SEE ALSO" file(n), open(n), close(n), gets(n), seek(n), Tcl_StandardChannels(3) .SH KEYWORDS access position, channel, seeking

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: time.n,v 1.3 2000/09/07 14:27:52 poenitz Exp $ '\" RCS: @(#) $Id: time.n,v 1.3.18.1 2004/10/27 14:43:14 dkf Exp $ '\" .so man.macros .TH time n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME time \- Time the execution of a script
︙
24 25 26 27 28 29 30 31 32 33 34 35 36	24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46	+ + + + + + + + + +	specified). It will then return a string of the form .CS \fB503 microseconds per iteration\fR .CE which indicates the average amount of time required per iteration, in microseconds. Time is measured in elapsed time, not CPU time. .SH EXAMPLE Estimate how long it takes for a simple Tcl \fBfor\fR loop to count to a thousand: .CS time { for {set i 0} {$i<1000} {incr i} { # empty body } } .CE .SH "SEE ALSO" clock(n) .SH KEYWORDS script, time

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" Copyright (c) 2000 Ajuba Solutions. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: trace.n,v 1.13 2003/02/04 00:56:20 hobbs Exp $ '\" RCS: @(#) $Id: trace.n,v 1.13.2.2 2004/10/27 14:43:14 dkf Exp $ '\" .so man.macros .TH trace n "8.4" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME trace \- Monitor variable accesses, command usages and command executions
︙
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	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	+ - + - + - + - + - +	command will not cause further trace evaluations to occur. Both \fIoldName\fR and \fInewName\fR are fully qualified with any namespace(s) in which they appear. .RE .TP \fBtrace add execution\fR \fIname ops command\fR Arrange for \fIcommand\fR to be executed whenever command \fIname\fR is executed, with traces occurring at the points indicated by the list is modified in one of the ways given by the list \fIops\fR. \fIName\fR will be \fIops\fR. \fIName\fR will be resolved using the usual namespace resolution rules used by procedures. If the command does not exist, an error will be thrown. .RS .PP \fIOps\fR indicates which operations are of interest, and is a list of one or more of the following items: .TP \fBenter\fR Invoke \fIcommand\fR whenever the command \fIname\fR is executed, just before the actual execution takes place. .TP \fBleave\fR Invoke \fIcommand\fR whenever the command \fIname\fR is executed, just after the actual execution takes place. .TP \fBenterstep\fR Invoke \fIcommand\fR for every tcl command which is executed Invoke \fIcommand\fR for every Tcl command which is executed inside the procedure \fIname\fR, just before the actual execution takes place. For example if we have 'proc foo {} { puts "hello" }', then a \fIenterstep\fR trace would be then an \fIenterstep\fR trace would be invoked just before \fIputs "hello"\fR is executed. Setting a \fIenterstep\fR trace on a \fIcommand\fR Setting an \fIenterstep\fR trace on a \fIcommand\fR will not result in an error and is simply ignored. .TP \fBleavestep\fR Invoke \fIcommand\fR for every tcl command which is executed Invoke \fIcommand\fR for every Tcl command which is executed inside the procedure \fIname\fR, just after the actual execution takes place. Setting a \fIleavestep\fR trace on a \fIcommand\fR will not result in an error and is simply ignored. .PP When the trace triggers, depending on the operations being traced, a number of arguments are appended to \fIcommand\fR so that the actual
︙
136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170	137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171	- + - + - - + + - +	\fIOp\fR indicates what operation is being performed on the command execution, and is one of \fBleave\fR or \fBleavestep\fR as defined above. Note that the creation of many \fBenterstep\fR or \fBleavestep\fR traces can lead to unintuitive results, since the invoked commands from one trace can themselves lead to further command invocations for other traces. .PP \fICommand\fR executes in the same context as the code that invoked the traced operation: thus the \fIcommand\fR, if invoked from a procedure, will have access to the same local variables as code in the procedure. This context may be different than the context in which the trace was created. If \fIcommand\fR invokes a procedure (which it normally does) then the procedure will have to use upvar or uplevel commands if it wishes to access the local variables of the code which invoked the trace operation. .PP While \fIcommand\fR is executing during an execution trace, traces on \fIname\fR are temporarily disabled. This allows the \fIcommand\fR to execute \fIname\fR in its body without invoking any other traces again. If an error occurs while executing the \fIcommand\fR body, then the \fIcommand\fR name as a whole will return that same error. command \fIname\fR as a whole will return that same error. .PP When multiple traces are set on \fIname\fR, then for \fIenter\fR and \fIenterstep\fR operations, the traced commands are invoked in the reverse order of how the traces were originally created; and for \fIleave\fR and \fIleavestep\fR operations, the traced commands are invoked in the original order of creation. .PP The behavior of execution traces is currently undefined for a command \fIname\fR imported into another namespace. .RE .TP \fBtrace add variable\fI name ops command\fR Arrange for \fIcommand\fR to be executed whenever variable \fIname\fR is accessed in one of the ways given by the list \fIops\fR. \fIName\fR may
︙
349 350 351 352 353 354 355 356 357 358 359 360 361	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	+ + + + + + + + + + + + + + + + + + + + + + +	.PP These subcommands are deprecated and will likely be removed in a future version of Tcl. They use an older syntax in which \fBarray\fR, \fBread\fR, \fBwrite\fR, \fBunset\fR are replaced by \fBa\fR, \fBr\fR, \fBw\fR and \fBu\fR respectively, and the \fIops\fR argument is not a list, but simply a string concatenation of the operations, such as \fBrwua\fR. .SH EXAMPLES Print a message whenever either of the global variables \fBfoo\fR and \fBbar\fR are updated, even if they have a different local name at the time (which can be done with the \fBupvar\fR command): .CS proc tracer {varname args} { upvar #0 $varname var puts "$varname was updated to be \e"$var\e"" } \fBtrace add\fR variable foo write "tracer foo" \fBtrace add\fR variable bar write "tracer bar" .CE .PP Ensure that the global variable \fBfoobar\fR always contains the product of the global variables \fBfoo\fR and \fBbar\fR: .CS proc doMult args { global foo bar foobar set foobar [expr {$foo * $bar}] } \fBtrace add\fR variable foo write doMult \fBtrace add\fR variable bar write doMult .CE .SH "SEE ALSO" set(n), unset(n) .SH KEYWORDS read, command, rename, variable, write, trace, unset

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: unknown.n,v 1.4 2001/06/27 21:00:45 hobbs Exp $ '\" RCS: @(#) $Id: unknown.n,v 1.4.12.1 2004/10/27 14:43:15 dkf Exp $ '\" .so man.macros .TH unknown n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME unknown \- Handle attempts to use non-existent commands
︙
67 68 69 70 71 72 73 74 75 76 77 78 79	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	+ + + + + + + + + + + + + +	If the global variable \fBauto_noload\fR is defined, then the auto-load step is skipped. If the global variable \fBauto_noexec\fR is defined then the auto-exec step is skipped. Under normal circumstances the return value from \fBunknown\fR is the return value from the command that was eventually executed. .SH EXAMPLE Arrange for the \fBunknown\fR command to have its standard behavior except for first logging the fact that a command was not found: .PP .CS # Save the original one so we can chain to it rename \fBunknown\fR _original_unknown # Provide our own implementation proc \fBunknown\fR args { puts stderr "WARNING: unknown command: $args" uplevel 1 [list _original_unknown {expand}$args] } .CE .SH "SEE ALSO" info(n), proc(n), interp(n), library(n) .SH KEYWORDS error, non-existent command

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" Copyright (c) 2000 Ajuba Solutions. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: unset.n,v 1.5 2001/03/06 14:45:03 dkf Exp $ '\" RCS: @(#) $Id: unset.n,v 1.5.18.2 2004/10/27 14:43:15 dkf Exp $ '\" .so man.macros .TH unset n 8.4 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME unset \- Delete variables
︙
35 36 37 38 39 40 41 42 43 44 45 46 47	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	+ + + + + + + + + + - + + + + + + + + + + + + - +	indicates the end of the options, and should be used if you wish to remove a variable with the same name as any of the options. .VE 8.4 If an error occurs, any variables after the named one causing the error not deleted. An error can occur when the named variable doesn't exist, or the name refers to an array element but the variable is a scalar, or the name refers to a variable in a non-existent namespace. .SH EXAMPLE Create an array containing a mapping from some numbers to their squares and remove the array elements for non-prime numbers: .CS array set squares { 1 1 6 36 2 4 7 49 3 9 8 64 4 16 9 81 5 25 10 100 } puts "The squares are:" parray squares \fBunset\fR squares(1) squares(4) squares(6) \fBunset\fR squares(8) squares(9) squares(10) puts "The prime squares are:" parray squares .CE .SH "SEE ALSO" set(n), trace(n) set(n), trace(n), upvar(n) .SH KEYWORDS remove, variable

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1990-1992 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: update.n,v 1.4 2000/09/07 14:27:52 poenitz Exp $ '\" RCS: @(#) $Id: update.n,v 1.4.18.1 2004/10/27 14:43:15 dkf Exp $ '\" .so man.macros .TH update n 7.5 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME update \- Process pending events and idle callbacks
︙
39 40 41 42 43 44 45 46 47 48 49 50 51	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	+ + + + + + + + + + + + + + + +	these updates will not occur in \fBupdate idletasks\fR. .PP The \fBupdate\fR command with no options is useful in scripts where you are performing a long-running computation but you still want the application to respond to events such as user interactions; if you occasionally call \fBupdate\fR then user input will be processed during the next call to \fBupdate\fR. .SH EXAMPLE Run computations for about a second and then finish: .CS set x 1000 set done 0 after 1000 set done 1 while {!$done} { # A very silly example! set x [expr {log($x) ** 2.8}] # Test to see if our time-limit has been hit. This would # also give a chance for serving network sockets and, if # the Tk package is loaded, updating a user interface. \fBupdate\fR } .CE .SH "SEE ALSO" after(n), bgerror(n) .SH KEYWORDS event, flush, handler, idle, update

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-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. '\" '\" RCS: @(#) $Id: uplevel.n,v 1.3 2000/09/07 14:27:52 poenitz Exp $ '\" RCS: @(#) $Id: uplevel.n,v 1.3.18.1 2004/10/27 14:43:15 dkf Exp $ '\" .so man.macros .TH uplevel n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME uplevel \- Execute a script in a different stack frame
︙
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	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 95 96 97 98 99 100	- + - + + + + + + + + + + + + + + + + + + + + +	If \fIlevel\fR is \fB3\fR or \fB#0\fR then the command will be executed at top-level (only global variables will be visible). .PP The \fBuplevel\fR command causes the invoking procedure to disappear from the procedure calling stack while the command is being executed. In the above example, suppose \fBc\fR invokes the command .CS \fBuplevel 1 {set x 43; d}\fR \fBuplevel\fR 1 {set x 43; d} .CE where \fBd\fR is another Tcl procedure. The \fBset\fR command will modify the variable \fBx\fR in \fBb\fR's context, and \fBd\fR will execute at level 3, as if called from \fBb\fR. If it in turn executes the command .CS \fBuplevel {set x 42}\fR \fBuplevel\fR {set x 42} .CE then the \fBset\fR command will modify the same variable \fBx\fR in \fBb\fR's context: the procedure \fBc\fR does not appear to be on the call stack when \fBd\fR is executing. The command ``\fBinfo level\fR'' may be used to obtain the level of the current procedure. .PP \fBUplevel\fR makes it possible to implement new control constructs as Tcl procedures (for example, \fBuplevel\fR could be used to implement the \fBwhile\fR construct as a Tcl procedure). .PP \fBnamespace eval\fR is another way (besides procedure calls) that the Tcl naming context can change. It adds a call frame to the stack to represent the namespace context. This means each \fBnamespace eval\fR command counts as another call level for \fBuplevel\fR and \fBupvar\fR commands. For example, \fBinfo level 1\fR will return a list describing a command that is either the outermost procedure call or the outermost \fBnamespace eval\fR command. Also, \fBuplevel #0\fR evaluates a script at top-level in the outermost namespace (the global namespace). .SH EXAMPLE As stated above, the \fBuplevel\fR command is useful for creating new control constructs. This example shows how (without error handling) it can be used to create a \fBdo\fR command that is the counterpart of \fBwhile\fR except for always performing the test after running the loop body: .CS proc do {body while condition} { if {$while ne "while"} { error "required word missing" } set conditionCmd [list expr $condition] while {1} { \fBuplevel\fR 1 $body if {![\fBuplevel\fR 1 $conditionCmd]} { break } } } .CE .SH "SEE ALSO" namespace(n), upvar(n) .SH KEYWORDS context, level, namespace, stack frame, variables

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-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. '\" '\" RCS: @(#) $Id: upvar.n,v 1.5 2000/11/21 15:56:21 dkf Exp $ '\" RCS: @(#) $Id: upvar.n,v 1.5.18.2 2004/11/12 09:02:30 das Exp $ '\" .so man.macros .TH upvar n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME upvar \- Create link to variable in a different stack frame
︙
42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61	42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61	- - - + + + - + - +	\fBUpvar\fR returns an empty string. .PP The \fBupvar\fR command simplifies the implementation of call-by-name procedure calling and also makes it easier to build new control constructs as Tcl procedures. For example, consider the following procedure: .CS \fBproc add2 name { upvar $name x set x [expr $x+2] proc add2 name { \fBupvar\fR $name x set x [expr $x+2] }\fR } .CE \fBAdd2\fR is invoked with an argument giving the name of a variable, \fBadd2\fR is invoked with an argument giving the name of a variable, and it adds two to the value of that variable. Although \fBadd2\fR could have been implemented using \fBuplevel\fR instead of \fBupvar\fR, \fBupvar\fR makes it simpler for \fBadd2\fR to access the variable in the caller's procedure frame. .PP \fBnamespace eval\fR is another way (besides procedure calls) that the Tcl naming context can change.
︙
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	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 116 117 118 119 120	- + - - - + + - - - + + + - - + + - + - + + + + + + + + + +	.VS If an upvar variable is unset (e.g. \fBx\fR in \fBadd2\fR above), the \fBunset\fR operation affects the variable it is linked to, not the upvar variable. There is no way to unset an upvar variable except by exiting the procedure in which it is defined. However, it is possible to retarget an upvar variable by executing another \fBupvar\fR command. .SH "TRACES AND UPVAR" .SH Traces and upvar .PP Upvar interacts with traces in a straightforward but possibly unexpected manner. If a variable trace is defined on \fIotherVar\fR, that trace will be triggered by actions involving \fImyVar\fR. However, the trace procedure will be passed the name of \fImyVar\fR, rather than the name of \fIotherVar\fR. Thus, the output of the following code will be \fBlocalVar\fR rather than \fBoriginalVar\fR: .CS \fBproc traceproc { name index op } { puts $name proc \fBtraceproc\fR { name index op } { puts $name } proc setByUpvar { name value } { upvar $name localVar set localVar $value proc \fBsetByUpvar\fR { name value } { \fBupvar\fR $name localVar set localVar $value } set originalVar 1 trace variable originalVar w traceproc setByUpvar originalVar 2 trace variable originalVar w \fBtraceproc\fR \fBsetByUpvar\fR originalVar 2 }\fR } .CE .PP If \fIotherVar\fR refers to an element of an array, then variable traces set for the entire array will not be invoked when \fImyVar\fR is accessed (but traces on the particular element will still be invoked). In particular, if the array is \fBenv\fR, then changes made to \fImyVar\fR will not be passed to subprocesses correctly. .VE .SH EXAMPLE A \fBdecr\fR command that works like \fBincr\fR except it subtracts the value from the variable instead of adding it: .CS proc decr {varName {decrement 1}} { \fBupvar\fR 1 $varName var incr var [expr {-$decrement}] } .CE .SH "SEE ALSO" global(n), namespace(n), uplevel(n), variable(n) .SH KEYWORDS context, frame, global, level, namespace, procedure, variable

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies '\" Copyright (c) 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. '\" '\" RCS: @(#) $Id: variable.n,v 1.4 2000/11/21 15:56:21 dkf Exp $ '\" RCS: @(#) $Id: variable.n,v 1.4.18.2 2005/02/16 18:53:02 msofer Exp $ '\" .so man.macros .TH variable n 8.0 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME variable \- create and initialize a namespace variable
︙
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	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 95 96 97 98 99	- + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	the variable is created in the specified namespace. If the variable is not defined, it will be visible to the \fBnamespace which\fR command, but not to the \fBinfo exists\fR command. .PP If the \fBvariable\fR command is executed inside a Tcl procedure, it creates local variables linked to the corresponding namespace variables (and therefore these variables are listed by \fBinfo locals\fR.) variables are listed by \fBinfo vars\fR.) In this way the \fBvariable\fR command resembles the \fBglobal\fR command, although the \fBglobal\fR command only links to variables in the global namespace. If any \fIvalue\fRs are given, they are used to modify the values of the associated namespace variables. If a namespace variable does not exist, it is created and optionally initialized. .PP A \fIname\fR argument cannot reference an element within an array. Instead, \fIname\fR should reference the entire array, and the initialization \fIvalue\fR should be left off. After the variable has been declared, elements within the array can be set using ordinary \fBset\fR or \fBarray\fR commands. .SH EXAMPLES Create a variable in a namespace: .CS namespace eval foo { \fBvariable\fR bar 12345 } .CE .PP Create an array in a namespace: .CS namespace eval someNS { \fBvariable\fR someAry array set someAry { someName someValue otherName otherValue } } .CE .PP Access variables in namespaces from a procedure: .CS namespace eval foo { proc spong {} { # Variable in this namespace \fBvariable\fR bar puts "bar is $bar" # Variable in another namespace \fBvariable\fR ::someNS::someAry parray someAry } } .CE .SH "SEE ALSO" global(n), namespace(n), upvar(n) .SH KEYWORDS global, namespace, procedure, variable

1 2 3 4 5 6 7 8 9 10 11 12 13 14	1 2 3 4 5 6 7 8 9 10 11 12 13 14	- +	'\" '\" Copyright (c) 1995-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" '\" RCS: @(#) $Id: vwait.n,v 1.4 2000/09/07 14:27:52 poenitz Exp $ '\" RCS: @(#) $Id: vwait.n,v 1.4.18.1 2004/10/27 14:43:15 dkf Exp $ '\" .so man.macros .TH vwait n 8.0 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME vwait \- Process events until a variable is written
︙
31 32 33 34 35 36 37 38 39 40 41 42 43	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	+ + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + - +	after \fIvarName\fR is set. This can happen if the event handler that sets \fIvarName\fR does not complete immediately. For example, if an event handler sets \fIvarName\fR and then itself calls \fBvwait\fR to wait for a different variable, then it may not return for a long time. During this time the top-level \fBvwait\fR is blocked waiting for the event handler to complete, so it cannot return either. .SH EXAMPLES Run the event-loop continually until some event calls \fBexit\fR. (You can use any variable not mentioned elsewhere, but the name \fIforever\fR reminds you at a glance of the intent.) .CS \fBvwait\fR forever .CE .PP Wait five seconds for a connection to a server socket, otherwise close the socket and continue running the script: .CS # Initialise the state after 5000 set state timeout set server [socket -server accept 12345] proc accept {args} { global state connectionInfo set state accepted set connectionInfo $args } # Wait for something to happen \fBvwait\fR state # Clean up events that could have happened close $server after cancel set state timeout # Do something based on how the vwait finished... switch $state { timeout { puts "no connection on port 12345" } accepted { puts "connection: $connectionInfo" puts [lindex $connectionInfo 0] "Hello there!" } } .CE .SH "SEE ALSO" global(n) global(n), update(n) .SH KEYWORDS event, variable, wait

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	'\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-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. '\" '\" RCS: @(#) $Id: while.n,v 1.3 2000/09/07 14:27:52 poenitz Exp $ '\" RCS: @(#) $Id: while.n,v 1.3.18.1 2004/10/27 14:43:15 dkf Exp $ '\" .so man.macros .TH while n "" Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME while \- Execute script repeatedly as long as a condition is met
︙
41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58	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	- - - + + + + + + + + + + + +	enclosed in braces, variable substitutions are delayed until the expression is evaluated (before each loop iteration), so changes in the variables will be visible. For an example, try the following script with and without the braces around \fB$x<10\fR: .CS set x 0 while {$x<10} { puts "x is $x" incr x \fBwhile\fR {$x<10} { puts "x is $x" incr x } .CE .SH EXAMPLE Read lines from a channel until we get to the end of the stream, and print them out with a line-number prepended: .CS set lineCount 0 \fBwhile\fR {[gets $chan line] >= 0} { puts "[incr lineCount]: $line" } .CE .SH "SEE ALSO" break(n), continue(n), for(n), foreach(n) .SH KEYWORDS boolean value, loop, test, while

1 2 3 4 5

1 2 3 4 5

- + - +

This directory contains Tcl source files that work on all the platforms where Tcl runs (e.g. UNIX, PCs, and Macintoshes). Platform-specific sources are in the directories ../unix, ../win, and ../mac. sources are in the directories ../unix, ../win, ../macosx, and ../mac. RCS: @(#) $Id: README,v 1.2 1998/09/14 18:39:56 stanton Exp $ RCS: @(#) $Id: README,v 1.2.40.1 2005/12/02 21:13:26 dgp Exp $

︙
549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564	549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568	+ + + - - + + +	slist = NULL; for (a = pre->outs; a != NULL; a = a->outchain) { s = a->to; for (b = s->ins; b != NULL; b = b->inchain) if (b->from != pre) break; if (b != NULL) { /* must be split */ if (s->tmp == NULL) { /* if not already in the list */ /* (fixes bugs 505048, 230589, */ /* 840258, 504785) */ s->tmp = slist; slist = s; s->tmp = slist; slist = s; } } } /* do the splits */ for (s = slist; s != NULL; s = s2) { s2 = newstate(nfa); copyouts(nfa, s, s2);
︙
2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175	2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179	- + - +	static char * /* points to buf or constant string */ stid(t, buf, bufsize) struct subre *t; char *buf; size_t bufsize; { /* big enough for hex int or decimal t->retry? */ if (bufsize < sizeof(int)*2 + 3 || bufsize < sizeof(t->retry)*3 + 1) if (bufsize < sizeof(void*)*2 + 3 || bufsize < sizeof(t->retry)*3 + 1) return "unable"; if (t->retry != 0) sprintf(buf, "%d", t->retry); else sprintf(buf, "0x%x", (int)t); /* may lose bits, that's okay */ sprintf(buf, "%p", t); return buf; } #include "regc_lex.c" #include "regc_color.c" #include "regc_nfa.c" #include "regc_cvec.c" #include "regc_locale.c"

︙
87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103	87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109	+ + + + + +	typedef Tcl_UniChar chr; /* the type itself */ typedef int pchr; /* what it promotes to */ typedef unsigned uchr; /* unsigned type that will hold a chr */ typedef int celt; /* type to hold chr, MCCE number, or NOCELT */ #define NOCELT (-1) /* celt value which is not valid chr or MCCE */ #define CHR(c) (UCHAR(c)) /* turn char literal into chr literal */ #define DIGITVAL(c) ((c)-'0') /* turn chr digit into its value */ #if TCL_UTF_MAX > 3 #define CHRBITS 32 /* bits in a chr; must not use sizeof */ #define CHR_MIN 0x00000000 /* smallest and largest chr; the value */ #define CHR_MAX 0xffffffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */ #else #define CHRBITS 16 /* bits in a chr; must not use sizeof */ #define CHR_MIN 0x0000 /* smallest and largest chr; the value */ #define CHR_MAX 0xffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */ #endif /* functions operating on chr */ #define iscalnum(x) Tcl_UniCharIsAlnum(x) #define iscalpha(x) Tcl_UniCharIsAlpha(x) #define iscdigit(x) Tcl_UniCharIsDigit(x) #define iscspace(x) Tcl_UniCharIsSpace(x)
︙

︙
557 558 559 560 561 562 563 564 565 566 567 568 569 570 571	557 558 559 560 561 562 563 564 565 566 567 568 569 570 571	- +	chr *cp; chr *start; { int i; struct sset *ss; struct sset *p; struct arcp ap; struct arcp lastap; struct arcp lastap = {NULL, 0}; /* silence gcc 4 warning */ color co; ss = pickss(v, d, cp, start); assert(!(ss->flags&LOCKED)); /* clear out its inarcs, including self-referential ones */ ap = ss->ins;
︙

︙
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	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	- - + + - +	}; /* - regerror - the interface to error numbers */ /* ARGSUSED */ size_t /* actual space needed (including NUL) */ regerror(errcode, preg, errbuf, errbuf_size) int errcode; /* error code, or REG_ATOI or REG_ITOA */ regerror(code, preg, errbuf, errbuf_size) int code; /* error code, or REG_ATOI or REG_ITOA */ CONST regex_t *preg; /* associated regex_t (unused at present) */ char *errbuf; /* result buffer (unless errbuf_size==0) */ size_t errbuf_size; /* available space in errbuf, can be 0 */ { struct rerr *r; char *msg; char convbuf[sizeof(unk)+50]; /* 50 = plenty for int */ size_t len; int icode; switch (errcode) { switch (code) { case REG_ATOI: /* convert name to number */ for (r = rerrs; r->code >= 0; r++) if (strcmp(r->name, errbuf) == 0) break; sprintf(convbuf, "%d", r->code); /* -1 for unknown */ msg = convbuf; break;
︙
80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99	80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99	- + - +	else { /* unknown; tell him the number */ sprintf(convbuf, "REG_%u", (unsigned)icode); msg = convbuf; } break; default: /* a real, normal error code */ for (r = rerrs; r->code >= 0; r++) if (r->code == errcode) if (r->code == code) break; if (r->code >= 0) msg = r->explain; else { /* unknown; say so */ sprintf(convbuf, unk, errcode); sprintf(convbuf, unk, code); msg = convbuf; } break; } len = strlen(msg) + 1; /* space needed, including NUL */ if (errbuf_size > 0) {
︙

︙
345 346 347 348 349 350 351 352 353 354 355 356 357 358 359	345 346 347 348 349 350 351 352 353 354 355 356 357 358 359	- +	cfind(v, cnfa, cm) struct vars *v; struct cnfa *cnfa; struct colormap *cm; { struct dfa *s; struct dfa *d; chr *cold; chr *cold = NULL; /* silence gcc 4 warning */ int ret; s = newdfa(v, &v->g->search, cm, &v->dfa1); NOERR(); d = newdfa(v, cnfa, cm, &v->dfa2); if (ISERR()) { assert(d == NULL);
︙

︙
51 52 53 54 55 56 57 58 59 60 61 62 63 64 65	51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67	+ +	#include <limits.h> #include <string.h> #endif /* assertions */ #ifndef assert # ifndef REG_DEBUG # ifndef NDEBUG # define NDEBUG /* no assertions */ # endif # endif #include <assert.h> #endif /* voids */ #ifndef VOID #define VOID void /* for function return values */
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	# tcl.decls -- # # This file contains the declarations for all supported public # functions that are exported by the Tcl library via the stubs table. # This file is used to generate the tclDecls.h, tclPlatDecls.h, # tclStub.c, and tclPlatStub.c files. # # # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 2001, 2002 by Kevin B. Kenny. All rights reserved. # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: tcl.decls,v 1.94 2002/08/31 06:09:45 das Exp $ # RCS: @(#) $Id: tcl.decls,v 1.94.2.4 2006/09/22 01:26:22 andreas_kupries Exp $ library tcl # Define the tcl interface with several sub interfaces: # tclPlat - platform specific public # tclInt - generic private # tclPlatInt - platform specific private
︙
967 968 969 970 971 972 973 974 975 976 977 978 979 980	967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984	+ + + +	CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr) } declare 273 generic { int Tcl_PkgProvide(Tcl_Interp *interp, CONST char *name, CONST char *version) } # TIP #268: The internally used new Require function is in slot # 573. Assuming TCL_TIP268 was activated. declare 274 generic { CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp, CONST char *name, CONST char *version, int exact) } declare 275 generic { void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList) }
︙
1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467	1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471	- +	declare 411 generic { Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc(Tcl_ChannelType *chanTypePtr) } # Introduced in 8.4a2 declare 412 generic { int Tcl_JoinThread(Tcl_ThreadId id, int* result) int Tcl_JoinThread(Tcl_ThreadId threadId, int* result) } declare 413 generic { int Tcl_IsChannelShared(Tcl_Channel channel) } declare 414 generic { int Tcl_IsChannelRegistered(Tcl_Interp* interp, Tcl_Channel channel) }
︙
1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762	1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	} # New export due to TIP#91 declare 493 generic { Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc( Tcl_ChannelType *chanTypePtr) } # Slots 494 to 553 are taken already by 8.5 # #111 - Dicts (494 ... 504) # #59 - Config (505) # #139 - Namespace API (506 ... 517) # #137 - source -encoding (518) # #121 - ExitProc (519) # #121 - Resource Limits (520 ... 534) # #226 - S/R Interp State (535 ... 537) # #227 - S/G Return Opts (538 ... 539) # #235 - Ensemble C API (540 ... 551) # #233 - Virtualized Time (552 ... 553) # TIP#218 (Driver Thread Actions) davygrvy/akupries ChannelType ver 4 # These slots are used by 8.5 as well. declare 554 generic { Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc(Tcl_ChannelType *chanTypePtr) } # Slots 555 to 572 are taken already by 8.5 # TIP #237: Arbitrary-prec Integers (555 ... 559) # TIP #208: 'chan' Command (560 ... 561) # TIP #219: Channel Reflection (562 ... 565) # TIP #237: Add. bignum support (566) # TIP #181: 'namespace unknown' Cmd (567 ... 568) # TIP #258: Enhanced Encodings API (569 ... 572) # TIP#268: Extended version numbers and requirements. # The slot is present even if TCL_TIP268 is not activated. declare 573 generic { int Tcl_PkgRequireProc(Tcl_Interp *interp, CONST char *name, int objc, Tcl_Obj *CONST objv[], ClientData *clientDataPtr) } ############################################################################## # Define the platform specific public Tcl interface. These functions are # only available on the designated platform. interface tclPlat
︙
1829 1830 1831 1832 1833 1834 1835	1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881	+ + + + + + + +	declare 0 macosx { int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, CONST char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath) } declare 1 macosx { int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp, CONST char *bundleName, CONST char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath) }

︙
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	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	- + - + - - + + - + - - - - +	* Copyright (c) 1994-1998 Sun Microsystems, Inc. * Copyright (c) 1998-2000 by Scriptics Corporation. * Copyright (c) 2002 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tcl.h,v 1.153 2003/02/15 02:16:29 hobbs Exp $ * RCS: @(#) $Id: tcl.h,v 1.153.2.31 2007/05/30 14:05:18 dgp Exp $ */ #ifndef _TCL #define _TCL /* * For C++ compilers, use extern "C" */ #ifdef __cplusplus extern "C" { #endif /* * The following defines are used to indicate the various release levels. */ #define TCL_ALPHA_RELEASE 0 #define TCL_BETA_RELEASE 1 #define TCL_FINAL_RELEASE 2 /* * When version numbers change here, must also go into the following files * and update the version numbers: * * library/init.tcl (only if Major.minor changes, not patchlevel) 1 LOC * unix/configure.in (2 LOC Major, 2 LOC minor, 1 LOC patch) * win/configure.in (as above) * win/tcl.m4 (not patchlevel) * win/makefile.vc (not patchlevel) 2 LOC * README (sections 0 and 2) * mac/README (2 LOC, not patchlevel) * macosx/Tcl.pbproj/project.pbxproj * (7 LOC total, 2 LOC patch) * macosx/Tcl.pbproj/project.pbxproj (not patchlevel) 1 LOC * macosx/Tcl.pbproj/default.pbxuser (not patchlevel) 1 LOC * win/README.binary (sections 0-4) * win/README (not patchlevel) (sections 0 and 2) * unix/tcl.spec (2 LOC Major/Minor, 1 LOC patch) * tests/basic.test (1 LOC M/M, not patchlevel) * tools/tcl.hpj.in (not patchlevel, for windows installer) * tools/tcl.wse.in (for windows installer) * tools/tclSplash.bmp (not patchlevel) */ #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 4 #define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE #define TCL_RELEASE_SERIAL 2 #define TCL_RELEASE_SERIAL 16 #define TCL_PREFIX_IDENT "" #define TCL_DEBUG_IDENT TCL_DBGX #define TCL_VERSION "8.4" #define TCL_PATCH_LEVEL "8.4.2" #define TCL_PATCH_LEVEL "8.4.16" /* * The following definitions set up the proper options for Windows * compilers. We use this method because there is no autoconf equivalent. */ #ifndef __WIN32__
︙
314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340	311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350	- - - + + + + + + + + + + + + + + + +	#else # define VOID char #endif /* * Miscellaneous declarations. */ #ifndef NULL # define NULL 0 #endif #ifndef _CLIENTDATA # ifndef NO_VOID typedef void *ClientData; # else typedef int *ClientData; # endif # define _CLIENTDATA #endif /* * Darwin specifc configure overrides (to support fat compiles, where * configure runs only once for multiple architectures): */ #ifdef __APPLE__ # ifdef __LP64__ # undef TCL_WIDE_INT_TYPE # define TCL_WIDE_INT_IS_LONG 1 # else /* !__LP64__ */ # define TCL_WIDE_INT_TYPE long long # undef TCL_WIDE_INT_IS_LONG # endif /* __LP64__ */ # undef HAVE_STRUCT_STAT64 #endif /* __APPLE__ */ /* * Define Tcl_WideInt to be a type that is (at least) 64-bits wide, * and define Tcl_WideUInt to be the unsigned variant of that type * (assuming that where we have one, we can have the other.) * * Also defines the following macros: * TCL_WIDE_INT_IS_LONG - if wide ints are really longs (i.e. we're on
︙
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	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	- + + + + + - + + + + + +	* and sprintf(...,"%" TCL_LL_MODIFIER "d",...). TCL_LL_MODIFIER_SIZE * is the length of the modifier string, which is "ll" on most 32-bit * Unix systems. It has to be split up like this to allow for the more * complex formats sometimes needed (e.g. in the format(n) command.) */ #if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG) # if defined(__CYGWIN__) # if defined(__GNUC__) # define TCL_WIDE_INT_TYPE long long # if defined(__WIN32__) && !defined(__CYGWIN__) # define TCL_LL_MODIFIER "I64" # define TCL_LL_MODIFIER_SIZE 3 # else # define TCL_LL_MODIFIER "L" typedef struct stat Tcl_StatBuf; # define TCL_LL_MODIFIER_SIZE 1 # endif typedef struct stat Tcl_StatBuf; # elif defined(__WIN32__) # define TCL_WIDE_INT_TYPE __int64 # ifdef __BORLANDC__ typedef struct stati64 Tcl_StatBuf; # define TCL_LL_MODIFIER "L" # define TCL_LL_MODIFIER_SIZE 1 # else /* __BORLANDC__ */ # if _MSC_VER < 1400 || !defined(_M_IX86) typedef struct _stati64 Tcl_StatBuf; # else typedef struct _stat64 Tcl_StatBuf; # endif /* _MSC_VER < 1400 */ # define TCL_LL_MODIFIER "I64" # define TCL_LL_MODIFIER_SIZE 3 # endif /* __BORLANDC__ */ # else /* __WIN32__ */ /* * Don't know what platform it is and configure hasn't discovered what * is going on for us. Try to guess...
︙
629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654	648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668	- - - - -	/* * Argument descriptors for math function callbacks in expressions: */ typedef enum { TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT #ifdef TCL_WIDE_INT_IS_LONG = TCL_INT #endif } Tcl_ValueType; typedef struct Tcl_Value { Tcl_ValueType type; /* Indicates intValue or doubleValue is * valid, or both. */ long intValue; /* Integer value. */ double doubleValue; /* Double-precision floating value. */ #ifndef TCL_WIDE_INT_IS_LONG Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */ #endif } Tcl_Value; /* * Forward declaration of Tcl_Obj to prevent an error when the forward * reference to Tcl_Obj is encountered in the procedure types declared * below. */
︙
808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823	822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840	+ + + - +	# define Tcl_DecrRefCount(objPtr) \ Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__) # define Tcl_IsShared(objPtr) \ Tcl_DbIsShared(objPtr, __FILE__, __LINE__) #else # define Tcl_IncrRefCount(objPtr) \ ++(objPtr)->refCount /* * Use empty if ; else to handle use in unbraced outer if/else conditions */ # define Tcl_DecrRefCount(objPtr) \ if (--(objPtr)->refCount <= 0) TclFreeObj(objPtr) if (--(objPtr)->refCount > 0) ; else TclFreeObj(objPtr) # define Tcl_IsShared(objPtr) \ ((objPtr)->refCount > 1) #endif /* * Macros and definitions that help to debug the use of Tcl objects. * When TCL_MEM_DEBUG is defined, the Tcl_New declarations are
︙
1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438	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	- + + + + + + + + +	#define TCL_STDERR (1<<3) #define TCL_ENFORCE_MODE (1<<4) /* * Bits passed to Tcl_DriverClose2Proc to indicate which side of a channel * should be closed. */ #define TCL_CLOSE_READ (1<<1) #define TCL_CLOSE_READ (1<<1) #define TCL_CLOSE_WRITE (1<<2) /* * Value to use as the closeProc for a channel that supports the * close2Proc interface. */ #define TCL_CLOSE2PROC ((Tcl_DriverCloseProc *)1) /* * Channel version tag. This was introduced in 8.3.2/8.4. */ #define TCL_CHANNEL_VERSION_1 ((Tcl_ChannelTypeVersion) 0x1) #define TCL_CHANNEL_VERSION_2 ((Tcl_ChannelTypeVersion) 0x2) #define TCL_CHANNEL_VERSION_3 ((Tcl_ChannelTypeVersion) 0x3) #define TCL_CHANNEL_VERSION_4 ((Tcl_ChannelTypeVersion) 0x4) /* * TIP #218: Channel Actions, Ids for Tcl_DriverThreadActionProc */ #define TCL_CHANNEL_THREAD_INSERT (0) #define TCL_CHANNEL_THREAD_REMOVE (1) /* * Typedefs for the various operations in a channel type: */ typedef int (Tcl_DriverBlockModeProc) _ANSI_ARGS_(( ClientData instanceData, int mode)); typedef int (Tcl_DriverCloseProc) _ANSI_ARGS_((ClientData instanceData,
︙
1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473	1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501	+ + +	ClientData instanceData)); typedef int (Tcl_DriverHandlerProc) _ANSI_ARGS_(( ClientData instanceData, int interestMask)); typedef Tcl_WideInt (Tcl_DriverWideSeekProc) _ANSI_ARGS_(( ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCodePtr)); /* TIP #218, Channel Thread Actions */ typedef void (Tcl_DriverThreadActionProc) _ANSI_ARGS_ (( ClientData instanceData, int action)); /* * The following declarations either map ckalloc and ckfree to * malloc and free, or they map them to procedures with all sorts * of debugging hooks defined in tclCkalloc.c. */ #ifdef TCL_MEM_DEBUG
︙
1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572	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	+ + + + + + + + + + - - + +	*/ Tcl_DriverWideSeekProc *wideSeekProc; /* Procedure to call to seek * on the channel which can * handle 64-bit offsets. May be * NULL, and must be NULL if * seekProc is NULL. */ /* * Only valid in TCL_CHANNEL_VERSION_4 channels or later * TIP #218, Channel Thread Actions */ Tcl_DriverThreadActionProc *threadActionProc; /* Procedure to call to notify * the driver of thread specific * activity for a channel. * May be NULL. */ } Tcl_ChannelType; /* * The following flags determine whether the blockModeProc above should * set the channel into blocking or nonblocking mode. They are passed * as arguments to the blockModeProc procedure in the above structure. */ #define TCL_MODE_BLOCKING 0 /* Put channel into blocking mode. */ #define TCL_MODE_NONBLOCKING 1 /* Put channel into nonblocking #define TCL_MODE_BLOCKING 0 /* Put channel into blocking mode. */ #define TCL_MODE_NONBLOCKING 1 /* Put channel into nonblocking * mode. */ /* * Enum for different types of file paths. */ typedef enum Tcl_PathType { TCL_PATH_ABSOLUTE,
︙
1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609	1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648	+	#define TCL_GLOB_TYPE_BLOCK (1<<0) #define TCL_GLOB_TYPE_CHAR (1<<1) #define TCL_GLOB_TYPE_DIR (1<<2) #define TCL_GLOB_TYPE_PIPE (1<<3) #define TCL_GLOB_TYPE_FILE (1<<4) #define TCL_GLOB_TYPE_LINK (1<<5) #define TCL_GLOB_TYPE_SOCK (1<<6) #define TCL_GLOB_TYPE_MOUNT (1<<7) #define TCL_GLOB_PERM_RONLY (1<<0) #define TCL_GLOB_PERM_HIDDEN (1<<1) #define TCL_GLOB_PERM_R (1<<2) #define TCL_GLOB_PERM_W (1<<3) #define TCL_GLOB_PERM_X (1<<4)
︙
2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198	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 2257	- - + + + + + + + + + + + + + + + + + + + + + +	* TCL_ENCODING_STOPONERROR was specified. */ #define TCL_CONVERT_MULTIBYTE -1 #define TCL_CONVERT_SYNTAX -2 #define TCL_CONVERT_UNKNOWN -3 #define TCL_CONVERT_NOSPACE -4 /* * The maximum number of bytes that are necessary to represent a single * Unicode character in UTF-8. * Unicode character in UTF-8. The valid values should be 3 or 6 (or * perhaps 1 if we want to support a non-unicode enabled core). * If 3, then Tcl_UniChar must be 2-bytes in size (UCS-2). (default) * If 6, then Tcl_UniChar must be 4-bytes in size (UCS-4). * At this time UCS-2 mode is the default and recommended mode. * UCS-4 is experimental and not recommended. It works for the core, * but most extensions expect UCS-2. */ #ifndef TCL_UTF_MAX #define TCL_UTF_MAX 3 #endif /* * This represents a Unicode character. Any changes to this should * also be reflected in regcustom.h. */ #if TCL_UTF_MAX > 3 /* * unsigned int isn't 100% accurate as it should be a strict 4-byte * value (perhaps wchar_t). 64-bit systems may have troubles. The * size of this value must be reflected correctly in regcustom.h and * in tclEncoding.c. * XXX: Tcl is currently UCS-2 and planning UTF-16 for the Unicode * XXX: string rep that Tcl_UniChar represents. Changing the size * XXX: of Tcl_UniChar is /not/ supported. */ typedef unsigned int Tcl_UniChar; #else typedef unsigned short Tcl_UniChar; #endif /* * Deprecated Tcl procedures: */ #ifndef TCL_NO_DEPRECATED # define Tcl_EvalObj(interp,objPtr) \
︙

︙
11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33	11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33	- + - +	* Copyright (c) 1998-1999 by Scriptics Corporation. * * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclAlloc.c,v 1.16 2002/04/23 17:03:34 hobbs Exp $ * RCS: @(#) $Id: tclAlloc.c,v 1.16.2.1 2004/10/28 21:12:37 andreas_kupries Exp $ */ /* * Windows and Unix use an alternative allocator when building with threads * that has significantly reduced lock contention. */ #if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC) #if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC) || defined(TCL_MEM_DEBUG) #include "tclInt.h" #include "tclPort.h" #if USE_TCLALLOC #ifdef TCL_DEBUG
︙

︙
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	- +	* * Copyright (c) 1993 The Regents of the University of California. * Copyright (c) 1994 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclAsync.c,v 1.6 2001/08/30 07:50:18 davygrvy Exp $ * RCS: @(#) $Id: tclAsync.c,v 1.6.12.1 2006/07/11 13:18:10 vasiljevic Exp $ */ #include "tclInt.h" #include "tclPort.h" /* Forward declaration */ struct ThreadSpecificData;
︙
282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309	282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318	+ + + + + + + + - - - - - - - - - - - - - + + + + + + + + + + + + + +	Tcl_AsyncDelete(async) Tcl_AsyncHandler async; /* Token for handler to delete. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); AsyncHandler *asyncPtr = (AsyncHandler *) async; AsyncHandler *prevPtr; /* * Conservatively check the existence of the linked list of * registered handlers, as we may come at this point even * when the TSD's for the current thread have been already * garbage-collected. */ Tcl_MutexLock(&tsdPtr->asyncMutex); if (tsdPtr->firstHandler != NULL ) { if (tsdPtr->firstHandler == asyncPtr) { tsdPtr->firstHandler = asyncPtr->nextPtr; if (tsdPtr->firstHandler == NULL) { tsdPtr->lastHandler = NULL; } } else { prevPtr = tsdPtr->firstHandler; while (prevPtr->nextPtr != asyncPtr) { prevPtr = prevPtr->nextPtr; } prevPtr->nextPtr = asyncPtr->nextPtr; if (tsdPtr->lastHandler == asyncPtr) { tsdPtr->lastHandler = prevPtr; if (tsdPtr->firstHandler == asyncPtr) { tsdPtr->firstHandler = asyncPtr->nextPtr; if (tsdPtr->firstHandler == NULL) { tsdPtr->lastHandler = NULL; } } else { prevPtr = tsdPtr->firstHandler; while (prevPtr->nextPtr != asyncPtr) { prevPtr = prevPtr->nextPtr; } prevPtr->nextPtr = asyncPtr->nextPtr; if (tsdPtr->lastHandler == asyncPtr) { tsdPtr->lastHandler = prevPtr; } } } Tcl_MutexUnlock(&tsdPtr->asyncMutex); ckfree((char *) asyncPtr); }  /*
︙

︙
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	- +	* Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 2001, 2002 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclBasic.c,v 1.75 2003/02/18 02:37:52 msofer Exp $ * RCS: @(#) $Id: tclBasic.c,v 1.75.2.26 2006/11/28 22:19:59 andreas_kupries Exp $ */ #include "tclInt.h" #include "tclCompile.h" #ifndef TCL_GENERIC_ONLY # include "tclPort.h" #endif
︙
36 37 38 39 40 41 42 43 44 45 46 47 48 49	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	+ + + + + + + + + + +	Tcl_Interp* interp, int level, CONST char* command, Tcl_Command commandInfo, int objc, Tcl_Obj *CONST objv[])); static void StringTraceDeleteProc _ANSI_ARGS_((ClientData clientData)); #ifdef TCL_TIP280 /* TIP #280 - Modified token based evulation, with line information */ static int EvalEx _ANSI_ARGS_((Tcl_Interp *interp, CONST char *script, int numBytes, int flags, int line)); static int EvalTokensStandard _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, int line)); #endif extern TclStubs tclStubs; /* * The following structure defines the commands in the Tcl core. */
︙
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 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372	341 342 343 344 345 346 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 402 403	+ + + + + + + + + + + + + + + + + + + +	iPtr->interpInfo = NULL; Tcl_InitHashTable(&iPtr->mathFuncTable, TCL_STRING_KEYS); iPtr->numLevels = 0; iPtr->maxNestingDepth = MAX_NESTING_DEPTH; iPtr->framePtr = NULL; iPtr->varFramePtr = NULL; #ifdef TCL_TIP280 /* * TIP #280 - Initialize the arrays used to extend the ByteCode and * Proc structures. */ iPtr->cmdFramePtr = NULL; iPtr->linePBodyPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable)); iPtr->lineBCPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable)); Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS); #endif iPtr->activeVarTracePtr = NULL; iPtr->returnCode = TCL_OK; iPtr->errorInfo = NULL; iPtr->errorCode = NULL; iPtr->appendResult = NULL; iPtr->appendAvl = 0; iPtr->appendUsed = 0; Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; #ifdef TCL_TIP268 /* TIP #268 */ iPtr->packagePrefer = (getenv ("TCL_PKG_PREFER_LATEST") == NULL ? PKG_PREFER_STABLE : PKG_PREFER_LATEST); #endif iPtr->cmdCount = 0; iPtr->termOffset = 0; TclInitLiteralTable(&(iPtr->literalTable)); iPtr->compileEpoch = 0; iPtr->compiledProcPtr = NULL; iPtr->resolverPtr = NULL; iPtr->evalFlags = 0; iPtr->scriptFile = NULL; iPtr->flags = 0; iPtr->tracePtr = NULL; iPtr->tracesForbiddingInline = 0; iPtr->activeCmdTracePtr = NULL; iPtr->activeInterpTracePtr = NULL; iPtr->assocData = (Tcl_HashTable *) NULL; iPtr->execEnvPtr = NULL; /* set after namespaces initialized */ iPtr->emptyObjPtr = Tcl_NewObj(); /* another empty object */ Tcl_IncrRefCount(iPtr->emptyObjPtr); iPtr->resultSpace[0] = 0; iPtr->threadId = Tcl_GetCurrentThread(); iPtr->globalNsPtr = NULL; /* force creation of global ns below */ iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "", (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL); if (iPtr->globalNsPtr == NULL) { panic("Tcl_CreateInterp: can't create global namespace"); }
︙
567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584	598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626	+ + + - + + + + + + + + +	Tcl_SetVar2(interp, "tcl_platform", "threaded", "1", TCL_GLOBAL_ONLY); #endif /* * Register Tcl's version number. * TIP#268: Expose information about its status, * for runtime switches in the core library * and tests. */ Tcl_PkgProvideEx(interp, "Tcl", TCL_VERSION, (ClientData) &tclStubs); #ifdef TCL_TIP268 Tcl_SetVar2(interp, "tcl_platform", "tip,268", "1", TCL_GLOBAL_ONLY); #endif #ifdef TCL_TIP280 Tcl_SetVar2(interp, "tcl_platform", "tip,280", "1", TCL_GLOBAL_ONLY); #endif #ifdef Tcl_InitStubs #undef Tcl_InitStubs #endif Tcl_InitStubs(interp, TCL_VERSION, 1); return interp; }
︙
644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670	686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709	+ - + - - + - - - - + + -	Tcl_CallWhenDeleted(interp, proc, clientData) Tcl_Interp *interp; /* Interpreter to watch. */ Tcl_InterpDeleteProc *proc; /* Procedure to call when interpreter * is about to be deleted. */ ClientData clientData; /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; static Tcl_ThreadDataKey assocDataCounterKey; static int assocDataCounter = 0; int *assocDataCounterPtr = #ifdef TCL_THREADS static Tcl_Mutex assocMutex; Tcl_GetThreadData(&assocDataCounterKey, (int)sizeof(int)); #endif int new; char buffer[32 + TCL_INTEGER_SPACE]; AssocData *dPtr = (AssocData *) ckalloc(sizeof(AssocData)); Tcl_HashEntry *hPtr; Tcl_MutexLock(&assocMutex); sprintf(buffer, "Assoc Data Key #%d", assocDataCounter); assocDataCounter++; sprintf(buffer, "Assoc Data Key #%d", *assocDataCounterPtr); (*assocDataCounterPtr)++; Tcl_MutexUnlock(&assocMutex); if (iPtr->assocData == (Tcl_HashTable *) NULL) { iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); } hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &new); dPtr->proc = proc;
︙
1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106	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 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	/* * Free up literal objects created for scripts compiled by the * interpreter. */ TclDeleteLiteralTable(interp, &(iPtr->literalTable)); #ifdef TCL_TIP280 /* TIP #280 - Release the arrays for ByteCode/Proc extension, and contents. */ { Tcl_HashEntry *hPtr; Tcl_HashSearch hSearch; CmdFrame* cfPtr; ExtCmdLoc* eclPtr; int i; for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { cfPtr = (CmdFrame*) Tcl_GetHashValue (hPtr); if (cfPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount (cfPtr->data.eval.path); } ckfree ((char*) cfPtr->line); ckfree ((char*) cfPtr); Tcl_DeleteHashEntry (hPtr); } Tcl_DeleteHashTable (iPtr->linePBodyPtr); ckfree ((char*) iPtr->linePBodyPtr); iPtr->linePBodyPtr = NULL; /* See also tclCompile.c, TclCleanupByteCode */ for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hPtr); if (eclPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount (eclPtr->path); } for (i=0; i< eclPtr->nuloc; i++) { ckfree ((char*) eclPtr->loc[i].line); } if (eclPtr->loc != NULL) { ckfree ((char*) eclPtr->loc); } ckfree ((char*) eclPtr); Tcl_DeleteHashEntry (hPtr); } Tcl_DeleteHashTable (iPtr->lineBCPtr); ckfree((char*) iPtr->lineBCPtr); iPtr->lineBCPtr = NULL; } #endif ckfree((char *) iPtr); }  /* *--------------------------------------------------------------------------- * * Tcl_HideCommand --
︙
1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177	1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272	- - + +	* But as we currently limit ourselves to the global namespace only * for the source, in order to avoid potential confusion, * lets prevent "::" in the token too. --dl */ if (strstr(hiddenCmdToken, "::") != NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "cannot use namespace qualifiers as hidden command", "token (rename)", (char *) NULL); "cannot use namespace qualifiers in hidden command", " token (rename)", (char *) NULL); return TCL_ERROR; } /* * Find the command to hide. An error is returned if cmdName can't * be found. Look up the command only from the global namespace. * Full path of the command must be given if using namespaces.
︙
1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859	1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953	- + - + -	/* * Create the object argument array "objv". Make sure objv is large * enough to hold the objc arguments plus 1 extra for the zero * end-of-objv word. */ if ((argc + 1) > NUM_ARGS) { if (argc > NUM_ARGS) { objv = (Tcl_Obj **) ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *)); ckalloc((unsigned)(argc * sizeof(Tcl_Obj *))); } for (i = 0; i < argc; i++) { length = strlen(argv[i]); TclNewObj(objPtr); TclInitStringRep(objPtr, argv[i], length); Tcl_IncrRefCount(objPtr); objv[i] = objPtr; } objv[argc] = 0; /* * Invoke the command's object-based Tcl_ObjCmdProc. */ result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, argc, objv);
︙
2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443	2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544	+ + + + + + +	* delete procs may try to avoid this (renaming the command etc). * Also traces and delete procs may try to delete the command * themsevles. This flag declares that a delete is in progress * and that recursive deletes should be ignored. */ cmdPtr->flags |= CMD_IS_DELETED; /* * Bump the command epoch counter. This will invalidate all cached * references that point to this command. */ cmdPtr->cmdEpoch++; /* * Call trace procedures for the command being deleted. Then delete * its traces. */ if (cmdPtr->tracePtr != NULL) { CommandTrace *tracePtr;
︙
2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504	2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598	- - - - - - -	* this memory with free() instead of ckfree(). You should * pass a pointer to your own method that calls ckfree(). */ (*cmdPtr->deleteProc)(cmdPtr->deleteData); } /* * Bump the command epoch counter. This will invalidate all cached * references that point to this command. */ cmdPtr->cmdEpoch++; /* * If this command was imported into other namespaces, then imported * commands were created that refer back to this command. Delete these * imported commands now. */ for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
︙
2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570	2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665	- + - - - - + + + + +	Interp *iPtr; /* Interpreter containing command. */ Command *cmdPtr; /* Command whose traces are to be * invoked. */ CONST char *oldName; /* Command's old name, or NULL if we * must get the name from cmdPtr */ CONST char *newName; /* Command's new name, or NULL if * the command is not being renamed */ int flags; /* Flags passed to trace procedures: int flags; /* Flags indicating the type of traces * indicates what's happening to command, * plus other stuff like TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY, and * TCL_INTERP_DESTROYED. */ * to trigger, either TCL_TRACE_DELETE * or TCL_TRACE_RENAME. */ { register CommandTrace *tracePtr; ActiveCommandTrace active; char *result; Tcl_Obj *oldNamePtr = NULL; int mask = (TCL_TRACE_DELETE | TCL_TRACE_RENAME); /* Safety */ flags &= mask; if (cmdPtr->flags & CMD_TRACE_ACTIVE) { /* * While a rename trace is active, we will not process any more * rename traces; while a delete trace is active we will never * reach here -- because Tcl_DeleteCommandFromToken checks for the * condition (cmdPtr->flags & CMD_IS_DELETED) and returns immediately
︙
2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621	2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719	+ + + - + - + - +	} } cmdPtr->flags |= CMD_TRACE_ACTIVE; cmdPtr->refCount++; result = NULL; active.nextPtr = iPtr->activeCmdTracePtr; active.reverseScan = 0; iPtr->activeCmdTracePtr = &active; if (flags & TCL_TRACE_DELETE) { flags |= TCL_TRACE_DESTROYED; } active.cmdPtr = cmdPtr; Tcl_Preserve((ClientData) iPtr); for (tracePtr = cmdPtr->tracePtr; tracePtr != NULL; tracePtr = active.nextTracePtr) { int traceFlags = (tracePtr->flags & mask); active.nextTracePtr = tracePtr->nextPtr; if (!(tracePtr->flags & flags)) { if (!(traceFlags & flags)) { continue; } cmdPtr->flags |= tracePtr->flags; cmdPtr->flags |= traceFlags; if (oldName == NULL) { TclNewObj(oldNamePtr); Tcl_IncrRefCount(oldNamePtr); Tcl_GetCommandFullName((Tcl_Interp *) iPtr, (Tcl_Command) cmdPtr, oldNamePtr); oldName = TclGetString(oldNamePtr); } tracePtr->refCount++; (*tracePtr->traceProc)(tracePtr->clientData, (Tcl_Interp *) iPtr, oldName, newName, flags); cmdPtr->flags &= ~tracePtr->flags; cmdPtr->flags &= ~traceFlags; if ((--tracePtr->refCount) <= 0) { ckfree((char*)tracePtr); } } /* * If a new object was created to hold the full oldName,
︙
2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949	3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045	- + - + - -	} /* * Check depth of nested calls to Tcl_Eval: if this gets too large, * it's probably because of an infinite loop somewhere. */ if (((iPtr->numLevels) >= iPtr->maxNestingDepth) if (((iPtr->numLevels) > iPtr->maxNestingDepth) || (TclpCheckStackSpace() == 0)) { Tcl_AppendToObj(Tcl_GetObjResult(interp), "too many nested evaluations (infinite loop?)", -1); return TCL_ERROR; } return TCL_OK; }  /* *---------------------------------------------------------------------- * * TclEvalObjvInternal -- * * This procedure evaluates a Tcl command that has already been * parsed into words, with one Tcl_Obj holding each word. The caller * is responsible for checking that the interpreter is ready to * is responsible for managing the iPtr->numLevels. * evaluate (by calling TclInterpReady), and also to manage the * iPtr->numLevels. * * Results: * The return value is a standard Tcl completion code such as * TCL_OK or TCL_ERROR. A result or error message is left in * interp's result. If an error occurs, this procedure does * NOT add any information to the errorInfo variable. *
︙
2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 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 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 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	3078 3079 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 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219	+ + + + + + + + + + + + + + + + - - - - - - - - - - + + + + + + + + + + - + - - + + + - - - - - + + + + +	Tcl_Obj **newObjv; int i; CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr * in case TCL_EVAL_GLOBAL was set. */ int code = TCL_OK; int traceCode = TCL_OK; int checkTraces = 1; Namespace *savedNsPtr = NULL; if (TclInterpReady(interp) == TCL_ERROR) { return TCL_ERROR; } if (objc == 0) { return TCL_OK; } /* * If any execution traces rename or delete the current command, * we may need (at most) two passes here. */ savedVarFramePtr = iPtr->varFramePtr; while (1) { /* Configure evaluation context to match the requested flags */ if (flags & TCL_EVAL_GLOBAL) { iPtr->varFramePtr = NULL; } else if ((flags & TCL_EVAL_INVOKE) && iPtr->varFramePtr) { savedNsPtr = iPtr->varFramePtr->nsPtr; iPtr->varFramePtr->nsPtr = iPtr->globalNsPtr; } /* * Find the procedure to execute this command. If there isn't one, * then see if there is a command "unknown". If so, create a new * word array with "unknown" as the first word and the original * command words as arguments. Then call ourselves recursively * to execute it. */ savedVarFramePtr = iPtr->varFramePtr; if (flags & TCL_EVAL_INVOKE) { iPtr->varFramePtr = NULL; } cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]); iPtr->varFramePtr = savedVarFramePtr; if (cmdPtr == NULL) { newObjv = (Tcl_Obj **) ckalloc((unsigned) ((objc + 1) * sizeof (Tcl_Obj *))); for (i = objc-1; i >= 0; i--) { newObjv[i+1] = objv[i]; } newObjv[0] = Tcl_NewStringObj("::unknown", -1); Tcl_IncrRefCount(newObjv[0]); cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]); if (cmdPtr == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "invalid command name \"", Tcl_GetString(objv[0]), "\"", (char *) NULL); code = TCL_ERROR; } else if (TclInterpReady(interp) == TCL_ERROR) { code = TCL_ERROR; } else { iPtr->numLevels++; code = TclEvalObjvInternal(interp, objc+1, newObjv, command, length, 0); code = TclEvalObjvInternal(interp, objc+1, newObjv, command, length, 0); iPtr->numLevels--; } Tcl_DecrRefCount(newObjv[0]); ckfree((char *) newObjv); if (savedNsPtr) { iPtr->varFramePtr->nsPtr = savedNsPtr; } goto done; } if (savedNsPtr) { iPtr->varFramePtr->nsPtr = savedNsPtr; } /* * Call trace procedures if needed. */ if ((checkTraces) && (command != NULL)) { int cmdEpoch = cmdPtr->cmdEpoch; int newEpoch; cmdPtr->refCount++; cmdPtr->refCount++; /* * If the first set of traces modifies/deletes the command or * any existing traces, then the set checkTraces to 0 and * go through this while loop one more time. */ if (iPtr->tracePtr != NULL && traceCode == TCL_OK) { traceCode = TclCheckInterpTraces(interp, command, length, cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv); } if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) { traceCode = TclCheckExecutionTraces(interp, command, length, cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv); } cmdPtr->refCount--; if (cmdEpoch != cmdPtr->cmdEpoch) { newEpoch = cmdPtr->cmdEpoch; TclCleanupCommand(cmdPtr); if (cmdEpoch != newEpoch) { /* The command has been modified in some way */ checkTraces = 0; continue; } } break; } /* * Finally, invoke the command's Tcl_ObjCmdProc. */ cmdPtr->refCount++; iPtr->cmdCount++; if ( code == TCL_OK && traceCode == TCL_OK) { savedVarFramePtr = iPtr->varFramePtr; if (flags & TCL_EVAL_GLOBAL) { iPtr->varFramePtr = NULL; } code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv); iPtr->varFramePtr = savedVarFramePtr; } if (Tcl_AsyncReady()) { code = Tcl_AsyncInvoke(interp, code); } /* * Call 'leave' command traces */ if (!(cmdPtr->flags & CMD_IS_DELETED)) { int saveErrFlags = iPtr->flags & (ERR_IN_PROGRESS | ERR_ALREADY_LOGGED | ERROR_CODE_SET); if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) { traceCode = TclCheckExecutionTraces (interp, command, length, cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv); } if (iPtr->tracePtr != NULL && traceCode == TCL_OK) { traceCode = TclCheckInterpTraces(interp, command, length, cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv); } if (traceCode == TCL_OK) { iPtr->flags |= saveErrFlags; } } TclCleanupCommand(cmdPtr); /* * If one of the trace invocation resulted in error, then * change the result code accordingly. Note, that the * interp->result should already be set correctly by the
︙
3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132	3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246	+	*/ if (*(iPtr->result) != 0) { (void) Tcl_GetObjResult(interp); } done: iPtr->varFramePtr = savedVarFramePtr; return code; }  /* *---------------------------------------------------------------------- * * Tcl_EvalObjv --
︙
3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204	3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314	- - - - + + - - + -	} cmdString = Tcl_DStringValue(&cmdBuf); cmdLen = Tcl_DStringLength(&cmdBuf); break; } } code = TclInterpReady(interp); if (code == TCL_OK) { iPtr->numLevels++; code = TclEvalObjvInternal(interp, objc, objv, cmdString, cmdLen, iPtr->numLevels++; code = TclEvalObjvInternal(interp, objc, objv, cmdString, cmdLen, flags); flags); iPtr->numLevels--; iPtr->numLevels--; } /* * If we are again at the top level, process any unusual * return code returned by the evaluated code. */ if (iPtr->numLevels == 0) {
︙
3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356	3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 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 3483 3484 3485 3486 3487 3488 3489 3490 3491	+ + + + + + + + - + - + + + + + + + + + + + + + + + + + +	if (length < 0) { length = strlen(command); } if (length > 150) { length = 150; ellipsis = "..."; } while ( (command[length] & 0xC0) == 0x80 ) { /* * Back up truncation point so that we don't truncate in the * middle of a multi-byte character (in UTF-8) */ length--; ellipsis = "..."; } if (!(iPtr->flags & ERR_IN_PROGRESS)) { sprintf(buffer, "\n while executing\n\"%.*s%s\"", length, command, ellipsis); } else { sprintf(buffer, "\n invoked from within\n\"%.*s%s\"", length, command, ellipsis); } Tcl_AddObjErrorInfo(interp, buffer, -1); iPtr->flags &= ~ERR_ALREADY_LOGGED; }  /* *---------------------------------------------------------------------- * * Tcl_EvalTokensStandard -- * Tcl_EvalTokensStandard, EvalTokensStandard -- * * Given an array of tokens parsed from a Tcl command (e.g., the * tokens that make up a word or the index for an array variable) * this procedure evaluates the tokens and concatenates their * values to form a single result value. * * Results: * The return value is a standard Tcl completion code such as * TCL_OK or TCL_ERROR. A result or error message is left in * interp's result. * * Side effects: * Depends on the array of tokens being evaled. * * * TIP #280 : Keep public API, internally extended API. *---------------------------------------------------------------------- */ int Tcl_EvalTokensStandard(interp, tokenPtr, count) Tcl_Interp *interp; /* Interpreter in which to lookup * variables, execute nested commands, * and report errors. */ Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens * to evaluate and concatenate. */ int count; /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { #ifdef TCL_TIP280 return EvalTokensStandard (interp, tokenPtr, count, 1); } static int EvalTokensStandard(interp, tokenPtr, count, line) Tcl_Interp *interp; /* Interpreter in which to lookup * variables, execute nested commands, * and report errors. */ Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens * to evaluate and concatenate. */ int count; /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ int line; /* The line the script starts on. */ { #endif Tcl_Obj *resultPtr, *indexPtr, *valuePtr; char buffer[TCL_UTF_MAX]; #ifdef TCL_MEM_DEBUG # define MAX_VAR_CHARS 5 #else # define MAX_VAR_CHARS 30 #endif
︙
3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415	3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569	- - - + + + + + + + + + + + + + + + + + + + + + +	case TCL_TOKEN_BS: length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL, buffer); p = buffer; break; case TCL_TOKEN_COMMAND: code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2, 0); case TCL_TOKEN_COMMAND: { Interp *iPtr = (Interp *) interp; iPtr->numLevels++; code = TclInterpReady(interp); if (code == TCL_OK) { #ifndef TCL_TIP280 code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2, 0); #else /* TIP #280: Transfer line information to nested command */ code = EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2, 0, line); #endif } iPtr->numLevels--; if (code != TCL_OK) { goto done; } valuePtr = Tcl_GetObjResult(interp); break; } case TCL_TOKEN_VARIABLE: if (tokenPtr->numComponents == 1) { indexPtr = NULL; index = NULL; } else { #ifndef TCL_TIP280 code = Tcl_EvalTokensStandard(interp, tokenPtr+2, tokenPtr->numComponents - 1); #else /* TIP #280: Transfer line information to nested command */ code = EvalTokensStandard(interp, tokenPtr+2, tokenPtr->numComponents - 1, line); #endif if (code != TCL_OK) { goto done; } indexPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(indexPtr); index = Tcl_GetString(indexPtr); }
︙
3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496	3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649	- + -	done: if (resultPtr != NULL) { Tcl_DecrRefCount(resultPtr); } return code; }  /* *---------------------------------------------------------------------- * * Tcl_EvalTokens -- * * Given an array of tokens parsed from a Tcl command (e.g., the * tokens that make up a word or the index for an array variable)
︙
3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600	3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779	- + + + + + + + + + + + + + + + + + + + + + + - + + + + + +	} }  /* *---------------------------------------------------------------------- * * Tcl_EvalEx -- * Tcl_EvalEx, EvalEx -- * * This procedure evaluates a Tcl script without using the compiler * or byte-code interpreter. It just parses the script, creates * values for each word of each command, then calls EvalObjv * to execute each command. * * Results: * The return value is a standard Tcl completion code such as * TCL_OK or TCL_ERROR. A result or error message is left in * interp's result. * * Side effects: * Depends on the script. * * TIP #280 : Keep public API, internally extended API. *---------------------------------------------------------------------- */ int Tcl_EvalEx(interp, script, numBytes, flags) Tcl_Interp *interp; /* Interpreter in which to evaluate the * script. Also used for error reporting. */ CONST char *script; /* First character of script to evaluate. */ int numBytes; /* Number of bytes in script. If < 0, the * script consists of all bytes up to the * first null character. */ int flags; /* Collection of OR-ed bits that control * the evaluation of the script. Only * TCL_EVAL_GLOBAL is currently * supported. */ { #ifdef TCL_TIP280 return EvalEx (interp, script, numBytes, flags, 1); } static int EvalEx(interp, script, numBytes, flags, line) Tcl_Interp *interp; /* Interpreter in which to evaluate the * script. Also used for error reporting. */ CONST char *script; /* First character of script to evaluate. */ int numBytes; /* Number of bytes in script. If < 0, the * script consists of all bytes up to the * first null character. */ int flags; /* Collection of OR-ed bits that control * the evaluation of the script. Only * TCL_EVAL_GLOBAL is currently * supported. */ int line; /* The line the script starts on. */ { #endif Interp *iPtr = (Interp *) interp; CONST char *p, *next; Tcl_Parse parse; #define NUM_STATIC_OBJS 20 Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv; Tcl_Token *tokenPtr; int code = TCL_OK; int i, code, commandLength, bytesLeft, nested; int i, commandLength, bytesLeft, nested; CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr * in case TCL_EVAL_GLOBAL was set. */ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); /* * The variables below keep track of how much state has been * allocated while evaluating the script, so that it can be freed * properly if an error occurs. */ int gotParse = 0, objectsUsed = 0; #ifdef TCL_TIP280 /* TIP #280 Structures for tracking of command locations. */ CmdFrame eeFrame; #endif if (numBytes < 0) { numBytes = strlen(script); } Tcl_ResetResult(interp); savedVarFramePtr = iPtr->varFramePtr;
︙
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 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737	3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + - - - + + - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	p = script; bytesLeft = numBytes; if (iPtr->evalFlags & TCL_BRACKET_TERM) { nested = 1; } else { nested = 0; } #ifdef TCL_TIP280 /* TIP #280 Initialize tracking. Do not push on the frame stack yet. */ /* * We may cont. counting based on a specific context (CTX), or open a new * context, either for a sourced script, or 'eval'. For sourced files we * always have a path object, even if nothing was specified in the interp * itself. That makes code using it simpler as NULL checks can be left * out. Sourced file without path in the 'scriptFile' is possible during * Tcl initialization. */ if (iPtr->evalFlags & TCL_EVAL_CTX) { /* Path information comes out of the context. */ eeFrame.type = TCL_LOCATION_SOURCE; eeFrame.data.eval.path = iPtr->invokeCmdFramePtr->data.eval.path; Tcl_IncrRefCount (eeFrame.data.eval.path); } else if (iPtr->evalFlags & TCL_EVAL_FILE) { /* Set up for a sourced file */ eeFrame.type = TCL_LOCATION_SOURCE; if (iPtr->scriptFile) { /* Normalization here, to have the correct pwd. Should have * negligible impact on performance, as the norm should have been * done already by the 'source' invoking us, and it caches the * result */ Tcl_Obj* norm = Tcl_FSGetNormalizedPath (interp, iPtr->scriptFile); if (!norm) { /* Error message in the interp result */ return TCL_ERROR; } eeFrame.data.eval.path = norm; Tcl_IncrRefCount (eeFrame.data.eval.path); } else { eeFrame.data.eval.path = Tcl_NewStringObj ("",-1); } } else { /* Set up for plain eval */ eeFrame.type = TCL_LOCATION_EVAL; eeFrame.data.eval.path = NULL; } eeFrame.level = (iPtr->cmdFramePtr == NULL ? 1 : iPtr->cmdFramePtr->level + 1); eeFrame.framePtr = iPtr->framePtr; eeFrame.nextPtr = iPtr->cmdFramePtr; eeFrame.nline = 0; eeFrame.line = NULL; #endif iPtr->evalFlags = 0; do { if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse) != TCL_OK) { code = TCL_ERROR; goto error; } gotParse = 1; if (nested && parse.term == (script + numBytes)) { /* * A nested script can only terminate in ']'. If * the parsing got terminated at the end of the script, * there was no closing ']'. Report the syntax error. */ code = TCL_ERROR; goto error; } #ifdef TCL_TIP280 /* * TIP #280 Track lines. The parser may have skipped text till it * found the command we are now at. We have count the lines in this * block. */ TclAdvanceLines (&line, p, parse.commandStart); #endif if (parse.numWords > 0) { #ifdef TCL_TIP280 /* * TIP #280. Track lines within the words of the current * command. */ int wordLine = line; CONST char* wordStart = parse.commandStart; #endif /* * Generate an array of objects for the words of the command. */ if (parse.numWords <= NUM_STATIC_OBJS) { objv = staticObjArray; } else { objv = (Tcl_Obj **) ckalloc((unsigned) (parse.numWords * sizeof (Tcl_Obj *))); } #ifdef TCL_TIP280 eeFrame.nline = parse.numWords; eeFrame.line = (int*) ckalloc((unsigned) (parse.numWords * sizeof (int))); #endif for (objectsUsed = 0, tokenPtr = parse.tokenPtr; objectsUsed < parse.numWords; objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) { objectsUsed < parse.numWords; objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) { #ifndef TCL_TIP280 code = Tcl_EvalTokensStandard(interp, tokenPtr+1, tokenPtr->numComponents); #else /* * TIP #280. Track lines to current word. Save the * information on a per-word basis, signaling dynamic words as * needed. Make the information available to the recursively * called evaluator as well, including the type of context * (source vs. eval). */ TclAdvanceLines (&wordLine, wordStart, tokenPtr->start); wordStart = tokenPtr->start; eeFrame.line [objectsUsed] = (TclWordKnownAtCompileTime (tokenPtr) ? wordLine : -1); if (eeFrame.type == TCL_LOCATION_SOURCE) { iPtr->evalFlags |= TCL_EVAL_FILE; } code = EvalTokensStandard(interp, tokenPtr+1, tokenPtr->numComponents, wordLine); iPtr->evalFlags = 0; #endif if (code == TCL_OK) { objv[objectsUsed] = Tcl_GetObjResult(interp); Tcl_IncrRefCount(objv[objectsUsed]); } else { goto error; } } /* * Execute the command and free the objects for its words. * * TIP #280: Remember the command itself for 'info frame'. We * shorten the visible command by one char to exclude the * termination character, if necessary. Here is where we put our * frame on the stack of frames too. _After_ the nested commands * have been executed. */ if (TclInterpReady(interp) == TCL_ERROR) { code = TCL_ERROR; } else { iPtr->numLevels++; code = TclEvalObjvInternal(interp, objectsUsed, objv, p, parse.commandStart + parse.commandSize - p, 0); iPtr->numLevels--; } if (code != TCL_OK) { if (iPtr->numLevels == 0) { if (code == TCL_RETURN) { #ifdef TCL_TIP280 eeFrame.cmd.str.cmd = parse.commandStart; eeFrame.cmd.str.len = parse.commandSize; if (parse.term == parse.commandStart + parse.commandSize - 1) { eeFrame.cmd.str.len --; } iPtr->cmdFramePtr = &eeFrame; #endif iPtr->numLevels++; code = TclEvalObjvInternal(interp, objectsUsed, objv, parse.commandStart, parse.commandSize, 0); iPtr->numLevels--; #ifdef TCL_TIP280 iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr; ckfree ((char*) eeFrame.line); eeFrame.line = NULL; eeFrame.nline = 0; #endif code = TclUpdateReturnInfo(iPtr); } if ((code != TCL_OK) && (code != TCL_ERROR) if (code != TCL_OK) { && !allowExceptions) { ProcessUnexpectedResult(interp, code); code = TCL_ERROR; } } goto error; } for (i = 0; i < objectsUsed; i++) { Tcl_DecrRefCount(objv[i]); } objectsUsed = 0; if (objv != staticObjArray) { ckfree((char *) objv); objv = staticObjArray; } } /* * Advance to the next command in the script. * * TIP #280 Track Lines. Now we track how many lines were in the * executed command. */ next = parse.commandStart + parse.commandSize; bytesLeft -= next - p; p = next; #ifdef TCL_TIP280 TclAdvanceLines (&line, parse.commandStart, p); #endif Tcl_FreeParse(&parse); gotParse = 0; if (nested && (*parse.term == ']')) { /* * We get here in the special case where the TCL_BRACKET_TERM * flag was set in the interpreter and the latest parsed command * was terminated by the matching close-bracket we seek. * Return immediately. */ iPtr->termOffset = (p - 1) - script; iPtr->varFramePtr = savedVarFramePtr; #ifndef TCL_TIP280 return TCL_OK; #else code = TCL_OK; goto cleanup_return; #endif } } while (bytesLeft > 0); if (nested) { /* * This nested script did not terminate in ']', it is an error. */ code = TCL_ERROR; goto error; } iPtr->termOffset = p - script; iPtr->varFramePtr = savedVarFramePtr; #ifndef TCL_TIP280 return TCL_OK; #else code = TCL_OK; goto cleanup_return; #endif error: /* * Generate various pieces of error information, such as the line * number where the error occurred and information to add to the * errorInfo variable. Then free resources that had been allocated * to the command. */ if (iPtr->numLevels == 0) { if (code == TCL_RETURN) { code = TclUpdateReturnInfo(iPtr); } if ((code != TCL_OK) && (code != TCL_ERROR) && !allowExceptions) { ProcessUnexpectedResult(interp, code); code = TCL_ERROR; } } if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { commandLength = parse.commandSize; if (parse.term == parse.commandStart + commandLength - 1) { /* * The terminator character (such as ; or ]) of the command where * the error occurred is the last character in the parsed command. * Reduce the length by one so that the error message doesn't
︙
3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775	4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114	+ + + +	next = parse.commandStart + parse.commandSize; bytesLeft -= next - p; p = next; if (!nested) { iPtr->termOffset = p - script; #ifndef TCL_TIP280 return code; #else goto cleanup_return; #endif } /* * When we are nested (the TCL_BRACKET_TERM flag was set in the * interpreter), we must find the matching close-bracket to * end the script we are evaluating. *
︙
3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803	4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146	+ + + +	*/ if (next == NULL) { iPtr->termOffset = (parse.commandStart - 1) - script; } else { iPtr->termOffset = (next - 1) - script; } #ifndef TCL_TIP280 return code; #else goto cleanup_return; #endif } next = parse.commandStart + parse.commandSize; bytesLeft -= next - p; p = next; next = parse.commandStart; Tcl_FreeParse(&parse); }
︙
3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843	4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	/* * There was no close-bracket. Syntax error. */ iPtr->termOffset = parse.term - script; Tcl_SetObjResult(interp, Tcl_NewStringObj("missing close-bracket", -1)); #ifndef TCL_TIP280 return TCL_ERROR; #else code = TCL_ERROR; goto cleanup_return; #endif } else if (*parse.term != ']') { /* * There was no close-bracket. Syntax error. */ iPtr->termOffset = (parse.term + 1) - script; Tcl_SetObjResult(interp, Tcl_NewStringObj("missing close-bracket", -1)); #ifndef TCL_TIP280 return TCL_ERROR; #else code = TCL_ERROR; goto cleanup_return; #endif } else { /* * parse.term points to the close-bracket. */ iPtr->termOffset = parse.term - script; } #ifdef TCL_TIP280 cleanup_return: /* TIP #280. Release the local CmdFrame, and its contents. */ if (eeFrame.line != NULL) { ckfree ((char*) eeFrame.line); } if (eeFrame.type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount (eeFrame.data.eval.path); } #endif return code; }  #ifdef TCL_TIP280 /* *---------------------------------------------------------------------- * * TclAdvanceLines -- * * This procedure is a helper which counts the number of lines * in a block of text and advances an external counter. * * Results: * None. * * Side effects: * The specified counter is advanced per the number of lines found. * * TIP #280 *---------------------------------------------------------------------- */ void TclAdvanceLines (line,start,end) int* line; CONST char* start; CONST char* end; { CONST char* p; for (p = start; p < end; p++) { if (*p == '\n') { (*line) ++; } } } #endif  /* *---------------------------------------------------------------------- * * Tcl_Eval -- * * Execute a Tcl command in a string. This procedure executes the
︙
3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961	4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381	- + + + + + + + + + + + + + + + + + + + + + +	{ return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); }  /* *---------------------------------------------------------------------- * * Tcl_EvalObjEx -- * Tcl_EvalObjEx, TclEvalObjEx -- * * Execute Tcl commands stored in a Tcl object. These commands are * compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT * is specified. * * Results: * The return value is one of the return codes defined in tcl.h * (such as TCL_OK), and the interpreter's result contains a value * to supplement the return code. * * Side effects: * The object is converted, if necessary, to a ByteCode object that * holds the bytecode instructions for the commands. Executing the * commands will almost certainly have side effects that depend * on those commands. * * Just as in Tcl_Eval, interp->termOffset is set to the offset of the * last character executed in the objPtr's string. * * TIP #280 : Keep public API, internally extended API. *---------------------------------------------------------------------- */ int Tcl_EvalObjEx(interp, objPtr, flags) Tcl_Interp *interp; /* Token for command interpreter * (returned by a previous call to * Tcl_CreateInterp). */ register Tcl_Obj *objPtr; /* Pointer to object containing * commands to execute. */ int flags; /* Collection of OR-ed bits that * control the evaluation of the * script. Supported values are * TCL_EVAL_GLOBAL and * TCL_EVAL_DIRECT. */ { #ifdef TCL_TIP280 return TclEvalObjEx (interp, objPtr, flags, NULL, 0); } int TclEvalObjEx(interp, objPtr, flags, invoker, word) Tcl_Interp *interp; /* Token for command interpreter * (returned by a previous call to * Tcl_CreateInterp). */ register Tcl_Obj *objPtr; /* Pointer to object containing * commands to execute. */ int flags; /* Collection of OR-ed bits that * control the evaluation of the * script. Supported values are * TCL_EVAL_GLOBAL and * TCL_EVAL_DIRECT. */ CONST CmdFrame* invoker; /* Frame of the command doing the eval */ int word; /* Index of the word which is in objPtr */ { #endif register Interp *iPtr = (Interp *) interp; char *script; int numSrcBytes; int result; CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr * in case TCL_EVAL_GLOBAL was set. */ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
︙
3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031	4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + - +	* (ensure we go into the TCL_EVAL_DIRECT path, avoiding opt) */ if (!(iPtr->flags & USE_EVAL_DIRECT) && (objPtr->typePtr == &tclListType) && /* is a list... */ (objPtr->bytes == NULL) /* ...without a string rep */) { register List *listRepPtr = (List *) objPtr->internalRep.twoPtrValue.ptr1; int i, objc = listRepPtr->elemCount; #define TEOE_PREALLOC 10 Tcl_Obj *staticObjv[TEOE_PREALLOC], **objv = staticObjv; #ifdef TCL_TIP280 /* TIP #280 Structures for tracking lines. * As we know that this is dynamic execution we ignore the * invoker, even if known. */ int line; CmdFrame eoFrame; eoFrame.type = TCL_LOCATION_EVAL_LIST; eoFrame.level = (iPtr->cmdFramePtr == NULL ? 1 : iPtr->cmdFramePtr->level + 1); eoFrame.framePtr = iPtr->framePtr; eoFrame.nextPtr = iPtr->cmdFramePtr; eoFrame.nline = objc; eoFrame.line = (int*) ckalloc (objc * sizeof (int)); /* NOTE: Getting the string rep of the list to eval to fill the * command information required by 'info frame' implies that * further calls for the same list would not be optimized, as it * would not be 'pure' anymore. It would also be a waste of time * as most of the time this information is not needed at all. What * we do instead is to keep the list obj itself around and have * 'info frame' sort it out. */ eoFrame.cmd.listPtr = objPtr; Tcl_IncrRefCount (eoFrame.cmd.listPtr); eoFrame.data.eval.path = NULL; #endif if (objc > TEOE_PREALLOC) { objv = (Tcl_Obj **) ckalloc(objc*sizeof(Tcl_Obj *)); } #undef TEOE_PREALLOC /* * Copy the list elements here, to avoid a segfault if * objPtr loses its List internal rep [Bug 1119369]. * * TIP #280 Computes all the line numbers for the * words in the command. */ #ifdef TCL_TIP280 line = 1; #endif for (i=0; i < objc; i++) { objv[i] = listRepPtr->elements[i]; Tcl_IncrRefCount(objv[i]); #ifdef TCL_TIP280 eoFrame.line [i] = line; { char* w = Tcl_GetString (objv [i]); TclAdvanceLines (&line, w, w+ strlen(w)); } #endif } #ifdef TCL_TIP280 iPtr->cmdFramePtr = &eoFrame; #endif result = Tcl_EvalObjv(interp, listRepPtr->elemCount, listRepPtr->elements, flags); result = Tcl_EvalObjv(interp, objc, objv, flags); #ifdef TCL_TIP280 iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr; Tcl_DecrRefCount (eoFrame.cmd.listPtr); #endif for (i=0; i < objc; i++) { TclDecrRefCount(objv[i]); } if (objv != staticObjv) { ckfree((char *) objv); } #ifdef TCL_TIP280 ckfree ((char*) eoFrame.line); eoFrame.line = NULL; eoFrame.nline = 0; #endif } else { #ifndef TCL_TIP280 script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); result = Tcl_EvalEx(interp, script, numSrcBytes, flags); #else /* * TIP #280. Propagate context as much as we can. Especially if * the script to evaluate is a single literal it makes sense to * look if our context is one with absolute line numbers we can * then track into the literal itself too. * * See also tclCompile.c, TclInitCompileEnv, for the equivalent * code in the bytecode compiler. */ if (invoker == NULL) { /* No context, force opening of our own */ script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); result = Tcl_EvalEx(interp, script, numSrcBytes, flags); } else { /* We have an invoker, describing the command asking for the * evaluation of a subordinate script. This script may * originate in a literal word, or from a variable, etc. Using * the line array we now check if we have good line * information for the relevant word. The type of context is * relevant as well. In a non-'source' context we don't have * to try tracking lines. * * First see if the word exists and is a literal. If not we go * through the easy dynamic branch. No need to perform more * complex invokations. */ if ((invoker->nline <= word) || (invoker->line[word] < 0)) { /* Dynamic script, or dynamic context, force our own * context */ script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); result = Tcl_EvalEx(interp, script, numSrcBytes, flags); } else { /* Try to get an absolute context for the evaluation */ CmdFrame ctx = *invoker; int pc = 0; if (invoker->type == TCL_LOCATION_BC) { /* Note: Type BC => ctx.data.eval.path is not used. * ctx.data.tebc.codePtr is used instead. */ TclGetSrcInfoForPc (&ctx); pc = 1; } if (ctx.type == TCL_LOCATION_SOURCE) { /* Absolute context to reuse. */ iPtr->invokeCmdFramePtr = &ctx; iPtr->evalFlags |= TCL_EVAL_CTX; script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); result = EvalEx(interp, script, numSrcBytes, flags, ctx.line [word]); if (pc) { /* Death of SrcInfo reference */ Tcl_DecrRefCount (ctx.data.eval.path); } } else { /* Dynamic context or script, easier to make our own as * well */ script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); result = Tcl_EvalEx(interp, script, numSrcBytes, flags); } } } #endif } } else { /* * Let the compiler/engine subsystem do the evaluation. * * TIP #280 The invoker provides us with the context for the * script. We transfer this to the byte code compiler. */ savedVarFramePtr = iPtr->varFramePtr; if (flags & TCL_EVAL_GLOBAL) { iPtr->varFramePtr = NULL; } #ifndef TCL_TIP280 result = TclCompEvalObj(interp, objPtr); #else result = TclCompEvalObj(interp, objPtr, invoker, word); #endif /* * If we are again at the top level, process any unusual * return code returned by the evaluated code. */ if (iPtr->numLevels == 0) { if (result == TCL_RETURN) { result = TclUpdateReturnInfo(iPtr); } if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) { ProcessUnexpectedResult(interp, result); result = TCL_ERROR; /* * If an error was created here, record information about * what was being executed when the error occurred. * what was being executed when the error occurred. Remove * the extra \n added by tclMain.c in the command sent to * Tcl_LogCommandInfo [Bug 833150]. */ if (!(iPtr->flags & ERR_ALREADY_LOGGED)) { script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); Tcl_LogCommandInfo(interp, script, script, numSrcBytes); Tcl_LogCommandInfo(interp, script, script, --numSrcBytes); iPtr->flags &= ~ERR_ALREADY_LOGGED; } } } iPtr->evalFlags = 0; iPtr->varFramePtr = savedVarFramePtr; }
︙
4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130	4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731	- + + + + + + + + + + + + + + + + + + +	exprPtr = Tcl_NewStringObj(string, length); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprObj(interp, exprPtr, &resultPtr); if (result == TCL_OK) { /* * Store an integer based on the expression result. */ if (resultPtr->typePtr == &tclIntType) { *ptr = resultPtr->internalRep.longValue; } else if (resultPtr->typePtr == &tclDoubleType) { *ptr = (long) resultPtr->internalRep.doubleValue; } else if (resultPtr->typePtr == &tclWideIntType) { #ifndef TCL_WIDE_INT_IS_LONG /* * See Tcl_GetIntFromObj for conversion comments. */ Tcl_WideInt w = resultPtr->internalRep.wideValue; if ((w >= -(Tcl_WideInt)(ULONG_MAX)) && (w <= (Tcl_WideInt)(ULONG_MAX))) { *ptr = Tcl_WideAsLong(w); } else { Tcl_SetResult(interp, "integer value too large to represent as non-long integer", TCL_STATIC); result = TCL_ERROR; } #else *ptr = resultPtr->internalRep.longValue; #endif } else { Tcl_SetResult(interp, "expression didn't have numeric value", TCL_STATIC); result = TCL_ERROR; } Tcl_DecrRefCount(resultPtr); /* discard the result object */ } else {
︙
4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181	4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800	- + + + + + + + + + + + + + + + + + + +	exprPtr = Tcl_NewStringObj(string, length); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprObj(interp, exprPtr, &resultPtr); if (result == TCL_OK) { /* * Store a double based on the expression result. */ if (resultPtr->typePtr == &tclIntType) { *ptr = (double) resultPtr->internalRep.longValue; } else if (resultPtr->typePtr == &tclDoubleType) { *ptr = resultPtr->internalRep.doubleValue; } else if (resultPtr->typePtr == &tclWideIntType) { #ifndef TCL_WIDE_INT_IS_LONG /* * See Tcl_GetIntFromObj for conversion comments. */ Tcl_WideInt w = resultPtr->internalRep.wideValue; if ((w >= -(Tcl_WideInt)(ULONG_MAX)) && (w <= (Tcl_WideInt)(ULONG_MAX))) { *ptr = (double) Tcl_WideAsLong(w); } else { Tcl_SetResult(interp, "integer value too large to represent as non-long integer", TCL_STATIC); result = TCL_ERROR; } #else *ptr = (double) resultPtr->internalRep.longValue; #endif } else { Tcl_SetResult(interp, "expression didn't have numeric value", TCL_STATIC); result = TCL_ERROR; } Tcl_DecrRefCount(resultPtr); /* discard the result object */ } else {
︙
4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232	4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857	- + + + + + + +	exprPtr = Tcl_NewStringObj(string, length); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprObj(interp, exprPtr, &resultPtr); if (result == TCL_OK) { /* * Store a boolean based on the expression result. */ if (resultPtr->typePtr == &tclIntType) { *ptr = (resultPtr->internalRep.longValue != 0); } else if (resultPtr->typePtr == &tclDoubleType) { *ptr = (resultPtr->internalRep.doubleValue != 0.0); } else if (resultPtr->typePtr == &tclWideIntType) { #ifndef TCL_WIDE_INT_IS_LONG *ptr = (resultPtr->internalRep.wideValue != 0); #else *ptr = (resultPtr->internalRep.longValue != 0); #endif } else { result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr); } Tcl_DecrRefCount(resultPtr); /* discard the result object */ } if (result != TCL_OK) { /*
︙
4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578	5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202	- + -	char *cmdName; /* Name of the command from objv[0]. */ register Tcl_HashEntry *hPtr; Tcl_Command cmd; Command *cmdPtr; int localObjc; /* Used to invoke "unknown" if the */ Tcl_Obj **localObjv = NULL; /* command is not found. */ register int i; int length, result; int result; char *bytes; if (interp == (Tcl_Interp *) NULL) { return TCL_ERROR; } if ((objc < 1) || (objv == (Tcl_Obj **) NULL)) { Tcl_AppendToObj(Tcl_GetObjResult(interp),
︙
4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693	5281 5282 5283 5284 5285 5286 5287 5288 5289 5290 5291 5292 5293 5294 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 5325 5326 5327 5328 5329	- + - - + - + + + + + + - - - + + + + + + + - - - - - - - - - - - + + + + + + + + + + + + + + +	* If an error occurred, record information about what was being * executed when the error occurred. */ if ((result == TCL_ERROR) && ((flags & TCL_INVOKE_NO_TRACEBACK) == 0) && ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) { Tcl_DString ds; Tcl_Obj *msg; Tcl_DStringInit(&ds); if (!(iPtr->flags & ERR_IN_PROGRESS)) { Tcl_DStringAppend(&ds, "\n while invoking\n\"", -1); msg = Tcl_NewStringObj("\n while invoking\n\"", -1); } else { Tcl_DStringAppend(&ds, "\n invoked from within\n\"", -1); msg = Tcl_NewStringObj("\n invoked from within\n\"", -1); } Tcl_IncrRefCount(msg); for (i = 0; i < objc; i++) { CONST char *bytes; int length; Tcl_AppendObjToObj(msg, objv[i]); bytes = Tcl_GetStringFromObj(objv[i], &length); Tcl_DStringAppend(&ds, bytes, length); if (i < (objc - 1)) { bytes = Tcl_GetStringFromObj(msg, &length); if (length > 100) { /* * Back up truncation point so that we don't truncate * in the middle of a multi-byte character. */ length = 100; Tcl_DStringAppend(&ds, " ", -1); } else if (Tcl_DStringLength(&ds) > 100) { Tcl_DStringSetLength(&ds, 100); Tcl_DStringAppend(&ds, "...", -1); break; } } Tcl_DStringAppend(&ds, "\"", -1); Tcl_AddObjErrorInfo(interp, Tcl_DStringValue(&ds), -1); Tcl_DStringFree(&ds); while ( (bytes[length] & 0xC0) == 0x80 ) { length--; } Tcl_SetObjLength(msg, length); Tcl_AppendToObj(msg, "...", -1); break; } if (i != (objc - 1)) { Tcl_AppendToObj(msg, " ", -1); } } Tcl_AppendToObj(msg, "\"", -1); Tcl_AddObjErrorInfo(interp, Tcl_GetString(msg), -1); Tcl_DecrRefCount(msg); iPtr->flags &= ~ERR_ALREADY_LOGGED; } /* * Free any locally allocated storage used to call "unknown". */
︙
5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077	5685 5686 5687 5688 5689 5690 5691 5692 5693 5694 5695 5696 5697 5698 5699 5700 5701 5702 5703 5704 5705 5706 5707 5708 5709 5710 5711 5712 5713 5714 5715 5716 5717 5718 5719 5720 5721 5722 5723 5724 5725 5726 5727 5728 5729 5730 5731 5732 5733	- + + + + + + + + + + + + + + + + + + + + +	void Tcl_DeleteTrace(interp, trace) Tcl_Interp *interp; /* Interpreter that contains trace. */ Tcl_Trace trace; /* Token for trace (returned previously by * Tcl_CreateTrace). */ { Interp *iPtr = (Interp *) interp; Trace *tracePtr = (Trace *) trace; Trace *prevPtr, *tracePtr = (Trace *) trace; register Trace **tracePtr2 = &(iPtr->tracePtr); ActiveInterpTrace *activePtr; /* * Locate the trace entry in the interpreter's trace list, * and remove it from the list. */ prevPtr = NULL; while ((*tracePtr2) != NULL && (*tracePtr2) != tracePtr) { prevPtr = *tracePtr2; tracePtr2 = &((*tracePtr2)->nextPtr); } if (*tracePtr2 == NULL) { return; } (*tracePtr2) = (*tracePtr2)->nextPtr; /* * The code below makes it possible to delete traces while traces * are active: it makes sure that the deleted trace won't be * processed by TclCheckInterpTraces. */ for (activePtr = iPtr->activeInterpTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->nextTracePtr == tracePtr) { if (activePtr->reverseScan) { activePtr->nextTracePtr = prevPtr; } else { activePtr->nextTracePtr = tracePtr->nextPtr; } } } /* * If the trace forbids bytecode compilation, change the interpreter's * state. If bytecode compilation is now permitted, flag the fact and * advance the compilation epoch so that procs will be recompiled to * take advantage of it. */
︙
5157 5158 5159 5160 5161 5162 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209	5813 5814 5815 5816 5817 5818 5819 5820 5821 5822 5823 5824 5825 5826 5827 5828 5829 5830 5831 5832 5833 5834 5835 5836 5837 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 5859 5860 5861 5862 5863 5864 5865 5866 5867 5868 5869 5870 5871	- + + + - + + + + - + + - - + + - - + +	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, then append all bytes up to a * NULL byte. */ { register Interp *iPtr = (Interp *) interp; Tcl_Obj *messagePtr; Tcl_Obj *objPtr; /* * If we are just starting to log an error, errorInfo is initialized * from the error message in the interpreter's result. */ if (!(iPtr->flags & ERR_IN_PROGRESS)) { /* just starting to log error */ iPtr->flags |= ERR_IN_PROGRESS; if (iPtr->result[0] == 0) { Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL, iPtr->objResultPtr, TCL_GLOBAL_ONLY); } else { /* use the string result */ objPtr = Tcl_NewStringObj(interp->result, -1); Tcl_IncrRefCount(objPtr); Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL, Tcl_NewStringObj(interp->result, -1), TCL_GLOBAL_ONLY); objPtr, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(objPtr); } /* * If the errorCode variable wasn't set by the code that generated * the error, set it to "NONE". */ if (!(iPtr->flags & ERROR_CODE_SET)) { objPtr = Tcl_NewStringObj("NONE", -1); Tcl_IncrRefCount(objPtr); Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorCode, NULL, Tcl_NewStringObj("NONE", -1), TCL_GLOBAL_ONLY); objPtr, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(objPtr); } } /* * Now append "message" to the end of errorInfo. */ if (length != 0) { messagePtr = Tcl_NewStringObj(message, length); Tcl_IncrRefCount(messagePtr); objPtr = Tcl_NewStringObj(message, length); Tcl_IncrRefCount(objPtr); Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL, messagePtr, (TCL_GLOBAL_ONLY | TCL_APPEND_VALUE)); Tcl_DecrRefCount(messagePtr); /* free msg object appended above */ objPtr, (TCL_GLOBAL_ONLY | TCL_APPEND_VALUE)); Tcl_DecrRefCount(objPtr); /* free msg object appended above */ } }  /* *--------------------------------------------------------------------------- * * Tcl_VarEvalVA --
︙
5416 5417 5418 5419 5420 5421 5422 5423	6078 6079 6080 6081 6082 6083 6084 6085 6086 6087 6088 6089 6090 6091 6092 6093	- + + + + + + + + +	if (patchLevelV != NULL) { *patchLevelV = TCL_RELEASE_SERIAL; } if (type != NULL) { *type = TCL_RELEASE_LEVEL; } }  /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclBinary.c -- * * This file contains the implementation of the "binary" Tcl built-in * command and the Tcl binary data object. * * Copyright (c) 1997 by 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. * * RCS: @(#) $Id: tclBinary.c,v 1.13 2003/02/21 21:54:11 dkf Exp $ * RCS: @(#) $Id: tclBinary.c,v 1.13.2.4 2005/10/23 22:01:29 msofer Exp $ */ #include "tclInt.h" #include "tclPort.h" #include <math.h> /*
︙
49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71	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	+ + - + +	* Prototypes for local procedures defined in this file: */ static void DupByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)); static int FormatNumber _ANSI_ARGS_((Tcl_Interp *interp, int type, Tcl_Obj *src, unsigned char **cursorPtr)); static void CopyNumber _ANSI_ARGS_((CONST VOID *from, VOID *to, unsigned int length)); static void FreeByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr)); static int GetFormatSpec _ANSI_ARGS_((char **formatPtr, char *cmdPtr, int *countPtr)); static Tcl_Obj * ScanNumber _ANSI_ARGS_((unsigned char *buffer, int type, Tcl_HashTable **numberCachePtr)); static int SetByteArrayFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static void UpdateStringOfByteArray _ANSI_ARGS_((Tcl_Obj *listPtr)); static void DeleteScanNumberCache _ANSI_ARGS_(( Tcl_HashTable *numberCachePtr)); /* * The following object type represents an array of bytes. An array of * bytes is not equivalent to an internationalized string. Conceptually, a * string is an array of 16-bit quantities organized as a sequence of properly * formed UTF-8 characters, while a ByteArray is an array of 8-bit quantities. * Accessor functions are provided to convert a ByteArray to a String or a
︙
747 748 749 750 751 752 753 754 755 756 757 758 759 760 761	750 751 752 753 754 755 756 757 758 759 760 761 762 763 764	- +	} else { offset = count; } break; } default: { errorString = str; goto badfield; goto badField; } } } if (offset > length) { length = offset; } if (length == 0) {
︙
1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062	1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063	- + - -	} switch (cmd) { case 'a': case 'A': { unsigned char *src; if (arg >= objc) { if (numberCachePtr != NULL) { DeleteScanNumberCache(numberCachePtr); Tcl_DeleteHashTable(numberCachePtr); } goto badIndex; } if (count == BINARY_ALL) { count = length - offset; } else { if (count == BINARY_NOCOUNT) { count = 1;
︙
1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113	1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111	+ + - + - - - - + - -	if (src[size-1] != '\0' && src[size-1] != ' ') { break; } size--; } } valuePtr = Tcl_NewByteArrayObj(src, size); Tcl_IncrRefCount(valuePtr); resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); Tcl_DecrRefCount(valuePtr); arg++; if (resultPtr == NULL) { if (numberCachePtr != NULL) { DeleteScanNumberCache(numberCachePtr); Tcl_DeleteHashTable(numberCachePtr); } Tcl_DecrRefCount(valuePtr); /* unneeded */ return TCL_ERROR; } offset += count; break; } case 'b': case 'B': { unsigned char *src; char *dest; if (arg >= objc) { if (numberCachePtr != NULL) { DeleteScanNumberCache(numberCachePtr); Tcl_DeleteHashTable(numberCachePtr); } goto badIndex; } if (count == BINARY_ALL) { count = (length - offset) * 8; } else { if (count == BINARY_NOCOUNT) { count = 1;
︙
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 1174	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	- + + + - + - - - - + - -	value <<= 1; } else { value = *src++; } *dest++ = (char) ((value & 0x80) ? '1' : '0'); } } Tcl_IncrRefCount(valuePtr); resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); Tcl_DecrRefCount(valuePtr); arg++; if (resultPtr == NULL) { if (numberCachePtr != NULL) { DeleteScanNumberCache(numberCachePtr); Tcl_DeleteHashTable(numberCachePtr); } Tcl_DecrRefCount(valuePtr); /* unneeded */ return TCL_ERROR; } offset += (count + 7 ) / 8; break; } case 'h': case 'H': { char *dest; unsigned char *src; int i; static char hexdigit[] = "0123456789abcdef"; if (arg >= objc) { if (numberCachePtr != NULL) { DeleteScanNumberCache(numberCachePtr); Tcl_DeleteHashTable(numberCachePtr); } goto badIndex; } if (count == BINARY_ALL) { count = (length - offset)*2; } else { if (count == BINARY_NOCOUNT) { count = 1;
︙
1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219	1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213	+ + - + - - -	} else { value = *src++; } *dest++ = hexdigit[(value >> 4) & 0xf]; } } Tcl_IncrRefCount(valuePtr); resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); Tcl_DecrRefCount(valuePtr); arg++; if (resultPtr == NULL) { if (numberCachePtr != NULL) { DeleteScanNumberCache(numberCachePtr); Tcl_DeleteHashTable(numberCachePtr); } Tcl_DecrRefCount(valuePtr); /* unneeded */ return TCL_ERROR; } offset += (count + 1) / 2; break; } case 'c': { size = 1;
︙
1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258	1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250	- + - -	unsigned char *src; size = sizeof(double); /* fall through */ scanNumber: if (arg >= objc) { if (numberCachePtr != NULL) { DeleteScanNumberCache(numberCachePtr); Tcl_DeleteHashTable(numberCachePtr); } goto badIndex; } if (count == BINARY_NOCOUNT) { if ((length - offset) < size) { goto done; } valuePtr = ScanNumber(buffer+offset, cmd,
︙
1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294	1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285	+ + - + - - -	src += size; Tcl_ListObjAppendElement(NULL, valuePtr, elementPtr); } offset += count*size; } Tcl_IncrRefCount(valuePtr); resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); Tcl_DecrRefCount(valuePtr); arg++; if (resultPtr == NULL) { if (numberCachePtr != NULL) { DeleteScanNumberCache(numberCachePtr); Tcl_DeleteHashTable(numberCachePtr); } Tcl_DecrRefCount(valuePtr); /* unneeded */ return TCL_ERROR; } break; } case 'x': { if (count == BINARY_NOCOUNT) { count = 1;
︙
1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375	1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361	- + - - - + - - - + - + - - - + +	} else { offset -= count; } break; } case '@': { if (count == BINARY_NOCOUNT) { if (numberCachePtr != NULL) { DeleteScanNumberCache(numberCachePtr); Tcl_DeleteHashTable(numberCachePtr); } goto badCount; } if ((count == BINARY_ALL) || (count > length)) { offset = length; } else { offset = count; } break; } default: { if (numberCachePtr != NULL) { DeleteScanNumberCache(numberCachePtr); Tcl_DeleteHashTable(numberCachePtr); } errorString = str; goto badfield; goto badField; } } } /* * Set the result to the last position of the cursor. */ done: Tcl_ResetResult(interp); Tcl_SetLongObj(Tcl_GetObjResult(interp), arg - 4); if (numberCachePtr != NULL) { DeleteScanNumberCache(numberCachePtr); Tcl_DeleteHashTable(numberCachePtr); } break; } } return TCL_OK; badValue: Tcl_ResetResult(interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "expected ", errorString, " string but got \"", errorValue, "\" instead", NULL); return TCL_ERROR; badCount: errorString = "missing count for \"@\" field specifier"; goto error; badIndex: errorString = "not enough arguments for all format specifiers"; goto error; badfield: { badField: { Tcl_UniChar ch; char buf[TCL_UTF_MAX + 1]; Tcl_UtfToUniChar(errorString, &ch); buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; Tcl_AppendResult(interp, "bad field specifier \"", buf, "\"", NULL); return TCL_ERROR;
︙
1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491	1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481	+ + + - + +	* memcpy to avoid alignment issues. */ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { return TCL_ERROR; } if (type == 'd') { /* * Can't just memcpy() here. [Bug 1116542] */ memcpy((VOID *) *cursorPtr, (VOID *) &dvalue, sizeof(double)); CopyNumber(&dvalue, *cursorPtr, sizeof(double)); *cursorPtr += sizeof(double); } else { float fvalue; /* * Because some compilers will generate floating point exceptions * on an overflow cast (e.g. Borland), we restrict the values
︙
1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566	1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566	+ + + + + + + + + +	*(*cursorPtr)++ = (unsigned char) (value >> 16); *(*cursorPtr)++ = (unsigned char) (value >> 8); *(*cursorPtr)++ = (unsigned char) value; } return TCL_OK; } }  /* Ugly workaround for old and broken compiler! */ static void CopyNumber(from, to, length) CONST VOID *from; VOID *to; unsigned int length; { memcpy(to, from, length); }  /* *---------------------------------------------------------------------- * * ScanNumber -- * * This routine is called by Tcl_BinaryObjCmd to scan a number
︙
1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712	1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765	- + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	* a LOT of varied binary data in a single call! * Bail out by switching back to the old behaviour * for the rest of the scan. * * Note that anyone just using the 'c' conversion * (for bytes) cannot trigger this. */ Tcl_DeleteHashTable(tablePtr); DeleteScanNumberCache(tablePtr); *numberCachePtrPtr = NULL; return Tcl_NewLongObj(value); } else { register Tcl_Obj *objPtr = Tcl_NewLongObj(value); /* Don't need to fiddle with refcount... */ Tcl_IncrRefCount(objPtr); Tcl_SetHashValue(hPtr, (ClientData) objPtr); return objPtr; } } /* * Do not cache wide values; they are already too large to * use as keys. */ case 'w': uwvalue = ((Tcl_WideUInt) buffer[0]) | (((Tcl_WideUInt) buffer[1]) << 8) | (((Tcl_WideUInt) buffer[2]) << 16) | (((Tcl_WideUInt) buffer[3]) << 24) | (((Tcl_WideUInt) buffer[4]) << 32) | (((Tcl_WideUInt) buffer[5]) << 40) | (((Tcl_WideUInt) buffer[6]) << 48) | (((Tcl_WideUInt) buffer[7]) << 56); return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue); case 'W': uwvalue = ((Tcl_WideUInt) buffer[7]) | (((Tcl_WideUInt) buffer[6]) << 8) | (((Tcl_WideUInt) buffer[5]) << 16) | (((Tcl_WideUInt) buffer[4]) << 24) | (((Tcl_WideUInt) buffer[3]) << 32) | (((Tcl_WideUInt) buffer[2]) << 40) | (((Tcl_WideUInt) buffer[1]) << 48) | (((Tcl_WideUInt) buffer[0]) << 56); return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue); /* * Do not cache double values; they are already too large * to use as keys and the values stored are utterly * incompatible too. */ case 'f': { float fvalue; memcpy((VOID *) &fvalue, (VOID *) buffer, sizeof(float)); return Tcl_NewDoubleObj(fvalue); } case 'd': { double dvalue; memcpy((VOID *) &dvalue, (VOID *) buffer, sizeof(double)); return Tcl_NewDoubleObj(dvalue); } } return NULL; }  /* *---------------------------------------------------------------------- * * DeleteScanNumberCache -- * * Deletes the hash table acting as a scan number cache. * * Results: * None * * Side effects: * Decrements the reference counts of the objects in the cache. * *---------------------------------------------------------------------- */ static void DeleteScanNumberCache(numberCachePtr) Tcl_HashTable *numberCachePtr; /* Pointer to the hash table, or * NULL (when the cache has already * been deleted due to overflow.) */ { Tcl_HashEntry *hEntry; Tcl_HashSearch search; if (numberCachePtr == NULL) { return; } hEntry = Tcl_FirstHashEntry(numberCachePtr, &search); while (hEntry != NULL) { register Tcl_Obj *value = (Tcl_Obj *) Tcl_GetHashValue(hEntry); if (value != NULL) { Tcl_DecrRefCount(value); } hEntry = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(numberCachePtr); }

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	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	- + - +	/* * tclClock.c -- * * Contains the time and date related commands. This code * is derived from the time and date facilities of TclX, * by Mark Diekhans and Karl Lehenbauer. * * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans. * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclClock.c,v 1.20 2003/02/01 21:27:55 kennykb Exp $ * RCS: @(#) $Id: tclClock.c,v 1.20.2.3 2007/04/21 22:42:49 kennykb Exp $ */ #include "tcl.h" #include "tclInt.h" #include "tclPort.h" /* * The date parsing stuff uses lexx and has tons o statics. */ TCL_DECLARE_MUTEX(clockMutex) /* * Function prototypes for local procedures in this file: */ static int FormatClock _ANSI_ARGS_((Tcl_Interp *interp, unsigned long clockVal, int useGMT, Tcl_WideInt clockVal, int useGMT, char *format));  /* *------------------------------------------------------------------------- * * Tcl_ClockObjCmd -- *
︙
58 59 60 61 62 63 64 65 66 67 68 69 70 71 72	58 59 60 61 62 63 64 65 66 67 68 69 70 71 72	- +	{ Tcl_Obj *resultPtr; int index; Tcl_Obj *CONST *objPtr; int useGMT = 0; char *format = "%a %b %d %X %Z %Y"; int dummy; unsigned long baseClock, clockVal; Tcl_WideInt baseClock, clockVal; long zone; Tcl_Obj *baseObjPtr = NULL; char *scanStr; int n; static CONST char *switches[] = {"clicks", "format", "scan", "seconds", (char *) NULL};
︙
124 125 126 127 128 129 130 131 132 133 134 135 136 137 138	124 125 126 127 128 129 130 131 132 133 134 135 136 137 138	- +	if ((objc < 3) || (objc > 7)) { wrongFmtArgs: Tcl_WrongNumArgs(interp, 2, objv, "clockval ?-format string? ?-gmt boolean?"); return TCL_ERROR; } if (Tcl_GetLongFromObj(interp, objv[2], (long*) &clockVal) if (Tcl_GetWideIntFromObj(interp, objv[2], &clockVal) != TCL_OK) { return TCL_ERROR; } objPtr = objv+3; objc -= 3; while (objc > 1) {
︙
153 154 155 156 157 158 159 160 161 162 163 164 165 166 167	153 154 155 156 157 158 159 160 161 162 163 164 165 166 167	- +	} objPtr += 2; objc -= 2; } if (objc != 0) { goto wrongFmtArgs; } return FormatClock(interp, (unsigned long) clockVal, useGMT, return FormatClock(interp, clockVal, useGMT, format); case COMMAND_SCAN: /* scan */ if ((objc < 3) || (objc > 7)) { wrongScanArgs: Tcl_WrongNumArgs(interp, 2, objv, "dateString ?-base clockValue? ?-gmt boolean?");
︙
190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230	190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230	- - + + - + - - + + - +	objc -= 2; } if (objc != 0) { goto wrongScanArgs; } if (baseObjPtr != NULL) { if (Tcl_GetLongFromObj(interp, baseObjPtr, (long*) &baseClock) != TCL_OK) { if (Tcl_GetWideIntFromObj(interp, baseObjPtr, &baseClock) != TCL_OK) { return TCL_ERROR; } } else { baseClock = TclpGetSeconds(); } if (useGMT) { zone = -50000; /* Force GMT */ } else { zone = TclpGetTimeZone((unsigned long) baseClock); zone = TclpGetTimeZone(baseClock); } scanStr = Tcl_GetStringFromObj(objv[2], &dummy); Tcl_MutexLock(&clockMutex); if (TclGetDate(scanStr, (unsigned long) baseClock, zone, (unsigned long *) &clockVal) < 0) { if (TclGetDate(scanStr, baseClock, zone, &clockVal) < 0) { Tcl_MutexUnlock(&clockMutex); Tcl_AppendStringsToObj(resultPtr, "unable to convert date-time string \"", scanStr, "\"", (char *) NULL); return TCL_ERROR; } Tcl_MutexUnlock(&clockMutex); Tcl_SetLongObj(resultPtr, (long) clockVal); Tcl_SetWideIntObj(resultPtr, clockVal); return TCL_OK; case COMMAND_SECONDS: /* seconds */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; }
︙
251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277	251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277	- + - - + +	* *----------------------------------------------------------------------------- */ static int FormatClock(interp, clockVal, useGMT, format) Tcl_Interp *interp; /* Current interpreter. */ unsigned long clockVal; /* Time in seconds. */ Tcl_WideInt clockVal; /* Time in seconds. */ int useGMT; /* Boolean */ char *format; /* Format string */ { struct tm *timeDataPtr; Tcl_DString buffer, uniBuffer; int bufSize; char *p; int result; time_t tclockVal; #if !defined(HAVE_TM_ZONE) && !defined(WIN32) int savedTimeZone = 0; /* lint. */ char *savedTZEnv = NULL; /* lint. */ TIMEZONE_t savedTimeZone = 0; /* lint. */ char *savedTZEnv = NULL; /* lint. */ #endif #ifdef HAVE_TZSET /* * Some systems forgot to call tzset in localtime, make sure its done. */ static int calledTzset = 0;
︙
306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327	306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327	- + - +	varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY); if (varValue != NULL) { savedTZEnv = strcpy(ckalloc(strlen(varValue) + 1), varValue); } else { savedTZEnv = NULL; } Tcl_SetVar2(interp, "env", "TZ", "GMT", TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "env", "TZ", "GMT0", TCL_GLOBAL_ONLY); savedTimeZone = timezone; timezone = 0; tzset(); } #endif tclockVal = clockVal; tclockVal = (time_t) clockVal; timeDataPtr = TclpGetDate((TclpTime_t) &tclockVal, useGMT); /* * Make a guess at the upper limit on the substituted string size * based on the number of percents in the string. */
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	/* * tclCmdAH.c -- * * This file contains the top-level command routines for most of * the Tcl built-in commands whose names begin with the letters * A to H. * * Copyright (c) 1987-1993 The Regents of the University of California. * Copyright (c) 1994-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. * * RCS: @(#) $Id: tclCmdAH.c,v 1.27 2002/07/02 12:16:05 vincentdarley Exp $ * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.16 2006/11/28 22:20:00 andreas_kupries Exp $ */ #include "tclInt.h" #include "tclPort.h" #include <locale.h> /*
︙
231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261	231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263	+ + + - - - - - - + + + + +	ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { Tcl_Obj *varNamePtr = NULL; int result; #ifdef TCL_TIP280 Interp* iPtr = (Interp*) interp; #endif if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 1, objv, "command ?varName?"); return TCL_ERROR; } /* * Save a pointer to the variable name object, if any, in case the * Tcl_EvalObj reallocates the bytecode interpreter's evaluation * stack rendering objv invalid. */ if (objc == 3) { varNamePtr = objv[2]; } #ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, objv[1], 0); #else /* TIP #280. Make invoking context available to caught script */ result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr,1); #endif if (objc == 3) { if (Tcl_ObjSetVar2(interp, varNamePtr, NULL, Tcl_GetObjResult(interp), 0) == NULL) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "couldn't save command result in variable", -1);
︙
442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473	444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472	- - + + - + + + - - - - -	&index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { case ENC_CONVERTTO: case ENC_CONVERTFROM: { char *name; Tcl_Obj *data; if (objc == 3) { name = NULL; encoding = Tcl_GetEncoding(interp, NULL); data = objv[2]; } else if (objc == 4) { if (TclGetEncodingFromObj(interp, objv[2], &encoding) name = Tcl_GetString(objv[2]); != TCL_OK) { return TCL_ERROR; } data = objv[3]; } else { Tcl_WrongNumArgs(interp, 2, objv, "?encoding? data"); return TCL_ERROR; } encoding = Tcl_GetEncoding(interp, name); if (!encoding) { return TCL_ERROR; } if ((enum options) index == ENC_CONVERTFROM) { /* * Treat the string as binary data. */ string = (char *) Tcl_GetByteArrayFromObj(data, &length); Tcl_ExternalToUtfDString(encoding, string, length, &ds);
︙
555 556 557 558 559 560 561 562 563 564 565 566 567 568 569	554 555 556 557 558 559 560 561 562 563 564 565 566 567 568	- +	if ((objc < 2) || (objc > 4)) { Tcl_WrongNumArgs(interp, 1, objv, "message ?errorInfo? ?errorCode?"); return TCL_ERROR; } if (objc >= 3) { /* process the optional info argument */ info = Tcl_GetStringFromObj(objv[2], &infoLen); if (*info != 0) { if (infoLen > 0) { Tcl_AddObjErrorInfo(interp, info, infoLen); iPtr->flags |= ERR_ALREADY_LOGGED; } } if (objc == 4) { Tcl_SetVar2Ex(interp, "errorCode", NULL, objv[3], TCL_GLOBAL_ONLY);
︙
597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626	596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639	+ + + + + + + + + + + + + +	ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { int result; register Tcl_Obj *objPtr; #ifdef TCL_TIP280 Interp* iPtr = (Interp*) interp; #endif if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?"); return TCL_ERROR; } if (objc == 2) { #ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, objv[1], TCL_EVAL_DIRECT); #else /* TIP #280. Make invoking context available to eval'd script */ result = TclEvalObjEx(interp, objv[1], TCL_EVAL_DIRECT, iPtr->cmdFramePtr,1); #endif } else { /* * More than one argument: concatenate them together with spaces * between, then evaluate the result. Tcl_EvalObjEx will delete * the object when it decrements its refcount after eval'ing it. */ objPtr = Tcl_ConcatObj(objc-1, objv+1); #ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT); #else /* TIP #280. Make invoking context available to eval'd script */ result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0); #endif } if (result == TCL_ERROR) { char msg[32 + TCL_INTEGER_SPACE]; sprintf(msg, "\n (\"eval\" body line %d)", interp->errorLine); Tcl_AddObjErrorInfo(interp, msg, -1); }
︙
759 760 761 762 763 764 765 766 767 768 769 770 771 772 773	772 773 774 775 776 777 778 779 780 781 782 783 784 785 786	- +	* * This procedure is invoked to process the "file" Tcl command. * See the user documentation for details on what it does. * PLEASE NOTE THAT THIS FAILS WITH FILENAMES AND PATHS WITH * EMBEDDED NULLS, WHICH COULD THEORETICALLY HAPPEN ON A MAC. * With the object-based Tcl_FS APIs, the above NOTE may no * longer be true. In any case this assertion should be tested. * * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *----------------------------------------------------------------------
︙
797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849	810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863	- - - - - - - - - - + + + + + + + + + + - + + + - + - - +	"pathtype", "readable", "readlink", "rename", "rootname", "separator", "size", "split", "stat", "system", "tail", "type", "volumes", "writable", (char *) NULL }; enum options { FILE_ATIME, FILE_ATTRIBUTES, FILE_CHANNELS, FILE_COPY, FILE_DELETE, FILE_DIRNAME, FILE_EXECUTABLE, FILE_EXISTS, FILE_EXTENSION, FILE_ISDIRECTORY, FILE_ISFILE, FILE_JOIN, FILE_LINK, FILE_LSTAT, FILE_MTIME, FILE_MKDIR, FILE_NATIVENAME, FILE_NORMALIZE, FILE_OWNED, FILE_PATHTYPE, FILE_READABLE, FILE_READLINK, FILE_RENAME, FILE_ROOTNAME, FILE_SEPARATOR, FILE_SIZE, FILE_SPLIT, FILE_STAT, FILE_SYSTEM, FILE_TAIL, FILE_TYPE, FILE_VOLUMES, FILE_WRITABLE FCMD_ATIME, FCMD_ATTRIBUTES, FCMD_CHANNELS, FCMD_COPY, FCMD_DELETE, FCMD_DIRNAME, FCMD_EXECUTABLE, FCMD_EXISTS, FCMD_EXTENSION, FCMD_ISDIRECTORY, FCMD_ISFILE, FCMD_JOIN, FCMD_LINK, FCMD_LSTAT, FCMD_MTIME, FCMD_MKDIR, FCMD_NATIVENAME, FCMD_NORMALIZE, FCMD_OWNED, FCMD_PATHTYPE, FCMD_READABLE, FCMD_READLINK, FCMD_RENAME, FCMD_ROOTNAME, FCMD_SEPARATOR, FCMD_SIZE, FCMD_SPLIT, FCMD_STAT, FCMD_SYSTEM, FCMD_TAIL, FCMD_TYPE, FCMD_VOLUMES, FCMD_WRITABLE }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], fileOptions, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { case FILE_ATIME: { case FCMD_ATIME: { Tcl_StatBuf buf; struct utimbuf tval; if ((objc < 3) || (objc > 4)) { Tcl_WrongNumArgs(interp, 2, objv, "name ?time?"); return TCL_ERROR; } if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } if (objc == 4) { long newTime; if (Tcl_GetLongFromObj(interp, objv[3], if (Tcl_GetLongFromObj(interp, objv[3], &newTime) != TCL_OK) { (long*)(&buf.st_atime)) != TCL_OK) { return TCL_ERROR; } tval.actime = buf.st_atime; tval.actime = newTime; tval.modtime = buf.st_mtime; if (Tcl_FSUtime(objv[2], &tval) != 0) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "could not set access time for file \"", Tcl_GetString(objv[2]), "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR;
︙
857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965	871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979	- + - + - + - + - + - + - + - + - + - + - + - +	if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } } Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_atime); return TCL_OK; } case FILE_ATTRIBUTES: { case FCMD_ATTRIBUTES: { return TclFileAttrsCmd(interp, objc, objv); } case FILE_CHANNELS: { case FCMD_CHANNELS: { if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 2, objv, "?pattern?"); return TCL_ERROR; } return Tcl_GetChannelNamesEx(interp, ((objc == 2) ? NULL : Tcl_GetString(objv[2]))); } case FILE_COPY: { case FCMD_COPY: { return TclFileCopyCmd(interp, objc, objv); } case FILE_DELETE: { case FCMD_DELETE: { return TclFileDeleteCmd(interp, objc, objv); } case FILE_DIRNAME: { case FCMD_DIRNAME: { Tcl_Obj *dirPtr; if (objc != 3) { goto only3Args; } dirPtr = TclFileDirname(interp, objv[2]); if (dirPtr == NULL) { return TCL_ERROR; } else { Tcl_SetObjResult(interp, dirPtr); Tcl_DecrRefCount(dirPtr); return TCL_OK; } } case FILE_EXECUTABLE: { case FCMD_EXECUTABLE: { if (objc != 3) { goto only3Args; } return CheckAccess(interp, objv[2], X_OK); } case FILE_EXISTS: { case FCMD_EXISTS: { if (objc != 3) { goto only3Args; } return CheckAccess(interp, objv[2], F_OK); } case FILE_EXTENSION: { case FCMD_EXTENSION: { char *fileName, *extension; if (objc != 3) { goto only3Args; } fileName = Tcl_GetString(objv[2]); extension = TclGetExtension(fileName); if (extension != NULL) { Tcl_SetStringObj(Tcl_GetObjResult(interp), extension, -1); } return TCL_OK; } case FILE_ISDIRECTORY: { case FCMD_ISDIRECTORY: { int value; Tcl_StatBuf buf; if (objc != 3) { goto only3Args; } value = 0; if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) { value = S_ISDIR(buf.st_mode); } Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value); return TCL_OK; } case FILE_ISFILE: { case FCMD_ISFILE: { int value; Tcl_StatBuf buf; if (objc != 3) { goto only3Args; } value = 0; if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) { value = S_ISREG(buf.st_mode); } Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value); return TCL_OK; } case FILE_JOIN: { case FCMD_JOIN: { Tcl_Obj *resObj; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?"); return TCL_ERROR; } resObj = Tcl_FSJoinToPath(NULL, objc - 2, objv + 2); Tcl_SetObjResult(interp, resObj); return TCL_OK; } case FILE_LINK: { case FCMD_LINK: { Tcl_Obj *contents; int index; if (objc < 3 || objc > 5) { Tcl_WrongNumArgs(interp, 2, objv, "?-linktype? linkname ?target?"); return TCL_ERROR;
︙
1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143	1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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	- + - + + + - + - - + - + - + - + + + + - +	* result refCount. If we are creating a link, this * will just be objv[index+1], and so we don't own it. */ Tcl_DecrRefCount(contents); } return TCL_OK; } case FILE_LSTAT: { case FCMD_LSTAT: { char *varName; Tcl_StatBuf buf; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "name varName"); return TCL_ERROR; } if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) { return TCL_ERROR; } varName = Tcl_GetString(objv[3]); return StoreStatData(interp, varName, &buf); } case FILE_MTIME: { case FCMD_MTIME: { Tcl_StatBuf buf; struct utimbuf tval; if ((objc < 3) || (objc > 4)) { Tcl_WrongNumArgs(interp, 2, objv, "name ?time?"); return TCL_ERROR; } if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } if (objc == 4) { long newTime; if (Tcl_GetLongFromObj(interp, objv[3], if (Tcl_GetLongFromObj(interp, objv[3], &newTime) != TCL_OK) { (long*)(&buf.st_mtime)) != TCL_OK) { return TCL_ERROR; } tval.actime = buf.st_atime; tval.modtime = buf.st_mtime; tval.modtime = newTime; if (Tcl_FSUtime(objv[2], &tval) != 0) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "could not set modification time for file \"", Tcl_GetString(objv[2]), "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } /* * Do another stat to ensure that the we return the * new recognized atime - hopefully the same as the * one we sent in. However, fs's like FAT don't * even know what atime is. */ if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } } Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_mtime); return TCL_OK; } case FILE_MKDIR: { case FCMD_MKDIR: { if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?"); return TCL_ERROR; } return TclFileMakeDirsCmd(interp, objc, objv); } case FILE_NATIVENAME: { case FCMD_NATIVENAME: { CONST char *fileName; Tcl_DString ds; if (objc != 3) { goto only3Args; } fileName = Tcl_GetString(objv[2]); fileName = Tcl_TranslateFileName(interp, fileName, &ds); if (fileName == NULL) { return TCL_ERROR; } Tcl_SetStringObj(Tcl_GetObjResult(interp), fileName, Tcl_DStringLength(&ds)); Tcl_DStringFree(&ds); return TCL_OK; } case FILE_NORMALIZE: { case FCMD_NORMALIZE: { Tcl_Obj *fileName; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "filename"); return TCL_ERROR; } fileName = Tcl_FSGetNormalizedPath(interp, objv[2]); if (fileName == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, fileName); return TCL_OK; } case FILE_OWNED: { case FCMD_OWNED: { int value; Tcl_StatBuf buf; if (objc != 3) { goto only3Args; } value = 0;
︙
1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190	1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208	- + - + - +	#else value = (geteuid() == buf.st_uid); #endif } Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value); return TCL_OK; } case FILE_PATHTYPE: { case FCMD_PATHTYPE: { if (objc != 3) { goto only3Args; } switch (Tcl_FSGetPathType(objv[2])) { case TCL_PATH_ABSOLUTE: Tcl_SetStringObj(Tcl_GetObjResult(interp), "absolute", -1); break; case TCL_PATH_RELATIVE: Tcl_SetStringObj(Tcl_GetObjResult(interp), "relative", -1); break; case TCL_PATH_VOLUME_RELATIVE: Tcl_SetStringObj(Tcl_GetObjResult(interp), "volumerelative", -1); break; } return TCL_OK; } case FILE_READABLE: { case FCMD_READABLE: { if (objc != 3) { goto only3Args; } return CheckAccess(interp, objv[2], R_OK); } case FILE_READLINK: { case FCMD_READLINK: { Tcl_Obj *contents; if (objc != 3) { goto only3Args; } if (Tcl_FSConvertToPathType(interp, objv[2]) != TCL_OK) {
︙
1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233	1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251	- + - + - +	Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, contents); Tcl_DecrRefCount(contents); return TCL_OK; } case FILE_RENAME: { case FCMD_RENAME: { return TclFileRenameCmd(interp, objc, objv); } case FILE_ROOTNAME: { case FCMD_ROOTNAME: { int length; char *fileName, *extension; if (objc != 3) { goto only3Args; } fileName = Tcl_GetStringFromObj(objv[2], &length); extension = TclGetExtension(fileName); if (extension == NULL) { Tcl_SetObjResult(interp, objv[2]); } else { Tcl_SetStringObj(Tcl_GetObjResult(interp), fileName, (int) (length - strlen(extension))); } return TCL_OK; } case FILE_SEPARATOR: { case FCMD_SEPARATOR: { if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 2, objv, "?name?"); return TCL_ERROR; } if (objc == 2) { char *separator = NULL; /* lint */ switch (tclPlatform) {
︙
1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313	1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331	- + - + - + - + - +	Tcl_SetObjResult(interp, Tcl_NewStringObj("Unrecognised path",-1)); return TCL_ERROR; } } return TCL_OK; } case FILE_SIZE: { case FCMD_SIZE: { Tcl_StatBuf buf; if (objc != 3) { goto only3Args; } if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt) buf.st_size); return TCL_OK; } case FILE_SPLIT: { case FCMD_SPLIT: { if (objc != 3) { goto only3Args; } Tcl_SetObjResult(interp, Tcl_FSSplitPath(objv[2], NULL)); return TCL_OK; } case FILE_STAT: { case FCMD_STAT: { char *varName; Tcl_StatBuf buf; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "stat name varName"); return TCL_ERROR; } if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } varName = Tcl_GetString(objv[3]); return StoreStatData(interp, varName, &buf); } case FILE_SYSTEM: { case FCMD_SYSTEM: { Tcl_Obj* fsInfo; if (objc != 3) { goto only3Args; } fsInfo = Tcl_FSFileSystemInfo(objv[2]); if (fsInfo != NULL) { Tcl_SetObjResult(interp, fsInfo); return TCL_OK; } else { Tcl_SetObjResult(interp, Tcl_NewStringObj("Unrecognised path",-1)); return TCL_ERROR; } } case FILE_TAIL: { case FCMD_TAIL: { int splitElements; Tcl_Obj *splitPtr; if (objc != 3) { goto only3Args; } /*
︙
1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375	1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393	- + - + - +	Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &tail); Tcl_SetObjResult(interp, tail); } } Tcl_DecrRefCount(splitPtr); return TCL_OK; } case FILE_TYPE: { case FCMD_TYPE: { Tcl_StatBuf buf; if (objc != 3) { goto only3Args; } if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) { return TCL_ERROR; } Tcl_SetStringObj(Tcl_GetObjResult(interp), GetTypeFromMode((unsigned short) buf.st_mode), -1); return TCL_OK; } case FILE_VOLUMES: { case FCMD_VOLUMES: { if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_FSListVolumes()); return TCL_OK; } case FILE_WRITABLE: { case FCMD_WRITABLE: { if (objc != 3) { goto only3Args; } return CheckAccess(interp, objv[2], W_OK); } }
︙
1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627	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	+ + + + + + + +	Tcl_ForObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { int result, value; #ifdef TCL_TIP280 Interp* iPtr = (Interp*) interp; #endif if (objc != 5) { Tcl_WrongNumArgs(interp, 1, objv, "start test next command"); return TCL_ERROR; } #ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, objv[1], 0); #else /* TIP #280. Make invoking context available to initial script */ result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr,1); #endif if (result != TCL_OK) { if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (\"for\" initial command)"); } return result; } while (1) {
︙
1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659	1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695	+ + + + + + + + + +	result = Tcl_ExprBooleanObj(interp, objv[2], &value); if (result != TCL_OK) { return result; } if (!value) { break; } #ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, objv[4], 0); #else /* TIP #280. Make invoking context available to loop body */ result = TclEvalObjEx(interp, objv[4], 0, iPtr->cmdFramePtr,4); #endif if ((result != TCL_OK) && (result != TCL_CONTINUE)) { if (result == TCL_ERROR) { char msg[32 + TCL_INTEGER_SPACE]; sprintf(msg, "\n (\"for\" body line %d)",interp->errorLine); Tcl_AddErrorInfo(interp, msg); } break; } #ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, objv[3], 0); #else /* TIP #280. Make invoking context available to next script */ result = TclEvalObjEx(interp, objv[3], 0, iPtr->cmdFramePtr,3); #endif if (result == TCL_BREAK) { break; } else if (result != TCL_OK) { if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (\"for\" loop-end command)"); } return result;
︙
1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732	1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771	+ + +	Tcl_Obj **argvListArray[STATIC_LIST_SIZE]; int *index = indexArray; /* Array of value list indices */ int *varcList = varcListArray; /* # loop variables per list */ Tcl_Obj ***varvList = varvListArray; /* Array of var name lists */ int *argcList = argcListArray; /* Array of value list sizes */ Tcl_Obj ***argvList = argvListArray; /* Array of value lists */ #ifdef TCL_TIP280 Interp* iPtr = (Interp*) interp; #endif if (objc < 4 || (objc%2 != 0)) { Tcl_WrongNumArgs(interp, 1, objv, "varList list ?varList list ...? command"); return TCL_ERROR; }
︙
1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865	1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906	- - + - - - + - + + + + + +	if (result != TCL_OK) { panic("Tcl_ForeachObjCmd: could not reconvert value list %d to a list object\n", i); } for (v = 0; v < varcList[i]; v++) { int k = index[i]++; Tcl_Obj *valuePtr, *varValuePtr; int isEmptyObj = 0; if (k < argcList[i]) { valuePtr = argvList[i][k]; } else { valuePtr = Tcl_NewObj(); /* empty string */ isEmptyObj = 1; } Tcl_IncrRefCount(valuePtr); varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v], NULL, valuePtr, 0); if (varValuePtr == NULL) { if (isEmptyObj) { Tcl_DecrRefCount(valuePtr); Tcl_DecrRefCount(valuePtr); } if (varValuePtr == NULL) { Tcl_ResetResult(interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "couldn't set loop variable: \"", Tcl_GetString(varvList[i][v]), "\"", (char *) NULL); result = TCL_ERROR; goto done; } } } #ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, bodyPtr, 0); #else /* TIP #280. Make invoking context available to loop body */ result = TclEvalObjEx(interp, bodyPtr, 0, iPtr->cmdFramePtr,objc-1); #endif if (result != TCL_OK) { if (result == TCL_CONTINUE) { result = TCL_OK; } else if (result == TCL_BREAK) { result = TCL_OK; break; } else if (result == TCL_ERROR) {
︙
1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024	1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 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 2053 2054 2055 2056 2057 2058 2059	- - - + - + - - - + - -	* ("e", "s", etc.), width, and precision. */ long intValue; /* Used to hold value to pass to sprintf, if * it's a one-word integer or char value */ char *ptrValue = NULL; /* Used to hold value to pass to sprintf, if * it's a one-word value. */ double doubleValue; /* Used to hold value to pass to sprintf if * it's a double value. */ #ifndef TCL_WIDE_INT_IS_LONG Tcl_WideInt wideValue; /* Used to hold value to pass to sprintf if * it's a 'long long' value. */ #endif /* TCL_WIDE_INT_IS_LONG */ int whichValue; /* Indicates which of intValue, ptrValue, * or doubleValue has the value to pass to * sprintf, according to the following * definitions: */ # define INT_VALUE 0 # define CHAR_VALUE 1 # define PTR_VALUE 2 # define DOUBLE_VALUE 3 # define STRING_VALUE 4 # define WIDE_VALUE 5 # define MAX_FLOAT_SIZE 320 Tcl_Obj *resultPtr; /* Where result is stored finally. */ char staticBuf[MAX_FLOAT_SIZE + 1]; /* A static buffer to copy the format results /* A static buffer to copy the format results * into */ char *dst = staticBuf; /* The buffer that sprintf writes into each * time the format processes a specifier */ int dstSize = MAX_FLOAT_SIZE; /* The size of the dst buffer */ /* The size of the dst buffer */ int noPercent; /* Special case for speed: indicates there's * no field specifier, just a string to copy.*/ int objIndex; /* Index of argument to substitute next. */ int gotXpg = 0; /* Non-zero means that an XPG3 %n$-style * specifier has been seen. */ int gotSequential = 0; /* Non-zero means that a regular sequential * (non-XPG3) conversion specifier has been * seen. */ int useShort; /* Value to be printed is short (half word). */ char *end; /* Used to locate end of numerical fields. */ int stringLen = 0; /* Length of string in characters rather * than bytes. Used for %s substitution. */ int gotMinus; /* Non-zero indicates that a minus flag has * been seen in the current field. */ int gotPrecision; /* Non-zero indicates that a precision has * been set for the current field. */ int gotZero; /* Non-zero indicates that a zero flag has * been seen in the current field. */ #ifndef TCL_WIDE_INT_IS_LONG int useWide; /* Value to be printed is Tcl_WideInt. */ #endif /* TCL_WIDE_INT_IS_LONG */ /* * This procedure is a bit nasty. The goal is to use sprintf to * do most of the dirty work. There are several problems: * 1. this procedure can't trust its arguments. * 2. we must be able to provide a large enough result area to hold * whatever's generated. This is hard to estimate. * 3. there's no way to move the arguments from objv to the call * to sprintf in a reasonable way. This is particularly nasty * because some of the arguments may be two-word values (doubles * and wide-ints). * So, what happens here is to scan the format string one % group * at a time, making many individual calls to sprintf. */ if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg arg ...?"); Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg arg ...?"); return TCL_ERROR; } format = Tcl_GetStringFromObj(objv[1], &formatLen); endPtr = format + formatLen; resultPtr = Tcl_NewObj(); objIndex = 2; while (format < endPtr) { register char *newPtr = newFormat; width = precision = noPercent = useShort = 0; gotZero = gotMinus = gotPrecision = 0; #ifndef TCL_WIDE_INT_IS_LONG useWide = 0; #endif /* TCL_WIDE_INT_IS_LONG */ whichValue = PTR_VALUE; /* * Get rid of any characters before the next field specifier. */ if (*format != '%') { ptrValue = format;
︙
2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 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 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275	2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 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 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332	- + + + + + + + + + + + - - + + - + - - - - - - - + + + + + + + - - - - - - - - - - + + + + + + + + + - - - + + + + + + + + - - - + + + + + + + + + - - - - - - - - - - + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	if (gotPrecision) { TclFormatInt(newPtr, precision); /* INTL: printf format. */ while (*newPtr != 0) { newPtr++; } } if (*format == 'l') { #ifndef TCL_WIDE_INT_IS_LONG useWide = 1; /* * Only add a 'll' modifier for integer values as it makes * some libc's go into spasm otherwise. [Bug #702622] */ switch (format[1]) { case 'i': case 'd': case 'o': case 'u': case 'x': case 'X': strcpy(newPtr, TCL_LL_MODIFIER); newPtr += TCL_LL_MODIFIER_SIZE; strcpy(newPtr, TCL_LL_MODIFIER); newPtr += TCL_LL_MODIFIER_SIZE; #endif /* TCL_WIDE_INT_IS_LONG */ } format++; } else if (*format == 'h') { useShort = 1; *newPtr = 'h'; newPtr++; format++; } *newPtr = *format; newPtr++; *newPtr = 0; if (objIndex >= objc) { goto badIndex; } switch (*format) { case 'i': newPtr[-1] = 'd'; case 'd': case 'o': case 'u': case 'x': case 'X': case 'i': newPtr[-1] = 'd'; case 'd': case 'o': case 'u': case 'x': case 'X': #ifndef TCL_WIDE_INT_IS_LONG if (useWide) { if (Tcl_GetWideIntFromObj(interp, /* INTL: Tcl source. */ objv[objIndex], &wideValue) != TCL_OK) { goto fmtError; } whichValue = WIDE_VALUE; size = 40 + precision; break; } if (useWide) { if (Tcl_GetWideIntFromObj(interp, /* INTL: Tcl source. */ objv[objIndex], &wideValue) != TCL_OK) { goto fmtError; } whichValue = WIDE_VALUE; size = 40 + precision; break; } #endif /* TCL_WIDE_INT_IS_LONG */ if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */ objv[objIndex], &intValue) != TCL_OK) { if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */ objv[objIndex], &intValue) != TCL_OK) { if (Tcl_GetWideIntFromObj(interp, /* INTL: Tcl source. */ objv[objIndex], &wideValue) != TCL_OK) { goto fmtError; } intValue = Tcl_WideAsLong(wideValue); } #if (LONG_MAX > INT_MAX) if (!useShort) { /* * Add the 'l' for long format type because we are on * an LP64 archtecture and we are really going to pass * a long argument to sprintf. * Add the 'l' for long format type because we are on an * LP64 archtecture and we are really going to pass a long * argument to sprintf. * * Do not add this if we're going to pass in a short (i.e. * if we've got an 'h' modifier already in the string); some * libc implementations of sprintf() do not like it at all. * [Bug 1154163] */ newPtr++; *newPtr = 0; newPtr[-1] = newPtr[-2]; newPtr[-2] = 'l'; } #endif /* LONG_MAX > INT_MAX */ whichValue = INT_VALUE; size = 40 + precision; break; case 's': /* * Compute the length of the string in characters and add * any additional space required by the field width. All of * the extra characters will be spaces, so one byte per * character is adequate. */ whichValue = INT_VALUE; size = 40 + precision; break; case 's': /* * Compute the length of the string in characters and add * any additional space required by the field width. All * of the extra characters will be spaces, so one byte per * character is adequate. */ whichValue = STRING_VALUE; ptrValue = Tcl_GetStringFromObj(objv[objIndex], &size); stringLen = Tcl_NumUtfChars(ptrValue, size); if (gotPrecision && (precision < stringLen)) { stringLen = precision; } size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue; if (width > stringLen) { size += (width - stringLen); } break; case 'c': if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */ objv[objIndex], &intValue) != TCL_OK) { goto fmtError; } whichValue = CHAR_VALUE; size = width + TCL_UTF_MAX; break; case 'e': case 'E': case 'f': case 'g': case 'G': if (Tcl_GetDoubleFromObj(interp, /* INTL: Tcl source. */ objv[objIndex], &doubleValue) != TCL_OK) { goto fmtError; } whichValue = DOUBLE_VALUE; size = MAX_FLOAT_SIZE; if (precision > 10) { size += precision; } break; case 0: Tcl_SetResult(interp, "format string ended in middle of field specifier", TCL_STATIC); goto fmtError; default: { char buf[40]; sprintf(buf, "bad field specifier \"%c\"", *format); Tcl_SetResult(interp, buf, TCL_VOLATILE); goto fmtError; } whichValue = STRING_VALUE; ptrValue = Tcl_GetStringFromObj(objv[objIndex], &size); stringLen = Tcl_NumUtfChars(ptrValue, size); if (gotPrecision && (precision < stringLen)) { stringLen = precision; } size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue; if (width > stringLen) { size += (width - stringLen); } break; case 'c': if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */ objv[objIndex], &intValue) != TCL_OK) { goto fmtError; } whichValue = CHAR_VALUE; size = width + TCL_UTF_MAX; break; case 'e': case 'E': case 'f': case 'g': case 'G': if (Tcl_GetDoubleFromObj(interp, /* INTL: Tcl source. */ objv[objIndex], &doubleValue) != TCL_OK) { goto fmtError; } whichValue = DOUBLE_VALUE; size = MAX_FLOAT_SIZE; if (precision > 10) { size += precision; } break; case 0: Tcl_SetResult(interp, "format string ended in middle of field specifier", TCL_STATIC); goto fmtError; default: { char buf[40]; sprintf(buf, "bad field specifier \"%c\"", *format); Tcl_SetResult(interp, buf, TCL_VOLATILE); goto fmtError; } } objIndex++; format++; /* * Make sure that there's enough space to hold the formatted * result, then format it.
︙
2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393	2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 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 2451 2452 2453	- - - + + + - - - - - + + + - - - - - - - - - + + + + + + + - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + - - - - - - + + + + + + - - - - - - + + + + + + - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + - - - + + - + - - + + - - + + - - + + + + + + + + + + +	if (dst != staticBuf) { ckfree(dst); } dst = (char *) ckalloc((unsigned) (size + 1)); dstSize = size; } switch (whichValue) { case DOUBLE_VALUE: { sprintf(dst, newFormat, doubleValue); /* INTL: user locale. */ break; case DOUBLE_VALUE: sprintf(dst, newFormat, doubleValue); /* INTL: user locale. */ break; } #ifndef TCL_WIDE_INT_IS_LONG case WIDE_VALUE: { sprintf(dst, newFormat, wideValue); break; case WIDE_VALUE: sprintf(dst, newFormat, wideValue); break; } #endif /* TCL_WIDE_INT_IS_LONG */ case INT_VALUE: { if (useShort) { sprintf(dst, newFormat, (short) intValue); } else { sprintf(dst, newFormat, intValue); } break; case INT_VALUE: if (useShort) { sprintf(dst, newFormat, (short) intValue); } else { sprintf(dst, newFormat, intValue); } break; } case CHAR_VALUE: { char *ptr; char padChar = (gotZero ? '0' : ' '); ptr = dst; if (!gotMinus) { for ( ; --width > 0; ptr++) { *ptr = padChar; } } ptr += Tcl_UniCharToUtf(intValue, ptr); for ( ; --width > 0; ptr++) { *ptr = padChar; } *ptr = '\0'; break; } case STRING_VALUE: { char *ptr; char padChar = (gotZero ? '0' : ' '); int pad; case CHAR_VALUE: { char *ptr; char padChar = (gotZero ? '0' : ' '); ptr = dst; if (!gotMinus) { for ( ; --width > 0; ptr++) { *ptr = padChar; } } ptr += Tcl_UniCharToUtf(intValue, ptr); for ( ; --width > 0; ptr++) { *ptr = padChar; } *ptr = '\0'; break; } case STRING_VALUE: { char *ptr; char padChar = (gotZero ? '0' : ' '); int pad; ptr = dst; if (width > stringLen) { pad = width - stringLen; } else { pad = 0; } ptr = dst; if (width > stringLen) { pad = width - stringLen; } else { pad = 0; } if (!gotMinus) { while (pad > 0) { *ptr++ = padChar; pad--; } } if (!gotMinus) { while (pad > 0) { *ptr++ = padChar; pad--; } } size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue; if (size) { memcpy(ptr, ptrValue, (size_t) size); ptr += size; } while (pad > 0) { *ptr++ = padChar; pad--; } *ptr = '\0'; break; } default: { sprintf(dst, newFormat, ptrValue); break; size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue; if (size) { memcpy(ptr, ptrValue, (size_t) size); ptr += size; } while (pad > 0) { *ptr++ = padChar; pad--; } *ptr = '\0'; break; } default: sprintf(dst, newFormat, ptrValue); break; } } Tcl_AppendToObj(resultPtr, dst, -1); } } Tcl_SetObjResult(interp, resultPtr); if(dst != staticBuf) { ckfree(dst); if (dst != staticBuf) { ckfree(dst); } return TCL_OK; mixedXPG: Tcl_SetResult(interp, "cannot mix \"%\" and \"%n$\" conversion specifiers", TCL_STATIC); "cannot mix \"%\" and \"%n$\" conversion specifiers", TCL_STATIC); goto fmtError; badIndex: if (gotXpg) { Tcl_SetResult(interp, "\"%n$\" argument index out of range", TCL_STATIC); Tcl_SetResult(interp, "\"%n$\" argument index out of range", TCL_STATIC); } else { Tcl_SetResult(interp, "not enough arguments for all format specifiers", TCL_STATIC); Tcl_SetResult(interp, "not enough arguments for all format specifiers", TCL_STATIC); } fmtError: if(dst != staticBuf) { ckfree(dst); if (dst != staticBuf) { ckfree(dst); } Tcl_DecrRefCount(resultPtr); return TCL_ERROR; }  /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */

︙
11 12 13 14 15 16 17 18 19 20 21 22 23 24 25	11 12 13 14 15 16 17 18 19 20 21 22 23 24 25	- +	* Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclCmdIL.c,v 1.47 2003/02/27 16:01:55 dkf Exp $ * RCS: @(#) $Id: tclCmdIL.c,v 1.47.2.11 2007/03/10 14:57:38 dkf Exp $ */ #include "tclInt.h" #include "tclPort.h" #include "tclRegexp.h" /*
︙
105 106 107 108 109 110 111 112 113 114 115 116 117 118	105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124	+ + + + + +	Tcl_Obj *CONST objv[])); static int InfoDefaultCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int InfoExistsCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); #ifdef TCL_TIP280 /* TIP #280 - New 'info' subcommand 'frame' */ static int InfoFrameCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); #endif static int InfoFunctionsCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int InfoGlobalsCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int InfoHostnameCmd _ANSI_ARGS_((ClientData dummy,
︙
184 185 186 187 188 189 190 191 192 193 194 195 196 197	190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206	+ + +	Tcl_IfObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { int thenScriptIndex = 0; /* then script to be evaled after syntax check */ #ifdef TCL_TIP280 Interp* iPtr = (Interp*) interp; #endif int i, result, value; char *clause; i = 1; while (1) { /* * At this point in the loop, objv and objc refer to an expression * to test, either for the main expression or an expression
︙
236 237 238 239 240 241 242 243 244 245 246 247 248 249 250	245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265	+ + + + + +	* The expression evaluated to false. Skip the command, then * see if there is an "else" or "elseif" clause. */ i++; if (i >= objc) { if (thenScriptIndex) { #ifndef TCL_TIP280 return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0); #else /* TIP #280. Make invoking context available to branch */ return TclEvalObjEx(interp, objv[thenScriptIndex], 0, iPtr->cmdFramePtr,thenScriptIndex); #endif } return TCL_OK; } clause = Tcl_GetString(objv[i]); if ((clause[0] == 'e') && (strcmp(clause, "elseif") == 0)) { i++; continue;
︙
270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286	285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311	+ + + + + + + + + +	if (i < objc - 1) { Tcl_AppendResult(interp, "wrong # args: extra words after \"else\" clause in \"if\" command", (char *) NULL); return TCL_ERROR; } if (thenScriptIndex) { #ifndef TCL_TIP280 return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0); #else /* TIP #280. Make invoking context available to branch/else */ return TclEvalObjEx(interp, objv[thenScriptIndex], 0, iPtr->cmdFramePtr,thenScriptIndex); #endif } #ifndef TCL_TIP280 return Tcl_EvalObjEx(interp, objv[i], 0); #else return TclEvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr,i); #endif }  /* *---------------------------------------------------------------------- * * Tcl_IncrObjCmd -- *
︙
319 320 321 322 323 324 325 326 327 328 329 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 355 356 357 358 359 360 361 362	344 345 346 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	- - - + -	/* * Calculate the amount to increment by. */ if (objc == 2) { incrAmount = 1; } else { #ifdef TCL_WIDE_INT_IS_LONG if (Tcl_GetLongFromObj(interp, objv[2], &incrAmount) != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (reading increment)"); return TCL_ERROR; } #else /* * Need to be a bit cautious to ensure that [expr]-like rules * are enforced for interpretation of wide integers, despite * the fact that the underlying API itself is a 'long' only one. */ if (objv[2]->typePtr == &tclIntType) { incrAmount = objv[2]->internalRep.longValue; } else if (objv[2]->typePtr == &tclWideIntType) { incrAmount = Tcl_WideAsLong(objv[2]->internalRep.wideValue); TclGetLongFromWide(incrAmount,objv[2]); } else { Tcl_WideInt wide; if (Tcl_GetWideIntFromObj(interp, objv[2], &wide) != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (reading increment)"); return TCL_ERROR; } incrAmount = Tcl_WideAsLong(wide); if ((wide <= Tcl_LongAsWide(LONG_MAX)) && (wide >= Tcl_LongAsWide(LONG_MIN))) { objv[2]->typePtr = &tclIntType; objv[2]->internalRep.longValue = incrAmount; } } #endif } /* * Increment the variable's value. */ newValuePtr = TclIncrVar2(interp, objv[1], (Tcl_Obj *) NULL, incrAmount,
︙
396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419	418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449	- - - + + + + + + + - - + + + + + +	Tcl_InfoObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Arbitrary value passed to the command. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { static CONST char *subCmds[] = { "args", "body", "cmdcount", "commands", "complete", "default", "exists", "functions", "globals", "hostname", "level", "library", "loaded", "args", "body", "cmdcount", "commands", "complete", "default", "exists", #ifdef TCL_TIP280 "frame", #endif "functions", "globals", "hostname", "level", "library", "loaded", "locals", "nameofexecutable", "patchlevel", "procs", "script", "sharedlibextension", "tclversion", "vars", (char *) NULL}; enum ISubCmdIdx { IArgsIdx, IBodyIdx, ICmdCountIdx, ICommandsIdx, ICompleteIdx, IDefaultIdx, IExistsIdx, IFunctionsIdx, IGlobalsIdx, IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx, ICompleteIdx, IDefaultIdx, IExistsIdx, #ifdef TCL_TIP280 IFrameIdx, #endif IFunctionsIdx, IGlobalsIdx, IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx, ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx, IScriptIdx, ISharedLibExtensionIdx, ITclVersionIdx, IVarsIdx }; int index, result; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
︙
444 445 446 447 448 449 450 451 452 453 454 455 456 457	474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493	+ + + + + +	break; case IDefaultIdx: result = InfoDefaultCmd(clientData, interp, objc, objv); break; case IExistsIdx: result = InfoExistsCmd(clientData, interp, objc, objv); break; #ifdef TCL_TIP280 case IFrameIdx: /* TIP #280 - New method 'frame' */ result = InfoFrameCmd(clientData, interp, objc, objv); break; #endif case IFunctionsIdx: result = InfoFunctionsCmd(clientData, interp, objc, objv); break; case IGlobalsIdx: result = InfoGlobalsCmd(clientData, interp, objc, objv); break; case IHostnameIdx:
︙
733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757	769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827	+ + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + +	if (nsPtr != NULL) { /* we successfully found the pattern's ns */ specificNsInPattern = (strcmp(simplePattern, pattern) != 0); } } else { Tcl_WrongNumArgs(interp, 2, objv, "?pattern?"); return TCL_ERROR; } /* * Exit as quickly as possible if we couldn't find the namespace. */ if (nsPtr == NULL) { return TCL_OK; } /* * Scan through the effective namespace's command table and create a * list with all commands that match the pattern. If a specific * namespace was requested in the pattern, qualify the command names * with the namespace name. */ listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) { /* * Special case for when the pattern doesn't include any of * glob's special characters. This lets us avoid scans of any * hash tables. */ entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern); if (nsPtr != NULL) { if (entryPtr != NULL) { if (specificNsInPattern) { cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr); elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, cmd, elemObjPtr); } else { cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); elemObjPtr = Tcl_NewStringObj(cmdName, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) { entryPtr = Tcl_FindHashEntry(&globalNsPtr->cmdTable, simplePattern); if (entryPtr != NULL) { cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(cmdName, -1)); } } } else { entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { if (specificNsInPattern) { cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
︙
898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915	968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986	+ - - + +	"couldn't store default value in variable \"", varName, "\"", (char *) NULL); return TCL_ERROR; } Tcl_SetIntObj(Tcl_GetObjResult(interp), 1); } else { Tcl_Obj *nullObjPtr = Tcl_NewObj(); Tcl_IncrRefCount(nullObjPtr); valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL, nullObjPtr, 0); if (valueObjPtr == NULL) { Tcl_DecrRefCount(nullObjPtr); /* free unneeded obj */ Tcl_DecrRefCount(nullObjPtr); /* free unneeded obj */ if (valueObjPtr == NULL) { goto defStoreError; } Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); } return TCL_OK; } }
︙
960 961 962 963 964 965 966 967 968 969 970 971 972 973	1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	if ((varPtr != NULL) && !TclIsVarUndefined(varPtr)) { Tcl_SetIntObj(Tcl_GetObjResult(interp), 1); } else { Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); } return TCL_OK; }  #ifdef TCL_TIP280 /* *---------------------------------------------------------------------- * * InfoFrameCmd -- * TIP #280 * * Called to implement the "info frame" command that returns the * location of either the currently executing command, or its caller. * Handles the following syntax: * * info frame ?number? * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is * an error, the result is an error message. * *---------------------------------------------------------------------- */ static int InfoFrameCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { Interp *iPtr = (Interp *) interp; if (objc == 2) { /* just "info frame" */ int levels = (iPtr->cmdFramePtr == NULL ? 0 : iPtr->cmdFramePtr->level); Tcl_SetIntObj(Tcl_GetObjResult(interp), levels); return TCL_OK; } else if (objc == 3) { /* "info frame level" */ int level; CmdFrame *framePtr; if (Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) { return TCL_ERROR; } if (level <= 0) { /* Relative adressing */ if (iPtr->cmdFramePtr == NULL) { levelError: Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad level \"", Tcl_GetString(objv[2]), "\"", (char *) NULL); return TCL_ERROR; } /* Convert to absolute. */ level += iPtr->cmdFramePtr->level; } for (framePtr = iPtr->cmdFramePtr; framePtr != NULL; framePtr = framePtr->nextPtr) { if (framePtr->level == level) { break; } } if (framePtr == NULL) { goto levelError; } /* * Pull the information and construct the dictionary to return, as * list. Regarding use of the CmdFrame fields see tclInt.h, and its * definition. */ { Tcl_Obj* lv [20]; /* Keep uptodate when more keys are added to the dict */ int lc = 0; /* This array is indexed by the TCL_LOCATION_... values, except * for _LAST. */ static CONST char* typeString [TCL_LOCATION_LAST] = { "eval", "eval", "eval", "precompiled", "source", "proc" }; switch (framePtr->type) { case TCL_LOCATION_EVAL: /* Evaluation, dynamic script. Type, line, cmd, the latter * through str. */ lv [lc ++] = Tcl_NewStringObj ("type",-1); lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1); lv [lc ++] = Tcl_NewStringObj ("line",-1); lv [lc ++] = Tcl_NewIntObj (framePtr->line[0]); lv [lc ++] = Tcl_NewStringObj ("cmd",-1); lv [lc ++] = Tcl_NewStringObj (framePtr->cmd.str.cmd, framePtr->cmd.str.len); break; case TCL_LOCATION_EVAL_LIST: /* List optimized evaluation. Type, line, cmd, the latter * through listPtr, possibly a frame. */ lv [lc ++] = Tcl_NewStringObj ("type",-1); lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1); lv [lc ++] = Tcl_NewStringObj ("line",-1); lv [lc ++] = Tcl_NewIntObj (framePtr->line[0]); /* We put a duplicate of the command list obj into the result * to ensure that the 'pure List'-property of the command * itself is not destroyed. Otherwise the query here would * disable the list optimization path in Tcl_EvalObjEx. */ lv [lc ++] = Tcl_NewStringObj ("cmd",-1); lv [lc ++] = Tcl_DuplicateObj (framePtr->cmd.listPtr); break; case TCL_LOCATION_PREBC: /* Precompiled. Result contains the type as signal, nothing * else */ lv [lc ++] = Tcl_NewStringObj ("type",-1); lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1); break; case TCL_LOCATION_BC: { /* Execution of bytecode. Talk to the BC engine to fill out * the frame. */ CmdFrame f = *framePtr; Proc* procPtr = f.framePtr ? f.framePtr->procPtr : NULL; /* Note: Type BC => f.data.eval.path is not used. * f.data.tebc.codePtr is used instead. */ TclGetSrcInfoForPc (&f); /* Now filled: cmd.str.(cmd,len), line */ /* Possibly modified: type, path! */ lv [lc ++] = Tcl_NewStringObj ("type",-1); lv [lc ++] = Tcl_NewStringObj (typeString [f.type],-1); lv [lc ++] = Tcl_NewStringObj ("line",-1); lv [lc ++] = Tcl_NewIntObj (f.line[0]); if (f.type == TCL_LOCATION_SOURCE) { lv [lc ++] = Tcl_NewStringObj ("file",-1); lv [lc ++] = f.data.eval.path; /* Death of reference by TclGetSrcInfoForPc */ Tcl_DecrRefCount (f.data.eval.path); } lv [lc ++] = Tcl_NewStringObj ("cmd",-1); lv [lc ++] = Tcl_NewStringObj (f.cmd.str.cmd, f.cmd.str.len); if (procPtr != NULL) { Tcl_HashEntry* namePtr = procPtr->cmdPtr->hPtr; char* procName = Tcl_GetHashKey (namePtr->tablePtr, namePtr); char* nsName = procPtr->cmdPtr->nsPtr->fullName; lv [lc ++] = Tcl_NewStringObj ("proc",-1); lv [lc ++] = Tcl_NewStringObj (nsName,-1); if (strcmp (nsName, "::") != 0) { Tcl_AppendToObj (lv [lc-1], "::", -1); } Tcl_AppendToObj (lv [lc-1], procName, -1); } break; } case TCL_LOCATION_SOURCE: /* Evaluation of a script file */ lv [lc ++] = Tcl_NewStringObj ("type",-1); lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1); lv [lc ++] = Tcl_NewStringObj ("line",-1); lv [lc ++] = Tcl_NewIntObj (framePtr->line[0]); lv [lc ++] = Tcl_NewStringObj ("file",-1); lv [lc ++] = framePtr->data.eval.path; /* Refcount framePtr->data.eval.path goes up when lv * is converted into the result list object. */ lv [lc ++] = Tcl_NewStringObj ("cmd",-1); lv [lc ++] = Tcl_NewStringObj (framePtr->cmd.str.cmd, framePtr->cmd.str.len); break; case TCL_LOCATION_PROC: Tcl_Panic ("TCL_LOCATION_PROC found in standard frame"); break; } /* 'level'. Common to all frame types. Conditional on having an * associated _visible_ CallFrame */ if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) { CallFrame* current = framePtr->framePtr; CallFrame* top = iPtr->varFramePtr; CallFrame* idx; for (idx = top; idx != NULL; idx = idx->callerVarPtr) { if (idx == current) { int c = framePtr->framePtr->level; int t = iPtr->varFramePtr->level; lv [lc ++] = Tcl_NewStringObj ("level",-1); lv [lc ++] = Tcl_NewIntObj (t - c); break; } } } Tcl_SetObjResult(interp, Tcl_NewListObj (lc, lv)); return TCL_OK; } } Tcl_WrongNumArgs(interp, 2, objv, "?number?"); return TCL_ERROR; } #endif  /* *---------------------------------------------------------------------- * * InfoFunctionsCmd -- * * Called to implement the "info functions" command that returns the
︙
1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084	1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411	- + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - + + + + + + + + + + + + +	Tcl_HashSearch search; Var *varPtr; Tcl_Obj *listPtr; if (objc == 2) { pattern = NULL; } else if (objc == 3) { pattern = Tcl_GetString(objv[2]); pattern = Tcl_GetString(objv[2]); /* * Strip leading global-namespace qualifiers. [Bug 1057461] */ if (pattern[0] == ':' && pattern[1] == ':') { while (*pattern == ':') { pattern++; } } } else { Tcl_WrongNumArgs(interp, 2, objv, "?pattern?"); return TCL_ERROR; } /* * Scan through the global :: namespace's variable table and create a * list of all global variables that match the pattern. */ listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); if (pattern != NULL && TclMatchIsTrivial(pattern)) { entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable, pattern); if (entryPtr != NULL) { varPtr = (Var *) Tcl_GetHashValue(entryPtr); if (!TclIsVarUndefined(varPtr)) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(pattern, -1)); } } } else { for (entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search); entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) { varPtr = (Var *) Tcl_GetHashValue(entryPtr); if (TclIsVarUndefined(varPtr)) { continue; } varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr); if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(varName, -1)); } for (entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search); entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) { varPtr = (Var *) Tcl_GetHashValue(entryPtr); if (TclIsVarUndefined(varPtr)) { continue; } varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr); if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(varName, -1)); } } } Tcl_SetObjResult(interp, listPtr); return TCL_OK; }  /* *----------------------------------------------------------------------
︙
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	1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978	+ + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + - - - - + + + + + + + - -	if (nsPtr != NULL) { /* we successfully found the pattern's ns */ specificNsInPattern = (strcmp(simplePattern, pattern) != 0); } } else { Tcl_WrongNumArgs(interp, 2, objv, "?pattern?"); return TCL_ERROR; } if (nsPtr == NULL) { return TCL_OK; } /* * Scan through the effective namespace's command table and create a * list with all procs that match the pattern. If a specific * namespace was requested in the pattern, qualify the command names * with the namespace name. */ listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); #ifndef INFO_PROCS_SEARCH_GLOBAL_NS if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) { entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern); if (nsPtr != NULL) { if (entryPtr != NULL) { cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); if (!TclIsProc(cmdPtr)) { realCmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr); if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) { goto simpleProcOK; } } else { simpleProcOK: if (specificNsInPattern) { elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, elemObjPtr); } else { elemObjPtr = Tcl_NewStringObj(simplePattern, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } } } else #endif /* !INFO_PROCS_SEARCH_GLOBAL_NS */ { entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); if (!TclIsProc(cmdPtr)) { realCmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr); if (TclIsProc(cmdPtr) realCmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr); if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) { goto procOK; } } else { procOK: || ((realCmdPtr != NULL) && TclIsProc(realCmdPtr))) { if (specificNsInPattern) { elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, elemObjPtr); } else { elemObjPtr = Tcl_NewStringObj(cmdName, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } } entryPtr = Tcl_NextHashEntry(&search); } /*
︙
1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946	2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345	+ + + + + + - - - - - + + + + + - - - - + - + + + + + + + + + + - + - - - - + + + + - - - - + - - - + - - + - - + + - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	/* * There is no frame pointer, the frame pointer was pushed only * to activate a namespace, or we are in a procedure call frame * but a specific namespace was specified. Create a list containing * only the variables in the effective namespace's variable table. */ if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) { /* * If we can just do hash lookups, that simplifies things * a lot. */ entryPtr = Tcl_FirstHashEntry(&nsPtr->varTable, &search); while (entryPtr != NULL) { varPtr = (Var *) Tcl_GetHashValue(entryPtr); if (!TclIsVarUndefined(varPtr) || (varPtr->flags & VAR_NAMESPACE_VAR)) { entryPtr = Tcl_FindHashEntry(&nsPtr->varTable, simplePattern); if (entryPtr != NULL) { varPtr = (Var *) Tcl_GetHashValue(entryPtr); if (!TclIsVarUndefined(varPtr) || (varPtr->flags & VAR_NAMESPACE_VAR)) { varName = Tcl_GetHashKey(&nsPtr->varTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(varName, simplePattern)) { if (specificNsInPattern) { elemObjPtr = Tcl_NewObj(); Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, elemObjPtr); elemObjPtr); } else { elemObjPtr = Tcl_NewStringObj(varName, -1); elemObjPtr = Tcl_NewStringObj(simplePattern, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) { entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable, simplePattern); if (entryPtr != NULL) { varPtr = (Var *) Tcl_GetHashValue(entryPtr); if (!TclIsVarUndefined(varPtr) || (varPtr->flags & VAR_NAMESPACE_VAR)) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(simplePattern, -1)); } } entryPtr = Tcl_NextHashEntry(&search); } /* } } } else { /* * If the effective namespace isn't the global :: namespace, and a * specific namespace wasn't requested in the pattern (i.e., the * pattern only specifies variable names), then add in all global :: * variables that match the simple pattern. Of course, add in only * Have to scan the tables of variables. * those variables that aren't hidden by a variable in the effective * namespace. */ */ if ((nsPtr != globalNsPtr) && !specificNsInPattern) { entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search); entryPtr = Tcl_FirstHashEntry(&nsPtr->varTable, &search); while (entryPtr != NULL) { varPtr = (Var *) Tcl_GetHashValue(entryPtr); if (!TclIsVarUndefined(varPtr) || (varPtr->flags & VAR_NAMESPACE_VAR)) { varName = Tcl_GetHashKey(&globalNsPtr->varTable, || (varPtr->flags & VAR_NAMESPACE_VAR)) { varName = Tcl_GetHashKey(&nsPtr->varTable, entryPtr); entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(varName, simplePattern)) { if (Tcl_FindHashEntry(&nsPtr->varTable, varName) == NULL) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(varName, -1)); || Tcl_StringMatch(varName, simplePattern)) { if (specificNsInPattern) { elemObjPtr = Tcl_NewObj(); Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, elemObjPtr); } else { elemObjPtr = Tcl_NewStringObj(varName, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } } entryPtr = Tcl_NextHashEntry(&search); } /* * If the effective namespace isn't the global :: * namespace, and a specific namespace wasn't requested in * the pattern (i.e., the pattern only specifies variable * names), then add in all global :: variables that match * the simple pattern. Of course, add in only those * variables that aren't hidden by a variable in the * effective namespace. */ if ((nsPtr != globalNsPtr) && !specificNsInPattern) { entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search); while (entryPtr != NULL) { varPtr = (Var *) Tcl_GetHashValue(entryPtr); if (!TclIsVarUndefined(varPtr) || (varPtr->flags & VAR_NAMESPACE_VAR)) { varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(varName, simplePattern)) { if (Tcl_FindHashEntry(&nsPtr->varTable, varName) == NULL) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(varName, -1)); } } } entryPtr = Tcl_NextHashEntry(&search); } } } } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) { AppendLocals(interp, listPtr, simplePattern, 1); } Tcl_SetObjResult(interp, listPtr); return TCL_OK;
︙
2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907	3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321	- + + + + + + + + + + + + + + - - + + + +	} } } if ((enum modes) mode == REGEXP) { /* * We can shimmer regexp/list if listv[i] == pattern, so get the * regexp rep before the list rep. * regexp rep before the list rep. First time round, omit the interp * and hope that the compilation will succeed. If it fails, we'll * recompile in "expensive" mode with a place to put error messages. */ regexp = Tcl_GetRegExpFromObj(NULL, objv[objc - 1], TCL_REG_ADVANCED | TCL_REG_NOSUB); if (regexp == NULL) { /* * Failed to compile the RE. Try again without the TCL_REG_NOSUB * flag in case the RE had sub-expressions in it [Bug 1366683]. * If this fails, an error message will be left in the * interpreter. */ regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1], TCL_REG_ADVANCED | TCL_REG_NOSUB); regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1], TCL_REG_ADVANCED); } if (regexp == NULL) { if (startPtr) { Tcl_DecrRefCount(startPtr); } return TCL_ERROR; } }
︙
2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939	3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364	+ + + + + + + + - + + + +	*/ if (startPtr) { result = TclGetIntForIndex(interp, startPtr, listc-1, &offset); Tcl_DecrRefCount(startPtr); if (result != TCL_OK) { return result; } /* * If the search started past the end of the list, we just return a * "did not match anything at all" result straight away. [Bug 1374778] */ if (offset > listc-1) { if (allMatches || inlineReturn) { Tcl_ResetResult(interp); offset = listc-1; } else { Tcl_SetObjResult(interp, Tcl_NewIntObj(-1)); } return TCL_OK; } if (offset < 0) { offset = 0; } } patObj = objv[objc - 1];
︙
3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383	3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817	+ + + + + + + + +	goto done; } elementArray = (SortElement *) ckalloc(length * sizeof(SortElement)); for (i=0; i < length; i++){ elementArray[i].objPtr = listObjPtrs[i]; elementArray[i].count = 0; elementArray[i].nextPtr = &elementArray[i+1]; /* * When sorting using a command, we are reentrant and therefore might * have the representation of the list being sorted shimmered out from * underneath our feet. Increment the reference counts of the elements * to sort to prevent this. [Bug 1675116] */ Tcl_IncrRefCount(elementArray[i].objPtr); } elementArray[length-1].nextPtr = NULL; elementPtr = MergeSort(elementArray, &sortInfo); if (sortInfo.resultCode == TCL_OK) { /* * Note: must clear the interpreter's result object: it could * have been set by the -command script.
︙
3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408	3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845	+ + +	} else { for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){ Tcl_ListObjAppendElement(interp, resultPtr, elementPtr->objPtr); } } } for (i=0; i<length; i++) { Tcl_DecrRefCount(elementArray[i].objPtr); } ckfree((char*) elementArray); done: if (sortInfo.sortMode == SORTMODE_COMMAND) { Tcl_DecrRefCount(sortInfo.compareCmdPtr); sortInfo.compareCmdPtr = NULL; }
︙
3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712	4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149	- +	* Parse the result of the command. */ if (Tcl_GetIntFromObj(infoPtr->interp, Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) { Tcl_ResetResult(infoPtr->interp); Tcl_AppendToObj(Tcl_GetObjResult(infoPtr->interp), "-compare command returned non-numeric result", -1); "-compare command returned non-integer result", -1); infoPtr->resultCode = TCL_ERROR; return order; } } if (!infoPtr->isIncreasing) { order = -order; }
︙
3840 3841 3842 3843 3844 3845 3846	4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292	+ + + + + + + + +	} } if (diff == 0) { diff = secondaryDiff; } return diff; }  /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */

︙
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	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	- + + - + + + + + +	* Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Scriptics Corporation. * Copyright (c) 2002 ActiveState Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclCmdMZ.c,v 1.82 2003/02/27 00:54:36 hobbs Exp $ * RCS: @(#) $Id: tclCmdMZ.c,v 1.82.2.28 2007/05/10 18:23:58 dgp Exp $ */ #include "tclInt.h" #include "tclPort.h" #include "tclRegexp.h" #include "tclCompile.h" /* * Structure used to hold information about variable traces: * Structures used to hold information about variable traces: */ typedef struct { int flags; /* Operations for which Tcl command is * to be invoked. */ size_t length; /* Number of non-NULL chars. in command. */ char command[4]; /* Space for Tcl command to invoke. Actual * size will be as large as necessary to * hold command. This field must be the * last in the structure, so that it can * be larger than 4 bytes. */ } TraceVarInfo; typedef struct { VarTrace trace; TraceVarInfo tvar; } CompoundVarTrace; /* * Structure used to hold information about command traces: */ typedef struct { int flags; /* Operations for which Tcl command is * to be invoked. */
︙
128 129 130 131 132 133 134 135 136 137 138 139 140 141	134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151	+ + + +	Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags)); static void TraceCommandProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, CONST char *oldName, CONST char *newName, int flags)); static Tcl_CmdObjTraceProc TraceExecutionProc; #ifdef TCL_TIP280 static void ListLines _ANSI_ARGS_((CONST char* listStr, int line, int n, int* lines)); #endif /* *---------------------------------------------------------------------- * * Tcl_PwdObjCmd -- * * This procedure is invoked to process the "pwd" Tcl command. * See the user documentation for details on what it does.
︙
364 365 366 367 368 369 370 371 372 373 374 375 376 377 378	374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391	- + + + +	* hasn't been specified then the loop body only gets executed once. * We terminate the loop when the starting offset is past the end of the * string. */ while (1) { match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset /* offset */, numMatchesSaved, eflags); offset /* offset */, numMatchesSaved, eflags | ((offset > 0 && (Tcl_GetUniChar(objPtr,offset-1) != (Tcl_UniChar)'\n')) ? TCL_REG_NOTBOL : 0)); if (match < 0) { return TCL_ERROR; } if (match == 0) { /*
︙
453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469	466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483	+ - - + +	if (Tcl_ListObjAppendElement(interp, resultPtr, newPtr) != TCL_OK) { Tcl_DecrRefCount(newPtr); return TCL_ERROR; } } else { Tcl_Obj *valuePtr; Tcl_IncrRefCount(newPtr); valuePtr = Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr, 0); if (valuePtr == NULL) { Tcl_DecrRefCount(newPtr); Tcl_DecrRefCount(newPtr); if (valuePtr == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", Tcl_GetString(objv[i]), "\"", (char *) NULL); return TCL_ERROR; } } }
︙
715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741	729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760	- + + + + - + - + + +	result = TCL_OK; /* * The following loop is to handle multiple matches within the * same source string; each iteration handles one match and its * corresponding substitution. If "-all" hasn't been specified * then the loop body only gets executed once. * then the loop body only gets executed once. We must use * 'offset <= wlen' in particular for the case where the regexp * pattern can match the empty string - this is useful when * doing, say, 'regsub -- ^ $str ...' when $str might be empty. */ numMatches = 0; for ( ; offset < wlen; ) { for ( ; offset <= wlen; ) { /* * The flags argument is set if string is part of a larger string, * so that "^" won't match. */ match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset, 10 /* matches */, ((offset > 0) ? TCL_REG_NOTBOL : 0)); 10 /* matches */, ((offset > 0 && (wstring[offset-1] != (Tcl_UniChar)'\n')) ? TCL_REG_NOTBOL : 0)); if (match < 0) { result = TCL_ERROR; goto done; } if (match == 0) { break;
︙
815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832	834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864	+ - + + + + + + + + + + + + +	} if (end == 0) { /* * Always consume at least one character of the input string * in order to prevent infinite loops. */ if (offset < wlen) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } else { offset += end; if (start == end) { /* * We matched an empty string, which means we must go * forward one more step so we don't match again at the * same spot. */ if (offset < wlen) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } } if (!all) { break; } } /*
︙
1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587	1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613	- - + - - - - - - +	break; } } break; case STR_IS_BOOL: case STR_IS_TRUE: case STR_IS_FALSE: if (objPtr->typePtr == &tclBooleanType) { if ((((enum isOptions) index == STR_IS_TRUE) && /* Optimizers, beware Bug 1187123 ! */ objPtr->internalRep.longValue == 0) || (((enum isOptions) index == STR_IS_FALSE) && objPtr->internalRep.longValue != 0)) { result = 0; } } else if ((Tcl_GetBoolean(NULL, string1, &i) if ((Tcl_GetBoolean(NULL, string1, &i) == TCL_ERROR) || (((enum isOptions) index == STR_IS_TRUE) && i == 0) || (((enum isOptions) index == STR_IS_FALSE) && i != 0)) { result = 0; }
︙
1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692	1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716	+ - - + + - + - - + - - - - + +	break; } case STR_IS_GRAPH: chcomp = Tcl_UniCharIsGraph; break; case STR_IS_INT: { char *stop; long int l = 0; if ((objPtr->typePtr == &tclIntType) || (Tcl_GetInt(NULL, string1, &i) == TCL_OK)) { if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &i)) { break; } /* * Like STR_IS_DOUBLE, but we use strtoul. * Since Tcl_GetIntFromObj already failed, * Since Tcl_GetInt already failed, we set result to 0. * we set result to 0. */ result = 0; errno = 0; #ifdef TCL_WIDE_INT_IS_LONG strtoul(string1, &stop, 0); /* INTL: Tcl source. */ l = strtol(string1, &stop, 0); /* INTL: Tcl source. */ #else strtoull(string1, &stop, 0); /* INTL: Tcl source. */ #endif if (errno == ERANGE) { if ((errno == ERANGE) || (l > INT_MAX) || (l < INT_MIN)) { /* * if (errno == ERANGE), then it was an over/underflow * problem, but in this method, we only want to know * yes or no, so bad flow returns 0 (false) and sets * the failVarObj to the string length. */ failat = -1; } else if (stop == string1) { /* * In this case, nothing like a number was found */ failat = 0; } else { /*
︙
1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757	1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787	- - - - + + + + + + + + + +	} } str_is_done: /* * Only set the failVarObj when we will return 0 * and we have indicated a valid fail index (>= 0) */ if ((result == 0) && (failVarObj != NULL) && Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(failat), TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; if ((result == 0) && (failVarObj != NULL)) { Tcl_Obj *resPtr, *tmpPtr = Tcl_NewIntObj(failat); Tcl_IncrRefCount(tmpPtr); resPtr = Tcl_ObjSetVar2(interp, failVarObj, NULL, tmpPtr, TCL_LEAVE_ERR_MSG); Tcl_DecrRefCount(tmpPtr); if (resPtr == NULL) { return TCL_ERROR; } } Tcl_SetBooleanObj(resultPtr, result); break; } case STR_LAST: { Tcl_UniChar *ustring1, *ustring2, *p; int match, start;
︙
1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849	1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879	- - + +	length1 = Tcl_GetCharLength(objv[2]); } } Tcl_SetIntObj(resultPtr, length1); break; } case STR_MAP: { int mapElemc, nocase = 0; Tcl_Obj **mapElemv; int mapElemc, nocase = 0, copySource = 0; Tcl_Obj **mapElemv, *sourceObj; Tcl_UniChar *ustring1, *ustring2, *p, *end; int (*strCmpFn)_ANSI_ARGS_((CONST Tcl_UniChar*, CONST Tcl_UniChar*, unsigned long)); if (objc < 4 || objc > 5) { Tcl_WrongNumArgs(interp, 2, objv, "?-nocase? charMap string"); return TCL_ERROR;
︙
1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895	1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938	- - - + + + + + + + + + + + + + + + +	} else if (mapElemc & 1) { /* * The charMap must be an even number of key/value items */ Tcl_SetStringObj(resultPtr, "char map list unbalanced", -1); return TCL_ERROR; } objc--; ustring1 = Tcl_GetUnicodeFromObj(objv[objc], &length1); /* * Take a copy of the source string object if it is the * same as the map string to cut out nasty sharing * crashes. [Bug 1018562] */ if (objv[objc-2] == objv[objc-1]) { sourceObj = Tcl_DuplicateObj(objv[objc-1]); copySource = 1; } else { sourceObj = objv[objc-1]; } ustring1 = Tcl_GetUnicodeFromObj(sourceObj, &length1); if (length1 == 0) { /* * Empty input string, just stop now */ if (copySource) { Tcl_DecrRefCount(sourceObj); } break; } end = ustring1 + length1; strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp; /*
︙
1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919	1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963	- + +	* This will be >30% faster on larger strings. */ int mapLen; Tcl_UniChar *mapString, u2lc; ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2); p = ustring1; if (length2 == 0) { if ((length2 > length1) || (length2 == 0)) { /* match string is either longer than input or empty */ ustring1 = end; } else { mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen); u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0); for (; ustring1 < end; ustring1++) { if (((*ustring1 == *ustring2) || (nocase && (Tcl_UniCharToLower(*ustring1) ==
︙
1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976	2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022	+ +	* Get the key string to match on. */ ustring2 = mapStrings[index]; length2 = mapLens[index]; if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase && (Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) && /* restrict max compare length */ ((end - ustring1) >= length2) && ((length2 == 1) || strCmpFn(ustring2, ustring1, (unsigned long) length2) == 0)) { if (p != ustring1) { /* * Put the skipped chars onto the result first */ Tcl_AppendUnicodeToObj(resultPtr, p,
︙
2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014	2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063	+ + +	} if (p != ustring1) { /* * Put the rest of the unmapped chars onto result */ Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p); } if (copySource) { Tcl_DecrRefCount(sourceObj); } break; } case STR_MATCH: { Tcl_UniChar *ustring1, *ustring2; int nocase = 0; if (objc < 4 || objc > 5) {
︙
2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117	2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175	+ + + + + + + + +	} else if (count > 1) { string1 = Tcl_GetStringFromObj(objv[2], &length1); if (length1 > 0) { /* * Only build up a string that has data. Instead of * building it up with repeated appends, we just allocate * the necessary space once and copy the string value in. * Check for overflow with back-division. [Bug #714106] */ length2 = length1 * count; if ((length2 / count) != length1) { char buf[TCL_INTEGER_SPACE+1]; sprintf(buf, "%d", INT_MAX); Tcl_AppendStringsToObj(resultPtr, "string size overflow, must be less than ", buf, (char *) NULL); return TCL_ERROR; } /* * Include space for the NULL */ string2 = (char *) ckalloc((size_t) length2+1); for (index = 0; index < count; index++) { memcpy(string2 + (length1 * index), string1, (size_t) length1);
︙
2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560	2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613	+ - + - + - - - - - - - + - +	Tcl_SubstObj(interp, objPtr, flags) Tcl_Interp *interp; Tcl_Obj *objPtr; int flags; { Tcl_Obj *resultObj; char *p, *old; int length; old = p = Tcl_GetString(objPtr); old = p = Tcl_GetStringFromObj(objPtr, &length); resultObj = Tcl_NewStringObj("", 0); while (1) { while (length) { switch (*p) { case 0: if (p != old) { Tcl_AppendToObj(resultObj, old, p-old); } return resultObj; case '\\': if (flags & TCL_SUBST_BACKSLASHES) { char buf[TCL_UTF_MAX]; int count; if (p != old) { Tcl_AppendToObj(resultObj, old, p-old); } Tcl_AppendToObj(resultObj, buf, Tcl_UtfBackslash(p, &count, buf)); p += count; p += count; length -= count; old = p; } else { p++; p++; length--; } break; case '$': if (flags & TCL_SUBST_VARIABLES) { Tcl_Parse parse; int code;
︙
2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643	2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 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 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707	- + + - + + + + - + + + + - + - + + + + +	goto errorResult; } if (parse.numTokens == 1) { /* * There isn't a variable name after all: the $ is * just a $. */ p++; p++; length--; break; } if (p != old) { Tcl_AppendToObj(resultObj, old, p-old); } p += parse.tokenPtr->size; length -= parse.tokenPtr->size; code = Tcl_EvalTokensStandard(interp, parse.tokenPtr, parse.numTokens); if (code == TCL_ERROR) { goto errorResult; } if (code == TCL_BREAK) { Tcl_ResetResult(interp); return resultObj; } if (code != TCL_CONTINUE) { Tcl_AppendObjToObj(resultObj, Tcl_GetObjResult(interp)); } Tcl_ResetResult(interp); old = p; } else { p++; p++; length--; } break; case '[': if (flags & TCL_SUBST_COMMANDS) { Interp *iPtr = (Interp *) interp; int code; if (p != old) { Tcl_AppendToObj(resultObj, old, p-old); } iPtr->evalFlags = TCL_BRACKET_TERM; iPtr->numLevels++; code = TclInterpReady(interp); if (code == TCL_OK) { code = Tcl_EvalEx(interp, p+1, -1, 0); code = Tcl_EvalEx(interp, p+1, -1, 0); } iPtr->numLevels--; switch (code) { case TCL_ERROR: goto errorResult; case TCL_BREAK: Tcl_ResetResult(interp); return resultObj; default: Tcl_AppendObjToObj(resultObj, Tcl_GetObjResult(interp)); case TCL_CONTINUE: Tcl_ResetResult(interp); old = p = (p+1 + iPtr->termOffset + 1); length -= (iPtr->termOffset + 2); } } else { p++; p++; length--; } break; default: p++; p++; length--; break; } } if (p != old) { Tcl_AppendToObj(resultObj, old, p-old); } return resultObj; errorResult: Tcl_DecrRefCount(resultObj); return NULL; }  /*
︙
2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678	2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751	+ + + + + + + + +	int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { int i, j, index, mode, matched, result, splitObjs; char *string, *pattern; Tcl_Obj *stringObj; Tcl_Obj *CONST *savedObjv = objv; #ifdef TCL_TIP280 Interp* iPtr = (Interp*) interp; int pc = 0; int bidx = 0; /* Index of body argument */ Tcl_Obj* blist = NULL; /* List obj which is the body */ CmdFrame ctx; /* Copy of the topmost cmdframe, * to allow us to mess with the * line information */ #endif static CONST char *options[] = { "-exact", "-glob", "-regexp", "--", NULL }; enum options { OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_LAST };
︙
2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722	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	+ + + + + + + - + + +	"?switches? string pattern body ... ?default body?"); return TCL_ERROR; } stringObj = objv[i]; objc -= i + 1; objv += i + 1; #ifdef TCL_TIP280 bidx = i+1; /* First after the match string */ #endif /* * If all of the pattern/command pairs are lumped into a single * argument, split them out again. * * TIP #280: Determine the lines the words in the list start at, based on * the same data for the list word itself. The cmdFramePtr line information * is manipulated directly. */ splitObjs = 0; if (objc == 1) { Tcl_Obj **listv; #ifdef TCL_TIP280 blist = objv[0]; #endif if (Tcl_ListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK) { return TCL_ERROR; } /* * Ensure that the list is non-empty. */
︙
2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835	2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 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 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	if (matched == 0) { continue; } /* * We've got a match. Find a body to execute, skipping bodies * that are "-". * * TIP#280: Now is also the time to determine a line number for the * single-word case. */ #ifdef TCL_TIP280 ctx = *iPtr->cmdFramePtr; if (splitObjs) { /* We have to perform the GetSrc and other type dependent handling * of the frame here because we are munging with the line numbers, * something the other commands like if, etc. are not doing. Them * are fine with simply passing the CmdFrame through and having * the special handling done in 'info frame', or the bc compiler */ if (ctx.type == TCL_LOCATION_BC) { /* Note: Type BC => ctx.data.eval.path is not used. * ctx.data.tebc.codePtr is used instead. */ TclGetSrcInfoForPc (&ctx); pc = 1; /* The line information in the cmdFrame is now a copy we do * not own */ } if (ctx.type == TCL_LOCATION_SOURCE) { int bline = ctx.line [bidx]; if (bline >= 0) { ctx.line = (int*) ckalloc (objc * sizeof(int)); ctx.nline = objc; ListLines (Tcl_GetString (blist), bline, objc, ctx.line); } else { int k; /* Dynamic code word ... All elements are relative to themselves */ ctx.line = (int*) ckalloc (objc * sizeof(int)); ctx.nline = objc; for (k=0; k < objc; k++) {ctx.line[k] = -1;} } } else { int k; /* Anything else ... No information, or dynamic ... */ ctx.line = (int*) ckalloc (objc * sizeof(int)); ctx.nline = objc; for (k=0; k < objc; k++) {ctx.line[k] = -1;} } } #endif for (j = i + 1; ; j += 2) { if (j >= objc) { /* * This shouldn't happen since we've checked that the * last body is not a continuation... */ panic("fall-out when searching for body to match pattern"); } if (strcmp(Tcl_GetString(objv[j]), "-") != 0) { break; } } #ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, objv[j], 0); #else /* TIP #280. Make invoking context available to switch branch */ result = TclEvalObjEx(interp, objv[j], 0, &ctx, j); if (splitObjs) { ckfree ((char*) ctx.line); if (pc && (ctx.type == TCL_LOCATION_SOURCE)) { /* Death of SrcInfo reference */ Tcl_DecrRefCount (ctx.data.eval.path); } } #endif if (result == TCL_ERROR) { char msg[100 + TCL_INTEGER_SPACE]; sprintf(msg, "\n (\"%.50s\" arm line %d)", pattern, interp->errorLine); Tcl_AddObjErrorInfo(interp, msg, -1); }
︙
2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878	3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022	+ -	Tcl_TimeObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { register Tcl_Obj *objPtr; Tcl_Obj *objs[4]; register int i, result; int count; double totalMicroSec; Tcl_Time start, stop; char buf[100]; if (objc == 2) { count = 1; } else if (objc == 3) { result = Tcl_GetIntFromObj(interp, objv[2], &count); if (result != TCL_OK) { return result;
︙
2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908	3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058	- - - - + + + + + + + + + +	return result; } } Tcl_GetTime(&stop); totalMicroSec = ( ( (double) ( stop.sec - start.sec ) ) * 1.0e6 + ( stop.usec - start.usec ) ); sprintf(buf, "%.0f microseconds per iteration", ((count <= 0) ? 0 : totalMicroSec/count)); Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1); if (count <= 1) { /* Use int obj since we know time is not fractional [Bug 1202178] */ objs[0] = Tcl_NewIntObj((count <= 0) ? 0 : (int) totalMicroSec); } else { objs[0] = Tcl_NewDoubleObj(totalMicroSec/count); } objs[1] = Tcl_NewStringObj("microseconds", -1); objs[2] = Tcl_NewStringObj("per", -1); objs[3] = Tcl_NewStringObj("iteration", -1); Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs)); return TCL_OK; }  /* *---------------------------------------------------------------------- * * Tcl_TraceObjCmd --
︙
2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943	3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092	- - + + -	int Tcl_TraceObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { int optionIndex, commandLength; char *name, *flagOps, *command, *p; int optionIndex; char *name, *flagOps, *p; size_t length; /* Main sub commands to 'trace' */ static CONST char *traceOptions[] = { "add", "info", "remove", #ifndef TCL_REMOVE_OBSOLETE_TRACES "variable", "vdelete", "vinfo", #endif (char *) NULL
︙
2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 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 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089	3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184	- - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - + - - - - + + + + + + + - + + - + + - - - - - - - - + - - - - + - - - - + + - - + + + + + - - - - - - - - - - - - - - - - + + + + + + + + + - +	return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions, "option", 0, &typeIndex) != TCL_OK) { return TCL_ERROR; } return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv); break; } #ifndef TCL_REMOVE_OBSOLETE_TRACES case TRACE_OLD_VARIABLE: { case TRACE_OLD_VARIABLE: int flags; TraceVarInfo *tvarPtr; if (objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "name ops command"); return TCL_ERROR; } flags = 0; flagOps = Tcl_GetString(objv[3]); for (p = flagOps; *p != 0; p++) { if (*p == 'r') { flags |= TCL_TRACE_READS; } else if (*p == 'w') { flags |= TCL_TRACE_WRITES; } else if (*p == 'u') { flags |= TCL_TRACE_UNSETS; } else if (*p == 'a') { flags |= TCL_TRACE_ARRAY; } else { goto badVarOps; } } if (flags == 0) { goto badVarOps; } flags |= TCL_TRACE_OLD_STYLE; command = Tcl_GetStringFromObj(objv[4], &commandLength); length = (size_t) commandLength; tvarPtr = (TraceVarInfo *) ckalloc((unsigned) (sizeof(TraceVarInfo) - sizeof(tvarPtr->command) + length + 1)); tvarPtr->flags = flags; tvarPtr->length = length; flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT; strcpy(tvarPtr->command, command); name = Tcl_GetString(objv[2]); if (Tcl_TraceVar(interp, name, flags, TraceVarProc, (ClientData) tvarPtr) != TCL_OK) { ckfree((char *) tvarPtr); return TCL_ERROR; } break; } case TRACE_OLD_VDELETE: { Tcl_Obj *copyObjv[6]; Tcl_Obj *opsList; int flags; int code, numFlags; TraceVarInfo *tvarPtr; ClientData clientData; if (objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "name ops command"); return TCL_ERROR; } flags = 0; flagOps = Tcl_GetString(objv[3]); opsList = Tcl_NewObj(); Tcl_IncrRefCount(opsList); flagOps = Tcl_GetStringFromObj(objv[3], &numFlags); if (numFlags == 0) { Tcl_DecrRefCount(opsList); goto badVarOps; } for (p = flagOps; *p != 0; p++) { if (*p == 'r') { flags |= TCL_TRACE_READS; Tcl_ListObjAppendElement(NULL, opsList, Tcl_NewStringObj("read", -1)); } else if (*p == 'w') { flags |= TCL_TRACE_WRITES; Tcl_ListObjAppendElement(NULL, opsList, Tcl_NewStringObj("write", -1)); } else if (*p == 'u') { flags |= TCL_TRACE_UNSETS; } else if (*p == 'a') { flags |= TCL_TRACE_ARRAY; } else { goto badVarOps; } } if (flags == 0) { Tcl_ListObjAppendElement(NULL, opsList, goto badVarOps; } flags |= TCL_TRACE_OLD_STYLE; Tcl_NewStringObj("unset", -1)); /* * Search through all of our traces on this variable to * see if there's one with the given command. If so, then * delete the first one that matches. } else if (*p == 'a') { Tcl_ListObjAppendElement(NULL, opsList, */ Tcl_NewStringObj("array", -1)); } else { Tcl_DecrRefCount(opsList); goto badVarOps; } command = Tcl_GetStringFromObj(objv[4], &commandLength); length = (size_t) commandLength; clientData = 0; name = Tcl_GetString(objv[2]); while ((clientData = Tcl_VarTraceInfo(interp, name, 0, TraceVarProc, clientData)) != 0) { tvarPtr = (TraceVarInfo *) clientData; if ((tvarPtr->length == length) && (tvarPtr->flags == flags) && (strncmp(command, tvarPtr->command, (size_t) length) == 0)) { Tcl_UntraceVar2(interp, name, NULL, flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT, TraceVarProc, clientData); Tcl_EventuallyFree((ClientData) tvarPtr, TCL_DYNAMIC); break; } } copyObjv[0] = NULL; memcpy(copyObjv+1, objv, objc*sizeof(Tcl_Obj *)); copyObjv[4] = opsList; if (optionIndex == TRACE_OLD_VARIABLE) { code = (traceSubCmds[2])(interp,TRACE_ADD,objc+1,copyObjv); } else { code = (traceSubCmds[2])(interp,TRACE_REMOVE,objc+1,copyObjv); } Tcl_DecrRefCount(opsList); break; return code; } case TRACE_OLD_VINFO: { ClientData clientData; char ops[5]; Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr; if (objc != 3) {
︙
3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251	3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348	- - + + + +	tcmdPtr->flags = flags; tcmdPtr->stepTrace = NULL; tcmdPtr->startLevel = 0; tcmdPtr->startCmd = NULL; tcmdPtr->length = length; tcmdPtr->refCount = 1; flags |= TCL_TRACE_DELETE; if (flags & (TRACE_EXEC_ENTER_STEP | TRACE_EXEC_LEAVE_STEP)) { flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC); if (flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC)) { flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC); } strcpy(tcmdPtr->command, command); name = Tcl_GetString(objv[3]); if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc, (ClientData) tcmdPtr) != TCL_OK) { ckfree((char *) tcmdPtr); return TCL_ERROR;
︙
3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314	3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415	- - + + - + + + + +	if ((tcmdPtr->length == length) && ((tcmdPtr->flags & (TCL_TRACE_ANY_EXEC | TCL_TRACE_RENAME | TCL_TRACE_DELETE)) == flags) && (strncmp(command, tcmdPtr->command, (size_t) length) == 0)) { flags |= TCL_TRACE_DELETE; if (flags & (TRACE_EXEC_ENTER_STEP | TRACE_EXEC_LEAVE_STEP)) { if (flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC)) { flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC); } Tcl_UntraceCommand(interp, name, flags, TraceCommandProc, clientData); if (tcmdPtr->stepTrace != NULL) { /* * We need to remove the interpreter-wide trace * which we created to allow 'step' traces. */ Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; if (tcmdPtr->startCmd != NULL) { ckfree((char *)tcmdPtr->startCmd); } } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* Postpone deletion */ tcmdPtr->flags = 0; } if ((--tcmdPtr->refCount) <= 0) { tcmdPtr->refCount--; if (tcmdPtr->refCount < 0) { Tcl_Panic("TclTraceExecutionObjCmd: negative TraceCommandInfo refCount"); } if (tcmdPtr->refCount == 0) { ckfree((char*)tcmdPtr); } break; } } } break;
︙
3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372	3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 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	+ - - + + + + + + + +	TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } resultListPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, TraceCommandProc, clientData)) != NULL) { int numOps = 0; TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData; eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); /* * Build a list with the ops list as the first obj * element and the tcmdPtr->command string as the * second obj element. Append this list (as an * element) to the end of the result object list. */ elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); Tcl_IncrRefCount(elemObjPtr); if (tcmdPtr->flags & TCL_TRACE_ENTER_EXEC) { Tcl_ListObjAppendElement(NULL, elemObjPtr, Tcl_NewStringObj("enter",5)); } if (tcmdPtr->flags & TCL_TRACE_LEAVE_EXEC) { Tcl_ListObjAppendElement(NULL, elemObjPtr, Tcl_NewStringObj("leave",5)); } if (tcmdPtr->flags & TCL_TRACE_ENTER_DURING_EXEC) { Tcl_ListObjAppendElement(NULL, elemObjPtr, Tcl_NewStringObj("enterstep",9)); } if (tcmdPtr->flags & TCL_TRACE_LEAVE_DURING_EXEC) { Tcl_ListObjAppendElement(NULL, elemObjPtr, Tcl_NewStringObj("leavestep",9)); } Tcl_ListObjLength(NULL, elemObjPtr, &numOps); if (0 == numOps) { Tcl_DecrRefCount(elemObjPtr); continue; } eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr); Tcl_DecrRefCount(elemObjPtr); elemObjPtr = NULL; Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, Tcl_NewStringObj(tcmdPtr->command, -1)); Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr); }
︙
3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509	3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621	- + + + + +	&& (tcmdPtr->flags == flags) && (strncmp(command, tcmdPtr->command, (size_t) length) == 0)) { Tcl_UntraceCommand(interp, name, flags | TCL_TRACE_DELETE, TraceCommandProc, clientData); tcmdPtr->flags |= TCL_TRACE_DESTROYED; if ((--tcmdPtr->refCount) <= 0) { tcmdPtr->refCount--; if (tcmdPtr->refCount < 0) { Tcl_Panic("TclTraceCommandObjCmd: negative TraceCommandInfo refCount"); } if (tcmdPtr->refCount == 0) { ckfree((char *) tcmdPtr); } break; } } } break;
︙
3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559	3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678	+ - - + + + + + + + +	TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } resultListPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, TraceCommandProc, clientData)) != NULL) { int numOps = 0; TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData; eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); /* * Build a list with the ops list as * the first obj element and the tcmdPtr->command string * as the second obj element. Append this list (as an * element) to the end of the result object list. */ elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); Tcl_IncrRefCount(elemObjPtr); if (tcmdPtr->flags & TCL_TRACE_RENAME) { Tcl_ListObjAppendElement(NULL, elemObjPtr, Tcl_NewStringObj("rename",6)); } if (tcmdPtr->flags & TCL_TRACE_DELETE) { Tcl_ListObjAppendElement(NULL, elemObjPtr, Tcl_NewStringObj("delete",6)); } Tcl_ListObjLength(NULL, elemObjPtr, &numOps); if (0 == numOps) { Tcl_DecrRefCount(elemObjPtr); continue; } eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr); Tcl_DecrRefCount(elemObjPtr); elemObjPtr = Tcl_NewStringObj(tcmdPtr->command, -1); Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr); Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr); } Tcl_SetObjResult(interp, resultListPtr);
︙
3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692	3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841	+ + + + + + + + + + + + - - + + + + + + + + - - - + + + + + + + + + + + + + + + + - + -	flags |= TCL_TRACE_WRITES; break; } } command = Tcl_GetStringFromObj(objv[5], &commandLength); length = (size_t) commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { /* * This code essentially mallocs together the VarTrace and the * TraceVarInfo, then inlines the Tcl_TraceVar(). This is * necessary in order to have the TraceVarInfo to be freed * automatically when the VarTrace is freed [Bug 1348775] */ CompoundVarTrace *compTracePtr; TraceVarInfo *tvarPtr; Var *varPtr, *arrayPtr; VarTrace *tracePtr; int flagMask; tvarPtr = (TraceVarInfo *) ckalloc((unsigned) (sizeof(TraceVarInfo) - sizeof(tvarPtr->command) compTracePtr = (CompoundVarTrace *) ckalloc((unsigned) (sizeof(CompoundVarTrace) - sizeof(tvarPtr->command) + length + 1)); tracePtr = &(compTracePtr->trace); tvarPtr = &(compTracePtr->tvar); tvarPtr->flags = flags; if (objv[0] == NULL) { tvarPtr->flags |= TCL_TRACE_OLD_STYLE; } tvarPtr->length = length; flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT; strcpy(tvarPtr->command, command); name = Tcl_GetString(objv[3]); flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY; if (Tcl_TraceVar(interp, name, flags, TraceVarProc, (ClientData) tvarPtr) != TCL_OK) { ckfree((char *) tvarPtr); varPtr = TclLookupVar(interp, name, NULL, (flags & flagMask) | TCL_LEAVE_ERR_MSG, "trace", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { ckfree((char *) tracePtr); return TCL_ERROR; } flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT; #ifndef TCL_REMOVE_OBSOLETE_TRACES flagMask |= TCL_TRACE_OLD_STYLE; #endif tracePtr->traceProc = TraceVarProc; tracePtr->clientData = (ClientData) tvarPtr; tracePtr->flags = flags & flagMask; tracePtr->nextPtr = varPtr->tracePtr; varPtr->tracePtr = tracePtr; } else { /* * Search through all of our traces on this variable to * see if there's one with the given command. If so, then * delete the first one that matches. */ TraceVarInfo *tvarPtr; ClientData clientData = 0; name = Tcl_GetString(objv[3]); while ((clientData = Tcl_VarTraceInfo(interp, name, 0, TraceVarProc, clientData)) != 0) { tvarPtr = (TraceVarInfo *) clientData; if ((tvarPtr->length == length) && (tvarPtr->flags == flags) && ((tvarPtr->flags & ~TCL_TRACE_OLD_STYLE)==flags) && (strncmp(command, tvarPtr->command, (size_t) length) == 0)) { Tcl_UntraceVar2(interp, name, NULL, flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT, TraceVarProc, clientData); Tcl_EventuallyFree((ClientData) tvarPtr, TCL_DYNAMIC); break; } } } break; } case TRACE_INFO: {
︙
3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715	3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863	-	clientData = 0; name = Tcl_GetString(objv[3]); while ((clientData = Tcl_VarTraceInfo(interp, name, 0, TraceVarProc, clientData)) != 0) { TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData; eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); /* * Build a list with the ops list as * the first obj element and the tcmdPtr->command string * as the second obj element. Append this list (as an * element) to the end of the result object list. */
︙
3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739	3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888	+	Tcl_ListObjAppendElement(NULL, elemObjPtr, Tcl_NewStringObj("write", 5)); } if (tvarPtr->flags & TCL_TRACE_UNSETS) { Tcl_ListObjAppendElement(NULL, elemObjPtr, Tcl_NewStringObj("unset", 5)); } eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr); elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1); Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr); Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr); }
︙
3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956	4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109	+ + + - + +	* are active: it makes sure that the deleted trace won't be * processed by CallCommandTraces. */ for (activePtr = iPtr->activeCmdTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->nextTracePtr == tracePtr) { if (activePtr->reverseScan) { activePtr->nextTracePtr = prevPtr; } else { activePtr->nextTracePtr = tracePtr->nextPtr; activePtr->nextTracePtr = tracePtr->nextPtr; } } } if (prevPtr == NULL) { cmdPtr->tracePtr = tracePtr->nextPtr; } else { prevPtr->nextPtr = tracePtr->nextPtr; }
︙
4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024	4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177	- +	Tcl_SavedResult state; TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData; int code; Tcl_DString cmd; tcmdPtr->refCount++; if ((tcmdPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)) { if ((tcmdPtr->flags & flags) && !Tcl_InterpDeleted(interp)) { /* * Generate a command to execute by appending list elements * for the old and new command name and the operation. */ Tcl_DStringInit(&cmd); Tcl_DStringAppend(&cmd, tcmdPtr->command, (int) tcmdPtr->length);
︙
4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090	4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279	+ + + - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + +	Tcl_DStringFree(&cmd); } /* * We delete when the trace was destroyed or if this is a delete trace, * because command deletes are unconditional, so the trace must go away. */ if (flags & (TCL_TRACE_DESTROYED | TCL_TRACE_DELETE)) { int untraceFlags = tcmdPtr->flags; if (tcmdPtr->stepTrace != NULL) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; if (tcmdPtr->startCmd != NULL) { ckfree((char *)tcmdPtr->startCmd); } } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* Postpone deletion, until exec trace returns */ tcmdPtr->flags = 0; } /* * Decrement the refCount since the command which held our * reference (ever since we were created) has just gone away /* * We need to construct the same flags for Tcl_UntraceCommand * as were passed to Tcl_TraceCommand. Reproduce the processing * of [trace add execution/command]. Be careful to keep this * code in sync with that. */ if (untraceFlags & TCL_TRACE_ANY_EXEC) { untraceFlags |= TCL_TRACE_DELETE; if (untraceFlags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC)) { untraceFlags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC); } } else if (untraceFlags & TCL_TRACE_RENAME) { untraceFlags |= TCL_TRACE_DELETE; } /* * Remove the trace since TCL_TRACE_DESTROYED tells us to, or the * command we're tracing has just gone away. Then decrement the * clientData refCount that was set up by trace creation. * * Note that we save the (return) state of the interpreter to prevent * bizarre error messages. */ Tcl_SaveResult(interp, &state); stateCode = iPtr->returnCode; Tcl_UntraceCommand(interp, oldName, untraceFlags, TraceCommandProc, clientData); Tcl_RestoreResult(interp, &state); iPtr->returnCode = stateCode; tcmdPtr->refCount--; } if ((--tcmdPtr->refCount) <= 0) { tcmdPtr->refCount--; if (tcmdPtr->refCount < 0) { Tcl_Panic("TraceCommandProc: negative TraceCommandInfo refCount"); } if (tcmdPtr->refCount == 0) { ckfree((char*)tcmdPtr); } return; }  /* *----------------------------------------------------------------------
︙
4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178	4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377	+ + + - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + +	active.cmdPtr = cmdPtr; lastTracePtr = NULL; for (tracePtr = cmdPtr->tracePtr; (traceCode == TCL_OK) && (tracePtr != NULL); tracePtr = active.nextTracePtr) { if (traceFlags & TCL_TRACE_LEAVE_EXEC) { /* execute the trace command in order of creation for "leave" */ active.reverseScan = 1; active.nextTracePtr = NULL; tracePtr = cmdPtr->tracePtr; while (tracePtr->nextPtr != lastTracePtr) { active.nextTracePtr = tracePtr; tracePtr = tracePtr->nextPtr; } } else { active.reverseScan = 0; active.nextTracePtr = tracePtr->nextPtr; } if (tracePtr->traceProc == TraceCommandProc) { tcmdPtr = (TraceCommandInfo*)tracePtr->clientData; if (tcmdPtr->flags != 0) { tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT; tcmdPtr->curCode = code; tcmdPtr->refCount++; traceCode = TraceExecutionProc((ClientData)tcmdPtr, interp, curLevel, command, (Tcl_Command)cmdPtr, objc, objv); if ((--tcmdPtr->refCount) <= 0) { ckfree((char*)tcmdPtr); } } lastTracePtr = tracePtr; tcmdPtr = (TraceCommandInfo*)tracePtr->clientData; if (tcmdPtr->flags != 0) { tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT; tcmdPtr->curCode = code; tcmdPtr->refCount++; traceCode = TraceExecutionProc((ClientData)tcmdPtr, interp, curLevel, command, (Tcl_Command)cmdPtr, objc, objv); tcmdPtr->refCount--; if (tcmdPtr->refCount < 0) { Tcl_Panic("TclCheckExecutionTraces: negative TraceCommandInfo refCount"); } if (tcmdPtr->refCount == 0) { ckfree((char*)tcmdPtr); } } } if (active.nextTracePtr) { lastTracePtr = active.nextTracePtr->nextPtr; } } iPtr->activeCmdTracePtr = active.nextPtr; return(traceCode); }  /* *----------------------------------------------------------------------
︙
4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301	4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503	- - + + + - - - - - - + + + + + + + + - - - - + + + - + +	Tcl_Obj *CONST objv[]; /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; Trace *tracePtr, *lastTracePtr; ActiveInterpTrace active; int curLevel; int traceCode = TCL_OK; TraceCommandInfo* tcmdPtr; if (command == NULL || iPtr->tracePtr == NULL || (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) { return(traceCode); } curLevel = ((iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level); curLevel = iPtr->numLevels; active.nextPtr = iPtr->activeInterpTracePtr; iPtr->activeInterpTracePtr = &active; lastTracePtr = NULL; for ( tracePtr = iPtr->tracePtr; (traceCode == TCL_OK) && (tracePtr != NULL); tracePtr = active.nextTracePtr) { if (traceFlags & TCL_TRACE_ENTER_EXEC) { /* * Execute the trace command in reverse order of creation * for "enterstep" operation. The order is changed for * "enterstep" instead of for "leavestep" as was done in * TclCheckExecutionTraces because for step traces, * Tcl_CreateObjTrace creates one more linked list of traces * which results in one more reversal of trace invocation. */ active.reverseScan = 1; active.nextTracePtr = NULL; tracePtr = iPtr->tracePtr; while (tracePtr->nextPtr != lastTracePtr) { active.nextTracePtr = tracePtr; tracePtr = tracePtr->nextPtr; } } else { active.reverseScan = 0; active.nextTracePtr = tracePtr->nextPtr; } if (tracePtr->level > 0 && curLevel > tracePtr->level) { continue; } if (!(tracePtr->flags & TCL_TRACE_EXEC_IN_PROGRESS)) { /* * The proc invoked might delete the traced command which * which might try to free tracePtr. We want to use tracePtr * until the end of this if section, so we use * Tcl_Preserve() and Tcl_Release() to be sure it is not * freed while we still need it. */ Tcl_Preserve((ClientData) tracePtr); tracePtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS; if (tracePtr->flags & (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC)) { /* New style trace */ if ((tracePtr->flags != TCL_TRACE_EXEC_IN_PROGRESS) && ((tracePtr->flags & traceFlags) != 0)) { tcmdPtr = (TraceCommandInfo*)tracePtr->clientData; tcmdPtr->curFlags = traceFlags; tcmdPtr->curCode = code; traceCode = (tracePtr->proc)((ClientData)tcmdPtr, if (tracePtr->flags & traceFlags) { if (tracePtr->proc == TraceExecutionProc) { TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) tracePtr->clientData; tcmdPtr->curFlags = traceFlags; tcmdPtr->curCode = code; } traceCode = (tracePtr->proc)(tracePtr->clientData, (Tcl_Interp*)interp, curLevel, command, (Tcl_Command)cmdPtr, objc, objv); interp, curLevel, command, (Tcl_Command)cmdPtr, objc, objv); } } else { /* Old-style trace */ if (traceFlags & TCL_TRACE_ENTER_EXEC) { /* * Old-style interpreter-wide traces only trigger * before the command is executed. */ traceCode = CallTraceProcedure(interp, tracePtr, cmdPtr, command, numChars, objc, objv); } } tracePtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS; Tcl_Release((ClientData) tracePtr); } if (active.nextTracePtr) { lastTracePtr = tracePtr; lastTracePtr = active.nextTracePtr->nextPtr; } } iPtr->activeInterpTracePtr = active.nextPtr; return(traceCode); }  /* *----------------------------------------------------------------------
︙
4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382	4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588	- - + + + + + +	* May release memory. * *---------------------------------------------------------------------- */ static void CommandObjTraceDeleted(ClientData clientData) { TraceCommandInfo* tcmdPtr = (TraceCommandInfo*)clientData; if ((--tcmdPtr->refCount) <= 0) { ckfree((char*)tcmdPtr); tcmdPtr->refCount--; if (tcmdPtr->refCount < 0) { Tcl_Panic("CommandObjTraceDeleted: negative TraceCommandInfo refCount"); } if (tcmdPtr->refCount == 0) { ckfree((char*)tcmdPtr); } }  /* *---------------------------------------------------------------------- * * TraceExecutionProc --
︙
4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442	4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648	- + - - + +	* Inside any kind of execution trace callback, we do * not allow any further execution trace callbacks to * be called for the same trace. */ return traceCode; } if (!(flags & TCL_INTERP_DESTROYED)) { if (!Tcl_InterpDeleted(interp)) { /* * Check whether the current call is going to eval arbitrary * Tcl code with a generated trace, or whether we are only * going to setup interpreter-wide traces to implement the * 'step' traces. This latter situation can happen if * we create a command trace without either before or after * operations, but with either of the step operations. */ if (flags & TCL_TRACE_EXEC_DIRECT) { call = flags & tcmdPtr->flags & (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC); call = flags & tcmdPtr->flags & (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC); } else { call = 1; } /* * First, if we have returned back to the level at which we * created an interpreter trace for enterstep and/or leavestep * execution traces, we remove it here.
︙
4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470	4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675	- + -	} /* * Second, create the tcl callback, if required. */ if (call) { Tcl_SavedResult state; int stateCode; int stateCode, i, saveInterpFlags; Tcl_DString cmd; Tcl_DString sub; int i; Tcl_DStringInit(&cmd); Tcl_DStringAppend(&cmd, tcmdPtr->command, (int)tcmdPtr->length); /* Append command with arguments */ Tcl_DStringInit(&sub); for (i = 0; i < objc; i++) { char* str;
︙
4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543	4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756	- + + - + + + + + + + + - +	* may be modified when Tcl_Eval is invoked. We discard any * object result the command returns. */ Tcl_SaveResult(interp, &state); stateCode = iPtr->returnCode; tcmdPtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS; saveInterpFlags = iPtr->flags; iPtr->flags |= INTERP_TRACE_IN_PROGRESS; tcmdPtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS; tcmdPtr->refCount++; /* * This line can have quite arbitrary side-effects, * including deleting the trace, the command being * traced, or even the interpreter. */ traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd)); tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS; iPtr->flags &= ~INTERP_TRACE_IN_PROGRESS; /* * Restore the interp tracing flag to prevent cmd traces * from affecting interp traces */ iPtr->flags = saveInterpFlags;; if (tcmdPtr->flags == 0) { flags |= TCL_TRACE_DESTROYED; } if (traceCode == TCL_OK) { /* Restore result if trace execution was successful */ Tcl_RestoreResult(interp, &state); iPtr->returnCode = stateCode; } else { Tcl_DiscardResult(&state); } } Tcl_DStringFree(&cmd); } /* * Third, if there are any step execution traces for this proc, * we register an interpreter trace to invoke enterstep and/or
︙
4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580	4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797	- + + + + +	tcmdPtr->stepTrace = NULL; if (tcmdPtr->startCmd != NULL) { ckfree((char *)tcmdPtr->startCmd); } } } if (call) { if ((--tcmdPtr->refCount) <= 0) { tcmdPtr->refCount--; if (tcmdPtr->refCount < 0) { Tcl_Panic("TraceExecutionProc: negative TraceCommandInfo refCount"); } if (tcmdPtr->refCount == 0) { ckfree((char*)tcmdPtr); } } return traceCode; }  /*
︙
4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633	4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847	- + - - + + - - - + + - - - +	* scalar variable is being referenced. */ int flags; /* OR-ed bits giving operation and other * information. */ { Tcl_SavedResult state; TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData; char *result; int code; int code, destroy = 0; Tcl_DString cmd; /* * We might call Tcl_Eval() below, and that might evaluate * [trace vdelete] which might try to free tvarPtr. We want * We might call Tcl_Eval() below, and that might evaluate [trace * vdelete] which might try to free tvarPtr. However we do not * to use tvarPtr until the end of this function, so we use * Tcl_Preserve() and Tcl_Release() to be sure it is not * freed while we still need it. * need to protect anything here; it's done by our caller because * the TraceVarInfo is really part of a CompoundVarTrace. [Bug 1348775] */ Tcl_Preserve((ClientData) tvarPtr); result = NULL; if ((tvarPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)) { if ((tvarPtr->flags & flags) && !Tcl_InterpDeleted(interp)) { if (tvarPtr->length != (size_t) 0) { /* * Generate a command to execute by appending list elements * for the two variable names and the operation. */ Tcl_DStringInit(&cmd);
︙
4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706	4880 4881 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920	- + + + - + - -	* * Add the TCL_TRACE_DESTROYED flag to tvarPtr to indicate to * other areas that this will be destroyed by us, otherwise a * double-free might occur depending on what the eval does. */ Tcl_SaveResult(interp, &state); if (flags & TCL_TRACE_DESTROYED) { if ((flags & TCL_TRACE_DESTROYED) && !(tvarPtr->flags & TCL_TRACE_DESTROYED)) { destroy = 1; tvarPtr->flags |= TCL_TRACE_DESTROYED; } code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), Tcl_DStringLength(&cmd), 0); if (code != TCL_OK) { /* copy error msg to result */ register Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp); Tcl_IncrRefCount(errMsgObj); result = (char *) errMsgObj; } Tcl_RestoreResult(interp, &state); Tcl_DStringFree(&cmd); } } if (flags & TCL_TRACE_DESTROYED) { if (destroy) { if (result != NULL) { register Tcl_Obj *errMsgObj = (Tcl_Obj *) result; Tcl_DecrRefCount(errMsgObj); result = NULL; } Tcl_EventuallyFree((ClientData) tvarPtr, TCL_DYNAMIC); } Tcl_Release((ClientData) tvarPtr); return result; }  /* *---------------------------------------------------------------------- * * Tcl_WhileObjCmd --
︙
4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767	4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 5028 5029 5030	+ + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	Tcl_WhileObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { int result, value; #ifdef TCL_TIP280 Interp* iPtr = (Interp*) interp; #endif if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "test command"); return TCL_ERROR; } while (1) { result = Tcl_ExprBooleanObj(interp, objv[1], &value); if (result != TCL_OK) { return result; } if (!value) { break; } #ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, objv[2], 0); #else /* TIP #280. */ result = TclEvalObjEx(interp, objv[2], 0, iPtr->cmdFramePtr,2); #endif if ((result != TCL_OK) && (result != TCL_CONTINUE)) { if (result == TCL_ERROR) { char msg[32 + TCL_INTEGER_SPACE]; sprintf(msg, "\n (\"while\" body line %d)", interp->errorLine); Tcl_AddErrorInfo(interp, msg); } break; } } if (result == TCL_BREAK) { result = TCL_OK; } if (result == TCL_OK) { Tcl_ResetResult(interp); } return result; }  #ifdef TCL_TIP280 static void ListLines(listStr, line, n, lines) CONST char* listStr; /* Pointer to string with list structure. * Assumed to be valid. Assumed to contain * n elements. */ int line; /* line the list as a whole starts on */ int n; /* #elements in lines */ int* lines; /* Array of line numbers, to fill */ { int i; int length = strlen( listStr); CONST char *element = NULL; CONST char* next = NULL; for (i = 0; i < n; i++) { TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL); TclAdvanceLines (&line, listStr, element); /* Leading whitespace */ lines [i] = line; length -= (next - listStr); TclAdvanceLines (&line, element, next); /* Element */ listStr = next; if (*element == 0) { /* ASSERT i == n */ break; } } } #endif  /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */

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	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	- + + + + + + + +	/* * tclCompCmds.c -- * * This file contains compilation procedures that compile various * Tcl commands into a sequence of instructions ("bytecodes"). * * Copyright (c) 1997-1998 Sun Microsystems, Inc. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * Copyright (c) 2002 ActiveState Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclCompCmds.c,v 1.39 2003/02/07 01:07:05 mdejong Exp $ * RCS: @(#) $Id: tclCompCmds.c,v 1.39.2.6 2007/03/01 16:06:19 dkf Exp $ */ #include "tclInt.h" #include "tclCompile.h" /* * Prototypes for procedures defined later in this file: */ static ClientData DupForeachInfo _ANSI_ARGS_((ClientData clientData)); static void FreeForeachInfo _ANSI_ARGS_((ClientData clientData)); #ifndef TCL_TIP280 static int TclPushVarName _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr)); #else static int TclPushVarName _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr, int line)); #endif /* * Flags bits used by TclPushVarName. */ #define TCL_CREATE_VAR 1 /* Create a compiled local if none is found */ #define TCL_NO_LARGE_INDEX 2 /* Do not return localIndex value > 255 */
︙
73 74 75 76 77 78 79 80 81 82 83 84 85 86	80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103	+ + + + + + + + + +	Tcl_Parse *parsePtr; /* Points to a parse structure for the * command created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *valueTokenPtr; int simpleVarName, isScalar, localIndex, numWords; int code = TCL_OK; #ifdef TCL_TIP280 /* TIP #280 : Remember the per-word line information of the current * command. An index is used instead of a pointer as recursive compilation * may reallocate, i.e. move, the array. This is also the reason to save * the nuloc now, it may change during the course of the function. */ ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr; int eclIndex = mapPtr->nuloc - 1; #endif numWords = parsePtr->numWords; if (numWords == 1) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args: should be \"append varName ?value value ...?\"", -1);
︙
105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135	122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160	+ + + + + + + +	* namespace qualifiers. */ varTokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1); code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, #ifndef TCL_TIP280 &localIndex, &simpleVarName, &isScalar); #else &localIndex, &simpleVarName, &isScalar, mapPtr->loc [eclIndex].line [1]); #endif if (code != TCL_OK) { goto done; } /* * We are doing an assignment, otherwise TclCompileSetCmd was called, * so push the new value. This will need to be extended to push a * value for each argument. */ if (numWords > 2) { valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { TclEmitPush(TclRegisterNewLiteral(envPtr, valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr); } else { #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [2]; #endif code = TclCompileTokens(interp, valueTokenPtr+1, valueTokenPtr->numComponents, envPtr); if (code != TCL_OK) { goto done; } } }
︙
241 242 243 244 245 246 247 248 249 250 251 252 253 254	266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289	+ + + + + + + + + +	{ JumpFixup jumpFixup; Tcl_Token *cmdTokenPtr, *nameTokenPtr; CONST char *name; int localIndex, nameChars, range, startOffset, jumpDist; int code; int savedStackDepth = envPtr->currStackDepth; #ifdef TCL_TIP280 /* TIP #280 : Remember the per-word line information of the current * command. An index is used instead of a pointer as recursive compilation * may reallocate, i.e. move, the array. This is also the reason to save * the nuloc now, it may change during the course of the function. */ ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr; int eclIndex = mapPtr->nuloc - 1; #endif if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args: should be \"catch command ?varName?\"", -1); return TCL_ERROR; }
︙
304 305 306 307 308 309 310 311 312 313 314 315 316 317	339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355	+ + +	* text without catching, a catch instruction that resets the * stack to what it was before substituting the body, and then * an instruction to eval the body. Care has to be taken to * register the correct startOffset for the catch range so that * errors in the substitution are not catched [Bug 219184] */ #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [1]; #endif if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { startOffset = (envPtr->codeNext - envPtr->codeStart); code = TclCompileCmdWord(interp, cmdTokenPtr+1, 1, envPtr); } else { code = TclCompileTokens(interp, cmdTokenPtr+1, cmdTokenPtr->numComponents, envPtr); startOffset = (envPtr->codeNext - envPtr->codeStart);
︙
458 459 460 461 462 463 464 465 466 467 468 469 470 471	496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514	+ + + + +	if (parsePtr->numWords == 1) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args: should be \"expr arg ?arg ...?\"", -1); return TCL_ERROR; } #ifdef TCL_TIP280 /* TIP #280 : Use the per-word line information of the current command. */ envPtr->line = envPtr->extCmdMapPtr->loc [envPtr->extCmdMapPtr->nuloc - 1].line [1]; #endif firstWordPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1); return TclCompileExprWords(interp, firstWordPtr, (parsePtr->numWords-1), envPtr); }  /*
︙
495 496 497 498 499 500 501 502 503 504 505 506 507 508	538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561	+ + + + + + + + + +	{ Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr; JumpFixup jumpEvalCondFixup; int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist; int bodyRange, nextRange, code; char buffer[32 + TCL_INTEGER_SPACE]; int savedStackDepth = envPtr->currStackDepth; #ifdef TCL_TIP280 /* TIP #280 : Remember the per-word line information of the current * command. An index is used instead of a pointer as recursive compilation * may reallocate, i.e. move, the array. This is also the reason to save * the nuloc now, it may change during the course of the function. */ ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr; int eclIndex = mapPtr->nuloc - 1; #endif if (parsePtr->numWords != 5) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args: should be \"for start test next command\"", -1); return TCL_ERROR; }
︙
544 545 546 547 548 549 550 551 552 553 554 555 556 557	597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613	+ + +	bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); /* * Inline compile the initial command. */ #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [1]; #endif code = TclCompileCmdWord(interp, startTokenPtr+1, startTokenPtr->numComponents, envPtr); if (code != TCL_OK) { if (code == TCL_ERROR) { Tcl_AddObjErrorInfo(interp, "\n (\"for\" initial command)", -1); }
︙
575 576 577 578 579 580 581 582 583 584 585 586 587 588	631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647	+ + +	/* * Compile the loop body. */ bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart); #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [4]; #endif code = TclCompileCmdWord(interp, bodyTokenPtr+1, bodyTokenPtr->numComponents, envPtr); envPtr->currStackDepth = savedStackDepth + 1; if (code != TCL_OK) { if (code == TCL_ERROR) { sprintf(buffer, "\n (\"for\" body line %d)", interp->errorLine);
︙
597 598 599 600 601 602 603 604 605 606 607 608 609 610	656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672	+ + +	/* * Compile the "next" subcommand. */ nextCodeOffset = (envPtr->codeNext - envPtr->codeStart); #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [3]; #endif envPtr->currStackDepth = savedStackDepth; code = TclCompileCmdWord(interp, nextTokenPtr+1, nextTokenPtr->numComponents, envPtr); envPtr->currStackDepth = savedStackDepth + 1; if (code != TCL_OK) { if (code == TCL_ERROR) { Tcl_AddObjErrorInfo(interp,
︙
627 628 629 630 631 632 633 634 635 636 637 638 639 640 641	689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705	- + + +	jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset; if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) { bodyCodeOffset += 3; nextCodeOffset += 3; testCodeOffset += 3; } #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [2]; #endif envPtr->currStackDepth = savedStackDepth; code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr); if (code != TCL_OK) { if (code == TCL_ERROR) { Tcl_AddObjErrorInfo(interp, "\n (\"for\" test expression)", -1); }
︙
718 719 720 721 722 723 724 725 726 727 728 729 730 731	782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806	+ + + + + + + + + + +	unsigned char *jumpPc; JumpFixup jumpFalseFixup; int jumpDist, jumpBackDist, jumpBackOffset, infoIndex, range; int numWords, numLists, numVars, loopIndex, tempVar, i, j, code; char buffer[32 + TCL_INTEGER_SPACE]; int savedStackDepth = envPtr->currStackDepth; #ifdef TCL_TIP280 /* TIP #280 : Remember the per-word line information of the current * command. An index is used instead of a pointer as recursive compilation * may reallocate, i.e. move, the array. This is also the reason to save * the nuloc now, it may change during the course of the function. */ ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr; int eclIndex = mapPtr->nuloc - 1; int bodyIndex; #endif /* * We parse the variable list argument words and create two arrays: * varcList[i] is number of variables in i-th var list * varvList[i] points to array of var names in i-th var list */ #define STATIC_VAR_LIST_SIZE 5
︙
759 760 761 762 763 764 765 766 767 768 769 770 771 772	834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850	+ + +	i < numWords-1; i++, tokenPtr += (tokenPtr->numComponents + 1)) { } bodyTokenPtr = tokenPtr; if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TCL_OUT_LINE_COMPILE; } #ifdef TCL_TIP280 bodyIndex = i-1; #endif /* * Allocate storage for the varcList and varvList arrays if necessary. */ numLists = (numWords - 2)/2; if (numLists > STATIC_VAR_LIST_SIZE) {
︙
812 813 814 815 816 817 818 819 820 821 822 823 824 825	890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915	+ + + + + + + + + + + +	code = Tcl_SplitList(interp, Tcl_DStringValue(&varList), &varcList[loopIndex], &varvList[loopIndex]); Tcl_DStringFree(&varList); if (code != TCL_OK) { goto done; } numVars = varcList[loopIndex]; /* * If the variable list is empty, we can enter an infinite * loop when the interpreted version would not. Take care to * ensure this does not happen. [Bug 1671138] */ if (numVars == 0) { code = TCL_OUT_LINE_COMPILE; goto done; } for (j = 0; j < numVars; j++) { CONST char *varName = varvList[loopIndex][j]; if (!TclIsLocalScalar(varName, (int) strlen(varName))) { code = TCL_OUT_LINE_COMPILE; goto done; } }
︙
882 883 884 885 886 887 888 889 890 891 892 893 894 895	972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988	+ + +	range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); loopIndex = 0; for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++, tokenPtr += (tokenPtr->numComponents + 1)) { if ((i%2 == 0) && (i > 0)) { #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [i]; #endif code = TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, envPtr); if (code != TCL_OK) { goto done; } tempVar = (firstValueTemp + loopIndex);
︙
919 920 921 922 923 924 925 926 927 928 929 930 931 932	1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028	+ + +	TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr); TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup); /* * Inline compile the loop body. */ #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [bodyIndex]; #endif envPtr->exceptArrayPtr[range].codeOffset = (envPtr->codeNext - envPtr->codeStart); code = TclCompileCmdWord(interp, bodyTokenPtr+1, bodyTokenPtr->numComponents, envPtr); envPtr->currStackDepth = savedStackDepth + 1; if (code != TCL_OK) { if (code == TCL_ERROR) {
︙
1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161	1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267	+ + + + + + + + + +	/* Saved stack depth at the start of the first * test; the envPtr current depth is restored * to this value at the start of each test. */ int realCond = 1; /* set to 0 for static conditions: "if 0 {..}" */ int boolVal; /* value of static condition */ int compileScripts = 1; #ifdef TCL_TIP280 /* TIP #280 : Remember the per-word line information of the current * command. An index is used instead of a pointer as recursive compilation * may reallocate, i.e. move, the array. This is also the reason to save * the nuloc now, it may change during the course of the function. */ ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr; int eclIndex = mapPtr->nuloc - 1; #endif /* * Only compile the "if" command if all arguments are simple * words, in order to insure correct substitution [Bug 219166] */ tokenPtr = parsePtr->tokenPtr; wordIdx = 0;
︙
1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207	1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313	- - + +	tokenPtr += (tokenPtr->numComponents + 1); wordIdx++; } else { break; } if (wordIdx >= numWords) { sprintf(buffer, "wrong # args: no expression after \"%.30s\" argument", word); "wrong # args: no expression after \"%.*s\" argument", (numBytes > 50 ? 50 : numBytes), word); Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), buffer, -1); code = TCL_ERROR; goto done; } /*
︙
1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242	1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351	+ + +	*/ realCond = 0; if (!boolVal) { compileScripts = 0; } } else { Tcl_ResetResult(interp); #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [wordIdx]; #endif code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr); if (code != TCL_OK) { if (code == TCL_ERROR) { Tcl_AddObjErrorInfo(interp, "\n (\"if\" test expression)", -1); } goto done;
︙
1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269	1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381	+ - + + +	/* * Skip over the optional "then" before the then clause. */ tokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1); wordIdx++; if (wordIdx >= numWords) { sprintf(buffer, sprintf(buffer, "wrong # args: no script following \"%.20s\" argument", testTokenPtr->start); "wrong # args: no script following \"%.*s\" argument", (testTokenPtr->size > 50 ? 50 : testTokenPtr->size), testTokenPtr->start); Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), buffer, -1); code = TCL_ERROR; goto done; } if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { word = tokenPtr[1].start;
︙
1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295	1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410	+ + +	} /* * Compile the "then" command body. */ if (compileScripts) { #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [wordIdx]; #endif envPtr->currStackDepth = savedStackDepth; code = TclCompileCmdWord(interp, tokenPtr+1, tokenPtr->numComponents, envPtr); if (code != TCL_OK) { if (code == TCL_ERROR) { sprintf(buffer, "\n (\"if\" then script line %d)", interp->errorLine);
︙
1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398	1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515	- + + +	} } if (compileScripts) { /* * Compile the else command body. */ #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [wordIdx]; #endif code = TclCompileCmdWord(interp, tokenPtr+1, tokenPtr->numComponents, envPtr); if (code != TCL_OK) { if (code == TCL_ERROR) { sprintf(buffer, "\n (\"if\" else script line %d)", interp->errorLine); Tcl_AddObjErrorInfo(interp, buffer, -1);
︙
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	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 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704	+ + + + + + + + + + + + + + + - + - - - - + + - - + - - - - - + + + + + + - + + + -	Tcl_Parse *parsePtr; /* Points to a parse structure for the * command created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *incrTokenPtr; int simpleVarName, isScalar, localIndex, haveImmValue, immValue; int code = TCL_OK; #ifdef TCL_TIP280 /* TIP #280 : Remember the per-word line information of the current * command. An index is used instead of a pointer as recursive compilation * may reallocate, i.e. move, the array. This is also the reason to save * the nuloc now, it may change during the course of the function. */ ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr; int eclIndex = mapPtr->nuloc - 1; #endif if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args: should be \"incr varName ?increment?\"", -1); return TCL_ERROR; } varTokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1); code = TclPushVarName(interp, varTokenPtr, envPtr, (TCL_NO_LARGE_INDEX | TCL_CREATE_VAR), #ifndef TCL_TIP280 &localIndex, &simpleVarName, &isScalar); #else &localIndex, &simpleVarName, &isScalar, mapPtr->loc [eclIndex].line [1]); #endif if (code != TCL_OK) { goto done; } /* * If an increment is given, push it, but see first if it's a small * integer. */ haveImmValue = 0; immValue = 0; immValue = 1; if (parsePtr->numWords == 3) { incrTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { CONST char *word = incrTokenPtr[1].start; int numBytes = incrTokenPtr[1].size; int validLength = TclParseInteger(word, numBytes); long n; /* * Note there is a danger that modifying the string could have * undesirable side effects. In this case, TclLooksLikeInt and * TclGetLong do not have any dependencies on shared strings so we * undesirable side effects. In this case, TclLooksLikeInt has * no dependencies on shared strings so we should be safe. * should be safe. */ if (validLength == numBytes) { if (TclLooksLikeInt(word, numBytes)) { int code; Tcl_Obj *longObj = Tcl_NewStringObj(word, numBytes); Tcl_IncrRefCount(longObj); code = Tcl_GetLongFromObj(NULL, longObj, &n); Tcl_DecrRefCount(longObj); if ((code == TCL_OK) && (-127 <= n) && (n <= 127)) { Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes); Tcl_IncrRefCount(intObj); code = Tcl_GetIntFromObj(NULL, intObj, &immValue); Tcl_DecrRefCount(intObj); if ((code == TCL_OK) && (-127 <= immValue) && (immValue <= 127)) { haveImmValue = 1; immValue = n; } } if (!haveImmValue) { TclEmitPush( TclRegisterNewLiteral(envPtr, word, numBytes), envPtr); } } else { #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [2]; #endif code = TclCompileTokens(interp, incrTokenPtr+1, incrTokenPtr->numComponents, envPtr); if (code != TCL_OK) { goto done; } } } else { /* no incr amount given so use 1 */ haveImmValue = 1; immValue = 1; } /* * Emit the instruction to increment the variable. */ if (simpleVarName) {
︙
1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657	1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798	+ + + + + + + + + +	* command created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *valueTokenPtr; int simpleVarName, isScalar, localIndex, numWords; int code = TCL_OK; #ifdef TCL_TIP280 /* TIP #280 : Remember the per-word line information of the current * command. An index is used instead of a pointer as recursive compilation * may reallocate, i.e. move, the array. This is also the reason to save * the nuloc now, it may change during the course of the function. */ ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr; int eclIndex = mapPtr->nuloc - 1; #endif /* * If we're not in a procedure, don't compile. */ if (envPtr->procPtr == NULL) { return TCL_OUT_LINE_COMPILE; }
︙
1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706	1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855	+ + + + + + + +	* namespace qualifiers. */ varTokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1); code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, #ifndef TCL_TIP280 &localIndex, &simpleVarName, &isScalar); #else &localIndex, &simpleVarName, &isScalar, mapPtr->loc [eclIndex].line [1]); #endif if (code != TCL_OK) { goto done; } /* * If we are doing an assignment, push the new value. * In the no values case, create an empty object. */ if (numWords > 2) { valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { TclEmitPush(TclRegisterNewLiteral(envPtr, valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr); } else { #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [2]; #endif code = TclCompileTokens(interp, valueTokenPtr+1, valueTokenPtr->numComponents, envPtr); if (code != TCL_OK) { goto done; } } }
︙
1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782	1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941	+ + + + + + + + + +	Tcl_Interp *interp; /* Used for error reporting. */ Tcl_Parse *parsePtr; /* Points to a parse structure for the * command created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; int code, i; #ifdef TCL_TIP280 /* TIP #280 : Remember the per-word line information of the current * command. An index is used instead of a pointer as recursive compilation * may reallocate, i.e. move, the array. This is also the reason to save * the nuloc now, it may change during the course of the function. */ ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr; int eclIndex = mapPtr->nuloc - 1; #endif int numWords; numWords = parsePtr->numWords; /* * Quit if too few args */
︙
1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807	1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969	+ + +	for ( i = 1 ; i < numWords ; i++ ) { if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { TclEmitPush( TclRegisterNewLiteral( envPtr, varTokenPtr[1].start, varTokenPtr[1].size), envPtr); } else { #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [i]; #endif code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); if (code != TCL_OK) { return code; } } varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
︙
1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860	2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032	+ + + + + + + + + +	int TclCompileListCmd(interp, parsePtr, envPtr) Tcl_Interp *interp; /* Used for error reporting. */ Tcl_Parse *parsePtr; /* Points to a parse structure for the * command created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { #ifdef TCL_TIP280 /* TIP #280 : Remember the per-word line information of the current * command. An index is used instead of a pointer as recursive compilation * may reallocate, i.e. move, the array. This is also the reason to save * the nuloc now, it may change during the course of the function. */ ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr; int eclIndex = mapPtr->nuloc - 1; #endif /* * If we're not in a procedure, don't compile. */ if (envPtr->procPtr == NULL) { return TCL_OUT_LINE_COMPILE; }
︙
1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889	2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064	+ + +	valueTokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1); for (i = 1; i < numWords; i++) { if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { TclEmitPush(TclRegisterNewLiteral(envPtr, valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr); } else { #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [i]; #endif code = TclCompileTokens(interp, valueTokenPtr+1, valueTokenPtr->numComponents, envPtr); if (code != TCL_OK) { return code; } } valueTokenPtr = valueTokenPtr + (valueTokenPtr->numComponents + 1);
︙
1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950	2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 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 2132 2133 2134 2135 2136 2137 2138	+ + + + + + + + + + + + +	Tcl_Interp *interp; /* Used for error reporting. */ Tcl_Parse *parsePtr; /* Points to a parse structure for the * command created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; int code; #ifdef TCL_TIP280 /* TIP #280 : Remember the per-word line information of the current * command. An index is used instead of a pointer as recursive compilation * may reallocate, i.e. move, the array. This is also the reason to save * the nuloc now, it may change during the course of the function. */ ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr; int eclIndex = mapPtr->nuloc - 1; #endif if (parsePtr->numWords != 2) { Tcl_SetResult(interp, "wrong # args: should be \"llength list\"", TCL_STATIC); return TCL_ERROR; } varTokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1); if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { /* * We could simply count the number of elements here and push * that value, but that is too rare a case to waste the code space. */ TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start, varTokenPtr[1].size), envPtr); } else { #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [1]; #endif code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); if (code != TCL_OK) { return code; } } TclEmitOpcode(INST_LIST_LENGTH, envPtr);
︙
2011 2012 2013 2014 2015 2016 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 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062	2199 2200 2201 2202 2203 2204 2205 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 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268	+ + + + + + + + + + + + + + + + + +	int result; /* Status return from library calls */ int localIndex; /* Index of var in local var table */ int simpleVarName; /* Flag == 1 if var name is simple */ int isScalar; /* Flag == 1 if scalar, 0 if array */ int i; #ifdef TCL_TIP280 /* TIP #280 : Remember the per-word line information of the current * command. An index is used instead of a pointer as recursive compilation * may reallocate, i.e. move, the array. This is also the reason to save * the nuloc now, it may change during the course of the function. */ ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr; int eclIndex = mapPtr->nuloc - 1; #endif /* Check argument count */ if ( parsePtr->numWords < 3 ) { /* Fail at run time, not in compilation */ return TCL_OUT_LINE_COMPILE; } /* * Decide if we can use a frame slot for the var/array name or if we * need to emit code to compute and push the name at runtime. We use a * frame slot (entry in the array of local vars) if we are compiling a * procedure body and if the name is simple text that does not include * namespace qualifiers. */ varTokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1); result = TclPushVarName( interp, varTokenPtr, envPtr, #ifndef TCL_TIP280 TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar ); #else TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar, mapPtr->loc [eclIndex].line [1]); #endif if (result != TCL_OK) { return result; } /* Push the "index" args and the new element value. */ for ( i = 2; i < parsePtr->numWords; ++i ) { /* Advance to next arg */ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); /* Push an arg */ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { TclEmitPush(TclRegisterNewLiteral( envPtr, varTokenPtr[1].start, varTokenPtr[1].size), envPtr); } else { #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [i]; #endif result = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); if ( result != TCL_OK ) { return result; } } }
︙
2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191	2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407	+ + + + + + + + + +	* the command */ CompileEnv* envPtr; /* Holds the resulting instructions */ { Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing * the parse of the RE or string */ int i, len, code, nocase, anchorLeft, anchorRight, start; char *str; #ifdef TCL_TIP280 /* TIP #280 : Remember the per-word line information of the current * command. An index is used instead of a pointer as recursive compilation * may reallocate, i.e. move, the array. This is also the reason to save * the nuloc now, it may change during the course of the function. */ ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr; int eclIndex = mapPtr->nuloc - 1; #endif /* * We are only interested in compiling simple regexp cases. * Currently supported compile cases are: * regexp ?-nocase? ?--? staticString $var * regexp ?-nocase? ?--? {^staticString$} $var */
︙
2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339	2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558	+ + +	* Push the string arg */ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start, varTokenPtr[1].size), envPtr); } else { #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [parsePtr->numWords-1]; #endif code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); if (code != TCL_OK) { return code; } }
︙
2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388	2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617	+ + + + + + + + + +	Tcl_Parse *parsePtr; /* Points to a parse structure for the * command created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; int code; int index = envPtr->exceptArrayNext - 1; #ifdef TCL_TIP280 /* TIP #280 : Remember the per-word line information of the current * command. An index is used instead of a pointer as recursive compilation * may reallocate, i.e. move, the array. This is also the reason to save * the nuloc now, it may change during the course of the function. */ ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr; int eclIndex = mapPtr->nuloc - 1; #endif /* * If we're not in a procedure, don't compile. */ if (envPtr->procPtr == NULL) { return TCL_OUT_LINE_COMPILE;
︙
2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446	2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678	+ + +	/* * Parse token is more complex, so compile it; this handles the * variable reference and nested command cases. If the * parse token can be byte-compiled, then this instance of * "return" will be byte-compiled; otherwise it will be * out line compiled. */ #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [1]; #endif code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); if (code != TCL_OK) { return code; } } break;
︙
2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505	2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747	+ + + + + + + + + +	Tcl_Parse *parsePtr; /* Points to a parse structure for the * command created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *valueTokenPtr; int isAssignment, isScalar, simpleVarName, localIndex, numWords; int code = TCL_OK; #ifdef TCL_TIP280 /* TIP #280 : Remember the per-word line information of the current * command. An index is used instead of a pointer as recursive compilation * may reallocate, i.e. move, the array. This is also the reason to save * the nuloc now, it may change during the course of the function. */ ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr; int eclIndex = mapPtr->nuloc - 1; #endif numWords = parsePtr->numWords; if ((numWords != 2) && (numWords != 3)) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args: should be \"set varName ?newValue?\"", -1); return TCL_ERROR;
︙
2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542	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	+ + + + + + + +	* namespace qualifiers. */ varTokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1); code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, #ifndef TCL_TIP280 &localIndex, &simpleVarName, &isScalar); #else &localIndex, &simpleVarName, &isScalar, mapPtr->loc [eclIndex].line [1]); #endif if (code != TCL_OK) { goto done; } /* * If we are doing an assignment, push the new value. */ if (isAssignment) { valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { TclEmitPush(TclRegisterNewLiteral(envPtr, valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr); } else { #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [2]; #endif code = TclCompileTokens(interp, valueTokenPtr+1, valueTokenPtr->numComponents, envPtr); if (code != TCL_OK) { goto done; } } }
︙
2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643	2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903	+ + + + + + + + + +	STR_BYTELENGTH, STR_COMPARE, STR_EQUAL, STR_FIRST, STR_INDEX, STR_IS, STR_LAST, STR_LENGTH, STR_MAP, STR_MATCH, STR_RANGE, STR_REPEAT, STR_REPLACE, STR_TOLOWER, STR_TOUPPER, STR_TOTITLE, STR_TRIM, STR_TRIMLEFT, STR_TRIMRIGHT, STR_WORDEND, STR_WORDSTART }; #ifdef TCL_TIP280 /* TIP #280 : Remember the per-word line information of the current * command. An index is used instead of a pointer as recursive compilation * may reallocate, i.e. move, the array. This is also the reason to save * the nuloc now, it may change during the course of the function. */ ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr; int eclIndex = mapPtr->nuloc - 1; #endif if (parsePtr->numWords < 2) { /* Fail at run time, not in compilation */ return TCL_OUT_LINE_COMPILE; } opTokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1);
︙
2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705	2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968	+ + +	*/ for (i = 0; i < 2; i++) { if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start, varTokenPtr[1].size), envPtr); } else { #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [i]; #endif code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); if (code != TCL_OK) { return code; } } varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
︙
2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735	2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001	+ + +	*/ for (i = 0; i < 2; i++) { if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start, varTokenPtr[1].size), envPtr); } else { #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [i]; #endif code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); if (code != TCL_OK) { return code; } } varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
︙
2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765	3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034	+ + +	char buf[TCL_INTEGER_SPACE]; int len = Tcl_NumUtfChars(varTokenPtr[1].start, varTokenPtr[1].size); len = sprintf(buf, "%d", len); TclEmitPush(TclRegisterNewLiteral(envPtr, buf, len), envPtr); return TCL_OK; } else { #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [2]; #endif code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); if (code != TCL_OK) { return code; } } TclEmitOpcode(INST_STR_LEN, envPtr);
︙
2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822	3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094	+ + +	exactMatch = (strpbrk(Tcl_GetString(copy), "*[]?\\") == NULL); Tcl_DecrRefCount(copy); } TclEmitPush( TclRegisterNewLiteral(envPtr, str, length), envPtr); } else { #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [i]; #endif code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); if (code != TCL_OK) { return code; } } varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
︙
2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937	3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219	+ + + + + + + + + +	int range, code; char buffer[32 + TCL_INTEGER_SPACE]; int savedStackDepth = envPtr->currStackDepth; int loopMayEnd = 1; /* This is set to 0 if it is recognized as * an infinite loop. */ Tcl_Obj *boolObj; int boolVal; #ifdef TCL_TIP280 /* TIP #280 : Remember the per-word line information of the current * command. An index is used instead of a pointer as recursive compilation * may reallocate, i.e. move, the array. This is also the reason to save * the nuloc now, it may change during the course of the function. */ ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr; int eclIndex = mapPtr->nuloc - 1; #endif if (parsePtr->numWords != 3) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args: should be \"while test command\"", -1); return TCL_ERROR; }
︙
3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023	3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308	+ + +	} /* * Compile the loop body. */ #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [2]; #endif bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart); code = TclCompileCmdWord(interp, bodyTokenPtr+1, bodyTokenPtr->numComponents, envPtr); envPtr->currStackDepth = savedStackDepth + 1; if (code != TCL_OK) { if (code == TCL_ERROR) { sprintf(buffer, "\n (\"while\" body line %d)",
︙
3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052	3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340	+ + +	testCodeOffset = (envPtr->codeNext - envPtr->codeStart); jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset; if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) { bodyCodeOffset += 3; testCodeOffset += 3; } envPtr->currStackDepth = savedStackDepth; #ifdef TCL_TIP280 envPtr->line = mapPtr->loc [eclIndex].line [1]; #endif code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr); if (code != TCL_OK) { if (code == TCL_ERROR) { Tcl_AddObjErrorInfo(interp, "\n (\"while\" test expression)", -1); } goto error;
︙
3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133	3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428	+ + + + + + +	* at runtime. * *---------------------------------------------------------------------- */ static int TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, #ifndef TCL_TIP280 simpleVarNamePtr, isScalarPtr) #else simpleVarNamePtr, isScalarPtr, line) #endif Tcl_Interp *interp; /* Used for error reporting. */ Tcl_Token *varTokenPtr; /* Points to a variable token. */ CompileEnv *envPtr; /* Holds resulting instructions. */ int flags; /* takes TCL_CREATE_VAR or * TCL_NO_LARGE_INDEX */ int *localIndexPtr; /* must not be NULL */ int *simpleVarNamePtr; /* must not be NULL */ int *isScalarPtr; /* must not be NULL */ #ifdef TCL_TIP280 int line; /* line the token starts on */ #endif { register CONST char *p; CONST char *name, *elName; register int i, n; int nameChars, elNameChars, simpleVarName, localIndex; int code = TCL_OK;
︙
3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340	3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 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 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650	+ + + + + + + + + + + + + + +	/* * Compile the element script, if any. */ if (elName != NULL) { if (elNameChars) { #ifdef TCL_TIP280 envPtr->line = line; #endif code = TclCompileTokens(interp, elemTokenPtr, elemTokenCount, envPtr); if (code != TCL_OK) { goto done; } } else { TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); } } } else { /* * The var name isn't simple: compile and push it. */ #ifdef TCL_TIP280 envPtr->line = line; #endif code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); if (code != TCL_OK) { goto done; } } done: if (removedParen) { ++varTokenPtr[removedParen].size; } if (allocedTokens) { ckfree((char *) elemTokenPtr); } *localIndexPtr = localIndex; *simpleVarNamePtr = simpleVarName; *isScalarPtr = (elName == NULL); return code; }  /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	/* * tclCompExpr.c -- * * This file contains the code to compile Tcl expressions. * * Copyright (c) 1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclCompExpr.c,v 1.13 2003/02/16 01:36:32 msofer Exp $ * RCS: @(#) $Id: tclCompExpr.c,v 1.13.2.3 2006/11/28 22:20:00 andreas_kupries Exp $ */ #include "tclInt.h" #include "tclCompile.h" /* * The stuff below is a bit of a hack so that this file can be used in
︙
253 254 255 256 257 258 259 260 261 262 263 264 265 266	253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271	+ + + + +	* Parse the expression then compile it. */ code = Tcl_ParseExpr(interp, script, numBytes, &parse); if (code != TCL_OK) { goto done; } #ifdef TCL_TIP280 /* TIP #280 : Track Lines within the expression */ TclAdvanceLines (&envPtr->line, script, parse.tokenPtr->start); #endif code = CompileSubExpr(parse.tokenPtr, &info, envPtr); if (code != TCL_OK) { Tcl_FreeParse(&parse); goto done; }
︙
282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298	287 288 289 290 291 292 293 294 295 296 297 298 299 300 301	- + - -	/* *---------------------------------------------------------------------- * * TclFinalizeCompilation -- * * Clean up the compilation environment so it can later be * properly reinitialized. This procedure is called by * properly reinitialized. This procedure is called by Tcl_Finalize(). * TclFinalizeCompExecEnv() in tclObj.c, which in turn is called * by Tcl_Finalize(). * * Results: * None. * * Side effects: * Cleans up the compilation environment. At the moment, just the * table of expression operators is freed.
︙
336 337 338 339 340 341 342 343 344 345 346 347 348 349 350	339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354	- + +	Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token * to compile. */ ExprInfo *infoPtr; /* Describes the compilation state for the * expression being compiled. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { Tcl_Interp *interp = infoPtr->interp; Tcl_Token *tokenPtr, *endPtr, *afterSubexprPtr; Tcl_Token *tokenPtr, *endPtr = NULL; /* silence gcc 4 warning */ Tcl_Token *afterSubexprPtr; OperatorDesc *opDescPtr; Tcl_HashEntry *hPtr; CONST char *operator; Tcl_DString opBuf; int objIndex, opIndex, length, code; char buffer[TCL_UTF_MAX];
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	/* * tclCompile.c -- * * This file contains procedures that compile Tcl commands or parts * of commands (like quoted strings or nested sub-commands) into a * sequence of instructions ("bytecodes"). * * Copyright (c) 1996-1998 Sun Microsystems, Inc. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclCompile.c,v 1.43 2003/02/19 14:33:39 msofer Exp $ * RCS: @(#) $Id: tclCompile.c,v 1.43.2.7 2006/11/28 22:20:00 andreas_kupries Exp $ */ #include "tclInt.h" #include "tclCompile.h" /* * Table of all AuxData types.
︙
296 297 298 299 300 301 302 303 304 305 306 307 308 309	296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319	+ + + + + + + + + +	int length)); #ifdef TCL_COMPILE_STATS static void RecordByteCodeStats _ANSI_ARGS_(( ByteCode *codePtr)); #endif /* TCL_COMPILE_STATS */ static int SetByteCodeFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); #ifdef TCL_TIP280 /* TIP #280 : Helper for building the per-word line information of all * compiled commands */ static void EnterCmdWordData _ANSI_ARGS_(( ExtCmdLoc *eclPtr, int srcOffset, Tcl_Token* tokenPtr, CONST char* cmd, int len, int numWords, int line, int** lines)); #endif /* * The structure below defines the bytecode Tcl object type by * means of procedures that can be invoked by generic object code. */ Tcl_ObjType tclByteCodeType = {
︙
370 371 372 373 374 375 376 377 378 379 380 381 382 383 384	380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406	+ + + + + + + + + + + +	if (iPtr->evalFlags & TCL_BRACKET_TERM) { nested = 1; } else { nested = 0; } string = Tcl_GetStringFromObj(objPtr, &length); #ifndef TCL_TIP280 TclInitCompileEnv(interp, &compEnv, string, length); #else /* * TIP #280. Pick up the CmdFrame in which the BC compiler was invoked * and use to initialize the tracking in the compiler. This information * was stored by TclCompEvalObj (tclExecute.c), and ProcCompileProc * (tclProc.c). */ TclInitCompileEnv(interp, &compEnv, string, length, iPtr->invokeCmdFramePtr, iPtr->invokeWord); #endif result = TclCompileScript(interp, string, length, nested, &compEnv); if (result == TCL_OK) { /* * Successful compilation. Add a "done" instruction at the end. */
︙
562 563 564 565 566 567 568 569 570 571 572 573 574 575	584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600	+ + +	*/ void TclCleanupByteCode(codePtr) register ByteCode *codePtr; /* Points to the ByteCode to free. */ { Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle; #ifdef TCL_TIP280 Interp* iPtr = (Interp*) interp; #endif int numLitObjects = codePtr->numLitObjects; int numAuxDataItems = codePtr->numAuxDataItems; register Tcl_Obj **objArrayPtr; register AuxData *auxDataPtr; int i; #ifdef TCL_COMPILE_STATS
︙
658 659 660 661 662 663 664 665 666 667 668 669 670 671	683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	auxDataPtr = codePtr->auxDataArrayPtr; for (i = 0; i < numAuxDataItems; i++) { if (auxDataPtr->type->freeProc != NULL) { (*auxDataPtr->type->freeProc)(auxDataPtr->clientData); } auxDataPtr++; } #ifdef TCL_TIP280 /* * TIP #280. Release the location data associated with this byte code * structure, if any. NOTE: The interp we belong to may be gone already, * and the data with it. * * See also tclBasic.c, DeleteInterpProc */ if (iPtr) { Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr); if (hePtr) { ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr); int i; if (eclPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount (eclPtr->path); } for (i=0; i< eclPtr->nuloc; i++) { ckfree ((char*) eclPtr->loc[i].line); } if (eclPtr->loc != NULL) { ckfree ((char*) eclPtr->loc); } ckfree ((char*) eclPtr); Tcl_DeleteHashEntry (hePtr); } } #endif TclHandleRelease(codePtr->interpHandle); ckfree((char *) codePtr); }  /* *----------------------------------------------------------------------
︙
681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701	738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767	+ + + + + + + + +	* Side effects: * The CompileEnv structure is initialized. * *---------------------------------------------------------------------- */ void #ifndef TCL_TIP280 TclInitCompileEnv(interp, envPtr, string, numBytes) #else TclInitCompileEnv(interp, envPtr, string, numBytes, invoker, word) #endif Tcl_Interp *interp; /* The interpreter for which a CompileEnv * structure is initialized. */ register CompileEnv *envPtr; /* Points to the CompileEnv structure to * initialize. */ char *string; /* The source string to be compiled. */ int numBytes; /* Number of bytes in source string. */ #ifdef TCL_TIP280 CONST CmdFrame* invoker; /* Location context invoking the bcc */ int word; /* Index of the word in that context * getting compiled */ #endif { Interp *iPtr = (Interp *) interp; envPtr->iPtr = iPtr; envPtr->source = string; envPtr->numSrcBytes = numBytes; envPtr->procPtr = iPtr->compiledProcPtr;
︙
720 721 722 723 724 725 726 727 728 729 730 731 732 733 734	786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867	- + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	envPtr->exceptArrayNext = 0; envPtr->exceptArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES; envPtr->mallocedExceptArray = 0; envPtr->cmdMapPtr = envPtr->staticCmdMapSpace; envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE; envPtr->mallocedCmdMap = 0; #ifdef TCL_TIP280 /* * TIP #280: Set up the extended command location information, based on * the context invoking the byte code compiler. This structure is used to * keep the per-word line information for all compiled commands. * * See also tclBasic.c, TclEvalObjEx, for the equivalent code in the * non-compiling evaluator */ envPtr->extCmdMapPtr = (ExtCmdLoc*) ckalloc (sizeof (ExtCmdLoc)); envPtr->extCmdMapPtr->loc = NULL; envPtr->extCmdMapPtr->nloc = 0; envPtr->extCmdMapPtr->nuloc = 0; envPtr->extCmdMapPtr->path = NULL; if (invoker == NULL) { /* Initialize the compiler for relative counting */ envPtr->line = 1; envPtr->extCmdMapPtr->type = (envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC); } else { /* Initialize the compiler using the context, making counting absolute * to that context. Note that the context can be byte code * execution. In that case we have to fill out the missing pieces * (line, path, ...). Which may make change the type as well. */ if ((invoker->nline <= word) || (invoker->line[word] < 0)) { /* Word is not a literal, relative counting */ envPtr->line = 1; envPtr->extCmdMapPtr->type = (envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC); } else { CmdFrame ctx = *invoker; int pc = 0; if (invoker->type == TCL_LOCATION_BC) { /* Note: Type BC => ctx.data.eval.path is not used. * ctx.data.tebc.codePtr is used instead. */ TclGetSrcInfoForPc (&ctx); pc = 1; } envPtr->line = ctx.line [word]; envPtr->extCmdMapPtr->type = ctx.type; if (ctx.type == TCL_LOCATION_SOURCE) { if (pc) { /* The reference 'TclGetSrcInfoForPc' made is transfered */ envPtr->extCmdMapPtr->path = ctx.data.eval.path; ctx.data.eval.path = NULL; } else { /* We have a new reference here */ envPtr->extCmdMapPtr->path = ctx.data.eval.path; Tcl_IncrRefCount (envPtr->extCmdMapPtr->path); } } } } #endif envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace; envPtr->auxDataArrayNext = 0; envPtr->auxDataArrayEnd = COMPILEENV_INIT_AUX_DATA_SIZE; envPtr->mallocedAuxDataArray = 0; }  /*
︙
769 770 771 772 773 774 775 776 777 778 779 780 781 782	902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	if (envPtr->mallocedCmdMap) { ckfree((char *) envPtr->cmdMapPtr); } if (envPtr->mallocedAuxDataArray) { ckfree((char *) envPtr->auxDataArrayPtr); } }  #ifdef TCL_TIP280 /* *---------------------------------------------------------------------- * * TclWordKnownAtCompileTime -- * * Test whether the value of a token is completely known at compile time. * * Results: * Returns true if the tokenPtr argument points to a word value that is * completely known at compile time. Generally, values that are known at * compile time can be compiled to their values, while values that cannot * be known until substitution at runtime must be compiled to bytecode * instructions that perform that substitution. For several commands, * whether or not arguments are known at compile time determine whether * it is worthwhile to compile at all. * * Side effects: * None. * * TIP #280 *---------------------------------------------------------------------- */ int TclWordKnownAtCompileTime (tokenPtr) Tcl_Token* tokenPtr; { int i; Tcl_Token* sub; if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {return 1;}; if (tokenPtr->type != TCL_TOKEN_WORD) {return 0;}; /* Check the sub tokens of the word. It is a literal if we find * only BS and TEXT tokens */ for (i=0, sub = tokenPtr + 1; i < tokenPtr->numComponents; i++, sub ++) { if (sub->type == TCL_TOKEN_TEXT) continue; if (sub->type == TCL_TOKEN_BS) continue; return 0; } return 1; } #endif  /* *---------------------------------------------------------------------- * * TclCompileScript -- * * Compile a Tcl script in a string.
︙
823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853	1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045	+ + + + + + + + + + +	CONST char *p, *next; Namespace *cmdNsPtr; Command *cmdPtr; Tcl_Token *tokenPtr; int bytesLeft, isFirstCmd, gotParse, wordIdx, currCmdIndex; int commandLength, objIndex, code; Tcl_DString ds; #ifdef TCL_TIP280 /* TIP #280 */ ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr; int* wlines; int wlineat, cmdLine; #endif Tcl_DStringInit(&ds); if (numBytes < 0) { numBytes = strlen(script); } Tcl_ResetResult(interp); isFirstCmd = 1; /* * Each iteration through the following loop compiles the next * command from the script. */ p = script; bytesLeft = numBytes; gotParse = 0; #ifdef TCL_TIP280 cmdLine = envPtr->line; #endif do { if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse) != TCL_OK) { code = TCL_ERROR; goto error; } gotParse = 1; if (nested) {
︙
948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965	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 1174 1175	- + + + + + + + + + + + + + + + + + + +	currCmdIndex = (envPtr->numCommands - 1); if (!nested) { lastTopLevelCmdIndex = currCmdIndex; } startCodeOffset = (envPtr->codeNext - envPtr->codeStart); EnterCmdStartData(envPtr, currCmdIndex, (parse.commandStart - envPtr->source), startCodeOffset); #ifdef TCL_TIP280 /* TIP #280. Scan the words and compute the extended location * information. The map first contain full per-word line * information for use by the compiler. This is later replaced by * a reduced form which signals non-literal words, stored in * 'wlines'. */ TclAdvanceLines (&cmdLine, p, parse.commandStart); EnterCmdWordData (eclPtr, (parse.commandStart - envPtr->source), parse.tokenPtr, parse.commandStart, parse.commandSize, parse.numWords, cmdLine, &wlines); wlineat = eclPtr->nuloc - 1; #endif for (wordIdx = 0, tokenPtr = parse.tokenPtr; wordIdx < parse.numWords; wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) { #ifdef TCL_TIP280 envPtr->line = eclPtr->loc [wlineat].line [wordIdx]; #endif if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { /* * If this is the first word and the command has a * compile procedure, let it compile the command. */ if (wordIdx == 0) {
︙
985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004	1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224	+ + + + - + + + + + + +	Tcl_DStringValue(&ds), (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0); if ((cmdPtr != NULL) && (cmdPtr->compileProc != NULL) && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES) && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) { int savedNumCmds = envPtr->numCommands; unsigned int savedCodeNext = envPtr->codeNext - envPtr->codeStart; code = (*(cmdPtr->compileProc))(interp, &parse, envPtr); if (code == TCL_OK) { goto finishCommand; } else if (code == TCL_OUT_LINE_COMPILE) { /* do nothing */ /* * Restore numCommands and codeNext to their correct * values, removing any commands compiled before * TCL_OUT_LINE_COMPILE [Bugs 705406 and 735055] */ envPtr->numCommands = savedNumCmds; envPtr->codeNext = envPtr->codeStart + savedCodeNext; } else { /* an error */ /* * There was a compilation error, the last * command did not get compiled into (*envPtr). * Decrement the number of commands * claimed to be in (*envPtr). */
︙
1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039	1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258	-	tokenPtr[1].start, tokenPtr[1].size); } TclEmitPush(objIndex, envPtr); } else { /* * The word is not a simple string of characters. */ code = TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, envPtr); if (code != TCL_OK) { goto log; } } }
︙
1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078	1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309	+ + + + + + + + - + + + + +	* offsets of the source and code for the command. */ finishCommand: EnterCmdExtentData(envPtr, currCmdIndex, commandLength, (envPtr->codeNext-envPtr->codeStart) - startCodeOffset); isFirstCmd = 0; #ifdef TCL_TIP280 /* TIP #280: Free full form of per-word line data and insert * the reduced form now */ ckfree ((char*) eclPtr->loc [wlineat].line); eclPtr->loc [wlineat].line = wlines; #endif } /* end if parse.numWords > 0 */ /* * Advance to the next command in the script. */ next = parse.commandStart + parse.commandSize; bytesLeft -= (next - p); p = next; #ifdef TCL_TIP280 /* TIP #280 : Track lines in the just compiled command */ TclAdvanceLines (&cmdLine, parse.commandStart, p); #endif Tcl_FreeParse(&parse); gotParse = 0; if (nested && (*parse.term == ']')) { /* * We get here in the special case where TCL_BRACKET_TERM was * set in the interpreter and the latest parsed command was * terminated by the matching close-bracket we were looking for.
︙
1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473	1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699	- + - - - - -	int numBytes, i, code; CONST char *script; code = TCL_OK; /* * If the expression is a single word that doesn't require * substitutions, just compile it's string into inline instructions. * substitutions, just compile its string into inline instructions. */ if ((numWords == 1) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) { /* * Temporarily overwrite the character just after the end of the * string with a 0 byte. */ script = tokenPtr[1].start; numBytes = tokenPtr[1].size; code = TclCompileExpr(interp, script, numBytes, envPtr); return code; } /*
︙
1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553	1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784	+ + + + +	register CompileEnv *envPtr; /* Points to the CompileEnv structure from * which to create a ByteCode structure. */ { register ByteCode *codePtr; size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes; size_t auxDataArrayBytes, structureSize; register unsigned char *p; #ifdef TCL_COMPILE_DEBUG unsigned char *nextPtr; #endif int numLitObjects = envPtr->literalArrayNext; Namespace *namespacePtr; int i; #ifdef TCL_TIP280 int new; #endif Interp *iPtr; iPtr = envPtr->iPtr; codeBytes = (envPtr->codeNext - envPtr->codeStart); objArrayBytes = (envPtr->literalArrayNext * sizeof(Tcl_Obj *)); exceptArrayBytes = (envPtr->exceptArrayNext * sizeof(ExceptionRange));
︙
1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632	1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865	+ + + -	memcpy((VOID *) p, (VOID *) envPtr->auxDataArrayPtr, (size_t) auxDataArrayBytes); } else { codePtr->auxDataArrayPtr = NULL; } p += auxDataArrayBytes; #ifndef TCL_COMPILE_DEBUG EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p); #else nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p); #ifdef TCL_COMPILE_DEBUG if (((size_t)(nextPtr - p)) != cmdLocBytes) { panic("TclInitByteCodeObj: encoded cmd location bytes %d != expected size %d\n", (nextPtr - p), cmdLocBytes); } #endif /* * Record various compilation-related statistics about the new ByteCode
︙
1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662	1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905	+ + + + + + + + + +	if ((objPtr->typePtr != NULL) && (objPtr->typePtr->freeIntRepProc != NULL)) { (*objPtr->typePtr->freeIntRepProc)(objPtr); } objPtr->internalRep.otherValuePtr = (VOID *) codePtr; objPtr->typePtr = &tclByteCodeType; #ifdef TCL_TIP280 /* TIP #280. Associate the extended per-word line information with the * byte code object (internal rep), for use with the bc compiler. */ Tcl_SetHashValue (Tcl_CreateHashEntry (iPtr->lineBCPtr, (char*) codePtr, &new), envPtr->extCmdMapPtr); envPtr->extCmdMapPtr = NULL; #endif }  /* *---------------------------------------------------------------------- * * LogCompilationInfo -- *
︙
1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733	1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984	+ + + + + + + +	if (length < 0) { length = strlen(command); } if (length > 150) { length = 150; ellipsis = "..."; } while ( (command[length] & 0xC0) == 0x80 ) { /* * Back up truncation point so that we don't truncate in the * middle of a multi-byte character (in UTF-8) */ length--; ellipsis = "..."; } sprintf(buffer, "\n while compiling\n\"%.*s%s\"", length, command, ellipsis); Tcl_AddObjErrorInfo(interp, buffer, -1); }  /*
︙
2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126	2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 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 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	cmdIndex); } cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]); cmdLocPtr->numSrcBytes = numSrcBytes; cmdLocPtr->numCodeBytes = numCodeBytes; }  #ifdef TCL_TIP280 /* *---------------------------------------------------------------------- * TIP #280 * * EnterCmdWordData -- * * Registers the lines for the words of a command. This information * is used at runtime by 'info frame'. * * Results: * None. * * Side effects: * Inserts word location information into the compilation * environment envPtr for the command at index cmdIndex. The * compilation environment's ExtCmdLoc.ECL array is grown if necessary. * *---------------------------------------------------------------------- */ static void EnterCmdWordData(eclPtr, srcOffset, tokenPtr, cmd, len, numWords, line, wlines) ExtCmdLoc *eclPtr; /* Points to the map environment * structure in which to enter command * location information. */ int srcOffset; /* Offset of first char of the command. */ Tcl_Token* tokenPtr; CONST char* cmd; int len; int numWords; int line; int** wlines; { ECL* ePtr; int wordIdx; CONST char* last; int wordLine; int* wwlines; if (eclPtr->nuloc >= eclPtr->nloc) { /* * Expand the ECL array by allocating more storage from the * heap. The currently allocated ECL entries are stored from * eclPtr->loc[0] up to eclPtr->loc[eclPtr->nuloc-1] (inclusive). */ size_t currElems = eclPtr->nloc; size_t newElems = (currElems ? 2*currElems : 1); size_t currBytes = currElems * sizeof(ECL); size_t newBytes = newElems * sizeof(ECL); ECL * newPtr = (ECL *) ckalloc((unsigned) newBytes); /* * Copy from old ECL array to new, free old ECL array if * needed. */ if (currBytes) { memcpy((VOID *) newPtr, (VOID *) eclPtr->loc, currBytes); } if (eclPtr->loc != NULL) { ckfree((char *) eclPtr->loc); } eclPtr->loc = (ECL *) newPtr; eclPtr->nloc = newElems; } ePtr = &eclPtr->loc [eclPtr->nuloc]; ePtr->srcOffset = srcOffset; ePtr->line = (int*) ckalloc (numWords * sizeof (int)); ePtr->nline = numWords; wwlines = (int*) ckalloc (numWords * sizeof (int)); last = cmd; wordLine = line; for (wordIdx = 0; wordIdx < numWords; wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) { TclAdvanceLines (&wordLine, last, tokenPtr->start); wwlines [wordIdx] = (TclWordKnownAtCompileTime (tokenPtr) ? wordLine : -1); ePtr->line [wordIdx] = wordLine; last = tokenPtr->start; } *wlines = wwlines; eclPtr->nuloc ++; } #endif  /* *---------------------------------------------------------------------- * * TclCreateExceptRange -- * * Procedure that allocates and initializes a new ExceptionRange
︙
3462 3463 3464 3465 3466 3467 3468	3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820	+ + + + + + + + +	statsPtr->currentExceptBytes += (double) (codePtr->numExceptRanges * sizeof(ExceptionRange)); statsPtr->currentAuxBytes += (double) (codePtr->numAuxDataItems * sizeof(AuxData)); statsPtr->currentCmdMapBytes += (double) codePtr->numCmdLocBytes; } #endif /* TCL_COMPILE_STATS */  /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	- +	/* * tclCompile.h -- * * Copyright (c) 1996-1998 Sun Microsystems, Inc. * Copyright (c) 1998-2000 by Scriptics Corporation. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclCompile.h,v 1.33 2002/10/09 11:54:05 das Exp $ * RCS: @(#) $Id: tclCompile.h,v 1.33.2.1 2006/11/28 22:20:00 andreas_kupries Exp $ */ #ifndef _TCLCOMPILATION #define _TCLCOMPILATION 1 #ifndef _TCLINT #include "tclInt.h"
︙
116 117 118 119 120 121 122 123 124 125 126 127 128 129	116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156	+ + + + + + + + + + + + + + + + + + + + + + + + + + +	typedef struct CmdLocation { int codeOffset; /* Offset of first byte of command code. */ int numCodeBytes; /* Number of bytes for command's code. */ int srcOffset; /* Offset of first char of the command. */ int numSrcBytes; /* Number of command source chars. */ } CmdLocation; #ifdef TCL_TIP280 /* * TIP #280 * Structure to record additional location information for byte code. * This information is internal and not saved. I.e. tbcload'ed code * will not have this information. It records the lines for all words * of all commands found in the byte code. The association with a * ByteCode structure BC is done through the 'lineBCPtr' HashTable in * Interp, keyed by the address of BC. Also recorded is information * coming from the context, i.e. type of the frame and associated * information, like the path of a sourced file. */ typedef struct ECL { int srcOffset; /* cmd location to find the entry */ int nline; int* line; /* line information for all words in the command */ } ECL; typedef struct ExtCmdLoc { int type; /* Context type */ Tcl_Obj* path; /* Path of the sourced file the command is in */ ECL* loc; /* Command word locations (lines) */ int nloc; /* Number of allocated entries in 'loc' */ int nuloc; /* Number of used entries in 'loc' */ } ExtCmdLoc; #endif /* * CompileProcs need the ability to record information during compilation * that can be used by bytecode instructions during execution. The AuxData * structure provides this "auxiliary data" mechanism. An arbitrary number * of these structures can be stored in the ByteCode record (during * compilation they are stored in a CompileEnv structure). Each AuxData
︙
260 261 262 263 264 265 266 267 268 269 270 271 272 273	287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308	+ + + + + + + +	/* Initial storage of LiteralEntry array. */ ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES]; /* Initial ExceptionRange array storage. */ CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE]; /* Initial storage for cmd location map. */ AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE]; /* Initial storage for aux data array. */ #ifdef TCL_TIP280 /* TIP #280 */ ExtCmdLoc* extCmdMapPtr; /* Extended command location information * for 'info frame'. */ int line; /* First line of the script, based on the * invoking context, then the line of the * command currently compiled. */ #endif } CompileEnv; /* * The structure defining the bytecode instructions resulting from compiling * a Tcl script. Note that this structure is variable length: a single heap * object is allocated to hold the ByteCode structure immediately followed * by the code bytes, the literal object array, the ExceptionRange array,
︙
723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738	758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779	+ + + + + +	/* *---------------------------------------------------------------- * Procedures exported by the engine to be used by tclBasic.c *---------------------------------------------------------------- */ #ifndef TCL_TIP280 EXTERN int TclCompEvalObj _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); #else EXTERN int TclCompEvalObj _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, CONST CmdFrame* invoker, int word)); #endif /* *---------------------------------------------------------------- * Procedures shared among Tcl bytecode compilation and execution * modules but not used outside: *---------------------------------------------------------------- */
︙
780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796	821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843	+ + + + + +	EXTERN void TclFreeCompileEnv _ANSI_ARGS_((CompileEnv *envPtr)); EXTERN void TclFreeJumpFixupArray _ANSI_ARGS_(( JumpFixupArray *fixupArrayPtr)); EXTERN void TclInitAuxDataTypeTable _ANSI_ARGS_((void)); EXTERN void TclInitByteCodeObj _ANSI_ARGS_((Tcl_Obj *objPtr, CompileEnv *envPtr)); EXTERN void TclInitCompilation _ANSI_ARGS_((void)); #ifndef TCL_TIP280 EXTERN void TclInitCompileEnv _ANSI_ARGS_((Tcl_Interp *interp, CompileEnv *envPtr, char *string, int numBytes)); #else EXTERN void TclInitCompileEnv _ANSI_ARGS_((Tcl_Interp *interp, CompileEnv *envPtr, char *string, int numBytes, CONST CmdFrame* invoker, int word)); #endif EXTERN void TclInitJumpFixupArray _ANSI_ARGS_(( JumpFixupArray *fixupArrayPtr)); EXTERN void TclInitLiteralTable _ANSI_ARGS_(( LiteralTable *tablePtr)); #ifdef TCL_COMPILE_STATS EXTERN char * TclLiteralStats _ANSI_ARGS_(( LiteralTable *tablePtr));
︙
1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046	1082 1083 1084 1085 1086 1087 1088	- - - - -	#define TclMin(i, j) ((((int) i) < ((int) j))? (i) : (j)) #define TclMax(i, j) ((((int) i) > ((int) j))? (i) : (j)) # undef TCL_STORAGE_CLASS # define TCL_STORAGE_CLASS DLLIMPORT #endif /* _TCLCOMPILATION */

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclDate.c -- * * This file is generated from a yacc grammar defined in * the file tclGetDate.y. It should not be edited directly. * * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans. * Copyright (c) 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. * * RCS: @(#) $Id: tclDate.c,v 1.20 2001/10/18 20:20:28 hobbs Exp $ * RCS: @(#) $Id: tclDate.c,v 1.20.4.3 2006/06/14 15:21:14 patthoyts Exp $ */ #include "tclInt.h" #include "tclPort.h" #if defined(MAC_TCL) && !defined(TCL_MAC_USE_MSL_EPOCH) # define EPOCH 1904
︙
330 331 332 333 334 335 336 337 338 339 340 341 342 343	330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346	+ + +	{ "sst", tZONE, -HOUR( 7) }, /* South Sumatra, USSR Zone 6 */ #endif /* 0 */ { "wast", tZONE, -HOUR( 7) }, /* West Australian Standard */ { "wadt", tDAYZONE, -HOUR( 7) }, /* West Australian Daylight */ { "jt", tZONE, -HOUR(15/2) }, /* Java (3pm in Cronusland!) */ { "cct", tZONE, -HOUR( 8) }, /* China Coast, USSR Zone 7 */ { "jst", tZONE, -HOUR( 9) }, /* Japan Standard, USSR Zone 8 */ { "jdt", tDAYZONE, -HOUR( 9) }, /* Japan Daylight */ { "kst", tZONE, -HOUR( 9) }, /* Korea Standard */ { "kdt", tDAYZONE, -HOUR( 9) }, /* Korea Daylight */ { "cast", tZONE, -HOUR(19/2) }, /* Central Australian Standard */ { "cadt", tDAYZONE, -HOUR(19/2) }, /* Central Australian Daylight */ { "east", tZONE, -HOUR(10) }, /* Eastern Australian Standard */ { "eadt", tDAYZONE, -HOUR(10) }, /* Eastern Australian Daylight */ { "gst", tZONE, -HOUR(10) }, /* Guam Standard, USSR Zone 9 */ { "nzt", tZONE, -HOUR(12) }, /* New Zealand */ { "nzst", tZONE, -HOUR(12) }, /* New Zealand Standard */
︙
471 472 473 474 475 476 477 478 479 480 481 482 483 484 485	474 475 476 477 478 479 480 481 482 483 484 485 486 487 488	- +	*/ for (Julian = Day - 1, i = 0; i < Month; i++) Julian += DaysInMonth[i]; if (Year >= EPOCH) { for (i = EPOCH; i < Year; i++) Julian += 365 + IsLeapYear(i); } else { for (i = Year; i < EPOCH; i++) for (i = (int)Year; i < EPOCH; i++) Julian -= 365 + IsLeapYear(i); } Julian *= SECSPERDAY; /* Add the timezone offset ?? */ Julian += TclDateTimezone * 60L;
︙
540 541 542 543 544 545 546 547 548 549 550 551 552 553 554	543 544 545 546 547 548 549 550 551 552 553 554 555 556 557	- +	tm = TclpGetDate((TclpTime_t)&now, 0); /* To compute the next n'th month, we use this alg: * add n to year value * if currentMonth < requestedMonth decrement year value by 1 (so that * doing next february from january gives us february of the current year) * set day to 1, time to 0 */ tm->tm_year += MonthOrdinal; tm->tm_year += (int)MonthOrdinal; if (tm->tm_mon < MonthNumber - 1) { tm->tm_year--; } result = Convert(MonthNumber, (time_t) 1, tm->tm_year + TM_YEAR_BASE, (time_t) 0, (time_t) 0, (time_t) 0, MER24, DSTmaybe, &now); if (result < 0) { return 0;
︙
828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855	831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858	- + - + - - + +	/* * Specify zone is of -50000 to force GMT. (This allows BST to work). */ int TclGetDate(p, now, zone, timePtr) char *p; unsigned long now; Tcl_WideInt now; long zone; unsigned long *timePtr; Tcl_WideInt *timePtr; { struct tm *tm; time_t Start; time_t Time; time_t tod; int thisyear; TclDateInput = p; /* now has to be cast to a time_t for 64bit compliance */ Start = now; tm = TclpGetDate((TclpTime_t) &Start, 0); Start = (time_t) now; tm = TclpGetDate((TclpTime_t) &Start, (zone == -50000)); thisyear = tm->tm_year + TM_YEAR_BASE; TclDateYear = thisyear; TclDateMonth = tm->tm_mon + 1; TclDateDay = tm->tm_mday; TclDateTimezone = zone; if (zone == -50000) { TclDateDSTmode = DSToff; /* assume GMT */
︙
900 901 902 903 904 905 906 907 908 909 910 911 912 913 914	903 904 905 906 907 908 909 910 911 912 913 914 915 916 917	- +	} } if (Convert(TclDateMonth, TclDateDay, TclDateYear, TclDateHour, TclDateMinutes, TclDateSeconds, TclDateMeridian, TclDateDSTmode, &Start) < 0) { return -1; } } else { Start = now; Start = (time_t) now; if (!TclDateHaveRel) { Start -= ((tm->tm_hour * 60L * 60L) + tm->tm_min * 60L) + tm->tm_sec; } } Start += TclDateRelSeconds;
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	- +	/* * tclDecls.h -- * * Declarations of functions in the platform independent public Tcl API. * * 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. * * RCS: @(#) $Id: tclDecls.h,v 1.93 2002/08/05 15:01:04 dgp Exp $ * RCS: @(#) $Id: tclDecls.h,v 1.93.2.7 2006/09/22 01:26:23 andreas_kupries Exp $ */ #ifndef _TCLDECLS #define _TCLDECLS /* * WARNING: This file is automatically generated by the tools/genStubs.tcl
︙
1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315	1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315	- +	/* 410 */ EXTERN Tcl_DriverFlushProc * Tcl_ChannelFlushProc _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 411 */ EXTERN Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 412 */ EXTERN int Tcl_JoinThread _ANSI_ARGS_((Tcl_ThreadId id, EXTERN int Tcl_JoinThread _ANSI_ARGS_((Tcl_ThreadId threadId, int* result)); /* 413 */ EXTERN int Tcl_IsChannelShared _ANSI_ARGS_((Tcl_Channel channel)); /* 414 */ EXTERN int Tcl_IsChannelRegistered _ANSI_ARGS_(( Tcl_Interp* interp, Tcl_Channel channel)); /* 415 */
︙
1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573	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 1656 1657 1658 1659	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	EXTERN Tcl_WideInt Tcl_Seek _ANSI_ARGS_((Tcl_Channel chan, Tcl_WideInt offset, int mode)); /* 492 */ EXTERN Tcl_WideInt Tcl_Tell _ANSI_ARGS_((Tcl_Channel chan)); /* 493 */ EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* Slot 494 is reserved */ /* Slot 495 is reserved */ /* Slot 496 is reserved */ /* Slot 497 is reserved */ /* Slot 498 is reserved */ /* Slot 499 is reserved */ /* Slot 500 is reserved */ /* Slot 501 is reserved */ /* Slot 502 is reserved */ /* Slot 503 is reserved */ /* Slot 504 is reserved */ /* Slot 505 is reserved */ /* Slot 506 is reserved */ /* Slot 507 is reserved */ /* Slot 508 is reserved */ /* Slot 509 is reserved */ /* Slot 510 is reserved */ /* Slot 511 is reserved */ /* Slot 512 is reserved */ /* Slot 513 is reserved */ /* Slot 514 is reserved */ /* Slot 515 is reserved */ /* Slot 516 is reserved */ /* Slot 517 is reserved */ /* Slot 518 is reserved */ /* Slot 519 is reserved */ /* Slot 520 is reserved */ /* Slot 521 is reserved */ /* Slot 522 is reserved */ /* Slot 523 is reserved */ /* Slot 524 is reserved */ /* Slot 525 is reserved */ /* Slot 526 is reserved */ /* Slot 527 is reserved */ /* Slot 528 is reserved */ /* Slot 529 is reserved */ /* Slot 530 is reserved */ /* Slot 531 is reserved */ /* Slot 532 is reserved */ /* Slot 533 is reserved */ /* Slot 534 is reserved */ /* Slot 535 is reserved */ /* Slot 536 is reserved */ /* Slot 537 is reserved */ /* Slot 538 is reserved */ /* Slot 539 is reserved */ /* Slot 540 is reserved */ /* Slot 541 is reserved */ /* Slot 542 is reserved */ /* Slot 543 is reserved */ /* Slot 544 is reserved */ /* Slot 545 is reserved */ /* Slot 546 is reserved */ /* Slot 547 is reserved */ /* Slot 548 is reserved */ /* Slot 549 is reserved */ /* Slot 550 is reserved */ /* Slot 551 is reserved */ /* Slot 552 is reserved */ /* Slot 553 is reserved */ /* 554 */ EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* Slot 555 is reserved */ /* Slot 556 is reserved */ /* Slot 557 is reserved */ /* Slot 558 is reserved */ /* Slot 559 is reserved */ /* Slot 560 is reserved */ /* Slot 561 is reserved */ /* Slot 562 is reserved */ /* Slot 563 is reserved */ /* Slot 564 is reserved */ /* Slot 565 is reserved */ /* Slot 566 is reserved */ /* Slot 567 is reserved */ /* Slot 568 is reserved */ /* Slot 569 is reserved */ /* Slot 570 is reserved */ /* Slot 571 is reserved */ /* Slot 572 is reserved */ /* 573 */ EXTERN int Tcl_PkgRequireProc _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, int objc, Tcl_Obj *CONST objv[], ClientData * clientDataPtr)); typedef struct TclStubHooks { struct TclPlatStubs *tclPlatStubs; struct TclIntStubs *tclIntStubs; struct TclIntPlatStubs *tclIntPlatStubs; } TclStubHooks;
︙
2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045	2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131	- +	Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 405 */ Tcl_DriverSetOptionProc * (*tcl_ChannelSetOptionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 406 */ Tcl_DriverGetOptionProc * (*tcl_ChannelGetOptionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 407 */ Tcl_DriverWatchProc * (*tcl_ChannelWatchProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 408 */ Tcl_DriverGetHandleProc * (*tcl_ChannelGetHandleProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 409 */ Tcl_DriverFlushProc * (*tcl_ChannelFlushProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 410 */ Tcl_DriverHandlerProc * (*tcl_ChannelHandlerProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 411 */ int (*tcl_JoinThread) _ANSI_ARGS_((Tcl_ThreadId id, int* result)); /* 412 */ int (*tcl_JoinThread) _ANSI_ARGS_((Tcl_ThreadId threadId, int* result)); /* 412 */ int (*tcl_IsChannelShared) _ANSI_ARGS_((Tcl_Channel channel)); /* 413 */ int (*tcl_IsChannelRegistered) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Channel channel)); /* 414 */ void (*tcl_CutChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 415 */ void (*tcl_SpliceChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 416 */ void (*tcl_ClearChannelHandlers) _ANSI_ARGS_((Tcl_Channel channel)); /* 417 */ int (*tcl_IsChannelExisting) _ANSI_ARGS_((CONST char* channelName)); /* 418 */ int (*tcl_UniCharNcasecmp) _ANSI_ARGS_((CONST Tcl_UniChar * cs, CONST Tcl_UniChar * ct, unsigned long n)); /* 419 */
︙
2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126	2199 2200 2201 2202 2203 2204 2205 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 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	int (*tcl_GetWideIntFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_WideInt * widePtr)); /* 487 */ Tcl_Obj * (*tcl_NewWideIntObj) _ANSI_ARGS_((Tcl_WideInt wideValue)); /* 488 */ void (*tcl_SetWideIntObj) _ANSI_ARGS_((Tcl_Obj * objPtr, Tcl_WideInt wideValue)); /* 489 */ Tcl_StatBuf * (*tcl_AllocStatBuf) _ANSI_ARGS_((void)); /* 490 */ Tcl_WideInt (*tcl_Seek) _ANSI_ARGS_((Tcl_Channel chan, Tcl_WideInt offset, int mode)); /* 491 */ Tcl_WideInt (*tcl_Tell) _ANSI_ARGS_((Tcl_Channel chan)); /* 492 */ Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 493 */ void *reserved494; void *reserved495; void *reserved496; void *reserved497; void *reserved498; void *reserved499; void *reserved500; void *reserved501; void *reserved502; void *reserved503; void *reserved504; void *reserved505; void *reserved506; void *reserved507; void *reserved508; void *reserved509; void *reserved510; void *reserved511; void *reserved512; void *reserved513; void *reserved514; void *reserved515; void *reserved516; void *reserved517; void *reserved518; void *reserved519; void *reserved520; void *reserved521; void *reserved522; void *reserved523; void *reserved524; void *reserved525; void *reserved526; void *reserved527; void *reserved528; void *reserved529; void *reserved530; void *reserved531; void *reserved532; void *reserved533; void *reserved534; void *reserved535; void *reserved536; void *reserved537; void *reserved538; void *reserved539; void *reserved540; void *reserved541; void *reserved542; void *reserved543; void *reserved544; void *reserved545; void *reserved546; void *reserved547; void *reserved548; void *reserved549; void *reserved550; void *reserved551; void *reserved552; void *reserved553; Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 554 */ void *reserved555; void *reserved556; void *reserved557; void *reserved558; void *reserved559; void *reserved560; void *reserved561; void *reserved562; void *reserved563; void *reserved564; void *reserved565; void *reserved566; void *reserved567; void *reserved568; void *reserved569; void *reserved570; void *reserved571; void *reserved572; int (*tcl_PkgRequireProc) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, int objc, Tcl_Obj *CONST objv[], ClientData * clientDataPtr)); /* 573 */ } TclStubs; #ifdef __cplusplus extern "C" { #endif extern TclStubs *tclStubsPtr; #ifdef __cplusplus
︙
4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142	4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	#define Tcl_Tell \ (tclStubsPtr->tcl_Tell) /* 492 */ #endif #ifndef Tcl_ChannelWideSeekProc #define Tcl_ChannelWideSeekProc \ (tclStubsPtr->tcl_ChannelWideSeekProc) /* 493 */ #endif /* Slot 494 is reserved */ /* Slot 495 is reserved */ /* Slot 496 is reserved */ /* Slot 497 is reserved */ /* Slot 498 is reserved */ /* Slot 499 is reserved */ /* Slot 500 is reserved */ /* Slot 501 is reserved */ /* Slot 502 is reserved */ /* Slot 503 is reserved */ /* Slot 504 is reserved */ /* Slot 505 is reserved */ /* Slot 506 is reserved */ /* Slot 507 is reserved */ /* Slot 508 is reserved */ /* Slot 509 is reserved */ /* Slot 510 is reserved */ /* Slot 511 is reserved */ /* Slot 512 is reserved */ /* Slot 513 is reserved */ /* Slot 514 is reserved */ /* Slot 515 is reserved */ /* Slot 516 is reserved */ /* Slot 517 is reserved */ /* Slot 518 is reserved */ /* Slot 519 is reserved */ /* Slot 520 is reserved */ /* Slot 521 is reserved */ /* Slot 522 is reserved */ /* Slot 523 is reserved */ /* Slot 524 is reserved */ /* Slot 525 is reserved */ /* Slot 526 is reserved */ /* Slot 527 is reserved */ /* Slot 528 is reserved */ /* Slot 529 is reserved */ /* Slot 530 is reserved */ /* Slot 531 is reserved */ /* Slot 532 is reserved */ /* Slot 533 is reserved */ /* Slot 534 is reserved */ /* Slot 535 is reserved */ /* Slot 536 is reserved */ /* Slot 537 is reserved */ /* Slot 538 is reserved */ /* Slot 539 is reserved */ /* Slot 540 is reserved */ /* Slot 541 is reserved */ /* Slot 542 is reserved */ /* Slot 543 is reserved */ /* Slot 544 is reserved */ /* Slot 545 is reserved */ /* Slot 546 is reserved */ /* Slot 547 is reserved */ /* Slot 548 is reserved */ /* Slot 549 is reserved */ /* Slot 550 is reserved */ /* Slot 551 is reserved */ /* Slot 552 is reserved */ /* Slot 553 is reserved */ #ifndef Tcl_ChannelThreadActionProc #define Tcl_ChannelThreadActionProc \ (tclStubsPtr->tcl_ChannelThreadActionProc) /* 554 */ #endif /* Slot 555 is reserved */ /* Slot 556 is reserved */ /* Slot 557 is reserved */ /* Slot 558 is reserved */ /* Slot 559 is reserved */ /* Slot 560 is reserved */ /* Slot 561 is reserved */ /* Slot 562 is reserved */ /* Slot 563 is reserved */ /* Slot 564 is reserved */ /* Slot 565 is reserved */ /* Slot 566 is reserved */ /* Slot 567 is reserved */ /* Slot 568 is reserved */ /* Slot 569 is reserved */ /* Slot 570 is reserved */ /* Slot 571 is reserved */ /* Slot 572 is reserved */ #ifndef Tcl_PkgRequireProc #define Tcl_PkgRequireProc \ (tclStubsPtr->tcl_PkgRequireProc) /* 573 */ #endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ /* !END!: Do not edit above this line. */ #endif /* _TCLDECLS */

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	- +	/* * tclEncoding.c -- * * Contains the implementation of the encoding conversion package. * * Copyright (c) 1996-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclEncoding.c,v 1.16 2003/02/21 02:40:58 hobbs Exp $ * RCS: @(#) $Id: tclEncoding.c,v 1.16.2.14 2007/02/12 19:25:42 andreas_kupries Exp $ */ #include "tclInt.h" #include "tclPort.h" typedef size_t (LengthProc)_ANSI_ARGS_((CONST char *src));
︙
174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199	174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202	+ + +	*/ static int BinaryProc _ANSI_ARGS_((ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)); static void DupEncodingIntRep _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *dupPtr)); static void EscapeFreeProc _ANSI_ARGS_((ClientData clientData)); static int EscapeFromUtfProc _ANSI_ARGS_((ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)); static int EscapeToUtfProc _ANSI_ARGS_((ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)); static void FreeEncoding _ANSI_ARGS_((Tcl_Encoding encoding)); static void FreeEncodingIntRep _ANSI_ARGS_((Tcl_Obj *objPtr)); static Encoding * GetTableEncoding _ANSI_ARGS_(( EscapeEncodingData *dataPtr, int state)); static Tcl_Encoding LoadEncodingFile _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name)); static Tcl_Encoding LoadTableEncoding _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, int type, Tcl_Channel chan)); static Tcl_Encoding LoadEscapeEncoding _ANSI_ARGS_((CONST char *name,
︙
222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237	225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)); static int UtfToUtfProc _ANSI_ARGS_((ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr, int pureNullMode)); static int UtfIntToUtfExtProc _ANSI_ARGS_((ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)); static int UtfExtToUtfIntProc _ANSI_ARGS_((ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)); static int TclFindEncodings _ANSI_ARGS_((CONST char *argv0)); /* * A Tcl_ObjType for holding a cached Tcl_Encoding as the intrep. * This should help the lifetime of encodings be more useful. * See concerns raised in [Bug 1077262]. */ static Tcl_ObjType EncodingType = { "encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL };  /* *---------------------------------------------------------------------- * * TclGetEncodingFromObj -- * * Writes to (*encodingPtr) the Tcl_Encoding value of (*objPtr), * if possible, and returns TCL_OK. If no such encoding exists, * TCL_ERROR is returned, and if interp is non-NULL, an error message * is written there. * * Results: * Standard Tcl return code. * * Side effects: * Caches the Tcl_Encoding value as the internal rep of (*objPtr). * *---------------------------------------------------------------------- */ int TclGetEncodingFromObj(interp, objPtr, encodingPtr) Tcl_Interp *interp; Tcl_Obj *objPtr; Tcl_Encoding *encodingPtr; { CONST char *name = Tcl_GetString(objPtr); if (objPtr->typePtr != &EncodingType) { Tcl_Encoding encoding = Tcl_GetEncoding(interp, name); if (encoding == NULL) { return TCL_ERROR; } if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) { objPtr->typePtr->freeIntRepProc(objPtr); } objPtr->internalRep.otherValuePtr = (VOID *) encoding; objPtr->typePtr = &EncodingType; } *encodingPtr = Tcl_GetEncoding(NULL, name); return TCL_OK; }  /* *---------------------------------------------------------------------- * * FreeEncodingIntRep -- * * The Tcl_FreeInternalRepProc for the "encoding" Tcl_ObjType. * *---------------------------------------------------------------------- */ static void FreeEncodingIntRep(objPtr) Tcl_Obj *objPtr; { Tcl_FreeEncoding((Tcl_Encoding) objPtr->internalRep.otherValuePtr); }  /* *---------------------------------------------------------------------- * * DupEncodingIntRep -- * * The Tcl_DupInternalRepProc for the "encoding" Tcl_ObjType. * *---------------------------------------------------------------------- */ static void DupEncodingIntRep(srcPtr, dupPtr) Tcl_Obj *srcPtr; Tcl_Obj *dupPtr; { dupPtr->internalRep.otherValuePtr = (VOID *) Tcl_GetEncoding(NULL, srcPtr->bytes); }  /* *--------------------------------------------------------------------------- * * TclInitEncodingSubsystem -- * * Initialize all resources used by this subsystem on a per-process
︙
268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283	367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382	- - + +	type.nullSize = 1; type.clientData = NULL; defaultEncoding = Tcl_CreateEncoding(&type); systemEncoding = Tcl_GetEncoding(NULL, type.encodingName); type.encodingName = "utf-8"; type.toUtfProc = UtfToUtfProc; type.fromUtfProc = UtfToUtfProc; type.toUtfProc = UtfExtToUtfIntProc; type.fromUtfProc = UtfIntToUtfExtProc; type.freeProc = NULL; type.nullSize = 1; type.clientData = NULL; Tcl_CreateEncoding(&type); type.encodingName = "unicode"; type.toUtfProc = UnicodeToUtfProc;
︙
309 310 311 312 313 314 315 316 317 318 319 320 321 322	408 409 410 411 412 413 414 415 416 417 418 419 420 421 422	+	TclFinalizeEncodingSubsystem() { Tcl_HashSearch search; Tcl_HashEntry *hPtr; Tcl_MutexLock(&encodingMutex); encodingsInitialized = 0; FreeEncoding(systemEncoding); hPtr = Tcl_FirstHashEntry(&encodingTable, &search); while (hPtr != NULL) { /* * Call FreeEncoding instead of doing it directly to handle refcounts * like escape encodings use. [Bug #524674] * Make sure to call Tcl_FirstHashEntry repeatedly so that all * encodings are eventually cleaned up.
︙
1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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	1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273	+ - - - - - + + + + + + + - + + - - - - + + + + + - - + + + + + + - +	*/ void Tcl_FindExecutable(argv0) CONST char *argv0; /* The value of the application's argv[0] * (native). */ { int mustCleanUtf; CONST char *name; Tcl_DString buffer, nameString; TclInitSubsystems(argv0); if (argv0 == NULL) { goto done; } if (tclExecutableName != NULL) { ckfree(tclExecutableName); tclExecutableName = NULL; } if ((name = TclpFindExecutable(argv0)) == NULL) { goto done; } /* * The value returned from TclpNameOfExecutable is a UTF string that * is possibly dirty depending on when it was initialized. To assure * that the UTF string is a properly encoded native string for this * system, convert the UTF string to the default native encoding * before the default encoding is initialized. Then, convert it back * to UTF after the system encoding is loaded. * is possibly dirty depending on when it was initialized. * TclFindEncodings will indicate whether we must "clean" the UTF (as * reported by the underlying system). To assure that the UTF string * is a properly encoded native string for this system, convert the * UTF string to the default native encoding before the default * encoding is initialized. Then, convert it back to UTF after the * system encoding is loaded. */ Tcl_UtfToExternalDString(NULL, name, -1, &buffer); TclFindEncodings(argv0); mustCleanUtf = TclFindEncodings(argv0); /* * Now it is OK to convert the native string back to UTF and set * the value of the tclExecutableName. */ if (mustCleanUtf) { Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&buffer), -1, &nameString); tclExecutableName = (char *) ckalloc((unsigned) (Tcl_DStringLength(&nameString) + 1)); strcpy(tclExecutableName, Tcl_DStringValue(&nameString)); Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&buffer), -1, &nameString); tclExecutableName = (char *) ckalloc((unsigned) (Tcl_DStringLength(&nameString) + 1)); strcpy(tclExecutableName, Tcl_DStringValue(&nameString)); Tcl_DStringFree(&buffer); Tcl_DStringFree(&nameString); Tcl_DStringFree(&nameString); } else { tclExecutableName = (char *) ckalloc((unsigned) (strlen(name) + 1)); strcpy(tclExecutableName, name); } Tcl_DStringFree(&buffer); return; done: TclFindEncodings(argv0); (void) TclFindEncodings(argv0); }  /* *--------------------------------------------------------------------------- * * LoadEncodingFile -- *
︙
1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255	1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367	+ + +	case 'E': { encoding = LoadEscapeEncoding(name, chan); break; } } if ((encoding == NULL) && (interp != NULL)) { Tcl_AppendResult(interp, "invalid encoding file \"", name, "\"", NULL); if (ch == 'E') { Tcl_AppendResult(interp, " or missing sub-encoding", NULL); } } Tcl_Close(NULL, chan); return encoding; unknown: if (interp != NULL) { Tcl_AppendResult(interp, "unknown encoding \"", name, "\"", NULL);
︙
1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623	1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735	- +	*/ static Tcl_Encoding LoadEscapeEncoding(name, chan) CONST char *name; /* Name for new encoding. */ Tcl_Channel chan; /* File containing new encoding. */ { int i; int i, missingSubEncoding = 0; unsigned int size; Tcl_DString escapeData; char init[16], final[16]; EscapeEncodingData *dataPtr; Tcl_EncodingType type; init[0] = '\0';
︙
1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675	1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798	+ + + + + - - - + + + + + + - + + + +	strncpy(est.sequence, argv[1], sizeof(est.sequence)); est.sequence[sizeof(est.sequence) - 1] = '\0'; est.sequenceLen = strlen(est.sequence); strncpy(est.name, argv[0], sizeof(est.name)); est.name[sizeof(est.name) - 1] = '\0'; /* * Load the subencodings first so we're never stuck * trying to use a half-loaded system encoding to * open/read a *.enc file. */ /* To avoid infinite recursion in [encoding system iso2022-*]*/ Tcl_GetEncoding(NULL, est.name); est.encodingPtr = (Encoding *) Tcl_GetEncoding(NULL, est.name); if ((est.encodingPtr == NULL) || (est.encodingPtr->toUtfProc != TableToUtfProc)) { missingSubEncoding = 1; } est.encodingPtr = NULL; Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est)); } } ckfree((char *) argv); Tcl_DStringFree(&lineString); } if (missingSubEncoding) { Tcl_DStringFree(&escapeData); return NULL; } size = sizeof(EscapeEncodingData) - sizeof(EscapeSubTable) + Tcl_DStringLength(&escapeData); dataPtr = (EscapeEncodingData *) ckalloc(size); dataPtr->initLen = strlen(init); strcpy(dataPtr->init, init);
︙
1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795	1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015	+ + + - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - +	srcLen = dstLen; result = TCL_CONVERT_NOSPACE; } *srcReadPtr = srcLen; *dstWrotePtr = srcLen; *dstCharsPtr = srcLen; memcpy((void *) dst, (void *) src, (size_t) srcLen); return result; } for ( ; --srcLen >= 0; ) { *dst++ = *src++; } return result;  /* *------------------------------------------------------------------------- * * UtfExtToUtfIntProc -- * * Convert from UTF-8 to UTF-8. While converting null-bytes from * the Tcl's internal representation (0xc0, 0x80) to the official * representation (0x00). See UtfToUtfProc for details. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int UtfIntToUtfExtProc(clientData, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr) ClientData clientData; /* Not used. */ CONST char *src; /* Source string in UTF-8. */ int srcLen; /* Source string length in bytes. */ int flags; /* Conversion control flags. */ Tcl_EncodingState *statePtr;/* Place for conversion routine to store * state information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst; /* Output buffer in which converted string * is stored. */ int dstLen; /* The maximum length of output buffer in * bytes. */ int *srcReadPtr; /* Filled with the number of bytes from the * source string that were converted. This * may be less than the original source length * if there was a problem converting some * source characters. */ int *dstWrotePtr; /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr; /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr, 1); } /* *------------------------------------------------------------------------- * * UtfExtToUtfIntProc -- * * Convert from UTF-8 to UTF-8 while converting null-bytes from * the official representation (0x00) to Tcl's internal * representation (0xc0, 0x80). See UtfToUtfProc for details. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int UtfExtToUtfIntProc(clientData, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr) ClientData clientData; /* Not used. */ CONST char *src; /* Source string in UTF-8. */ int srcLen; /* Source string length in bytes. */ int flags; /* Conversion control flags. */ Tcl_EncodingState *statePtr;/* Place for conversion routine to store * state information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst; /* Output buffer in which converted string * is stored. */ int dstLen; /* The maximum length of output buffer in * bytes. */ int *srcReadPtr; /* Filled with the number of bytes from the * source string that were converted. This * may be less than the original source length * if there was a problem converting some * source characters. */ int *dstWrotePtr; /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr; /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr, 0); }  /* *------------------------------------------------------------------------- * * UtfToUtfProc -- * * Convert from UTF-8 to UTF-8. Note that the UTF-8 to UTF-8 * translation is not a no-op, because it will turn a stream of * improperly formed UTF-8 into a properly formed stream. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: * None. * *------------------------------------------------------------------------- */ static int UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr) srcReadPtr, dstWrotePtr, dstCharsPtr, pureNullMode) ClientData clientData; /* Not used. */ CONST char *src; /* Source string in UTF-8. */ int srcLen; /* Source string length in bytes. */ int flags; /* Conversion control flags. */ Tcl_EncodingState *statePtr;/* Place for conversion routine to store * state information used during a piecewise * conversion. Contents of statePtr are
︙
1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819	2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043	+ + + +	* source characters. */ int *dstWrotePtr; /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr; /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ int pureNullMode; /* Convert embedded nulls from * internal representation to real * null-bytes or vice versa */ { CONST char *srcStart, *srcEnd, *srcClose; char *dstStart, *dstEnd; int result, numChars; Tcl_UniChar ch; result = TCL_OK;
︙
1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860	2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107	- + + + + + + + + + + + + + + + + + + + + + + + + - +	result = TCL_CONVERT_MULTIBYTE; break; } if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } if (UCHAR(*src) < 0x80) { if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && pureNullMode == 0)) { /* * Copy 7bit chatacters, but skip null-bytes when we are * in input mode, so that they get converted to 0xc080. */ *dst++ = *src++; } else if (pureNullMode == 1 && UCHAR(*src) == 0xc0 && UCHAR(*(src+1)) == 0x80) { /* * Convert 0xc080 to real nulls when we are in output mode. */ *dst++ = 0; src += 2; } else if (!Tcl_UtfCharComplete(src, srcEnd - src)) { /* Always check before using Tcl_UtfToUniChar. Not doing * can so cause it run beyond the endof the buffer! If we * * happen such an incomplete char its byts are made to * * represent themselves. */ ch = (Tcl_UniChar) *src; src += 1; dst += Tcl_UniCharToUtf(ch, dst); } else { src += Tcl_UtfToUniChar(src, &ch); dst += Tcl_UniCharToUtf(ch, dst); } } *srcReadPtr = src - srcStart; *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; return result; }  /* *-------------------------------------------------------------------------
︙
1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945	2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193	- + + - + - - - - + + - + - + + + - - + + - + - + - +	int *dstWrotePtr; /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr; /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { CONST Tcl_UniChar *wSrc, *wSrcStart, *wSrcEnd; CONST char *srcStart, *srcEnd; char *dstEnd, *dstStart; int result, numChars; Tcl_UniChar ch; result = TCL_OK; if ((srcLen % sizeof(Tcl_UniChar)) != 0) { result = TCL_CONVERT_MULTIBYTE; srcLen /= sizeof(Tcl_UniChar); srcLen *= sizeof(Tcl_UniChar); } wSrc = (Tcl_UniChar *) src; wSrcStart = (Tcl_UniChar *) src; wSrcEnd = (Tcl_UniChar *) (src + srcLen); srcStart = src; srcEnd = src + srcLen; dstStart = dst; dstEnd = dst + dstLen - TCL_UTF_MAX; for (numChars = 0; wSrc < wSrcEnd; numChars++) { for (numChars = 0; src < srcEnd; numChars++) { if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } /* * Special case for 1-byte utf chars for speed. * Special case for 1-byte utf chars for speed. Make sure we * work with Tcl_UniChar-size data. */ ch = *(Tcl_UniChar *)src; if (*wSrc && *wSrc < 0x80) { *dst++ = (char) *wSrc; if (ch && ch < 0x80) { *dst++ = (ch & 0xFF); } else { dst += Tcl_UniCharToUtf(*wSrc, dst); dst += Tcl_UniCharToUtf(ch, dst); } wSrc++; src += sizeof(Tcl_UniChar); } *srcReadPtr = (char *) wSrc - (char *) wSrcStart; *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; return result; }  /* *-------------------------------------------------------------------------
︙
1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029	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 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287	- + - + - + - - - + + - + - - + + + + + + + + + + + + + - +	int *dstWrotePtr; /* Filled with the number of bytes that were * stored in the output buffer as a result of * the conversion. */ int *dstCharsPtr; /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { CONST char *srcStart, *srcEnd, *srcClose; CONST char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd; Tcl_UniChar *wDst, *wDstStart, *wDstEnd; int result, numChars; Tcl_UniChar ch; srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } wDst = (Tcl_UniChar *) dst; wDstStart = (Tcl_UniChar *) dst; wDstEnd = (Tcl_UniChar *) (dst + dstLen - sizeof(Tcl_UniChar)); dstStart = dst; dstEnd = dst + dstLen - sizeof(Tcl_UniChar); result = TCL_OK; for (numChars = 0; src < srcEnd; numChars++) { if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { /* * If there is more string to follow, this will ensure that the * last UTF-8 character in the source buffer hasn't been cut off. */ result = TCL_CONVERT_MULTIBYTE; break; } if (wDst > wDstEnd) { if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } src += TclUtfToUniChar(src, wDst); wDst++; src += TclUtfToUniChar(src, &ch); /* * Need to handle this in a way that won't cause misalignment * by casting dst to a Tcl_UniChar. [Bug 1122671] * XXX: This hard-codes the assumed size of Tcl_UniChar as 2. */ #ifdef WORDS_BIGENDIAN *dst++ = (ch >> 8); *dst++ = (ch & 0xFF); #else *dst++ = (ch & 0xFF); *dst++ = (ch >> 8); #endif } *srcReadPtr = src - srcStart; *dstWrotePtr = (char *) wDst - (char *) wDstStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; return result; }  /* *------------------------------------------------------------------------- *
︙
2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223	2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492	+ + + + + + + + + + - + +	* last UTF-8 character in the source buffer hasn't been cut off. */ result = TCL_CONVERT_MULTIBYTE; break; } len = TclUtfToUniChar(src, &ch); #if TCL_UTF_MAX > 3 /* * This prevents a crash condition. More evaluation is required * for full support of int Tcl_UniChar. [Bug 1004065] */ if (ch & 0xffff0000) { word = 0; } else #endif word = fromUnicode[(ch >> 8)][ch & 0xff]; word = fromUnicode[(ch >> 8)][ch & 0xff]; if ((word == 0) && (ch != 0)) { if (flags & TCL_ENCODING_STOPONERROR) { result = TCL_CONVERT_UNKNOWN; break; } word = dataPtr->fallback; }
︙
2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575	2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844	- +	/* * RFC1468 states that the text starts in ASCII, and switches to Japanese * characters, and that the text must end in ASCII. [Patch #474358] */ if (flags & TCL_ENCODING_START) { state = 0; if (dst + dataPtr->initLen > dstEnd) { if ((dst + dataPtr->initLen) > dstEnd) { *srcReadPtr = 0; *dstWrotePtr = 0; return TCL_CONVERT_NOSPACE; } memcpy((VOID *) dst, (VOID *) dataPtr->init, (size_t) dataPtr->initLen); dst += dataPtr->initLen;
︙
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	2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973	+ + + + + + + + + + + - + +	dst++; } src += len; } if ((result == TCL_OK) && (flags & TCL_ENCODING_END)) { unsigned int len = dataPtr->subTables[0].sequenceLen; /* * [Bug 1516109]. * Certain encodings like iso2022-jp need to write * an escape sequence after all characters have * been converted. This logic checks that enough * room is available in the buffer for the escape bytes. * The TCL_ENCODING_END flag is cleared after a final * escape sequence has been added to the buffer so * that another call to this method does not attempt * to append escape bytes a second time. */ if (dst + dataPtr->finalLen + (state?len:0) > dstEnd) { if ((dst + dataPtr->finalLen + (state?len:0)) > dstEnd) { result = TCL_CONVERT_NOSPACE; } else { if (state) { memcpy((VOID *) dst, (VOID *) dataPtr->subTables[0].sequence, (size_t) len); dst += len; } memcpy((VOID *) dst, (VOID *) dataPtr->final, (size_t) dataPtr->finalLen); dst += dataPtr->finalLen; state &= ~TCL_ENCODING_END; } } *statePtr = (Tcl_EncodingState) state; *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars;
︙
2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770	3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056	+ + + + +	{ EscapeSubTable *subTablePtr; Encoding *encodingPtr; subTablePtr = &dataPtr->subTables[state]; encodingPtr = subTablePtr->encodingPtr; if (encodingPtr == NULL) { /* * Now that escape encodings load their sub-encodings first, and * fail to load if any sub-encodings are missing, this branch should * never happen. */ encodingPtr = (Encoding *) Tcl_GetEncoding(NULL, subTablePtr->name); if ((encodingPtr == NULL) || (encodingPtr->toUtfProc != TableToUtfProc)) { panic("EscapeToUtfProc: invalid sub table"); } subTablePtr->encodingPtr = encodingPtr; }
︙
2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884	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 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173	- - + + - + - + - - + + + + - + - + - + - - + + - - + + +	p = (unsigned short *) src; while (*p != 0x0000) { p++; } return (char *) p - src; }  /* *------------------------------------------------------------------------- * * TclFindEncodings -- * * Find and load the encoding file for this operating system. * Before this is called, Tcl makes assumptions about the * native string representation, but the true encoding is not * assured. * * Results: * None. * Return result of TclpInitLibraryPath, which reports whether the * path is clean (0) or dirty (1) UTF. * * Side effects: * Varied, see the respective initialization routines. * *------------------------------------------------------------------------- */ void static int TclFindEncodings(argv0) CONST char *argv0; /* Name of executable from argv[0] to main() * in native multi-byte encoding. */ { char *native; int mustCleanUtf = 0; Tcl_Obj *pathPtr; Tcl_DString libPath, buffer; if (encodingsInitialized == 0) { /* * Double check inside the mutex. There may be calls * back into this routine from some of the procedures below. */ TclpInitLock(); if (encodingsInitialized == 0) { char *native; Tcl_Obj *pathPtr; Tcl_DString libPath, buffer; /* * Have to set this bit here to avoid deadlock with the * routines below us that call into TclInitSubsystems. */ encodingsInitialized = 1; native = TclpFindExecutable(argv0); TclpInitLibraryPath(native); mustCleanUtf = TclpInitLibraryPath(native); /* * The library path was set in the TclpInitLibraryPath routine. * The string set is a dirty UTF string. To preserve the value * convert the UTF string back to native before setting the new * default encoding. */ pathPtr = TclGetLibraryPath(); if (pathPtr != NULL) { if ((pathPtr != NULL) && mustCleanUtf) { Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr), -1, &libPath); } TclpSetInitialEncodings(); /* * Now convert the native string back to UTF. */ if (pathPtr != NULL) { if ((pathPtr != NULL) && mustCleanUtf) { Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&libPath), -1, &buffer); pathPtr = Tcl_NewStringObj(Tcl_DStringValue(&buffer), -1); TclSetLibraryPath(pathPtr); Tcl_DStringFree(&libPath); Tcl_DStringFree(&buffer); } } TclpInitUnlock(); } } return mustCleanUtf; }

︙
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	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	- + + + + + + +	* * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclEnv.c,v 1.20 2003/01/14 02:06:11 mdejong Exp $ * RCS: @(#) $Id: tclEnv.c,v 1.20.2.3 2006/10/31 22:25:08 das Exp $ */ #include "tclInt.h" #include "tclPort.h" TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ */ static int cacheSize = 0; /* Number of env strings in environCache. */ static char **environCache = NULL; /* Array containing all of the environment * strings that Tcl has allocated. */ #ifndef USE_PUTENV static char **ourEnviron = NULL;/* Cache of the array that we allocate. * We need to track this in case another * subsystem swaps around the environ array * like we do. */ static int environSize = 0; /* Non-zero means that the environ array was * malloced and has this many total entries * allocated to it (not all may be in use at * once). Zero means that the environment * array is in its original static state. */ #endif /* * For MacOS X */ #if defined(__APPLE__) && defined(__DYNAMIC__) #include <crt_externs.h> __private_extern__ char **environ; char **environ = NULL; #endif /* * Declarations for local procedures defined in this file: */
︙
187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211	193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222	+ + + + + - + - - + + - +	*/ Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); if (index == -1) { #ifndef USE_PUTENV /* * We need to handle the case where the environment may be changed * outside our control. environSize is only valid if the current * environment is the one we allocated. [Bug 979640] */ if ((length + 2) > environSize) { if ((ourEnviron != environ) || ((length + 2) > environSize)) { char **newEnviron; newEnviron = (char **) ckalloc((unsigned) ((length + 5) * sizeof(char *))); memcpy((VOID *) newEnviron, (VOID *) environ, length*sizeof(char *)); if (environSize != 0) { ckfree((char *) environ); if ((environSize != 0) && (ourEnviron != NULL)) { ckfree((char *) ourEnviron); } environ = newEnviron; environ = ourEnviron = newEnviron; environSize = length + 5; #if defined(__APPLE__) && defined(__DYNAMIC__) { char ***e = _NSGetEnviron(); *e = environ; } #endif
︙
233 234 235 236 237 238 239 240 241 242 243 244 245 246 247	244 245 246 247 248 249 250 251 252 253 254 255 256 257	-	return; } Tcl_DStringFree(&envString); oldValue = environ[index]; nameLength = length; } /* * Create a new entry. Build a complete UTF string that contains * a "name=value" pattern. Then convert the string to the native * encoding, and set the environ array value. */
︙
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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438	384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463	- + - + - + + + + + + + + + + + - + + + + + +	void TclUnsetEnv(name) CONST char *name; /* Name of variable to remove (UTF-8). */ { char *oldValue; int length; int index; #ifdef USE_PUTENV #ifdef USE_PUTENV_FOR_UNSET Tcl_DString envString; char *string; #else char **envPtr; #endif Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); /* * First make sure that the environment variable exists to avoid * doing needless work and to avoid recursion on the unset. */ if (index == -1) { Tcl_MutexUnlock(&envMutex); return; } /* * Remember the old value so we can free it if Tcl created the string. */ oldValue = environ[index]; /* * Update the system environment. This must be done before we * update the interpreters or we will recurse. */ #ifdef USE_PUTENV #ifdef USE_PUTENV_FOR_UNSET /* * For those platforms that support putenv to unset, Linux indicates * that no = should be included, and Windows requires it. */ #ifdef WIN32 string = ckalloc((unsigned int) length+2); memcpy((VOID *) string, (VOID *) name, (size_t) length); string[length] = '='; string[length+1] = '\0'; #else string = ckalloc((unsigned int) length+1); memcpy((VOID *) string, (VOID *) name, (size_t) length); string[length] = '\0'; #endif Tcl_UtfToExternalDString(NULL, string, -1, &envString); string = ckrealloc(string, (unsigned) (Tcl_DStringLength(&envString)+1)); strcpy(string, Tcl_DStringValue(&envString)); Tcl_DStringFree(&envString); putenv(string); /* * Watch out for versions of putenv that copy the string (e.g. VC++). * In this case we need to free the string immediately. Otherwise * update the string in the cache. */ if (environ[index] == string) { ReplaceString(oldValue, string); #ifdef HAVE_PUTENV_THAT_COPIES } else { /* This putenv() copies instead of taking ownership */ ckfree(string); #endif } #else for (envPtr = environ+index+1; ; envPtr++) { envPtr[-1] = *envPtr; if (*envPtr == NULL) { break; }
︙
624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656	649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681	- + - + - +	/* * Replace or delete the old value. */ if (environCache[i]) { ckfree(environCache[i]); } if (newStr) { environCache[i] = newStr; } else { for (; i < cacheSize-1; i++) { environCache[i] = environCache[i+1]; } environCache[cacheSize-1] = NULL; } } else { } else { int allocatedSize = (cacheSize + 5) * sizeof(char *); /* * We need to grow the cache in order to hold the new string. */ newCache = (char **) ckalloc((unsigned) allocatedSize); (VOID *) memset(newCache, (int) 0, (size_t) allocatedSize); if (environCache) { memcpy((VOID *) newCache, (VOID *) environCache, (size_t) (cacheSize * sizeof(char*))); ckfree((char *) environCache); } environCache = newCache; environCache[cacheSize] = newStr;
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	/* * tclEvent.c -- * * This file implements some general event related interfaces including * background errors, exit handlers, and the "vwait" and "update" * command procedures. * * Copyright (c) 1990-1994 The Regents of the University of California. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclEvent.c,v 1.28 2003/02/22 09:23:16 vasiljevic Exp $ * RCS: @(#) $Id: tclEvent.c,v 1.28.2.15 2007/03/19 17:06:25 dgp Exp $ */ #include "tclInt.h" #include "tclPort.h" /* * The data structure below is used to report background errors. One
︙
96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111	96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123	+ - + + + + + + + + + + + +	* the standard channels. */ Tcl_Obj *tclLibraryPath; /* Path(s) to the Tcl library */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * Common string for the library path for sharing across threads. * This is ckalloc'd and cleared in Tcl_Finalize. */ char *tclLibraryPathStr; static char *tclLibraryPathStr = NULL; #ifdef TCL_THREADS typedef struct { Tcl_ThreadCreateProc *proc; /* Main() function of the thread */ ClientData clientData; /* The one argument to Main() */ } ThreadClientData; static Tcl_ThreadCreateType NewThreadProc _ANSI_ARGS_(( ClientData clientData)); #endif /* * Prototypes for procedures referenced only in this file: */ static void BgErrorDeleteProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp));
︙
589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616	601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635	+ + + + + - + + +	void TclSetLibraryPath(pathPtr) Tcl_Obj *pathPtr; /* A Tcl list object whose elements are * the new library path. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); const char *toDupe; int size; if (pathPtr != NULL) { Tcl_IncrRefCount(pathPtr); } if (tsdPtr->tclLibraryPath != NULL) { Tcl_DecrRefCount(tsdPtr->tclLibraryPath); } tsdPtr->tclLibraryPath = pathPtr; /* * No mutex locking is needed here as up the stack we're within * TclpInitLock(). */ if (tclLibraryPathStr != NULL) { ckfree(tclLibraryPathStr); } tclLibraryPathStr = Tcl_GetStringFromObj(pathPtr, NULL); toDupe = Tcl_GetStringFromObj(pathPtr, &size); tclLibraryPathStr = ckalloc((unsigned)size+1); memcpy(tclLibraryPathStr, toDupe, (unsigned)size+1); }  /* *------------------------------------------------------------------------- * * TclGetLibraryPath -- *
︙
708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733	727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753	+ - + - +	tclExecutableName = NULL; /* * Initialize locks used by the memory allocators before anything * interesting happens so we can use the allocators in the * implementation of self-initializing locks. */ #if USE_TCLALLOC TclInitAlloc(); /* process wide mutex init */ #endif #ifdef TCL_MEM_DEBUG TclInitDbCkalloc(); /* process wide mutex init */ #endif TclpInitPlatform(); /* creates signal handler(s) */ TclInitObjSubsystem(); /* register obj types, create mutexes */ TclInitObjSubsystem(); /* register obj types, create mutexes */ TclInitIOSubsystem(); /* inits a tsd key (noop) */ TclInitEncodingSubsystem(); /* process wide encoding init */ TclInitNamespaceSubsystem(); /* register ns obj type (mutexed) */ TclInitNamespaceSubsystem(); /* register ns obj type (mutexed) */ } TclpInitUnlock(); } if (tsdPtr == NULL) { /* * First time this thread has created an interpreter.
︙
759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883	779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947	- - + - - - - - - - - - + + + - - - - - - - - - + + + + + + + + + - - - - - - - - + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - +	*---------------------------------------------------------------------- */ void Tcl_Finalize() { ExitHandler *exitPtr; ThreadSpecificData *tsdPtr; TclpInitLock(); if (subsystemsInitialized != 0) { subsystemsInitialized = 0; tsdPtr = TCL_TSD_INIT(&dataKey); /* * Invoke exit handlers first. */ /* * Invoke exit handlers first. */ Tcl_MutexLock(&exitMutex); inFinalize = 1; for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) { /* * Be careful to remove the handler from the list before * invoking its callback. This protects us against * double-freeing if the callback should call * Tcl_DeleteExitHandler on itself. */ Tcl_MutexLock(&exitMutex); inFinalize = 1; for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) { /* * Be careful to remove the handler from the list before * invoking its callback. This protects us against * double-freeing if the callback should call * Tcl_DeleteExitHandler on itself. */ firstExitPtr = exitPtr->nextPtr; Tcl_MutexUnlock(&exitMutex); (*exitPtr->proc)(exitPtr->clientData); ckfree((char *) exitPtr); Tcl_MutexLock(&exitMutex); } firstExitPtr = NULL; Tcl_MutexUnlock(&exitMutex); firstExitPtr = exitPtr->nextPtr; Tcl_MutexUnlock(&exitMutex); (*exitPtr->proc)(exitPtr->clientData); ckfree((char *) exitPtr); Tcl_MutexLock(&exitMutex); } firstExitPtr = NULL; Tcl_MutexUnlock(&exitMutex); TclpInitLock(); if (subsystemsInitialized != 0) { subsystemsInitialized = 0; /* * Ensure the thread-specific data is initialised as it is * used in Tcl_FinalizeThread() */ (void) TCL_TSD_INIT(&dataKey); /* * Clean up after the current thread now, after exit handlers. * In particular, the testexithandler command sets up something * that writes to standard output, which gets closed. * Note that there is no thread-local storage after this call. */ Tcl_FinalizeThread(); /* * Now finalize the Tcl execution environment. Note that this * must be done after the exit handlers, because there are * order dependencies. */ TclFinalizeCompExecEnv(); TclFinalizeCompilation(); TclFinalizeExecution(); TclFinalizeEnvironment(); /* * Finalizing the filesystem must come after anything which * might conceivably interact with the 'Tcl_FS' API. */ TclFinalizeFilesystem(); /* * Undo all the Tcl_ObjType registrations, and reset the master list * of free Tcl_Obj's. After this returns, no more Tcl_Obj's should * be allocated or freed. * * Note in particular that TclFinalizeObjects() must follow * TclFinalizeFilesystem() because TclFinalizeFilesystem free's * the Tcl_Obj that holds the path of the current working directory. */ TclFinalizeObjects(); /* * We must be sure the encoding finalization doesn't need * to examine the filesystem in any way. Since it only * needs to clean up internal data structures, this is * fine. */ TclFinalizeEncodingSubsystem(); if (tclExecutableName != NULL) { ckfree(tclExecutableName); tclExecutableName = NULL; } if (tclNativeExecutableName != NULL) { ckfree(tclNativeExecutableName); tclNativeExecutableName = NULL; } if (tclDefaultEncodingDir != NULL) { ckfree(tclDefaultEncodingDir); tclDefaultEncodingDir = NULL; } if (tclLibraryPathStr != NULL) { ckfree(tclLibraryPathStr); tclLibraryPathStr = NULL; } Tcl_SetPanicProc(NULL); /* * There have been several bugs in the past that cause * exit handlers to be established during Tcl_Finalize * processing. Such exit handlers leave malloc'ed memory, * and Tcl_FinalizeThreadAlloc or Tcl_FinalizeMemorySubsystem * will result in a corrupted heap. The result can be a * mysterious crash on process exit. Check here that * nobody's done this. */ #ifdef TCL_MEM_DEBUG if ( firstExitPtr != NULL ) { Tcl_Panic( "exit handlers were created during Tcl_Finalize" ); } #endif TclFinalizePreserve(); /* * Free synchronization objects. There really should only be one * thread alive at this moment. */ TclFinalizeSynchronization(); #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG) && !defined(PURIFY) TclFinalizeThreadAlloc(); #endif /* * We defer unloading of packages until very late * to avoid memory access issues. Both exit callbacks and * synchronization variables may be stored in packages. * * Note that TclFinalizeLoad unloads packages in the reverse * of the order they were loaded in (i.e. last to be loaded * is the first to be unloaded). This can be important for * correct unloading when dependencies exist. * * Once load has been finalized, we will have deleted any * temporary copies of shared libraries and can therefore * reset the filesystem to its original state. */ TclFinalizeLoad(); TclResetFilesystem(); /* * There shouldn't be any malloc'ed memory after this. * At this point, there should no longer be any ckalloc'ed memory. */ TclFinalizeMemorySubsystem(); inFinalize = 0; } TclpInitUnlock(); TclFinalizeLock(); }  /* *---------------------------------------------------------------------- * * Tcl_FinalizeThread -- *
︙
893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909	957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973	- + - +	*---------------------------------------------------------------------- */ void Tcl_FinalizeThread() { ExitHandler *exitPtr; ThreadSpecificData *tsdPtr = ThreadSpecificData *tsdPtr; (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (tsdPtr != NULL) { tsdPtr->inExit = 1; /* * Clean up the library path now, before we invalidate thread-local * storage or calling thread exit handlers. */
︙
926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950	990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014	- - + + - + - +	ckfree((char *) exitPtr); } TclFinalizeIOSubsystem(); TclFinalizeNotifier(); TclFinalizeAsync(); } /* * Blow away all thread local storage blocks. /* * Blow away all thread local storage blocks. * * Note that Tcl API allows creation of threads which do not use any * Tcl interp or other Tcl subsytems. Those threads might, however, * use thread local storage, so we must unconditionally finalize it. * * Fix [Bug #571002] */ */ TclFinalizeThreadData(); TclFinalizeThreadData(); }  /* *---------------------------------------------------------------------- * * TclInExit -- *
︙
1128 1129 1130 1131 1132 1133 1134	1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	* Must clear the interpreter's result because event handlers could * have executed commands. */ Tcl_ResetResult(interp); return TCL_OK; } #ifdef TCL_THREADS /* *----------------------------------------------------------------------------- * * NewThreadProc -- * * Bootstrap function of a new Tcl thread. * * Results: * None. * * Side Effects: * Initializes Tcl notifier for the current thread. * *----------------------------------------------------------------------------- */ static Tcl_ThreadCreateType NewThreadProc(ClientData clientData) { ThreadClientData *cdPtr; ClientData threadClientData; Tcl_ThreadCreateProc *threadProc; cdPtr = (ThreadClientData*)clientData; threadProc = cdPtr->proc; threadClientData = cdPtr->clientData; ckfree((char*)clientData); /* Allocated in Tcl_CreateThread() */ (*threadProc)(threadClientData); TCL_THREAD_CREATE_RETURN; } #endif /* *---------------------------------------------------------------------- * * Tcl_CreateThread -- * * This procedure creates a new thread. This actually belongs * to the tclThread.c file but since we use some private * data structures local to this file, it is placed here. * * Results: * TCL_OK if the thread could be created. The thread ID is * returned in a parameter. * * Side effects: * A new thread is created. * *---------------------------------------------------------------------- */ int Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags) Tcl_ThreadId *idPtr; /* Return, the ID of the thread */ Tcl_ThreadCreateProc proc; /* Main() function of the thread */ ClientData clientData; /* The one argument to Main() */ int stackSize; /* Size of stack for the new thread */ int flags; /* Flags controlling behaviour of * the new thread */ { #ifdef TCL_THREADS ThreadClientData *cdPtr; cdPtr = (ThreadClientData*)ckalloc(sizeof(ThreadClientData)); cdPtr->proc = proc; cdPtr->clientData = clientData; return TclpThreadCreate(idPtr, NewThreadProc, (ClientData)cdPtr, stackSize, flags); #else return TCL_ERROR; #endif /* TCL_THREADS */ }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	/* * tclExecute.c -- * * This file contains procedures that execute byte-compiled Tcl * commands. * * Copyright (c) 1996-1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 by Scriptics Corporation. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclExecute.c,v 1.94 2003/02/19 14:33:39 msofer Exp $ * RCS: @(#) $Id: tclExecute.c,v 1.94.2.21 2007/03/13 16:26:32 dgp Exp $ */ #include "tclInt.h" #include "tclCompile.h" #ifndef TCL_NO_MATH # include "tclMath.h"
︙
254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279	254 255 256 257 258 259 260 261 262 263 264 265 266 267	- - - - - - - - - - - -	#else /* !TCL_COMPILE_DEBUG */ # define TRACE(a) # define TRACE_APPEND(a) # define TRACE_WITH_OBJ(a, objPtr) # define O2S(objPtr) #endif /* TCL_COMPILE_DEBUG */ /* * Most of the code to support working with wide values is factored * out here because it greatly reduces the number of conditionals * through the rest of the file. Note that this needs to be * conditional because we do not want to alter Tcl's behaviour on * native-64bit platforms... */ #ifndef TCL_WIDE_INT_IS_LONG #define W0 Tcl_LongAsWide(0) /* * Macro to read a string containing either a wide or an int and * decide which it is while decoding it at the same time. This * enforces the policy that integer constants between LONG_MIN and * LONG_MAX (inclusive) are represented by normal longs, and integer * constants outside that range are represented by wide ints. *
︙
293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 355	281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333	+ + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - + - - - - -	&(wideVar)); \ if ((resultVar) == TCL_OK && (wideVar) >= Tcl_LongAsWide(LONG_MIN) \ && (wideVar) <= Tcl_LongAsWide(LONG_MAX)) { \ (objPtr)->typePtr = &tclIntType; \ (objPtr)->internalRep.longValue = (longVar) \ = Tcl_WideAsLong(wideVar); \ } /* * Combined with REQUIRE_WIDE_OR_INT, this gets a long value from * an obj. */ #define FORCE_LONG(objPtr, longVar, wideVar) \ if ((objPtr)->typePtr == &tclWideIntType) { \ (longVar) = Tcl_WideAsLong(wideVar); \ } #define IS_INTEGER_TYPE(typePtr) \ ((typePtr) == &tclIntType || (typePtr) == &tclWideIntType) #define IS_NUMERIC_TYPE(typePtr) \ (IS_INTEGER_TYPE(typePtr) || (typePtr) == &tclDoubleType) #define W0 Tcl_LongAsWide(0) /* * For tracing that uses wide values. */ #define LLD "%" TCL_LL_MODIFIER "d" #ifndef TCL_WIDE_INT_IS_LONG /* * Extract a double value from a general numeric object. */ #define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr) \ if ((typePtr) == &tclIntType) { \ (doubleVar) = (double) (objPtr)->internalRep.longValue; \ } else if ((typePtr) == &tclWideIntType) { \ (doubleVar) = Tcl_WideAsDouble((objPtr)->internalRep.wideValue);\ } else { \ (doubleVar) = (objPtr)->internalRep.doubleValue; \ } /* * Combined with REQUIRE_WIDE_OR_INT, this gets a long value from * an obj. */ #define FORCE_LONG(objPtr, longVar, wideVar) \ if ((objPtr)->typePtr == &tclWideIntType) { \ (longVar) = Tcl_WideAsLong(wideVar); \ } /* * For tracing that uses wide values. */ #define LLTRACE(a) TRACE(a) #define LLTRACE_WITH_OBJ(a,b) TRACE_WITH_OBJ(a,b) #define LLD "%" TCL_LL_MODIFIER "d" #else /* TCL_WIDE_INT_IS_LONG */ /* * Versions of the above that do not use wide values. */ #define REQUIRE_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar) \ (resultVar) = Tcl_GetLongFromObj(interp, (objPtr), &(longVar)); #define GET_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar) \ (resultVar) = Tcl_GetLongFromObj((Tcl_Interp *) NULL, (objPtr), \ &(longVar)); #define IS_INTEGER_TYPE(typePtr) ((typePtr) == &tclIntType) #define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr) \ if ((typePtr) == &tclIntType) { \ if (((typePtr) == &tclIntType) || ((typePtr) == &tclWideIntType)) { \ (doubleVar) = (double) (objPtr)->internalRep.longValue; \ } else { \ (doubleVar) = (objPtr)->internalRep.doubleValue; \ } #define FORCE_LONG(objPtr, longVar, wideVar) #define LLTRACE(a) #define LLTRACE_WITH_OBJ(a,b) #endif /* TCL_WIDE_INT_IS_LONG */ #define IS_NUMERIC_TYPE(typePtr) \ (IS_INTEGER_TYPE(typePtr) || (typePtr) == &tclDoubleType) /* * Declarations for local procedures to this file: */ static int TclExecuteByteCode _ANSI_ARGS_((Tcl_Interp *interp, ByteCode *codePtr));
︙
367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384	345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360	- -	ExecEnv *eePtr, ClientData clientData)); static int ExprRoundFunc _ANSI_ARGS_((Tcl_Interp *interp, ExecEnv *eePtr, ClientData clientData)); static int ExprSrandFunc _ANSI_ARGS_((Tcl_Interp *interp, ExecEnv *eePtr, ClientData clientData)); static int ExprUnaryFunc _ANSI_ARGS_((Tcl_Interp *interp, ExecEnv *eePtr, ClientData clientData)); #ifndef TCL_WIDE_INT_IS_LONG static int ExprWideFunc _ANSI_ARGS_((Tcl_Interp *interp, ExecEnv *eePtr, ClientData clientData)); #endif /* TCL_WIDE_INT_IS_LONG */ #ifdef TCL_COMPILE_STATS static int EvalStatsCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); #endif /* TCL_COMPILE_STATS */ #ifdef TCL_COMPILE_DEBUG static char * GetOpcodeName _ANSI_ARGS_((unsigned char *pc));
︙
433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451	409 410 411 412 413 414 415 416 417 418 419 420 421 422 423	- - - -	#endif {"abs", 1, {TCL_EITHER}, ExprAbsFunc, 0}, {"double", 1, {TCL_EITHER}, ExprDoubleFunc, 0}, {"int", 1, {TCL_EITHER}, ExprIntFunc, 0}, {"rand", 0, {TCL_EITHER}, ExprRandFunc, 0}, /* NOTE: rand takes no args. */ {"round", 1, {TCL_EITHER}, ExprRoundFunc, 0}, {"srand", 1, {TCL_INT}, ExprSrandFunc, 0}, #ifdef TCL_WIDE_INT_IS_LONG {"wide", 1, {TCL_EITHER}, ExprIntFunc, 0}, #else {"wide", 1, {TCL_EITHER}, ExprWideFunc, 0}, #endif /* TCL_WIDE_INT_IS_LONG */ {0}, };  /* *---------------------------------------------------------------------- * * InitByteCodeExecution --
︙
771 772 773 774 775 776 777 778 779 780 781 782 783 784 785	743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762	+ + + + +	} else { (*tclByteCodeType.freeIntRepProc)(objPtr); objPtr->typePtr = (Tcl_ObjType *) NULL; } } } if (objPtr->typePtr != &tclByteCodeType) { #ifndef TCL_TIP280 TclInitCompileEnv(interp, &compEnv, string, length); #else /* TIP #280 : No invoker (yet) - Expression compilation */ TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0); #endif result = TclCompileExpr(interp, string, length, &compEnv); /* * Free the compilation environment's literal table bucket array if * it was dynamically allocated. */
︙
901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957	878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959	+ + + + + + + + + + + + + + + + + + + + + + + + + + -	* Side effects: * Almost certainly, depending on the ByteCode's instructions. * *---------------------------------------------------------------------- */ int #ifndef TCL_TIP280 TclCompEvalObj(interp, objPtr) #else TclCompEvalObj(interp, objPtr, invoker, word) #endif Tcl_Interp *interp; Tcl_Obj *objPtr; #ifdef TCL_TIP280 CONST CmdFrame* invoker; /* Frame of the command doing the eval */ int word; /* Index of the word which is in objPtr */ #endif { register Interp *iPtr = (Interp *) interp; register ByteCode* codePtr; /* Tcl Internal type of bytecode. */ int oldCount = iPtr->cmdCount; /* Used to tell whether any commands * at all were executed. */ char *script; int numSrcBytes; int result; Namespace *namespacePtr; /* * Check that the interpreter is ready to execute scripts */ iPtr->numLevels++; if (TclInterpReady(interp) == TCL_ERROR) { iPtr->numLevels--; return TCL_ERROR; } if (iPtr->varFramePtr != NULL) { namespacePtr = iPtr->varFramePtr->nsPtr; } else { namespacePtr = iPtr->globalNsPtr; } /* * If the object is not already of tclByteCodeType, compile it (and * reset the compilation flags in the interpreter; this should be * done after any compilation). * Otherwise, check that it is "fresh" enough. */ if (objPtr->typePtr != &tclByteCodeType) { recompileObj: iPtr->errorLine = 1; #ifdef TCL_TIP280 /* TIP #280. Remember the invoker for a moment in the interpreter * structures so that the byte code compiler can pick it up when * initializing the compilation environment, i.e. the extended * location information. */ iPtr->invokeCmdFramePtr = invoker; iPtr->invokeWord = word; #endif result = tclByteCodeType.setFromAnyProc(interp, objPtr); #ifdef TCL_TIP280 iPtr->invokeCmdFramePtr = NULL; #endif if (result != TCL_OK) { iPtr->numLevels--; return result; } iPtr->evalFlags = 0; codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; } else { /* * Make sure the Bytecode hasn't been invalidated by, e.g., someone * redefining a command with a compile procedure (this might make the * compiled code wrong). * The object needs to be recompiled if it was compiled in/for a
︙
1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023	1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025	- - + +	if ((numSrcBytes > 0) || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) { /* * Increment the code's ref count while it is being executed. If * afterwards no references to it remain, free the code. */ codePtr->refCount++; iPtr->numLevels++; result = TclExecuteByteCode(interp, codePtr); iPtr->numLevels--; codePtr->refCount--; if (codePtr->refCount <= 0) { TclCleanupByteCode(codePtr); } } else { result = TCL_OK; } iPtr->numLevels--; /* * If no commands at all were executed, check for asynchronous * handlers so that they at least get one change to execute. * This is needed to handle event loops written in Tcl with * empty bodies. */
︙
1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130	1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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	- - + + + + + + + + + + + + + + + + + + + + + + + + + +	* process break, continue, and errors. */ int result = TCL_OK; /* Return code returned after execution. */ int storeFlags; Tcl_Obj *valuePtr, *value2Ptr, *objPtr; char *bytes; int length; long i = 0; /* Init. avoids compiler warning. */ #ifndef TCL_WIDE_INT_IS_LONG Tcl_WideInt w; #endif register int cleanup; Tcl_Obj *objResultPtr; char *part1, *part2; Var *varPtr, *arrayPtr; CallFrame *varFramePtr = iPtr->varFramePtr; #ifdef TCL_TIP280 /* TIP #280 : Structures for tracking lines */ CmdFrame bcFrame; #endif #ifdef TCL_COMPILE_DEBUG int traceInstructions = (tclTraceExec == 3); char cmdNameBuf[21]; #endif /* * This procedure uses a stack to hold information about catch commands. * This information is the current operand stack top when starting to * execute the code for each catch command. It starts out with stack- * allocated space but uses dynamically-allocated storage if needed. */ #define STATIC_CATCH_STACK_SIZE 4 int (catchStackStorage[STATIC_CATCH_STACK_SIZE]); int *catchStackPtr = catchStackStorage; int catchTop = -1; #ifdef TCL_TIP280 /* TIP #280 : Initialize the frame. Do not push it yet. */ bcFrame.type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED) ? TCL_LOCATION_PREBC : TCL_LOCATION_BC); bcFrame.level = (iPtr->cmdFramePtr == NULL ? 1 : iPtr->cmdFramePtr->level + 1); bcFrame.framePtr = iPtr->framePtr; bcFrame.nextPtr = iPtr->cmdFramePtr; bcFrame.nline = 0; bcFrame.line = NULL; bcFrame.data.tebc.codePtr = codePtr; bcFrame.data.tebc.pc = NULL; bcFrame.cmd.str.cmd = NULL; bcFrame.cmd.str.len = 0; #endif #ifdef TCL_COMPILE_DEBUG if (tclTraceExec >= 2) { PrintByteCodeInfo(codePtr); fprintf(stdout, " Starting stack top=%d\n", eePtr->stackTop); fflush(stdout); }
︙
1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299	1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341	+ + + + + + + + + + + + + + + +	NEXT_INST_F(5, 0, 1); case INST_CONCAT1: opnd = TclGetUInt1AtPtr(pc+1); { int totalLen = 0; /* * Peephole optimisation for appending an empty string. * This enables replacing 'K $x [set x{}]' by '$x[set x{}]' * for fastest execution. Avoid doing the optimisation for wide * ints - a case where equal strings may refer to different values * (see [Bug 1251791]). */ if ((opnd == 2) && (stackPtr[stackTop-1]->typePtr != &tclWideIntType)) { Tcl_GetStringFromObj(stackPtr[stackTop], &length); if (length == 0) { /* Just drop the top item from the stack */ NEXT_INST_F(2, 1, 0); } } /* * Concatenate strings (with no separators) from the top * opnd items on the stack starting with the deepest item. * First, determine how many characters are needed. */ for (i = (stackTop - (opnd-1)); i <= stackTop; i++) {
︙
1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439	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	- + + + + - + + + + + + + +	* trace procedures. */ preservedStackRefCountPtr = (char **) (stackPtr-1); ++*preservedStackRefCountPtr; /* * Finally, let TclEvalObjvInternal handle the command. * Finally, let TclEvalObjvInternal handle the command. * * TIP #280 : Record the last piece of info needed by * 'TclGetSrcInfoForPc', and push the frame. */ Tcl_ResetResult(interp); #ifdef TCL_TIP280 bcFrame.data.tebc.pc = pc; iPtr->cmdFramePtr = &bcFrame; #endif DECACHE_STACK_INFO(); Tcl_ResetResult(interp); result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0); CACHE_STACK_INFO(); #ifdef TCL_TIP280 iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr; #endif /* * If the old stack is going to be released, it is * safe to do so now, since no references to objv are * going to be used from now on. */
︙
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	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	+ + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - +	* with the next instruction. */ TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=", objc, cmdNameBuf), Tcl_GetObjResult(interp)); objResultPtr = Tcl_GetObjResult(interp); /* * Reset the interp's result to avoid possible duplications * of large objects [Bug 781585]. We do not call * Tcl_ResetResult() to avoid any side effects caused by * the resetting of errorInfo and errorCode [Bug 804681], * which are not needed here. We chose instead to manipulate * the interp's object result directly. * * Note that the result object is now in objResultPtr, it * keeps the refCount it had in its role of iPtr->objResultPtr. */ { Tcl_Obj *newObjResultPtr; TclNewObj(newObjResultPtr); Tcl_IncrRefCount(newObjResultPtr); iPtr->objResultPtr = newObjResultPtr; } NEXT_INST_V(pcAdjustment, opnd, 1); NEXT_INST_V(pcAdjustment, opnd, -1); } else { cleanup = opnd; goto processExceptionReturn; } } case INST_EVAL_STK: /* * Note to maintainers: it is important that INST_EVAL_STK * pop its argument from the stack before jumping to * checkForCatch! DO NOT OPTIMISE! */ objPtr = stackPtr[stackTop]; DECACHE_STACK_INFO(); #ifndef TCL_TIP280 result = TclCompEvalObj(interp, objPtr); #else /* TIP #280: The invoking context is left NULL for a dynamically * constructed command. We cannot match its lines to the outer * context. */ result = TclCompEvalObj(interp, objPtr, NULL,0); #endif CACHE_STACK_INFO(); if (result == TCL_OK) { /* * Normal return; push the eval's object result. */ objResultPtr = Tcl_GetObjResult(interp); TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), Tcl_GetObjResult(interp)); /* * Reset the interp's result to avoid possible duplications * of large objects [Bug 781585]. We do not call * Tcl_ResetResult() to avoid any side effects caused by * the resetting of errorInfo and errorCode [Bug 804681], * which are not needed here. We chose instead to manipulate * the interp's object result directly. * * Note that the result object is now in objResultPtr, it * keeps the refCount it had in its role of iPtr->objResultPtr. */ { Tcl_Obj *newObjResultPtr; TclNewObj(newObjResultPtr); Tcl_IncrRefCount(newObjResultPtr); iPtr->objResultPtr = newObjResultPtr; } NEXT_INST_F(1, 1, 1); NEXT_INST_F(1, 1, -1); } else { cleanup = 1; goto processExceptionReturn; } case INST_EXPR_STK: objPtr = stackPtr[stackTop]; Tcl_ResetResult(interp); DECACHE_STACK_INFO(); Tcl_ResetResult(interp); result = Tcl_ExprObj(interp, objPtr, &valuePtr); CACHE_STACK_INFO(); if (result != TCL_OK) { TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)), Tcl_GetObjResult(interp)); goto checkForCatch; }
︙
1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928	2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027	- - + - + +	case INST_INCR_ARRAY_STK: case INST_INCR_SCALAR_STK: case INST_INCR_STK: opnd = TclGetUInt1AtPtr(pc+1); valuePtr = stackPtr[stackTop]; if (valuePtr->typePtr == &tclIntType) { i = valuePtr->internalRep.longValue; #ifndef TCL_WIDE_INT_IS_LONG } else if (valuePtr->typePtr == &tclWideIntType) { i = Tcl_WideAsLong(valuePtr->internalRep.wideValue); TclGetLongFromWide(i,valuePtr); #endif /* TCL_WIDE_INT_IS_LONG */ } else { REQUIRE_WIDE_OR_INT(result, valuePtr, i, w); if (result != TCL_OK) { TRACE_WITH_OBJ(("%u (by %s) => ERROR converting increment amount to int: ", opnd, O2S(valuePtr)), Tcl_GetObjResult(interp)); DECACHE_STACK_INFO(); Tcl_AddErrorInfo(interp, "\n (reading increment)"); CACHE_STACK_INFO(); goto checkForCatch; } FORCE_LONG(valuePtr, i, w); } stackTop--; TclDecrRefCount(valuePtr); switch (*pc) {
︙
1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971	2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072	+ +	TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), i)); } part1 = TclGetString(objPtr); varPtr = TclObjLookupVar(interp, objPtr, part2, TCL_LEAVE_ERR_MSG, "read", 0, 1, &arrayPtr); if (varPtr == NULL) { DECACHE_STACK_INFO(); Tcl_AddObjErrorInfo(interp, "\n (reading value of variable to increment)", -1); CACHE_STACK_INFO(); TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); result = TCL_ERROR; goto checkForCatch; } cleanup = ((part2 == NULL)? 1 : 2); goto doIncrVar;
︙
2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112	2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212	- - + - +	int b; valuePtr = stackPtr[stackTop]; if (valuePtr->typePtr == &tclIntType) { b = (valuePtr->internalRep.longValue != 0); } else if (valuePtr->typePtr == &tclDoubleType) { b = (valuePtr->internalRep.doubleValue != 0.0); #ifndef TCL_WIDE_INT_IS_LONG } else if (valuePtr->typePtr == &tclWideIntType) { b = (valuePtr->internalRep.wideValue != W0); TclGetWide(w,valuePtr); #endif /* TCL_WIDE_INT_IS_LONG */ b = (w != W0); } else { result = Tcl_GetBooleanFromObj(interp, valuePtr, &b); if (result != TCL_OK) { TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp)); goto checkForCatch; } }
︙
2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227	2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317	- - + - + - - - - - - + + - - + - + - - - - - - + +	value2Ptr = stackPtr[stackTop]; valuePtr = stackPtr[stackTop - 1];; t1Ptr = valuePtr->typePtr; t2Ptr = value2Ptr->typePtr; if ((t1Ptr == &tclIntType) || (t1Ptr == &tclBooleanType)) { i1 = (valuePtr->internalRep.longValue != 0); #ifndef TCL_WIDE_INT_IS_LONG } else if (t1Ptr == &tclWideIntType) { i1 = (valuePtr->internalRep.wideValue != W0); TclGetWide(w,valuePtr); #endif /* TCL_WIDE_INT_IS_LONG */ i1 = (w != W0); } else if (t1Ptr == &tclDoubleType) { i1 = (valuePtr->internalRep.doubleValue != 0.0); } else { s = Tcl_GetStringFromObj(valuePtr, &length); if (TclLooksLikeInt(s, length)) { #ifdef TCL_WIDE_INT_IS_LONG result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); i1 = (i != 0); #else /* !TCL_WIDE_INT_IS_LONG */ GET_WIDE_OR_INT(result, valuePtr, i, w); if (valuePtr->typePtr == &tclIntType) { i1 = (i != 0); } else { i1 = (w != W0); } #endif /* TCL_WIDE_INT_IS_LONG */ } else { result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL, valuePtr, &i1); i1 = (i1 != 0); } if (result != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), (t1Ptr? t1Ptr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); CACHE_STACK_INFO(); goto checkForCatch; } } if ((t2Ptr == &tclIntType) || (t2Ptr == &tclBooleanType)) { i2 = (value2Ptr->internalRep.longValue != 0); #ifndef TCL_WIDE_INT_IS_LONG } else if (t2Ptr == &tclWideIntType) { i2 = (value2Ptr->internalRep.wideValue != W0); TclGetWide(w,value2Ptr); #endif /* TCL_WIDE_INT_IS_LONG */ i2 = (w != W0); } else if (t2Ptr == &tclDoubleType) { i2 = (value2Ptr->internalRep.doubleValue != 0.0); } else { s = Tcl_GetStringFromObj(value2Ptr, &length); if (TclLooksLikeInt(s, length)) { #ifdef TCL_WIDE_INT_IS_LONG result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, value2Ptr, &i); i2 = (i != 0); #else /* !TCL_WIDE_INT_IS_LONG */ GET_WIDE_OR_INT(result, value2Ptr, i, w); if (value2Ptr->typePtr == &tclIntType) { i2 = (i != 0); } else { i2 = (w != W0); } #endif /* TCL_WIDE_INT_IS_LONG */ } else { result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL, value2Ptr, &i2); } if (result != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr), (t2Ptr? t2Ptr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, value2Ptr); CACHE_STACK_INFO(); goto checkForCatch; } } /* * Reuse the valuePtr object already on stack if possible. */
︙
2699 2700 2701 2702 2703 2704 2705 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	2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863	+ + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + - - - - - - - - - - + + + + + + + + + + + + + + -	double d1 = 0.0; /* Init. avoids compiler warning. */ double d2 = 0.0; /* Init. avoids compiler warning. */ long iResult = 0; /* Init. avoids compiler warning. */ value2Ptr = stackPtr[stackTop]; valuePtr = stackPtr[stackTop - 1]; /* * Be careful in the equal-object case; 'NaN' isn't supposed * to be equal to even itself. [Bug 761471] */ t1Ptr = valuePtr->typePtr; if (valuePtr == value2Ptr) { /* * If we are numeric already, we can proceed to the main * equality check right now. Otherwise, we need to try to * coerce to a numeric type so we can see if we've got a * NaN but haven't parsed it as numeric. */ if (!IS_NUMERIC_TYPE(t1Ptr)) { if (t1Ptr == &tclListType) { int length; /* * Only a list of length 1 can be NaN or such * things. */ (void) Tcl_ListObjLength(NULL, valuePtr, &length); if (length == 1) { goto mustConvertForNaNCheck; } } else { /* * Too bad, we'll have to compute the string and * Optimize the equal object case. */ * try the conversion */ mustConvertForNaNCheck: s1 = Tcl_GetStringFromObj(valuePtr, &length); if (TclLooksLikeInt(s1, length)) { GET_WIDE_OR_INT(iResult, valuePtr, i, w); } else { (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d1); } t1Ptr = valuePtr->typePtr; } } switch (*pc) { case INST_EQ: case INST_LE: case INST_GE: iResult = 1; break; case INST_NEQ: case INST_LT: case INST_GT: iResult = 0; break; case INST_EQ: case INST_LE: case INST_GE: iResult = !((t1Ptr == &tclDoubleType) && IS_NAN(valuePtr->internalRep.doubleValue)); break; case INST_LT: case INST_GT: iResult = 0; break; case INST_NEQ: iResult = ((t1Ptr == &tclDoubleType) && IS_NAN(valuePtr->internalRep.doubleValue)); break; } goto foundResult; } t1Ptr = valuePtr->typePtr; t2Ptr = value2Ptr->typePtr; /* * We only want to coerce numeric validation if neither type * is NULL. A NULL type means the arg is essentially an empty * object ("", {} or [list]). */
︙
2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850	2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980	- - + - + - - + +	case INST_LE: iResult = d1 <= d2; break; case INST_GE: iResult = d1 >= d2; break; } #ifndef TCL_WIDE_INT_IS_LONG } else if ((t1Ptr == &tclWideIntType) || (t2Ptr == &tclWideIntType)) { Tcl_WideInt w2; /* * Compare as wide ints (neither are doubles) */ if (t1Ptr == &tclIntType) { w = Tcl_LongAsWide(valuePtr->internalRep.longValue); w2 = value2Ptr->internalRep.wideValue; TclGetWide(w2,value2Ptr); } else if (t2Ptr == &tclIntType) { w = valuePtr->internalRep.wideValue; TclGetWide(w,valuePtr); w2 = Tcl_LongAsWide(value2Ptr->internalRep.longValue); } else { w = valuePtr->internalRep.wideValue; w2 = value2Ptr->internalRep.wideValue; TclGetWide(w,valuePtr); TclGetWide(w2,value2Ptr); } switch (*pc) { case INST_EQ: iResult = w == w2; break; case INST_NEQ: iResult = w != w2;
︙
2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872	2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001	-	case INST_LE: iResult = w <= w2; break; case INST_GE: iResult = w >= w2; break; } #endif /* TCL_WIDE_INT_IS_LONG */ } else { /* * Compare as ints. */ i = valuePtr->internalRep.longValue; i2 = value2Ptr->internalRep.longValue; switch (*pc) {
︙
2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013	3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 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 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132	- - - - + - + + - - + - + + - - - - - - - + - + - + - -	{ /* * Only integers are allowed. We compute value op value2. */ long i2 = 0, rem, negative; long iResult = 0; /* Init. avoids compiler warning. */ #ifndef TCL_WIDE_INT_IS_LONG Tcl_WideInt w2, wResult = W0; int doWide = 0; #endif /* TCL_WIDE_INT_IS_LONG */ value2Ptr = stackPtr[stackTop]; valuePtr = stackPtr[stackTop - 1]; if (valuePtr->typePtr == &tclIntType) { i = valuePtr->internalRep.longValue; #ifndef TCL_WIDE_INT_IS_LONG } else if (valuePtr->typePtr == &tclWideIntType) { w = valuePtr->internalRep.wideValue; TclGetWide(w,valuePtr); #endif /* TCL_WIDE_INT_IS_LONG */ } else { /* try to convert to int */ REQUIRE_WIDE_OR_INT(result, valuePtr, i, w); if (result != TCL_OK) { TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr), O2S(value2Ptr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); CACHE_STACK_INFO(); goto checkForCatch; } } if (value2Ptr->typePtr == &tclIntType) { i2 = value2Ptr->internalRep.longValue; #ifndef TCL_WIDE_INT_IS_LONG } else if (value2Ptr->typePtr == &tclWideIntType) { w2 = value2Ptr->internalRep.wideValue; TclGetWide(w2,value2Ptr); #endif /* TCL_WIDE_INT_IS_LONG */ } else { REQUIRE_WIDE_OR_INT(result, value2Ptr, i2, w2); if (result != TCL_OK) { TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr), O2S(value2Ptr), (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, value2Ptr); CACHE_STACK_INFO(); goto checkForCatch; } } switch (*pc) { case INST_MOD: /* * This code is tricky: C doesn't guarantee much about * the quotient or remainder, but Tcl does. The * remainder always has the same sign as the divisor and * a smaller absolute value. */ #ifdef TCL_WIDE_INT_IS_LONG if (i2 == 0) { TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2)); goto divideByZero; } #else /* !TCL_WIDE_INT_IS_LONG */ if (value2Ptr->typePtr == &tclWideIntType && w2 == W0) { if (valuePtr->typePtr == &tclIntType) { LLTRACE(("%ld "LLD" => DIVIDE BY ZERO\n", i, w2)); TRACE(("%ld "LLD" => DIVIDE BY ZERO\n", i, w2)); } else { LLTRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2)); TRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2)); } goto divideByZero; } if (value2Ptr->typePtr == &tclIntType && i2 == 0) { if (valuePtr->typePtr == &tclIntType) { TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2)); } else { LLTRACE((LLD" %ld => DIVIDE BY ZERO\n", w, i2)); TRACE((LLD" %ld => DIVIDE BY ZERO\n", w, i2)); } goto divideByZero; } #endif /* TCL_WIDE_INT_IS_LONG */ negative = 0; #ifndef TCL_WIDE_INT_IS_LONG if (valuePtr->typePtr == &tclWideIntType || value2Ptr->typePtr == &tclWideIntType) { Tcl_WideInt wRemainder; /* * Promote to wide */ if (valuePtr->typePtr == &tclIntType) {
︙
3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 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 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227	3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392	- - + + + + + + + + + + + + + + + - + + - - + + + + + + + + + + + + + + + + - - + - + + + + + + + + + + + + + + + + + + + + - - + - + + + + + + + + + + + + + + + + + + + + - - - - - - - - + - - - - - + - - - - - - - + -	if (negative) { wRemainder = -wRemainder; } wResult = wRemainder; doWide = 1; break; } #endif /* TCL_WIDE_INT_IS_LONG */ if (i2 < 0) { i2 = -i2; i = -i; negative = 1; } rem = i % i2; if (rem < 0) { rem += i2; } if (negative) { rem = -rem; } iResult = rem; break; case INST_LSHIFT: #ifndef TCL_WIDE_INT_IS_LONG /* * Shifts are never usefully 64-bits wide! */ FORCE_LONG(value2Ptr, i2, w2); if (valuePtr->typePtr == &tclWideIntType) { #ifdef TCL_COMPILE_DEBUG w2 = Tcl_LongAsWide(i2); #endif /* TCL_COMPILE_DEBUG */ wResult = w; /* * Shift in steps when the shift gets large to prevent * annoying compiler/processor bugs. [Bug 868467] */ if (i2 >= 64) { wResult = Tcl_LongAsWide(0); } else if (i2 > 60) { wResult = w << 30; wResult <<= 30; wResult <<= i2-60; } else if (i2 > 30) { wResult = w << 30; wResult <<= i2-30; } else { wResult = w << i2; wResult = w << i2; } doWide = 1; break; } #endif /* TCL_WIDE_INT_IS_LONG */ iResult = i << i2; /* * Shift in steps when the shift gets large to prevent * annoying compiler/processor bugs. [Bug 868467] */ if (i2 >= 64) { iResult = 0; } else if (i2 > 60) { iResult = i << 30; iResult <<= 30; iResult <<= i2-60; } else if (i2 > 30) { iResult = i << 30; iResult <<= i2-30; } else { iResult = i << i2; } break; case INST_RSHIFT: /* * The following code is a bit tricky: it ensures that * right shifts propagate the sign bit even on machines * where ">>" won't do it by default. */ #ifndef TCL_WIDE_INT_IS_LONG /* * Shifts are never usefully 64-bits wide! */ FORCE_LONG(value2Ptr, i2, w2); if (valuePtr->typePtr == &tclWideIntType) { #ifdef TCL_COMPILE_DEBUG w2 = Tcl_LongAsWide(i2); #endif /* TCL_COMPILE_DEBUG */ if (w < 0) { wResult = ~((~w) >> i2); wResult = ~w; } else { wResult = w >> i2; wResult = w; } /* * Shift in steps when the shift gets large to prevent * annoying compiler/processor bugs. [Bug 868467] */ if (i2 >= 64) { wResult = Tcl_LongAsWide(0); } else if (i2 > 60) { wResult >>= 30; wResult >>= 30; wResult >>= i2-60; } else if (i2 > 30) { wResult >>= 30; wResult >>= i2-30; } else { wResult >>= i2; } if (w < 0) { wResult = ~wResult; } doWide = 1; break; } #endif /* TCL_WIDE_INT_IS_LONG */ if (i < 0) { iResult = ~((~i) >> i2); iResult = ~i; } else { iResult = i >> i2; iResult = i; } /* * Shift in steps when the shift gets large to prevent * annoying compiler/processor bugs. [Bug 868467] */ if (i2 >= 64) { iResult = 0; } else if (i2 > 60) { iResult >>= 30; iResult >>= 30; iResult >>= i2-60; } else if (i2 > 30) { iResult >>= 30; iResult >>= i2-30; } else { iResult >>= i2; } if (i < 0) { iResult = ~iResult; } break; case INST_BITOR: #ifndef TCL_WIDE_INT_IS_LONG if (valuePtr->typePtr == &tclWideIntType || value2Ptr->typePtr == &tclWideIntType) { /* * Promote to wide */ if (valuePtr->typePtr == &tclIntType) { w = Tcl_LongAsWide(i); } else if (value2Ptr->typePtr == &tclIntType) { w2 = Tcl_LongAsWide(i2); } wResult = w | w2; doWide = 1; break; } #endif /* TCL_WIDE_INT_IS_LONG */ iResult = i | i2; break; case INST_BITXOR: #ifndef TCL_WIDE_INT_IS_LONG if (valuePtr->typePtr == &tclWideIntType || value2Ptr->typePtr == &tclWideIntType) { /* * Promote to wide */ if (valuePtr->typePtr == &tclIntType) { w = Tcl_LongAsWide(i); } else if (value2Ptr->typePtr == &tclIntType) { w2 = Tcl_LongAsWide(i2); } wResult = w ^ w2; doWide = 1; break; } #endif /* TCL_WIDE_INT_IS_LONG */ iResult = i ^ i2; break; case INST_BITAND: #ifndef TCL_WIDE_INT_IS_LONG if (valuePtr->typePtr == &tclWideIntType || value2Ptr->typePtr == &tclWideIntType) { /* * Promote to wide */ if (valuePtr->typePtr == &tclIntType) { w = Tcl_LongAsWide(i); } else if (value2Ptr->typePtr == &tclIntType) { w2 = Tcl_LongAsWide(i2); } wResult = w & w2; doWide = 1; break; } #endif /* TCL_WIDE_INT_IS_LONG */ iResult = i & i2; break; } /* * Reuse the valuePtr object already on stack if possible. */ if (Tcl_IsShared(valuePtr)) { #ifndef TCL_WIDE_INT_IS_LONG if (doWide) { objResultPtr = Tcl_NewWideIntObj(wResult); LLTRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult)); TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult)); } else { #endif /* TCL_WIDE_INT_IS_LONG */ objResultPtr = Tcl_NewLongObj(iResult); TRACE(("%ld %ld => %ld\n", i, i2, iResult)); #ifndef TCL_WIDE_INT_IS_LONG } #endif /* TCL_WIDE_INT_IS_LONG */ NEXT_INST_F(1, 2, 1); } else { /* reuse the valuePtr object */ #ifndef TCL_WIDE_INT_IS_LONG if (doWide) { LLTRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult)); TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult)); Tcl_SetWideIntObj(valuePtr, wResult); } else { #endif /* TCL_WIDE_INT_IS_LONG */ TRACE(("%ld %ld => %ld\n", i, i2, iResult)); Tcl_SetLongObj(valuePtr, iResult); #ifndef TCL_WIDE_INT_IS_LONG } #endif /* TCL_WIDE_INT_IS_LONG */ NEXT_INST_F(1, 1, 0); } } case INST_ADD: case INST_SUB: case INST_MULT: case INST_DIV: { /* * Operands must be numeric and ints get converted to floats * if necessary. We compute value op value2. */ Tcl_ObjType *t1Ptr, *t2Ptr; long i2 = 0, quot, rem; /* Init. avoids compiler warning. */ double d1, d2; long iResult = 0; /* Init. avoids compiler warning. */ double dResult = 0.0; /* Init. avoids compiler warning. */ int doDouble = 0; /* 1 if doing floating arithmetic */ #ifndef TCL_WIDE_INT_IS_LONG Tcl_WideInt w2, wquot, wrem; Tcl_WideInt wResult = W0; /* Init. avoids compiler warning. */ int doWide = 0; /* 1 if doing wide arithmetic. */ #endif /* TCL_WIDE_INT_IS_LONG */ value2Ptr = stackPtr[stackTop]; valuePtr = stackPtr[stackTop - 1]; t1Ptr = valuePtr->typePtr; t2Ptr = value2Ptr->typePtr; if (t1Ptr == &tclIntType) { i = valuePtr->internalRep.longValue; #ifndef TCL_WIDE_INT_IS_LONG } else if (t1Ptr == &tclWideIntType) { w = valuePtr->internalRep.wideValue; TclGetWide(w,valuePtr); #endif /* TCL_WIDE_INT_IS_LONG */ } else if ((t1Ptr == &tclDoubleType) && (valuePtr->bytes == NULL)) { /* * We can only use the internal rep directly if there is * no string rep. Otherwise the string rep might actually * look like an integer, which is preferred. */
︙
3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261	3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426	+ + - - + -	valuePtr, &d1); } if (result != TCL_OK) { TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", s, O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); CACHE_STACK_INFO(); goto checkForCatch; } t1Ptr = valuePtr->typePtr; } if (t2Ptr == &tclIntType) { i2 = value2Ptr->internalRep.longValue; #ifndef TCL_WIDE_INT_IS_LONG } else if (t2Ptr == &tclWideIntType) { w2 = value2Ptr->internalRep.wideValue; TclGetWide(w2,value2Ptr); #endif /* TCL_WIDE_INT_IS_LONG */ } else if ((t2Ptr == &tclDoubleType) && (value2Ptr->bytes == NULL)) { /* * We can only use the internal rep directly if there is * no string rep. Otherwise the string rep might actually * look like an integer, which is preferred. */
︙
3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304	3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469	+ + - -	value2Ptr, &d2); } if (result != TCL_OK) { TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(value2Ptr), s, (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, value2Ptr); CACHE_STACK_INFO(); goto checkForCatch; } t2Ptr = value2Ptr->typePtr; } if ((t1Ptr == &tclDoubleType) || (t2Ptr == &tclDoubleType)) { /* * Do double arithmetic. */ doDouble = 1; if (t1Ptr == &tclIntType) { d1 = i; /* promote value 1 to double */ } else if (t2Ptr == &tclIntType) { d2 = i2; /* promote value 2 to double */ #ifndef TCL_WIDE_INT_IS_LONG } else if (t1Ptr == &tclWideIntType) { d1 = Tcl_WideAsDouble(w); } else if (t2Ptr == &tclWideIntType) { d2 = Tcl_WideAsDouble(w2); #endif /* TCL_WIDE_INT_IS_LONG */ } switch (*pc) { case INST_ADD: dResult = d1 + d2; break; case INST_SUB: dResult = d1 - d2;
︙
3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336	3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502	+ + -	/* * Check now for IEEE floating-point error. */ if (IS_NAN(dResult) || IS_INF(dResult)) { TRACE(("%.20s %.20s => IEEE FLOATING PT ERROR\n", O2S(valuePtr), O2S(value2Ptr))); DECACHE_STACK_INFO(); TclExprFloatError(interp, dResult); CACHE_STACK_INFO(); result = TCL_ERROR; goto checkForCatch; } #ifndef TCL_WIDE_INT_IS_LONG } else if ((t1Ptr == &tclWideIntType) || (t2Ptr == &tclWideIntType)) { /* * Do wide integer arithmetic. */ doWide = 1; if (t1Ptr == &tclIntType) {
︙
3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381	3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546	- + -	/* * This code is tricky: C doesn't guarantee much * about the quotient or remainder, but Tcl does. * The remainder always has the same sign as the * divisor and a smaller absolute value. */ if (w2 == W0) { LLTRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2)); TRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2)); goto divideByZero; } if (w2 < 0) { w2 = -w2; w = -w; } wquot = w / w2; wrem = w % w2; if (wrem < W0) { wquot -= 1; } wResult = wquot; break; } #endif /* TCL_WIDE_INT_IS_LONG */ } else { /* * Do integer arithmetic. */ switch (*pc) { case INST_ADD: iResult = i + i2;
︙
3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447	3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608	- - + - - - + -	* Reuse the valuePtr object already on stack if possible. */ if (Tcl_IsShared(valuePtr)) { if (doDouble) { objResultPtr = Tcl_NewDoubleObj(dResult); TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult)); #ifndef TCL_WIDE_INT_IS_LONG } else if (doWide) { objResultPtr = Tcl_NewWideIntObj(wResult); LLTRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult)); TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult)); #endif /* TCL_WIDE_INT_IS_LONG */ } else { objResultPtr = Tcl_NewLongObj(iResult); TRACE(("%ld %ld => %ld\n", i, i2, iResult)); } NEXT_INST_F(1, 2, 1); } else { /* reuse the valuePtr object */ if (doDouble) { /* NB: stack top is off by 1 */ TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult)); Tcl_SetDoubleObj(valuePtr, dResult); #ifndef TCL_WIDE_INT_IS_LONG } else if (doWide) { LLTRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult)); TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult)); Tcl_SetWideIntObj(valuePtr, wResult); #endif /* TCL_WIDE_INT_IS_LONG */ } else { TRACE(("%ld %ld => %ld\n", i, i2, iResult)); Tcl_SetLongObj(valuePtr, iResult); } NEXT_INST_F(1, 1, 0); } }
︙
3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501	3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662	+ + - - + -	GET_WIDE_OR_INT(result, valuePtr, i, w); } else { result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d); } if (result != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", s, (tPtr? tPtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); CACHE_STACK_INFO(); goto checkForCatch; } tPtr = valuePtr->typePtr; } /* * Ensure that the operand's string rep is the same as the * formatted version of its internal rep. This makes sure * that "expr +000123" yields "83", not "000123". We * implement this by _discarding_ the string rep since we * know it will be regenerated, if needed later, by * formatting the internal rep's value. */ if (Tcl_IsShared(valuePtr)) { if (tPtr == &tclIntType) { i = valuePtr->internalRep.longValue; objResultPtr = Tcl_NewLongObj(i); #ifndef TCL_WIDE_INT_IS_LONG } else if (tPtr == &tclWideIntType) { w = valuePtr->internalRep.wideValue; TclGetWide(w,valuePtr); objResultPtr = Tcl_NewWideIntObj(w); #endif /* TCL_WIDE_INT_IS_LONG */ } else { d = valuePtr->internalRep.doubleValue; objResultPtr = Tcl_NewDoubleObj(d); } TRACE_WITH_OBJ(("%s => ", O2S(objResultPtr)), objResultPtr); NEXT_INST_F(1, 1, 1); } else {
︙
3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578	3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739	+ + - - + - + -	result = Tcl_GetBooleanFromObj((Tcl_Interp *)NULL, valuePtr, &boolvar); i = (long)boolvar; /* i is long, not int! */ } if (result != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", s, (tPtr? tPtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); CACHE_STACK_INFO(); goto checkForCatch; } } tPtr = valuePtr->typePtr; } if (Tcl_IsShared(valuePtr)) { /* * Create a new object. */ if ((tPtr == &tclIntType) || (tPtr == &tclBooleanType)) { i = valuePtr->internalRep.longValue; objResultPtr = Tcl_NewLongObj( (*pc == INST_UMINUS)? -i : !i); TRACE_WITH_OBJ(("%ld => ", i), objResultPtr); #ifndef TCL_WIDE_INT_IS_LONG } else if (tPtr == &tclWideIntType) { w = valuePtr->internalRep.wideValue; TclGetWide(w,valuePtr); if (*pc == INST_UMINUS) { objResultPtr = Tcl_NewWideIntObj(-w); } else { objResultPtr = Tcl_NewLongObj(w == W0); } LLTRACE_WITH_OBJ((LLD" => ", w), objResultPtr); TRACE_WITH_OBJ((LLD" => ", w), objResultPtr); #endif /* TCL_WIDE_INT_IS_LONG */ } else { d = valuePtr->internalRep.doubleValue; if (*pc == INST_UMINUS) { objResultPtr = Tcl_NewDoubleObj(-d); } else { /* * Should be able to use "!d", but apparently
︙
3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611	3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770	- - + - + -	* valuePtr is unshared. Modify it directly. */ if ((tPtr == &tclIntType) || (tPtr == &tclBooleanType)) { i = valuePtr->internalRep.longValue; Tcl_SetLongObj(valuePtr, (*pc == INST_UMINUS)? -i : !i); TRACE_WITH_OBJ(("%ld => ", i), valuePtr); #ifndef TCL_WIDE_INT_IS_LONG } else if (tPtr == &tclWideIntType) { w = valuePtr->internalRep.wideValue; TclGetWide(w,valuePtr); if (*pc == INST_UMINUS) { Tcl_SetWideIntObj(valuePtr, -w); } else { Tcl_SetLongObj(valuePtr, w == W0); } LLTRACE_WITH_OBJ((LLD" => ", w), valuePtr); TRACE_WITH_OBJ((LLD" => ", w), valuePtr); #endif /* TCL_WIDE_INT_IS_LONG */ } else { d = valuePtr->internalRep.doubleValue; if (*pc == INST_UMINUS) { Tcl_SetDoubleObj(valuePtr, -d); } else { /* * Should be able to use "!d", but apparently
︙
3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684	3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841	+ + - - + - + - + - - -	valuePtr = stackPtr[stackTop]; tPtr = valuePtr->typePtr; if (!IS_INTEGER_TYPE(tPtr)) { REQUIRE_WIDE_OR_INT(result, valuePtr, i, w); if (result != TCL_OK) { /* try to convert to double */ TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr), (tPtr? tPtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); CACHE_STACK_INFO(); goto checkForCatch; } } #ifndef TCL_WIDE_INT_IS_LONG if (valuePtr->typePtr == &tclWideIntType) { w = valuePtr->internalRep.wideValue; TclGetWide(w,valuePtr); if (Tcl_IsShared(valuePtr)) { objResultPtr = Tcl_NewWideIntObj(~w); LLTRACE(("0x%llx => (%llu)\n", w, ~w)); TRACE(("0x%llx => (%llu)\n", w, ~w)); NEXT_INST_F(1, 1, 1); } else { /* * valuePtr is unshared. Modify it directly. */ Tcl_SetWideIntObj(valuePtr, ~w); LLTRACE(("0x%llx => (%llu)\n", w, ~w)); TRACE(("0x%llx => (%llu)\n", w, ~w)); NEXT_INST_F(1, 0, 0); } } else { #endif /* TCL_WIDE_INT_IS_LONG */ i = valuePtr->internalRep.longValue; if (Tcl_IsShared(valuePtr)) { objResultPtr = Tcl_NewLongObj(~i); TRACE(("0x%lx => (%lu)\n", i, ~i)); NEXT_INST_F(1, 1, 1); } else { /* * valuePtr is unshared. Modify it directly. */ Tcl_SetLongObj(valuePtr, ~i); TRACE(("0x%lx => (%lu)\n", i, ~i)); NEXT_INST_F(1, 0, 0); } #ifndef TCL_WIDE_INT_IS_LONG } #endif /* TCL_WIDE_INT_IS_LONG */ } case INST_CALL_BUILTIN_FUNC1: opnd = TclGetUInt1AtPtr(pc+1); { /* * Call one of the built-in Tcl math functions.
︙
3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844	3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005	- - + - + + + + + +	* We only need to make a copy of the object * when it already had a string rep */ needNew = 1; if (tPtr == &tclIntType) { i = valuePtr->internalRep.longValue; objResultPtr = Tcl_NewLongObj(i); #ifndef TCL_WIDE_INT_IS_LONG } else if (tPtr == &tclWideIntType) { w = valuePtr->internalRep.wideValue; TclGetWide(w,valuePtr); objResultPtr = Tcl_NewWideIntObj(w); #endif /* TCL_WIDE_INT_IS_LONG */ } else { d = valuePtr->internalRep.doubleValue; objResultPtr = Tcl_NewDoubleObj(d); } tPtr = objResultPtr->typePtr; } } else { Tcl_InvalidateStringRep(valuePtr); } if (tPtr == &tclDoubleType) { d = objResultPtr->internalRep.doubleValue; if (IS_NAN(d) || IS_INF(d)) { TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n", O2S(objResultPtr))); DECACHE_STACK_INFO(); TclExprFloatError(interp, d); CACHE_STACK_INFO(); result = TCL_ERROR; goto checkForCatch; } } converted = converted; /* lint, converted not used. */ TRACE(("\"%.20s\" => numeric, %s, %s\n", O2S(valuePtr), (converted? "converted" : "not converted"), (needNew? "new Tcl_Obj" : "same Tcl_Obj"))); } else { TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr))); } if (needNew) { NEXT_INST_F(1, 1, 1); } else { NEXT_INST_F(1, 0, 0); } } case INST_BREAK: DECACHE_STACK_INFO(); Tcl_ResetResult(interp); CACHE_STACK_INFO(); result = TCL_BREAK; cleanup = 0; goto processExceptionReturn; case INST_CONTINUE: DECACHE_STACK_INFO(); Tcl_ResetResult(interp); CACHE_STACK_INFO(); result = TCL_CONTINUE; cleanup = 0; goto processExceptionReturn; case INST_FOREACH_START4: opnd = TclGetUInt4AtPtr(pc+1); {
︙
3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901	4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061	-	ForeachInfo *infoPtr = (ForeachInfo *) codePtr->auxDataArrayPtr[opnd].clientData; ForeachVarList *varListPtr; int numLists = infoPtr->numLists; Var *compiledLocals = iPtr->varFramePtr->compiledLocals; Tcl_Obj *listPtr; List *listRepPtr; Var *iterVarPtr, *listVarPtr; int iterNum, listTmpIndex, listLen, numVars; int varIndex, valIndex, continueLoop, j; /* * Increment the temp holding the loop iteration number. */
︙
3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965	4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131	- - - + + - + + + + + + + + + - - +	listTmpIndex = infoPtr->firstValueTemp; for (i = 0; i < numLists; i++) { varListPtr = infoPtr->varLists[i]; numVars = varListPtr->numVars; listVarPtr = &(compiledLocals[listTmpIndex]); listPtr = listVarPtr->value.objPtr; listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1; listLen = listRepPtr->elemCount; valIndex = (iterNum * numVars); for (j = 0; j < numVars; j++) { Tcl_Obj **elements; int setEmptyStr = 0; /* * The call to TclPtrSetVar might shimmer listPtr, * so re-fetch pointers every iteration for safety. * See test foreach-10.1. */ Tcl_ListObjGetElements(NULL, listPtr, &listLen, &elements); if (valIndex >= listLen) { setEmptyStr = 1; TclNewObj(valuePtr); } else { valuePtr = listRepPtr->elements[valIndex]; valuePtr = elements[valIndex]; } varIndex = varListPtr->varIndexes[j]; varPtr = &(varFramePtr->compiledLocals[varIndex]); part1 = varPtr->name; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr;
︙
3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999	4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164	+ + - - -	TclClearVarUndefined(varPtr); } varPtr->value.objPtr = valuePtr; Tcl_IncrRefCount(valuePtr); } } else { DECACHE_STACK_INFO(); Tcl_IncrRefCount(valuePtr); value2Ptr = TclPtrSetVar(interp, varPtr, NULL, part1, NULL, valuePtr, TCL_LEAVE_ERR_MSG); TclDecrRefCount(valuePtr); CACHE_STACK_INFO(); if (value2Ptr == NULL) { TRACE_WITH_OBJ(("%u => ERROR init. index temp %d: ", opnd, varIndex), Tcl_GetObjResult(interp)); if (setEmptyStr) { TclDecrRefCount(valuePtr); } result = TCL_ERROR; goto checkForCatch; } } valIndex++; } listTmpIndex++;
︙
4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066	4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245	+ + + + + + + + + + + - + + + +	result = TCL_OK; TRACE(("=> catchTop=%d\n", catchTop)); NEXT_INST_F(1, 0, 0); case INST_PUSH_RESULT: objResultPtr = Tcl_GetObjResult(interp); TRACE_WITH_OBJ(("=> "), Tcl_GetObjResult(interp)); /* * See the comments at INST_INVOKE_STK */ { Tcl_Obj *newObjResultPtr; TclNewObj(newObjResultPtr); Tcl_IncrRefCount(newObjResultPtr); iPtr->objResultPtr = newObjResultPtr; } NEXT_INST_F(1, 0, 1); NEXT_INST_F(1, 0, -1); case INST_PUSH_RETURN_CODE: objResultPtr = Tcl_NewLongObj(result); TRACE(("=> %u\n", result)); NEXT_INST_F(1, 0, 1); default: panic("TclExecuteByteCode: unrecognized opCode %u", *pc); } /* end of switch on opCode */ /* * Division by zero in an expression. Control only reaches this * point by "goto divideByZero". */ divideByZero: DECACHE_STACK_INFO(); Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "divide by zero", -1); Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", (char *) NULL); CACHE_STACK_INFO(); result = TCL_ERROR; goto checkForCatch; /* * An external evaluation (INST_INVOKE or INST_EVAL) returned * something different from TCL_OK, or else INST_BREAK or * INST_CONTINUE were called.
︙
4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156	4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337	+ +	* execution and return the "exception" code. */ checkForCatch: if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { bytes = GetSrcInfoForPc(pc, codePtr, &length); if (bytes != NULL) { DECACHE_STACK_INFO(); Tcl_LogCommandInfo(interp, codePtr->source, bytes, length); CACHE_STACK_INFO(); iPtr->flags |= ERR_ALREADY_LOGGED; } } if (catchTop == -1) { #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { fprintf(stdout, " ... no enclosing catch, returning %s\n",
︙
4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 4537	4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775	- + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	"\"", (char *) NULL); } }  /* *---------------------------------------------------------------------- * * GetSrcInfoForPc -- * TclGetSrcInfoForPc, GetSrcInfoForPc -- * * Given a program counter value, finds the closest command in the * bytecode code unit's CmdLocation array and returns information about * that command's source: a pointer to its first byte and the number of * characters. * * Results: * If a command is found that encloses the program counter value, a * pointer to the command's source is returned and the length of the * source is stored at *lengthPtr. If multiple commands resulted in * code at pc, information about the closest enclosing command is * returned. If no matching command is found, NULL is returned and * *lengthPtr is unchanged. * * Side effects: * None. * *---------------------------------------------------------------------- */ #ifdef TCL_TIP280 void TclGetSrcInfoForPc (cfPtr) CmdFrame* cfPtr; { ByteCode* codePtr = (ByteCode*) cfPtr->data.tebc.codePtr; if (cfPtr->cmd.str.cmd == NULL) { cfPtr->cmd.str.cmd = GetSrcInfoForPc((char*) cfPtr->data.tebc.pc, codePtr, &cfPtr->cmd.str.len); } if (cfPtr->cmd.str.cmd != NULL) { /* We now have the command. We can get the srcOffset back and * from there find the list of word locations for this command */ ExtCmdLoc* eclPtr; ECL* locPtr = NULL; int srcOffset; Interp* iPtr = (Interp*) *codePtr->interpHandle; Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr); if (!hePtr) return; srcOffset = cfPtr->cmd.str.cmd - codePtr->source; eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr); { int i; for (i=0; i < eclPtr->nuloc; i++) { if (eclPtr->loc [i].srcOffset == srcOffset) { locPtr = &(eclPtr->loc [i]); break; } } } if (locPtr == NULL) {Tcl_Panic ("LocSearch failure");} cfPtr->line = locPtr->line; cfPtr->nline = locPtr->nline; cfPtr->type = eclPtr->type; if (eclPtr->type == TCL_LOCATION_SOURCE) { cfPtr->data.eval.path = eclPtr->path; Tcl_IncrRefCount (cfPtr->data.eval.path); } /* Do not set cfPtr->data.eval.path NULL for non-SOURCE * Needed for cfPtr->data.tebc.codePtr. */ } } #endif static char * GetSrcInfoForPc(pc, codePtr, lengthPtr) unsigned char *pc; /* The program counter value for which to * return the closest command's source info. * This points to a bytecode instruction * in codePtr's code. */
︙
4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776	4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010	- - - - + -	if (IS_NUMERIC_TYPE(objPtr->typePtr)) { return TCL_OK; } else { int length, result = TCL_OK; char *s = Tcl_GetStringFromObj(objPtr, &length); if (TclLooksLikeInt(s, length)) { #ifdef TCL_WIDE_INT_IS_LONG long i; result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, objPtr, &i); #else /* !TCL_WIDE_INT_IS_LONG */ Tcl_WideInt w; result = Tcl_GetWideIntFromObj((Tcl_Interp *) NULL, objPtr, &w); GET_WIDE_OR_INT(result, objPtr, i, w); #endif /* TCL_WIDE_INT_IS_LONG */ } else { double d; result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, objPtr, &d); } if ((result != TCL_OK) && (interp != NULL)) { Tcl_ResetResult(interp); if (TclCheckBadOctal((Tcl_Interp *) NULL, s)) {
︙
4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019	5207 5208 5209 5210 5211 5212 5213 5214 5215 5216 5217 5218 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248 5249 5250 5251 5252 5253 5254 5255 5256 5257 5258 5259 5260 5261 5262	- - + - - - + + + + + + + - + + + + + + + + - - + + -	/* * Push a Tcl object with the result. */ if (valuePtr->typePtr == &tclIntType) { i = valuePtr->internalRep.longValue; if (i < 0) { iResult = -i; if (iResult < 0) { if (i == LONG_MIN) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "integer value too large to represent", -1); #ifdef TCL_WIDE_INT_IS_LONG Tcl_SetObjResult(interp, Tcl_NewStringObj( "integer value too large to represent", -1)); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", "integer value too large to represent", (char *) NULL); result = TCL_ERROR; goto done; #else /* * Special case: abs(MIN_INT) must promote to wide. */ } PUSH_OBJECT( Tcl_NewWideIntObj(-(Tcl_WideInt) i) ); result = TCL_OK; goto done; #endif } iResult = -i; } else { iResult = i; } PUSH_OBJECT(Tcl_NewLongObj(iResult)); #ifndef TCL_WIDE_INT_IS_LONG } else if (valuePtr->typePtr == &tclWideIntType) { Tcl_WideInt wResult, w = valuePtr->internalRep.wideValue; Tcl_WideInt wResult, w; TclGetWide(w,valuePtr); if (w < W0) { wResult = -w; if (wResult < 0) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "integer value too large to represent", -1); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", "integer value too large to represent", (char *) NULL); result = TCL_ERROR; goto done; } } else { wResult = w; } PUSH_OBJECT(Tcl_NewWideIntObj(wResult)); #endif /* TCL_WIDE_INT_IS_LONG */ } else { d = valuePtr->internalRep.doubleValue; if (d < 0.0) { dResult = -d; } else { dResult = d; }
︙
5116 5117 5118 5119 5120 5121 5122 5123 5124 5125 5126 5127 5128 5129 5130 5131 5132 5133	5359 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374	- - + -	if (VerifyExprObjType(interp, valuePtr) != TCL_OK) { result = TCL_ERROR; goto done; } if (valuePtr->typePtr == &tclIntType) { iResult = valuePtr->internalRep.longValue; #ifndef TCL_WIDE_INT_IS_LONG } else if (valuePtr->typePtr == &tclWideIntType) { iResult = Tcl_WideAsLong(valuePtr->internalRep.wideValue); TclGetLongFromWide(iResult,valuePtr); #endif /* TCL_WIDE_INT_IS_LONG */ } else { d = valuePtr->internalRep.doubleValue; if (d < 0.0) { if (d < (double) (long) LONG_MIN) { tooLarge: Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp),
︙
5162 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176	5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416	-	done: TclDecrRefCount(valuePtr); DECACHE_STACK_INFO(); return result; } #ifndef TCL_WIDE_INT_IS_LONG static int ExprWideFunc(interp, eePtr, clientData) Tcl_Interp *interp; /* The interpreter in which to execute the * function. */ ExecEnv *eePtr; /* Points to the environment for executing * the function. */ ClientData clientData; /* Ignored. */
︙
5197 5198 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 5211	5437 5438 5439 5440 5441 5442 5443 5444 5445 5446 5447 5448 5449 5450 5451	- +	if (VerifyExprObjType(interp, valuePtr) != TCL_OK) { result = TCL_ERROR; goto done; } if (valuePtr->typePtr == &tclWideIntType) { wResult = valuePtr->internalRep.wideValue; TclGetWide(wResult,valuePtr); } else if (valuePtr->typePtr == &tclIntType) { wResult = Tcl_LongAsWide(valuePtr->internalRep.longValue); } else { d = valuePtr->internalRep.doubleValue; if (d < 0.0) { if (d < Tcl_WideAsDouble(LLONG_MIN)) { tooLarge:
︙
5241 5242 5243 5244 5245 5246 5247 5248 5249 5250 5251 5252 5253 5254 5255	5481 5482 5483 5484 5485 5486 5487 5488 5489 5490 5491 5492 5493 5494	-	*/ done: TclDecrRefCount(valuePtr); DECACHE_STACK_INFO(); return result; } #endif /* TCL_WIDE_INT_IS_LONG */ static int ExprRandFunc(interp, eePtr, clientData) Tcl_Interp *interp; /* The interpreter in which to execute the * function. */ ExecEnv *eePtr; /* Points to the environment for executing * the function. */
︙
5354 5355 5356 5357 5358 5359 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 5426 5427 5428 5429 5430 5431 5432 5433 5434 5435 5436 5437 5438 5439 5440	5593 5594 5595 5596 5597 5598 5599 5600 5601 5602 5603 5604 5605 5606 5607 5608 5609 5610 5611 5612 5613 5614 5615 5616 5617 5618 5619 5620 5621 5622 5623 5624 5625 5626 5627 5628 5629 5630 5631 5632 5633 5634 5635 5636 5637 5638 5639 5640 5641 5642 5643 5644 5645 5646 5647 5648 5649 5650 5651 5652 5653 5654 5655 5656 5657 5658 5659 5660 5661 5662 5663 5664 5665 5666 5667 5668 5669 5670 5671 5672 5673 5674 5675 5676 5677 5678 5679 5680 5681 5682 5683 5684 5685 5686 5687 5688 5689 5690	- + - - + - - + + - - - + - - - + + + + + + + + + - + - - - - - - - - + - + + - - - + + + + - - - - - + + + + + + - - - - + + + + + + - - - + + + - + - - - + + + - - - - + + + + + + + + + + + + + +	* function. */ ExecEnv *eePtr; /* Points to the environment for executing * the function. */ ClientData clientData; /* Ignored. */ { Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */ register int stackTop; /* Cached top index of evaluation stack. */ Tcl_Obj *valuePtr; Tcl_Obj *valuePtr, *resPtr; long iResult; double d, temp; double d, f, i; int result; /* * Set stackPtr and stackTop from eePtr. */ result = TCL_OK; CACHE_STACK_INFO(); /* * Pop the argument from the evaluation stack. */ valuePtr = POP_OBJECT(); if (VerifyExprObjType(interp, valuePtr) != TCL_OK) { result = TCL_ERROR; goto done; } if (valuePtr->typePtr == &tclIntType) { if ((valuePtr->typePtr == &tclIntType) || iResult = valuePtr->internalRep.longValue; #ifndef TCL_WIDE_INT_IS_LONG } else if (valuePtr->typePtr == &tclWideIntType) { (valuePtr->typePtr == &tclWideIntType)) { PUSH_OBJECT(Tcl_NewWideIntObj(valuePtr->internalRep.wideValue)); goto done; #endif /* TCL_WIDE_INT_IS_LONG */ result = TCL_OK; resPtr = valuePtr; } else { /* * Round the number to the nearest integer. I'd like to use round(), * but it's C99 (or BSD), and not yet universal. */ d = valuePtr->internalRep.doubleValue; f = modf(d, &i); if (d < 0.0) { if (d <= (((double) (long) LONG_MIN) - 0.5)) { if (f <= -0.5) { tooLarge: Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "integer value too large to represent", -1); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", "integer value too large to represent", (char *) NULL); result = TCL_ERROR; i += -1.0; goto done; } if (i <= Tcl_WideAsDouble(LLONG_MIN)) { goto tooLarge; temp = (long) (d - 0.5); } else { if (d >= (((double) LONG_MAX + 0.5))) { } else if (i <= (double) LONG_MIN) { resPtr = Tcl_NewWideIntObj(Tcl_DoubleAsWide(i)); } else { resPtr = Tcl_NewLongObj((long) i); goto tooLarge; } temp = (long) (d + 0.5); } if (IS_NAN(temp) || IS_INF(temp)) { } } else { if (f >= 0.5) { i += 1.0; } if (i >= Tcl_WideAsDouble(LLONG_MAX)) { TclExprFloatError(interp, temp); result = TCL_ERROR; goto done; } goto tooLarge; } else if (i >= (double) LONG_MAX) { resPtr = Tcl_NewWideIntObj(Tcl_DoubleAsWide(i)); } else { resPtr = Tcl_NewLongObj((long) i); } iResult = (long) temp; } } } /* * Push a Tcl object with the result. * Push the result object and free the argument Tcl_Obj. */ PUSH_OBJECT(Tcl_NewLongObj(iResult)); PUSH_OBJECT(resPtr); /* * Reflect the change to stackTop back in eePtr. */ done: TclDecrRefCount(valuePtr); DECACHE_STACK_INFO(); return result; /* * Error return: result cannot be represented as an integer. */ tooLarge: Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "integer value too large to represent", -1); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", "integer value too large to represent", (char *) NULL); result = TCL_ERROR; goto done; } static int ExprSrandFunc(interp, eePtr, clientData) Tcl_Interp *interp; /* The interpreter in which to execute the * function. */ ExecEnv *eePtr; /* Points to the environment for executing
︙
5460 5461 5462 5463 5464 5465 5466 5467 5468 5469 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 5483 5484 5485 5486 5487 5488 5489 5490 5491	5710 5711 5712 5713 5714 5715 5716 5717 5718 5719 5720 5721 5722 5723 5724 5725 5726 5727 5728 5729 5730 5731 5732 5733 5734 5735	- + - - - - - + + - - - - - - + - - + - - - + + + + + +	valuePtr = POP_OBJECT(); if (VerifyExprObjType(interp, valuePtr) != TCL_OK) { goto badValue; } if (valuePtr->typePtr == &tclIntType) { if (Tcl_GetLongFromObj(NULL, valuePtr, &i) != TCL_OK) { i = valuePtr->internalRep.longValue; #ifndef TCL_WIDE_INT_IS_LONG } else if (valuePtr->typePtr == &tclWideIntType) { i = Tcl_WideAsLong(valuePtr->internalRep.wideValue); #endif /* TCL_WIDE_INT_IS_LONG */ Tcl_WideInt w; } else { /* * At this point, the only other possible type is double */ Tcl_ResetResult(interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), if (Tcl_GetWideIntFromObj(interp, valuePtr, &w) != TCL_OK) { "can't use floating-point value as argument to srand", (char *) NULL); badValue: Tcl_AddErrorInfo(interp, "\n (argument to \"srand()\")"); TclDecrRefCount(valuePtr); DECACHE_STACK_INFO(); return TCL_ERROR; TclDecrRefCount(valuePtr); DECACHE_STACK_INFO(); return TCL_ERROR; } i = Tcl_WideAsLong(w); } /* * Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2. * See comments in ExprRandFunc() for more details. */
︙
5602 5603 5604 5605 5606 5607 5608 5609 5610 5611 5612 5613 5614 5615 5616 5617 5618 5619 5620 5621 5622 5623 5624 5625 5626 5627 5628 5629 5630 5631 5632 5633 5634 5635 5636 5637 5638 5639 5640 5641 5642 5643 5644 5645 5646 5647 5648	5846 5847 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 5859 5860 5861 5862 5863 5864 5865 5866 5867 5868 5869 5870 5871 5872 5873 5874 5875 5876 5877 5878 5879 5880 5881 5882 5883 5884 5885 5886 5887	- - - - + + - + - + - - -	*/ if (valuePtr->typePtr == &tclIntType) { i = valuePtr->internalRep.longValue; if (mathFuncPtr->argTypes[k] == TCL_DOUBLE) { args[k].type = TCL_DOUBLE; args[k].doubleValue = i; #ifndef TCL_WIDE_INT_IS_LONG } else if (mathFuncPtr->argTypes[k] == TCL_WIDE_INT) { args[k].type = TCL_WIDE_INT; args[k].wideValue = Tcl_LongAsWide(i); #endif /* !TCL_WIDE_INT_IS_LONG */ } else { args[k].type = TCL_INT; args[k].intValue = i; } #ifndef TCL_WIDE_INT_IS_LONG } else if (valuePtr->typePtr == &tclWideIntType) { Tcl_WideInt w = valuePtr->internalRep.wideValue; Tcl_WideInt w; TclGetWide(w,valuePtr); if (mathFuncPtr->argTypes[k] == TCL_DOUBLE) { args[k].type = TCL_DOUBLE; args[k].wideValue = (Tcl_WideInt) Tcl_WideAsDouble(w); args[k].doubleValue = Tcl_WideAsDouble(w); } else if (mathFuncPtr->argTypes[k] == TCL_INT) { args[k].type = TCL_INT; args[k].wideValue = Tcl_WideAsLong(w); args[k].intValue = Tcl_WideAsLong(w); } else { args[k].type = TCL_WIDE_INT; args[k].wideValue = w; } #endif /* !TCL_WIDE_INT_IS_LONG */ } else { d = valuePtr->internalRep.doubleValue; if (mathFuncPtr->argTypes[k] == TCL_INT) { args[k].type = TCL_INT; args[k].intValue = (long) d; #ifndef TCL_WIDE_INT_IS_LONG } else if (mathFuncPtr->argTypes[k] == TCL_WIDE_INT) { args[k].type = TCL_WIDE_INT; args[k].wideValue = Tcl_DoubleAsWide(d); #endif /* !TCL_WIDE_INT_IS_LONG */ } else { args[k].type = TCL_DOUBLE; args[k].doubleValue = d; } } }
︙
5668 5669 5670 5671 5672 5673 5674 5675 5676 5677 5678 5679 5680 5681 5682 5683 5684 5685	5907 5908 5909 5910 5911 5912 5913 5914 5915 5916 5917 5918 5919 5920 5921 5922	- -	/* * Push the call's object result. */ if (funcResult.type == TCL_INT) { PUSH_OBJECT(Tcl_NewLongObj(funcResult.intValue)); #ifndef TCL_WIDE_INT_IS_LONG } else if (funcResult.type == TCL_WIDE_INT) { PUSH_OBJECT(Tcl_NewWideIntObj(funcResult.wideValue)); #endif /* !TCL_WIDE_INT_IS_LONG */ } else { d = funcResult.doubleValue; if (IS_NAN(d) || IS_INF(d)) { TclExprFloatError(interp, d); result = TCL_ERROR; goto done; }
︙
6210 6211 6212 6213 6214 6215 6216	6447 6448 6449 6450 6451 6452 6453 6454 6455 6456 6457 6458 6459 6460 6461 6462	+ + + + + + + + +	if ((result >= TCL_OK) && (result <= TCL_CONTINUE)) { return resultStrings[result]; } TclFormatInt(buf, result); return buf; } #endif /* TCL_COMPILE_DEBUG */  /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	/* * tclFCmd.c * * This file implements the generic portion of file manipulation * subcommands of the "file" command. * * Copyright (c) 1996-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclFCmd.c,v 1.20 2002/08/08 10:41:22 hobbs Exp $ * RCS: @(#) $Id: tclFCmd.c,v 1.20.2.2 2005/08/17 17:46:36 hobbs Exp $ */ #include "tclInt.h" #include "tclPort.h" /* * Declarations for local procedures defined in this file:
︙
257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283	257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309	- - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - +	if (Tcl_FSStat(target, &statBuf) == 0) { if (!S_ISDIR(statBuf.st_mode)) { errno = EEXIST; errfile = target; goto done; } } else if ((errno != ENOENT) || (Tcl_FSCreateDirectory(target) != TCL_OK)) { errfile = target; goto done; } /* Forget about this sub-path */ } else if (errno != ENOENT) { /* * If Tcl_FSStat() failed and the error is anything * other than non-existence of the target, throw the * error. */ errfile = target; goto done; } else if (Tcl_FSCreateDirectory(target) != TCL_OK) { /* * Create might have failed because of being in a race * condition with another process trying to create the * same subdirectory. */ if (errno == EEXIST) { if ((Tcl_FSStat(target, &statBuf) == 0) && S_ISDIR(statBuf.st_mode)) { /* * It is a directory that wasn't there before, * so keep going without error. */ Tcl_ResetResult(interp); } else { errfile = target; goto done; } } else { errfile = target; goto done; } } /* Forget about this sub-path */ Tcl_DecrRefCount(target); target = NULL; } Tcl_DecrRefCount(split); split = NULL; } done: if (errfile != NULL) { Tcl_AppendResult(interp, "can't create directory \"", Tcl_GetString(errfile), "\": ", Tcl_PosixError(interp), (char *) NULL); result = TCL_ERROR; }
︙
654 655 656 657 658 659 660 661 662 663 664 665 666 667	680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701	+ + + + + + + +	if (result != TCL_OK) { /* * We could examine 'errno' to double-check if the problem * was with the target, but we checked the source above, * so it should be quite clear */ errfile = target; /* * We now need to reset the result, because the above call, * if it failed, may have put an error message in place. * (Ideally we would prefer not to pass an interpreter in * above, but the channel IO code used by * TclCrossFilesystemCopy currently requires one) */ Tcl_ResetResult(interp); } } if ((copyFlag == 0) && (result == TCL_OK)) { if (S_ISDIR(sourceStatBuf.st_mode)) { result = Tcl_FSRemoveDirectory(source, 1, &errorBuffer); if (result != TCL_OK) { if (Tcl_FSEqualPaths(errfile, source) == 0) {
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclFileName.c -- * * This file contains routines for converting file names betwen * native and network form. * * Copyright (c) 1995-1998 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. * * RCS: @(#) $Id: tclFileName.c,v 1.40 2003/01/09 10:01:59 vincentdarley Exp $ * RCS: @(#) $Id: tclFileName.c,v 1.40.2.15 2006/10/03 18:20:33 dgp Exp $ */ #include "tclInt.h" #include "tclPort.h" #include "tclRegexp.h" /*
︙
240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284	240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294	- - - - - - + + + + + + + + - - + + + - - - + + + + + - - + + + + - - + + + + - - + + +	Tcl_DStringAppend(resultPtr, path, 2); Tcl_DStringAppend(resultPtr, "/", 1); return tail; } } else { int abs = 0; if (path[0] == 'c' && path[1] == 'o') { if (path[2] == 'm' && path[3] >= '1' && path[3] <= '9') { /* May have match for 'com[1-9]:?', which is a serial port */ if (path[4] == '\0') { abs = 4; } else if (path [4] == ':' && path[5] == '\0') { if ((path[0] == 'c' || path[0] == 'C') && (path[1] == 'o' || path[1] == 'O')) { if ((path[2] == 'm' || path[2] == 'M') && path[3] >= '1' && path[3] <= '4') { /* May have match for 'com[1-4]:?', which is a serial port */ if (path[4] == '\0') { abs = 4; } else if (path [4] == ':' && path[5] == '\0') { abs = 5; } } else if (path[2] == 'n' && path[3] == '\0') { } } else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') { /* Have match for 'con' */ abs = 3; } } else if ((path[0] == 'l' || path[0] == 'L') } else if (path[0] == 'l' && path[1] == 'p' && path[2] == 't') { if (path[3] >= '1' && path[3] <= '9') { /* May have match for 'lpt[1-9]:?' */ && (path[1] == 'p' || path[1] == 'P') && (path[2] == 't' || path[2] == 'T')) { if (path[3] >= '1' && path[3] <= '3') { /* May have match for 'lpt[1-3]:?' */ if (path[4] == '\0') { abs = 4; } else if (path [4] == ':' && path[5] == '\0') { abs = 5; } } } else if ((path[0] == 'p' || path[0] == 'P') } else if (path[0] == 'p' && path[1] == 'r' && path[2] == 'n' && path[3] == '\0') { && (path[1] == 'r' || path[1] == 'R') && (path[2] == 'n' || path[2] == 'N') && path[3] == '\0') { /* Have match for 'prn' */ abs = 3; } else if ((path[0] == 'n' || path[0] == 'N') } else if (path[0] == 'n' && path[1] == 'u' && path[2] == 'l' && path[3] == '\0') { && (path[1] == 'u' || path[1] == 'U') && (path[2] == 'l' || path[2] == 'L') && path[3] == '\0') { /* Have match for 'nul' */ abs = 3; } else if ((path[0] == 'a' || path[0] == 'A') } else if (path[0] == 'a' && path[1] == 'u' && path[2] == 'x' && path[3] == '\0') { && (path[1] == 'u' || path[1] == 'U') && (path[2] == 'x' || path[2] == 'X') && path[3] == '\0') { /* Have match for 'aux' */ abs = 3; } if (abs != 0) { *typePtr = TCL_PATH_ABSOLUTE; Tcl_DStringSetLength(resultPtr, offset); Tcl_DStringAppend(resultPtr, path, abs);
︙
778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804	788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818	- - + + + + - + + +	Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); } Tcl_DStringFree(&buf); /* * Split on slashes. Embedded elements that start with tilde will be * prefixed with "./" so they are not affected by tilde substitution. * Split on slashes. Embedded elements that start with tilde * or a drive letter will be prefixed with "./" so they are not * affected by tilde substitution. */ do { elementStart = p; while ((*p != '\0') && (*p != '/') && (*p != '\\')) { p++; } length = p - elementStart; if (length > 0) { Tcl_Obj *nextElt; if ((elementStart != path) if ((elementStart[0] == '~') && (elementStart != path)) { && ((elementStart[0] == '~') || (isalpha(UCHAR(elementStart[0])) && elementStart[1] == ':'))) { nextElt = Tcl_NewStringObj("./",2); Tcl_AppendToObj(nextElt, elementStart, length); } else { nextElt = Tcl_NewStringObj(elementStart, length); } Tcl_ListObjAppendElement(NULL, result, nextElt); }
︙
1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140	1125 1126 1127 1128 1129 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	- - + + - + + + + + - -	{ int length, needsSep; char *dest, *p, *start; start = Tcl_GetStringFromObj(prefix, &length); /* * Remove the ./ from tilde prefixed elements unless * it is the first component. * Remove the ./ from tilde prefixed elements, and drive-letter * prefixed elements on Windows, unless it is the first component. */ p = joining; if (length != 0) { if ((p[0] == '.') && (p[1] == '/') && (p[2] == '~')) { if ((p[0] == '.') && (p[1] == '/') && ((p[2] == '~') || ((tclPlatform == TCL_PLATFORM_WINDOWS) && isalpha(UCHAR(p[2])) && (p[3] == ':')))) { p += 2; } } if (*p == '\0') { return; } switch (tclPlatform) { case TCL_PLATFORM_UNIX: /* * Append a separator if needed. */
︙
1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432	1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431	- + - - + + + - + + - + - - - - - - - - - - - - - - - - - - -	* indicate current user's home directory) or * "~<user>" (to indicate any user's home * directory). */ Tcl_DString *bufferPtr; /* Uninitialized or free DString filled * with name after tilde substitution. */ { Tcl_Obj *path = Tcl_NewStringObj(name, -1); CONST char *result; Tcl_Obj *transPtr; Tcl_IncrRefCount(path); result = Tcl_FSGetTranslatedStringPath(interp, path); if (result == NULL) { transPtr = Tcl_FSGetTranslatedPath(interp, path); if (transPtr == NULL) { Tcl_DecrRefCount(path); return NULL; } Tcl_DStringInit(bufferPtr); Tcl_DStringAppend(bufferPtr, result, -1); Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1); Tcl_DecrRefCount(path); Tcl_DecrRefCount(transPtr); /* * Convert forward slashes to backslashes in Windows paths because * some system interfaces don't accept forward slashes. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { #if defined(__CYGWIN__) && defined(__WIN32__) extern int cygwin_conv_to_win32_path _ANSI_ARGS_((CONST char *, char *)); char winbuf[MAX_PATH]; /* * In the Cygwin world, call conv_to_win32_path in order to use the * mount table to translate the file name into something Windows will * understand. Take care when converting empty strings! */ if (Tcl_DStringLength(bufferPtr)) { cygwin_conv_to_win32_path(Tcl_DStringValue(bufferPtr), winbuf); Tcl_DStringFree(bufferPtr); Tcl_DStringAppend(bufferPtr, winbuf, -1); } #else /* __CYGWIN__ && __WIN32__ */ register char *p; for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) { if (*p == '/') { *p = '\\'; } } #endif /* __CYGWIN__ && __WIN32__ */ } return Tcl_DStringValue(bufferPtr); }  /* *---------------------------------------------------------------------- *
︙
1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612	1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610	-	enum pathDirOptions {PATH_NONE = -1 , PATH_GENERAL = 0, PATH_DIR = 1}; Tcl_GlobTypeData *globTypes = NULL; globFlags = 0; join = 0; dir = PATH_NONE; typePtr = NULL; resultPtr = Tcl_GetObjResult(interp); for (i = 1; i < objc; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) { string = Tcl_GetStringFromObj(objv[i], &length); if (string[0] == '-') { /* * It looks like the command contains an option so signal
︙
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 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701	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 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698	- - + + - + - + - - + + - + - + - - + + - - + - +	} switch (index) { case GLOB_NOCOMPLAIN: /* -nocomplain */ globFlags |= TCL_GLOBMODE_NO_COMPLAIN; break; case GLOB_DIR: /* -dir */ if (i == (objc-1)) { Tcl_AppendToObj(resultPtr, "missing argument to \"-directory\"", -1); Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing argument to \"-directory\"", -1)); return TCL_ERROR; } if (dir != PATH_NONE) { Tcl_AppendToObj(resultPtr, Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-directory\" cannot be used with \"-path\"", -1); -1)); return TCL_ERROR; } dir = PATH_DIR; globFlags |= TCL_GLOBMODE_DIR; pathOrDir = objv[i+1]; i++; break; case GLOB_JOIN: /* -join */ join = 1; break; case GLOB_TAILS: /* -tails */ globFlags |= TCL_GLOBMODE_TAILS; break; case GLOB_PATH: /* -path */ if (i == (objc-1)) { Tcl_AppendToObj(resultPtr, "missing argument to \"-path\"", -1); Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing argument to \"-path\"", -1)); return TCL_ERROR; } if (dir != PATH_NONE) { Tcl_AppendToObj(resultPtr, Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-path\" cannot be used with \"-directory\"", -1); -1)); return TCL_ERROR; } dir = PATH_GENERAL; pathOrDir = objv[i+1]; i++; break; case GLOB_TYPE: /* -types */ if (i == (objc-1)) { Tcl_AppendToObj(resultPtr, "missing argument to \"-types\"", -1); Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing argument to \"-types\"", -1)); return TCL_ERROR; } typePtr = objv[i+1]; if (Tcl_ListObjLength(interp, typePtr, &length) != TCL_OK) { return TCL_ERROR; } i++; break; case GLOB_LAST: /* -- */ i++; goto endOfForLoop; break; } } endOfForLoop: if (objc - i < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?switches? name ?name ...?"); return TCL_ERROR; } if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) { Tcl_AppendToObj(resultPtr, Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-tails\" must be used with either \"-directory\" or \"-path\"", -1); -1)); return TCL_ERROR; } separators = NULL; /* lint. */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: separators = "/";
︙
1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745	1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752	+ + + + + + + + + +	/* The whole thing is a prefix */ Tcl_DStringAppend(&pref, first, -1); pathOrDir = NULL; } else { /* Have to split off the end */ Tcl_DStringAppend(&pref, last, first+pathlength-last); pathOrDir = Tcl_NewStringObj(first, last-first-1); /* * We must ensure that we haven't cut off too much, * and turned a valid path like '/' or 'C:/' into * an incorrect path like '' or 'C:'. The way we * do this is to add a separator if there are none * presently in the prefix. */ if (strpbrk(Tcl_GetString(pathOrDir), "\\/") == NULL) { Tcl_AppendToObj(pathOrDir, last-1, 1); } } /* Need to quote 'prefix' */ Tcl_DStringInit(&prefix); search = Tcl_DStringValue(&pref); while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) { Tcl_DStringAppend(&prefix, search, find-search); Tcl_DStringAppend(&prefix, "\\", 1);
︙
1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896	1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896	- + - - + - - + - - - - -	globTypes->macCreator = item; Tcl_IncrRefCount(item); continue; } } } /* * Error cases. We re-get the interpreter's result, * Error cases. We reset * just to be sure it hasn't changed, and we reset * the 'join' flag to zero, since we haven't yet * made use of it. */ badTypesArg: resultPtr = Tcl_GetObjResult(interp); Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1); Tcl_AppendObjToObj(resultPtr, look); result = TCL_ERROR; join = 0; goto endOfGlob; badMacTypesArg: resultPtr = Tcl_GetObjResult(interp); Tcl_SetObjResult(interp, Tcl_NewStringObj( Tcl_AppendToObj(resultPtr, "only one MacOS type or creator argument" " to \"-types\" allowed", -1); " to \"-types\" allowed", -1)); result = TCL_ERROR; join = 0; goto endOfGlob; } } } /* * Now we perform the actual glob below. This may involve joining * together the pattern arguments, dealing with particular file types * etc. We use a 'goto' to ensure we free any memory allocated along * the way. */ objc -= i; objv += i; /* * We re-retrieve this, in case it was changed in * the Tcl_ResetResult above */ resultPtr = Tcl_GetObjResult(interp); result = TCL_OK; if (join) { if (dir != PATH_GENERAL) { Tcl_DStringInit(&prefix); } for (i = 0; i < objc; i++) { string = Tcl_GetStringFromObj(objv[i], &length);
︙
2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139	2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143	+ + + +	if (strchr(separators, c) == NULL) { /* * If the prefix is a directory, make sure it ends in a * directory separator. */ if (globFlags & TCL_GLOBMODE_DIR) { Tcl_DStringAppend(&buffer,separators,1); /* Try to borrow that separator from the tail */ if (*tail == *separators) { tail++; } } prefixLen++; } } /* * We need to get the old result, in case it is over-written
︙
2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343	2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365	+ + + + + + + + - - + + + + + + + + + + + +	* Consume any leading directory separators, leaving tail pointing * just past the last initial separator. */ count = 0; name = tail; for (; *tail != '\0'; tail++) { if (*tail == '\\') { /* * If the first character is escaped, either we have a directory * separator, or we have any other character. In the latter case * the rest of tail is a pattern, and we must break from the loop. * This is particularly important on Windows where '\' is both * the escaping character and a directory separator. */ if ((*tail == '\\') && (strchr(separators, tail[1]) != NULL)) { tail++; if (strchr(separators, tail[1]) != NULL) { tail++; } else { break; } } else if (strchr(separators, *tail) == NULL) { break; } if (tclPlatform != TCL_PLATFORM_MAC) { if (*tail == '\\') { Tcl_DStringAppend(headPtr, separators, 1); } else { Tcl_DStringAppend(headPtr, tail, 1); } } count++; } /* * Deal with path separators. On the Mac, we have to watch out * for multiple separators, since they are special in Mac-style
︙
2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435	2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439	- - - - - - - - - - - - - - - - - - - - + - + - + +	break; case TCL_PLATFORM_WINDOWS: /* * If this is a drive relative path, add the colon and the * trailing slash if needed. Otherwise add the slash if * this is the first absolute element, or a later relative * element. Add an extra slash if this is a UNC path. */ #if defined(__CYGWIN__) && defined(__WIN32__) { extern int cygwin_conv_to_win32_path _ANSI_ARGS_((CONST char *, char *)); char winbuf[MAX_PATH]; /* * In the Cygwin world, call conv_to_win32_path in order to use * the mount table to translate the file name into something * Windows will understand. */ cygwin_conv_to_win32_path(Tcl_DStringValue(headPtr), winbuf); Tcl_DStringFree(headPtr); Tcl_DStringAppend(headPtr, winbuf, -1); } #endif /* __CYGWIN__ && __WIN32__ */ if (*name == ':') { Tcl_DStringAppend(headPtr, ":", 1); if (count > 1) { Tcl_DStringAppend(headPtr, "/", 1); } } else if ((*tail != '\0') && (((length > 0) && (strchr(separators, lastChar) == NULL)) || ((length == 0) && (count > 0)))) { Tcl_DStringAppend(headPtr, "/", 1); if ((length == 0) && (count > 1)) { Tcl_DStringAppend(headPtr, "/", 1); } } */ break; case TCL_PLATFORM_UNIX: case TCL_PLATFORM_UNIX: { /* * Add a separator if this is the first absolute element, or * a later relative element. */ if ((*tail != '\0') && (((length > 0) && (strchr(separators, lastChar) == NULL)) || ((length == 0) && (count > 0)))) { Tcl_DStringAppend(headPtr, "/", 1); } */ break; } } /* * Look for the first matching pair of braces or the first * directory separator that is not inside a pair of braces. */
︙
2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574	2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578	- - + - + - + + - +	* each file that matches, it will add the match onto the * resultPtr given. */ if (*p == '\0') { ret = Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp), head, tail, types); } else { Tcl_Obj* resultPtr; /* * We do the recursion ourselves. This makes implementing * Tcl_FSMatchInDirectory for each filesystem much easier. */ Tcl_GlobTypeData dirOnly = { TCL_GLOB_TYPE_DIR, 0, NULL, NULL }; char save = *p; Tcl_Obj *resultPtr; *p = '\0'; resultPtr = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(resultPtr); *p = '\0'; ret = Tcl_FSMatchInDirectory(interp, resultPtr, head, tail, &dirOnly); *p = save; if (ret == TCL_OK) { int resLength; ret = Tcl_ListObjLength(interp, resultPtr, &resLength); if (ret == TCL_OK) { int i; for (i =0; i< resLength; i++) { Tcl_Obj *elt; Tcl_DString ds; Tcl_ListObjIndex(interp, resultPtr, i, &elt); Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, Tcl_GetString(elt), -1); if(tclPlatform == TCL_PLATFORM_MAC) { Tcl_DStringAppend(&ds, ":",1); } else { } else { Tcl_DStringAppend(&ds, "/",1); } ret = TclDoGlob(interp, separators, &ds, p+1, types); Tcl_DStringFree(&ds); if (ret != TCL_OK) { break; }
︙
2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623	2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638	- + + + + + + + + + + + +	} break; } case TCL_PLATFORM_WINDOWS: { if (Tcl_DStringLength(headPtr) == 0) { if (((*name == '\\') && (name[1] == '/' || name[1] == '\\')) || (*name == '/')) { Tcl_DStringAppend(headPtr, "\\", 1); Tcl_DStringAppend(headPtr, "/", 1); } else { Tcl_DStringAppend(headPtr, ".", 1); } } #if defined(__CYGWIN__) && defined(__WIN32__) { extern int cygwin_conv_to_win32_path _ANSI_ARGS_((CONST char *, char *)); char winbuf[MAX_PATH+1]; cygwin_conv_to_win32_path(Tcl_DStringValue(headPtr), winbuf); Tcl_DStringFree(headPtr); Tcl_DStringAppend(headPtr, winbuf, -1); } #endif /* __CYGWIN__ && __WIN32__ */ /* * Convert to forward slashes. This is required to pass * some Tcl tests. We should probably remove the conversions * here and in tclWinFile.c, since they aren't needed since * the dropping of support for Win32s. */ for (p = Tcl_DStringValue(headPtr); *p != '\0'; p++) {
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	/* * tclGet.c -- * * This file contains procedures to convert strings into * other forms, like integers or floating-point numbers or * booleans, doing syntax checking along the way. * * Copyright (c) 1990-1993 The Regents of the University of California. * Copyright (c) 1994-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. * * RCS: @(#) $Id: tclGet.c,v 1.8 2002/11/19 02:34:49 hobbs Exp $ * RCS: @(#) $Id: tclGet.c,v 1.8.2.1 2005/04/20 16:06:17 dgp Exp $ */ #include "tclInt.h" #include "tclPort.h" #include "tclMath.h"
︙
88 89 90 91 92 93 94 95 96 97 98 99 100 101 102	88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106	- + + + + +	/* * The second test below is needed on platforms where "long" is * larger than "int" to detect values that fit in a long but not in * an int. */ if ((errno == ERANGE) || (((long)(int) i) != i)) { if ((errno == ERANGE) #if (LONG_MAX > INT_MAX) || (i > UINT_MAX) || (i < -(long)UINT_MAX) #endif ) { if (interp != (Tcl_Interp *) NULL) { Tcl_SetResult(interp, "integer value too large to represent", TCL_STATIC); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", Tcl_GetStringResult(interp), (char *) NULL); } return TCL_ERROR;
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	/* * tclGetDate.y -- * * Contains yacc grammar for parsing date and time strings. * The output of this file should be the file tclDate.c which * is used directly in the Tcl sources. * * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans. * Copyright (c) 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. * * RCS: @(#) $Id: tclGetDate.y,v 1.18 2001/10/18 20:20:28 hobbs Exp $ * RCS: @(#) $Id: tclGetDate.y,v 1.18.4.2 2005/11/04 20:15:09 kennykb Exp $ */ %{ /* * tclDate.c -- * * This file is generated from a yacc grammar defined in
︙
549 550 551 552 553 554 555 556 557 558 559 560 561 562	549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565	+ + +	{ "sst", tZONE, -HOUR( 7) }, /* South Sumatra, USSR Zone 6 */ #endif /* 0 */ { "wast", tZONE, -HOUR( 7) }, /* West Australian Standard */ { "wadt", tDAYZONE, -HOUR( 7) }, /* West Australian Daylight */ { "jt", tZONE, -HOUR(15/2) }, /* Java (3pm in Cronusland!) */ { "cct", tZONE, -HOUR( 8) }, /* China Coast, USSR Zone 7 */ { "jst", tZONE, -HOUR( 9) }, /* Japan Standard, USSR Zone 8 */ { "jdt", tDAYZONE, -HOUR( 9) }, /* Japan Daylight */ { "kst", tZONE, -HOUR( 9) }, /* Korea Standard */ { "kdt", tDAYZONE, -HOUR( 9) }, /* Korea Daylight */ { "cast", tZONE, -HOUR(19/2) }, /* Central Australian Standard */ { "cadt", tDAYZONE, -HOUR(19/2) }, /* Central Australian Daylight */ { "east", tZONE, -HOUR(10) }, /* Eastern Australian Standard */ { "eadt", tDAYZONE, -HOUR(10) }, /* Eastern Australian Daylight */ { "gst", tZONE, -HOUR(10) }, /* Guam Standard, USSR Zone 9 */ { "nzt", tZONE, -HOUR(12) }, /* New Zealand */ { "nzst", tZONE, -HOUR(12) }, /* New Zealand Standard */
︙
1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074	1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077	- + - + - - + +	/* * Specify zone is of -50000 to force GMT. (This allows BST to work). */ int TclGetDate(p, now, zone, timePtr) char *p; unsigned long now; Tcl_WideInt now; long zone; unsigned long *timePtr; Tcl_WideInt *timePtr; { struct tm *tm; time_t Start; time_t Time; time_t tod; int thisyear; yyInput = p; /* now has to be cast to a time_t for 64bit compliance */ Start = now; tm = TclpGetDate((TclpTime_t) &Start, 0); Start = (time_t) now; tm = TclpGetDate((TclpTime_t) &Start, (zone == -50000)); thisyear = tm->tm_year + TM_YEAR_BASE; yyYear = thisyear; yyMonth = tm->tm_mon + 1; yyDay = tm->tm_mday; yyTimezone = zone; if (zone == -50000) { yyDSTmode = DSToff; /* assume GMT */
︙
1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133	1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136	- +	} } if (Convert(yyMonth, yyDay, yyYear, yyHour, yyMinutes, yySeconds, yyMeridian, yyDSTmode, &Start) < 0) { return -1; } } else { Start = now; Start = (time_t) now; if (!yyHaveRel) { Start -= ((tm->tm_hour * 60L * 60L) + tm->tm_min * 60L) + tm->tm_sec; } } Start += yyRelSeconds;
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclHash.c -- * * Implementation of in-memory hash tables for Tcl and Tcl-based * applications. * * Copyright (c) 1991-1993 The Regents of the University of California. * Copyright (c) 1994 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclHash.c,v 1.12 2002/11/12 02:23:18 hobbs Exp $ * RCS: @(#) $Id: tclHash.c,v 1.12.2.1 2004/11/11 01:18:07 das Exp $ */ #include "tclInt.h" /* * Prevent macros from clashing with function definitions. */
︙
312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333	312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334	+ - +	} /* * Search all of the entries in the appropriate bucket. */ if (typePtr->compareKeysProc) { Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc; for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { #if TCL_HASH_KEY_STORE_HASH if (hash != (unsigned int) hPtr->hash) { continue; } #endif if (typePtr->compareKeysProc ((VOID *) key, hPtr)) { if (compareKeysProc ((VOID *) key, hPtr)) { return hPtr; } } } else { for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { #if TCL_HASH_KEY_STORE_HASH
︙
410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431	411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433	+ - +	} /* * Search all of the entries in the appropriate bucket. */ if (typePtr->compareKeysProc) { Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc; for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { #if TCL_HASH_KEY_STORE_HASH if (hash != (unsigned int) hPtr->hash) { continue; } #endif if (typePtr->compareKeysProc ((VOID *) key, hPtr)) { if (compareKeysProc ((VOID *) key, hPtr)) { *newPtr = 0; return hPtr; } } } else { for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) {
︙
699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719	701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722	+ - + - +	Tcl_NextHashEntry(searchPtr) register Tcl_HashSearch *searchPtr; /* Place to store information about * progress through the table. Must * have been initialized by calling * Tcl_FirstHashEntry. */ { Tcl_HashEntry *hPtr; Tcl_HashTable *tablePtr = searchPtr->tablePtr; while (searchPtr->nextEntryPtr == NULL) { if (searchPtr->nextIndex >= searchPtr->tablePtr->numBuckets) { if (searchPtr->nextIndex >= tablePtr->numBuckets) { return NULL; } searchPtr->nextEntryPtr = searchPtr->tablePtr->buckets[searchPtr->nextIndex]; tablePtr->buckets[searchPtr->nextIndex]; searchPtr->nextIndex++; } hPtr = searchPtr->nextEntryPtr; searchPtr->nextEntryPtr = hPtr->nextPtr; return hPtr; }
︙

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	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	- + + + + +	/* * tclIO.c -- * * This file provides the generic portions (those that are the same on * all platforms and for all channel types) of Tcl's IO facilities. * * Copyright (c) 1998-2000 Ajuba Solutions * Copyright (c) 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. * * RCS: @(#) $Id: tclIO.c,v 1.61 2003/02/19 01:04:57 hobbs Exp $ * RCS: @(#) $Id: tclIO.c,v 1.61.2.23 2007/05/24 19:31:55 dgp Exp $ */ #include "tclInt.h" #include "tclPort.h" #include "tclIO.h" #include <assert.h> #ifndef TCL_INHERIT_STD_CHANNELS #define TCL_INHERIT_STD_CHANNELS 1 #endif  /* * All static variables used in this file are collected into a single * instance of the following structure. For multi-threaded implementations, * there is one instance of this structure for each thread. *
︙
181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283	185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313	- + - + - - - + + + + + + + + + + + + + + + + + + - - - - + + + + + + + + + + + + + + + - - - - - - - - - - - + + + + + + + + + + + - - - - - - - - - - + + + + + + + + + - - - - - - - - + + + + + + + - - + - - - - - - - - - - - - - - + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + +	}  /* *------------------------------------------------------------------------- * * TclFinalizeIOSubsystem -- * * Releases all resources used by this subsystem on a per-process * Releases all resources used by this subsystem on a per-thread * basis. Closes all extant channels that have not already been * closed because they were not owned by any interp. * * Results: * None. * * Side effects: * Depends on encoding and memory subsystems. * *------------------------------------------------------------------------- */ /* ARGSUSED */ void TclFinalizeIOSubsystem() TclFinalizeIOSubsystem(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Channel *chanPtr; /* Iterates over open channels. */ ChannelState *nextCSPtr; /* Iterates over open channels. */ ChannelState *statePtr; /* state of channel stack */ Channel *chanPtr = NULL; /* Iterates over open channels. */ ChannelState *statePtr; /* State of channel stack */ int active = 1; /* Flag == 1 while there's still work to do */ /* * Walk all channel state structures known to this thread and * close corresponding channels. */ while (active) { /* * Iterate through the open channel list, and find the first * channel that isn't dead. We start from the head of the list * each time, because the close action on one channel can close * others. */ active = 0; for (statePtr = tsdPtr->firstCSPtr; statePtr != (ChannelState *) NULL; statePtr = nextCSPtr) { chanPtr = statePtr->topChanPtr; nextCSPtr = statePtr->nextCSPtr; for (statePtr = tsdPtr->firstCSPtr; statePtr != NULL; statePtr = statePtr->nextCSPtr) { chanPtr = statePtr->topChanPtr; if (!(statePtr->flags & CHANNEL_DEAD)) { active = 1; break; } } /* * We've found a live channel. Close it. */ if (active) { /* * Set the channel back into blocking mode to ensure that we wait * for all data to flush out. */ (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, "-blocking", "on"); if ((chanPtr == (Channel *) tsdPtr->stdinChannel) || (chanPtr == (Channel *) tsdPtr->stdoutChannel) || (chanPtr == (Channel *) tsdPtr->stderrChannel)) { /* * Set the channel back into blocking mode to ensure that we * wait for all data to flush out. */ (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, "-blocking", "on"); if ((chanPtr == (Channel *) tsdPtr->stdinChannel) || (chanPtr == (Channel *) tsdPtr->stdoutChannel) || (chanPtr == (Channel *) tsdPtr->stderrChannel)) { /* * Decrement the refcount which was earlier artificially bumped * up to keep the channel from being closed. */ statePtr->refCount--; } if (statePtr->refCount <= 0) { /* * Decrement the refcount which was earlier artificially * bumped up to keep the channel from being closed. */ statePtr->refCount--; } if (statePtr->refCount <= 0) { /* * Close it only if the refcount indicates that the channel is not * referenced from any interpreter. If it is, that interpreter will * close the channel when it gets destroyed. */ (void) Tcl_Close((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr); /* * Close it only if the refcount indicates that the channel * is not referenced from any interpreter. If it is, that * interpreter will close the channel when it gets destroyed. */ (void) Tcl_Close(NULL, (Tcl_Channel) chanPtr); } else { } else { /* * The refcount is greater than zero, so flush the channel. */ Tcl_Flush((Tcl_Channel) chanPtr); /* * Call the device driver to actually close the underlying * device for this channel. */ if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) { (chanPtr->typePtr->closeProc)(chanPtr->instanceData, /* * The refcount is greater than zero, so flush the channel. */ Tcl_Flush((Tcl_Channel) chanPtr); /* * Call the device driver to actually close the underlying * device for this channel. */ if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) { (chanPtr->typePtr->closeProc)(chanPtr->instanceData, NULL); (Tcl_Interp *) NULL); } else { (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, (Tcl_Interp *) NULL, 0); } /* * Finally, we clean up the fields in the channel data structure * since all of them have been deleted already. We mark the * channel with CHANNEL_DEAD to prevent any further IO operations * on it. */ chanPtr->instanceData = (ClientData) NULL; statePtr->flags |= CHANNEL_DEAD; } } } else { (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, NULL, 0); } /* * Finally, we clean up the fields in the channel data * structure since all of them have been deleted already. * We mark the channel with CHANNEL_DEAD to prevent any * further IO operations * on it. */ chanPtr->instanceData = NULL; statePtr->flags |= CHANNEL_DEAD; } } } TclpFinalizeSockets(); TclpFinalizePipes(); }  /* *---------------------------------------------------------------------- * * Tcl_SetStdChannel --
︙
768 769 770 771 772 773 774 775 776 777 778 779 780 781	798 799 800 801 802 803 804 805 806 807 808 809 810 811 812	+	return; } panic("Tcl_RegisterChannel: duplicate channel names"); } Tcl_SetHashValue(hPtr, (ClientData) chanPtr); } statePtr->refCount++; }  /* *---------------------------------------------------------------------- * * Tcl_UnregisterChannel --
︙
804 805 806 807 808 809 810 811 812 813 814 815 816 817	835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859	+ + + + + + + + + + +	int Tcl_UnregisterChannel(interp, chan) Tcl_Interp *interp; /* Interpreter in which channel is defined. */ Tcl_Channel chan; /* Channel to delete. */ { ChannelState *statePtr; /* State of the real channel. */ statePtr = ((Channel *) chan)->state->bottomChanPtr->state; if (statePtr->flags & CHANNEL_INCLOSE) { if (interp != (Tcl_Interp*) NULL) { Tcl_AppendResult(interp, "Illegal recursive call to close through close-handler of channel", (char *) NULL); } return TCL_ERROR; } if (DetachChannel(interp, chan) != TCL_OK) { return TCL_OK; } statePtr = ((Channel *) chan)->state->bottomChanPtr->state; /*
︙
1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236	1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280	- - - - - + + + + + - - - - + + + + - + + - + - + +	/* * Link the channel into the list of all channels; create an on-exit * handler if there is not one already, to close off all the channels * in the list on exit. * * JH: Could call Tcl_SpliceChannel, but need to avoid NULL check. */ statePtr->nextCSPtr = tsdPtr->firstCSPtr; tsdPtr->firstCSPtr = statePtr; * * TIP #218. * AK: Just initialize the field to NULL before invoking Tcl_SpliceChannel * We need Tcl_SpliceChannel, for the threadAction calls. * There is no real reason to duplicate all of this. /* * TIP #10. Mark the current thread as the one managing the new * channel. Note: 'Tcl_GetCurrentThread' returns sensible * values even for a non-threaded core. * NOTE: All drivers using thread actions now have to perform their TSD * manipulation only in their thread action proc. Doing it when * creating their instance structures will collide with the thread * action activity and lead to damaged lists. */ statePtr->managingThread = Tcl_GetCurrentThread (); statePtr->nextCSPtr = (ChannelState *) NULL; Tcl_SpliceChannel ((Tcl_Channel) chanPtr); /* * Install this channel in the first empty standard channel slot, if * the channel was previously closed explicitly. */ #if TCL_INHERIT_STD_CHANNELS if ((tsdPtr->stdinChannel == NULL) && (tsdPtr->stdinInitialized == 1)) { Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN); Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr); } else if ((tsdPtr->stdoutChannel == NULL) && (tsdPtr->stdoutInitialized == 1)) { Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDOUT); Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr); } else if ((tsdPtr->stderrChannel == NULL) && (tsdPtr->stderrInitialized == 1)) { Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR); Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr); } } #endif return (Tcl_Channel) chanPtr; }  /* *---------------------------------------------------------------------- * * Tcl_StackChannel --
︙
1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340	1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390	- + + - - + + + + - - - + + + + + - - + + +	* * This operation should occur at the top of a channel stack. */ statePtr = (ChannelState *) tsdPtr->firstCSPtr; prevChanPtr = ((Channel *) prevChan)->state->topChanPtr; while (statePtr->topChanPtr != prevChanPtr) { while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) { statePtr = statePtr->nextCSPtr; } if (statePtr == NULL) { if (interp) { Tcl_AppendResult(interp, "couldn't find state for channel \"", Tcl_GetChannelName(prevChan), "\"", (char *) NULL); Tcl_AppendResult(interp, "couldn't find state for channel \"", Tcl_GetChannelName(prevChan), "\"", (char *) NULL); } return (Tcl_Channel) NULL; } /* * Here we check if the given "mask" matches the "flags" * of the already existing channel. * * | - | R | W | RW | * --+---+---+---+----+ <=> 0 != (chan->mask & prevChan->mask) * - | | | | | * R | | + | | + | The superceding channel is allowed to * W | | | + | + | restrict the capabilities of the * RW| | + | + | + | superceded one ! * --+---+---+---+----+ */ if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) { if (interp) { Tcl_AppendResult(interp, "reading and writing both disallowed for channel \"", Tcl_GetChannelName(prevChan), "\"", (char *) NULL); Tcl_AppendResult(interp, "reading and writing both disallowed for channel \"", Tcl_GetChannelName(prevChan), "\"", (char *) NULL); } return (Tcl_Channel) NULL; } /* * Flush the buffers. This ensures that any data still in them * at this time is not handled by the new transformation. Restrict * this to writable channels. Take care to hide a possible bg-copy * in progress from Tcl_Flush and the CheckForChannelErrors inside. */ if ((mask & TCL_WRITABLE) != 0) { CopyState *csPtr; csPtr = statePtr->csPtr; statePtr->csPtr = (CopyState*) NULL; if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) { statePtr->csPtr = csPtr; if (interp) { Tcl_AppendResult(interp, "could not flush channel \"", Tcl_GetChannelName(prevChan), "\"", (char *) NULL); Tcl_AppendResult(interp, "could not flush channel \"", Tcl_GetChannelName(prevChan), "\"", (char *) NULL); } return (Tcl_Channel) NULL; } statePtr->csPtr = csPtr; } /* * Discard any input in the buffers. They are not yet read by the
︙
1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468	1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520	+ - - - + + + +	CopyState* csPtr; csPtr = statePtr->csPtr; statePtr->csPtr = (CopyState*) NULL; if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) { statePtr->csPtr = csPtr; if (interp) { Tcl_AppendResult(interp, "could not flush channel \"", Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"", (char *) NULL); Tcl_AppendResult(interp, "could not flush channel \"", Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"", (char *) NULL); } return TCL_ERROR; } statePtr->csPtr = csPtr; } /*
︙
2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376	2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428	- +	* Results: * Nothing. * * Side effects: * Resets the field 'nextCSPtr' of the specified channel state to NULL. * * NOTE: * The channel to splice out of the list must not be referenced * The channel to cut out of the list must not be referenced * in any interpreter. This is something this procedure cannot * check (despite the refcount) because the caller usually wants * fiddle with the channel (like transfering it to a different * thread) and thus keeps the refcount artifically high to prevent * its destruction. * *----------------------------------------------------------------------
︙
2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397	2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450	+	{ ThreadSpecificData* tsdPtr = TCL_TSD_INIT(&dataKey); ChannelState *prevCSPtr; /* Preceding channel state in list of * all states - used to splice a * channel out of the list on close. */ ChannelState *statePtr = ((Channel *) chan)->state; /* state of the channel stack. */ Tcl_DriverThreadActionProc *threadActionProc; /* * Remove this channel from of the list of all channels * (in the current thread). */ if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) {
︙
2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 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 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473	2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537	- + + + + + + - + + - + + + + + +	panic("FlushChannel: damaged channel list"); } prevCSPtr->nextCSPtr = statePtr->nextCSPtr; } statePtr->nextCSPtr = (ChannelState *) NULL; TclpCutFileChannel(chan); /* TIP #218, Channel Thread Actions */ threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan)); if (threadActionProc != NULL) { (*threadActionProc) (Tcl_GetChannelInstanceData(chan), TCL_CHANNEL_THREAD_REMOVE); } }  /* *---------------------------------------------------------------------- * * Tcl_SpliceChannel -- * * Adds a channel to the (thread-)global list of all channels * (in that thread). Expects that the field 'nextChanPtr' in * the channel is set to NULL. * * Results: * Nothing. * * Side effects: * Nothing. * * NOTE: * The channel to add to the list must not be referenced in any * The channel to splice into the list must not be referenced in any * interpreter. This is something this procedure cannot check * (despite the refcount) because the caller usually wants figgle * with the channel (like transfering it to a different thread) * and thus keeps the refcount artifically high to prevent its * destruction. * *---------------------------------------------------------------------- */ void Tcl_SpliceChannel(chan) Tcl_Channel chan; /* The channel being added. Must * not be referenced in any * interpreter. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ChannelState *statePtr = ((Channel *) chan)->state; Tcl_DriverThreadActionProc *threadActionProc; if (statePtr->nextCSPtr != (ChannelState *) NULL) { panic("Tcl_SpliceChannel: trying to add channel used in different list"); } statePtr->nextCSPtr = tsdPtr->firstCSPtr; tsdPtr->firstCSPtr = statePtr; /* * TIP #10. Mark the current thread as the new one managing this * channel. Note: 'Tcl_GetCurrentThread' returns sensible * values even for a non-threaded core. */ statePtr->managingThread = Tcl_GetCurrentThread (); TclpSpliceFileChannel(chan); /* TIP #218, Channel Thread Actions */ threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan)); if (threadActionProc != NULL) { (*threadActionProc) (Tcl_GetChannelInstanceData(chan), TCL_CHANNEL_THREAD_INSERT); } }  /* *---------------------------------------------------------------------- * * Tcl_Close -- *
︙
2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536	2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610	+ + + + + + + + + +	chanPtr = (Channel *) chan; statePtr = chanPtr->state; chanPtr = statePtr->topChanPtr; if (statePtr->refCount > 0) { panic("called Tcl_Close on channel with refCount > 0"); } if (statePtr->flags & CHANNEL_INCLOSE) { if (interp) { Tcl_AppendResult(interp, "Illegal recursive call to close through close-handler of channel", (char *) NULL); } return TCL_ERROR; } statePtr->flags |= CHANNEL_INCLOSE; /* * When the channel has an escape sequence driven encoding such as * iso2022, the terminated escape sequence must write to the buffer. */ if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL) && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
︙
2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559	2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635	+ +	while (statePtr->closeCbPtr != (CloseCallback *) NULL) { cbPtr = statePtr->closeCbPtr; statePtr->closeCbPtr = cbPtr->nextPtr; (cbPtr->proc) (cbPtr->clientData); ckfree((char *) cbPtr); } statePtr->flags &= ~CHANNEL_INCLOSE; /* * Ensure that the last output buffer will be flushed. */ if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) && (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
︙
2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631	2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713	+ + + + + +	* This operation should occur at the top of a channel stack. */ chanPtr = (Channel *) channel; statePtr = chanPtr->state; chanPtr = statePtr->topChanPtr; /* * Cancel any outstanding timer. */ Tcl_DeleteTimerHandler(statePtr->timer); /* * Remove any references to channel handlers for this channel that * may be about to be invoked. */ for (nhPtr = tsdPtr->nestedHandlerPtr; nhPtr != (NextChannelHandler *) NULL;
︙
2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673	2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755	- + - +	/* * Must set the interest mask now to 0, otherwise infinite loops * will occur if Tcl_DoOneEvent is called before the channel is * finally deleted in FlushChannel. This can happen if the channel * has a background flush active. */ statePtr->interestMask = 0; /* * Remove any EventScript records for this channel. */ for (ePtr = statePtr->scriptRecordPtr; ePtr != (EventScriptRecord *) NULL; ePtr = eNextPtr) {
︙
4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263	4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367	+ + + + + + + + - - + + + + + + + + + + + + + + + +	if (statePtr->flags & CHANNEL_BLOCKED) { if (statePtr->flags & CHANNEL_NONBLOCKING) { goto done; } statePtr->flags &= (~(CHANNEL_BLOCKED)); } #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING /* [SF Tcl Bug 943274]. Better emulation of non-blocking * channels for channels without BlockModeProc, by keeping * track of true fileevents generated by the OS == Data * waiting and reading if and only if we are sure to have * data. */ if ((statePtr->flags & CHANNEL_TIMER_FEV) && (statePtr->flags & CHANNEL_NONBLOCKING)) { if ((statePtr->flags & CHANNEL_NONBLOCKING) && (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) && !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) { /* We bypass the driver, it would block, as no data is available */ nread = -1; result = EWOULDBLOCK; } else { #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ /* * Now go to the driver to get as much as is possible to * fill the remaining request. Do all the error handling * by ourselves. The code was stolen from 'GetInput' and * slightly adapted (different return value here). * * The case of 'bytesToRead == 0' at this point cannot happen. */ nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData, bufPtr + copied, bytesToRead - copied, &result); #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING } #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ if (nread > 0) { /* * If we get a short read, signal up that we may be * BLOCKED. We should avoid calling the driver because * on some platforms we will block in the low level * reading code even though the channel is set into * nonblocking mode. */ if (nread < (bytesToRead - copied)) { statePtr->flags |= CHANNEL_BLOCKED; } #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING if (nread <= (bytesToRead - copied)) { /* [SF Tcl Bug 943274] We have read the available * data, clear flag */ statePtr->flags &= ~CHANNEL_HAS_MORE_DATA; } #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ } else if (nread == 0) { statePtr->flags |= CHANNEL_EOF; statePtr->inputEncodingFlags |= TCL_ENCODING_END; } else if (nread < 0) { if ((result == EWOULDBLOCK) || (result == EAGAIN)) { if (copied > 0) { /*
︙
4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388	4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492	- +	{ ChannelState *statePtr = chanPtr->state; /* state info for channel */ ChannelBuffer *bufPtr; int offset, factor, copied, copiedNow, result; Tcl_Encoding encoding; #define UTF_EXPANSION_FACTOR 1024 /* * This operation should occur at the top of a channel stack. */ chanPtr = statePtr->topChanPtr; encoding = statePtr->encoding; factor = UTF_EXPANSION_FACTOR;
︙
4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648	4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753	+ - +	* based on the data seen so far. */ { int toRead, factor, offset, spaceLeft, length, srcLen, dstNeeded; int srcRead, dstWrote, numChars, dstRead; ChannelBuffer *bufPtr; char *src, *dst; Tcl_EncodingState oldState; int encEndFlagSuppressed = 0; factor = *factorPtr; offset = *offsetPtr; bufPtr = statePtr->inQueueHead; src = bufPtr->buf + bufPtr->nextRemoved; src = bufPtr->buf + bufPtr->nextRemoved; srcLen = bufPtr->nextAdded - bufPtr->nextRemoved; toRead = charsToRead; if ((unsigned)toRead > (unsigned)srcLen) { toRead = srcLen; }
︙
4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690	4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	* enough space, convert it using all available space in object * rather than using the factor. */ dstNeeded = spaceLeft; } dst = objPtr->bytes + offset; /* * SF Tcl Bug 1462248 * The cause of the crash reported in the referenced bug is this: * * - ReadChars, called with a single buffer, with a incomplete * multi-byte character at the end (only the first byte of it). * - Encoding translation fails, asks for more data * - Data is read, and eof is reached, TCL_ENCODING_END (TEE) is set. * - ReadChar is called again, converts the first buffer, but due * to TEE it does not check for incomplete multi-byte data, and the * character just after the end of the first buffer is a valid * completion of the multi-byte header in the actual buffer. The * conversion reads more characters from the buffer then present. * This causes nextRemoved to overshoot nextAdded and the next * reads compute a negative srcLen, cause further translations to * fail, causing copying of data into the next buffer using bad * arguments, causing the mecpy for to eventually fail. * * In the end it is a memory access bug spiraling out of control * if the conditions are _just so_. And ultimate cause is that TEE * is given to a conversion where it should not. TEE signals that * this is the last buffer. Except in our case it is not. * * My solution is to suppress TEE if the first buffer is not the * last. We will eventually need it given that EOF has been * reached, but not right now. This is what the new flag * "endEncSuppressFlag" is for. * * The bug in 'Tcl_Utf2UtfProc' where it read from memory behind * the actual buffer has been fixed as well, and fixes the problem * with the crash too, but this would still allow the generic * layer to accidentially break a multi-byte sequence if the * conditions are just right, because again the ExternalToUtf * would be successful where it should not. */ if ((statePtr->inputEncodingFlags & TCL_ENCODING_END) && (bufPtr->nextPtr != NULL)) { /* TEE is set for a buffer which is not the last. Squash it * for now, and restore it later, before yielding control to * our caller. */ statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; encEndFlagSuppressed = 1; } oldState = statePtr->inputEncodingState; if (statePtr->flags & INPUT_NEED_NL) { /* * We want a '\n' because the last character we saw was '\r'. */
︙
4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722	4856 4857 4858 4859 4860 4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884	+ + + + + + + + +	* The next char was not a '\n'. Produce a '\r'. */ *dst = '\r'; } statePtr->inputEncodingFlags &= ~TCL_ENCODING_START; *offsetPtr += 1; if (encEndFlagSuppressed) { statePtr->inputEncodingFlags |= TCL_ENCODING_END; } return 1; } Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen, statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst, dstNeeded + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars); if (encEndFlagSuppressed) { statePtr->inputEncodingFlags |= TCL_ENCODING_END; } if (srcRead == 0) { /* * Not enough bytes in src buffer to make a complete char. Copy * the bytes to the next buffer to make a new contiguous string, * then tell the caller to fill the buffer with more bytes. */
︙
4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752	4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931	+ + + + + + + + + + + + + + + + +	* was complete. */ statePtr->flags |= CHANNEL_NEED_MORE_DATA; } return -1; } /* Space is made at the beginning of the buffer to copy the * previous unused bytes there. Check first if the buffer we * are using actually has enough space at its beginning for * the data we are copying. Because if not we will write over the * buffer management information, especially the 'nextPtr'. * * Note that the BUFFER_PADDING (See AllocChannelBuffer) is * used to prevent exactly this situation. I.e. it should * never happen. Therefore it is ok to panic should it happen * despite the precautions. */ if (nextPtr->nextRemoved - srcLen < 0) { Tcl_Panic ("Buffer Underflow, BUFFER_PADDING not enough"); } nextPtr->nextRemoved -= srcLen; memcpy((VOID *) (nextPtr->buf + nextPtr->nextRemoved), (VOID *) src, (size_t) srcLen); RecycleBuffer(statePtr, bufPtr, 0); statePtr->inQueueHead = nextPtr; return ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr); }
︙
5037 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 5050 5051 5052 5053	5216 5217 5218 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231	- + -	if (statePtr->flags & CHANNEL_STICKY_EOF) { goto done; } statePtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF)); bufPtr = AllocChannelBuffer(len); for (i = 0; i < len; i++) { bufPtr->buf[i] = str[i]; bufPtr->buf[bufPtr->nextAdded++] = str[i]; } bufPtr->nextAdded += len; if (statePtr->inQueueHead == (ChannelBuffer *) NULL) { bufPtr->nextPtr = (ChannelBuffer *) NULL; statePtr->inQueueHead = bufPtr; statePtr->inQueueTail = bufPtr; } else if (atEnd) { bufPtr->nextPtr = (ChannelBuffer *) NULL;
︙
5291 5292 5293 5294 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 5325 5326	5469 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 5483 5484 5485 5486 5487 5488 5489 5490 5491 5492 5493 5494 5495 5496 5497 5498 5499 5500 5501 5502 5503 5504 5505 5506 5507 5508 5509 5510 5511 5512 5513 5514 5515 5516 5517 5518 5519 5520 5521 5522 5523 5524 5525 5526 5527 5528	+ + + + + + + - - + + + + + + + - + + + + + + + + + + + + +	* platforms it is impossible to read from a device after EOF. */ if (statePtr->flags & CHANNEL_EOF) { return 0; } #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING /* [SF Tcl Bug 943274]. Better emulation of non-blocking channels * for channels without BlockModeProc, by keeping track of true * fileevents generated by the OS == Data waiting and reading if * and only if we are sure to have data. */ if ((statePtr->flags & CHANNEL_TIMER_FEV) && (statePtr->flags & CHANNEL_NONBLOCKING)) { if ((statePtr->flags & CHANNEL_NONBLOCKING) && (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) && !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) { /* Bypass the driver, it would block, as no data is available */ nread = -1; result = EWOULDBLOCK; } else { #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData, bufPtr->buf + bufPtr->nextAdded, toRead, &result); } #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING } #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ if (nread > 0) { bufPtr->nextAdded += nread; /* * If we get a short read, signal up that we may be BLOCKED. We * should avoid calling the driver because on some platforms we * will block in the low level reading code even though the * channel is set into nonblocking mode. */ if (nread < toRead) { statePtr->flags |= CHANNEL_BLOCKED; } #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING if (nread <= toRead) { /* [SF Tcl Bug 943274] We have read the available data, * clear flag */ statePtr->flags &= ~CHANNEL_HAS_MORE_DATA; } #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ } else if (nread == 0) { statePtr->flags |= CHANNEL_EOF; statePtr->inputEncodingFlags |= TCL_ENCODING_END; } else if (nread < 0) { if ((result == EWOULDBLOCK) || (result == EAGAIN)) { statePtr->flags |= CHANNEL_BLOCKED; result = EAGAIN;
︙
5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 5483 5484 5485 5486 5487 5488 5489 5490 5491 5492 5493 5494 5495	5675 5676 5677 5678 5679 5680 5681 5682 5683 5684 5685 5686 5687 5688 5689 5690 5691 5692 5693 5694 5695 5696 5697	- + + - - + + -	if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) && chanPtr->typePtr->wideSeekProc != NULL) { curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData, offset, mode, &result); } else if (offset < Tcl_LongAsWide(LONG_MIN) || offset > Tcl_LongAsWide(LONG_MAX)) { Tcl_SetErrno(EOVERFLOW); result = EOVERFLOW; curPos = Tcl_LongAsWide(-1); } else { curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) ( chanPtr->instanceData, Tcl_WideAsLong(offset), mode, &result)); } if (curPos == Tcl_LongAsWide(-1)) { Tcl_SetErrno(result); if (curPos == Tcl_LongAsWide(-1)) { Tcl_SetErrno(result); } } } /* * Restore to nonblocking mode if that was the previous behavior. * * NOTE: Even if there was an async flush active we do not restore
︙
5914 5915 5916 5917 5918 5919 5920 5921 5922 5923 5924 5925 5926 5927 5928 5929 5930 5931 5932 5933 5934 5935 5936 5937 5938 5939 5940 5941 5942 5943 5944 5945 5946 5947 5948 5949 5950 5951 5952	6116 6117 6118 6119 6120 6121 6122 6123 6124 6125 6126 6127 6128 6129 6130 6131 6132 6133 6134 6135 6136 6137 6138 6139 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154	- + - + - +	/* *---------------------------------------------------------------------- * * Tcl_SetChannelBufferSize -- * * Sets the size of buffers to allocate to store input or output * in the channel. The size must be between 10 bytes and 1 MByte. * in the channel. The size must be between 1 byte and 1 MByte. * * Results: * None. * * Side effects: * Sets the size of buffers subsequently allocated for this channel. * *---------------------------------------------------------------------- */ void Tcl_SetChannelBufferSize(chan, sz) Tcl_Channel chan; /* The channel whose buffer size * to set. */ int sz; /* The size to set. */ { ChannelState *statePtr; /* State of real channel structure. */ /* * If the buffer size is smaller than 10 bytes or larger than one MByte, * If the buffer size is smaller than 1 byte or larger than one MByte, * do not accept the requested size and leave the current buffer size. */ if (sz < 10) { if (sz < 1) { return; } if (sz > (1024 * 1024)) { return; } statePtr = ((Channel *) chan)->state;
︙
6389 6390 6391 6392 6393 6394 6395 6396 6397 6398 6399 6400 6401 6402 6403 6404 6405 6406	6591 6592 6593 6594 6595 6596 6597 6598 6599 6600 6601 6602 6603 6604 6605 6606 6607 6608 6609	- - - - + + + + +	(char *) NULL); return TCL_ERROR; } } return TCL_OK; } else if ((len > 7) && (optionName[1] == 'b') && (strncmp(optionName, "-buffersize", len) == 0)) { statePtr->bufSize = atoi(newValue); /* INTL: "C", UTF safe. */ if ((statePtr->bufSize < 10) || (statePtr->bufSize > (1024 * 1024))) { statePtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE; } int newBufferSize; if (Tcl_GetInt(interp, newValue, &newBufferSize) == TCL_ERROR) { return TCL_ERROR; } Tcl_SetChannelBufferSize(chan, newBufferSize); } else if ((len > 2) && (optionName[1] == 'e') && (strncmp(optionName, "-encoding", len) == 0)) { Tcl_Encoding encoding; if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) { encoding = NULL; } else {
︙
6456 6457 6458 6459 6460 6461 6462 6463 6464 6465 6466 6467 6468 6469	6659 6660 6661 6662 6663 6664 6665 6666 6667 6668 6669 6670 6671 6672 6673 6674 6675 6676 6677 6678 6679 6680 6681	+ + + + + + + + +	if (statePtr->flags & TCL_WRITABLE) { statePtr->outEofChar = (int) argv[1][0]; } } if (argv != NULL) { ckfree((char *) argv); } /* * [SF Tcl Bug 930851] Reset EOF and BLOCKED flags. Changing * the character which signals eof can transform a current eof * condition into a 'go ahead'. Ditto for blocked. */ statePtr->flags &= (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED)); return TCL_OK; } else if ((len > 1) && (optionName[1] == 't') && (strncmp(optionName, "-translation", len) == 0)) { CONST char *readMode, *writeMode; if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) { return TCL_ERROR;
︙
6696 6697 6698 6699 6700 6701 6702 6703 6704 6705 6706 6707 6708 6709	6908 6909 6910 6911 6912 6913 6914 6915 6916 6917 6918 6919 6920 6921 6922 6923 6924 6925 6926 6927 6928 6929 6930 6931 6932 6933 6934 6935 6936 6937	+ + + + + + + + + + + + + + + +	ChannelState *statePtr = chanPtr->state; /* state info for channel */ ChannelHandler *chPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); NextChannelHandler nh; Channel* upChanPtr; Tcl_ChannelType* upTypePtr; #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING /* [SF Tcl Bug 943274] * For a non-blocking channel without blockmodeproc we keep track * of actual input coming from the OS so that we can do a credible * imitation of non-blocking behaviour. */ if ((mask & TCL_READABLE) && (statePtr->flags & CHANNEL_NONBLOCKING) && (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) && !(statePtr->flags & CHANNEL_TIMER_FEV)) { statePtr->flags |= CHANNEL_HAS_MORE_DATA; } #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ /* * In contrast to the other API functions this procedure walks towards * the top of a stack and not down from it. * * The channel calling this procedure is the one who generated the event, * and thus does not take part in handling it. IOW, its HandlerProc is * not called, instead we begin with the channel above it.
︙
6846 6847 6848 6849 6850 6851 6852 6853 6854 6855 6856 6857 6858 6859	7074 7075 7076 7077 7078 7079 7080 7081 7082 7083 7084 7085 7086 7087 7088 7089 7090 7091 7092 7093 7094 7095 7096 7097 7098 7099 7100 7101 7102 7103 7104 7105 7106 7107 7108 7109 7110 7111 7112 7113 7114 7115 7116 7117 7118 7119 7120 7121 7122 7123 7124 7125 7126 7127 7128 7129 7130	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	if (mask & TCL_READABLE) { if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA) && (statePtr->inQueueHead != (ChannelBuffer *) NULL) && (statePtr->inQueueHead->nextRemoved < statePtr->inQueueHead->nextAdded)) { mask &= ~TCL_READABLE; /* * Andreas Kupries, April 11, 2003 * * Some operating systems (Solaris 2.6 and higher (but not * Solaris 2.5, go figure)) generate READABLE and * EXCEPTION events when select()'ing [*] on a plain file, * even if EOF was not yet reached. This is a problem in * the following situation: * * - An extension asks to get both READABLE and EXCEPTION * events. * - It reads data into a buffer smaller than the buffer * used by Tcl itself. * - It does not process all events in the event queue, but * only only one, at least in some situations. * * In that case we can get into a situation where * * - Tcl drops READABLE here, because it has data in its own * buffers waiting to be read by the extension. * - A READABLE event is syntesized via timer. * - The OS still reports the EXCEPTION condition on the file. * - And the extension gets the EXCPTION event first, and * handles this as EOF. * * End result ==> Premature end of reading from a file. * * The concrete example is 'Expect', and its [expect] * command (and at the C-level, deep in the bowels of * Expect, 'exp_get_next_event'. See marker 'SunOS' for * commentary in that function too). * * [*] As the Tcl notifier does. See also for marker * 'SunOS' in file 'exp_event.c' of Expect. * * Our solution here is to drop the interest in the * EXCEPTION events too. This compiles on all platforms, * and also passes the testsuite on all of them. */ mask &= ~TCL_EXCEPTION; if (!statePtr->timer) { statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc, (ClientData) chanPtr); } } } (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);
︙
6892 6893 6894 6895 6896 6897 6898 6899 6900 6901 6902 6903 6904 6905 6906 6907 6908 6909 6910 6911 6912 6913 6914 6915 6916 6917 6918 6919 6920	7163 7164 7165 7166 7167 7168 7169 7170 7171 7172 7173 7174 7175 7176 7177 7178 7179 7180 7181 7182 7183 7184 7185 7186 7187 7188 7189 7190 7191 7192 7193 7194 7195 7196 7197	+ + + + + +	* Restart the timer in case a channel handler reenters the * event loop before UpdateInterest gets called by Tcl_NotifyChannel. */ statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc, (ClientData) chanPtr); #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING /* Set the TIMER flag to notify the higher levels that the * driver might have no data for us. We do this only if we are * in non-blocking mode and the driver has no BlockModeProc * because only then we really don't know if the driver will * block or not. A similar test is done in "PeekAhead". */ if ((statePtr->flags & CHANNEL_NONBLOCKING) && (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) { statePtr->flags |= CHANNEL_TIMER_FEV; } #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ Tcl_Preserve((ClientData) statePtr); Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE); #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING statePtr->flags &= ~CHANNEL_TIMER_FEV; #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ Tcl_Release((ClientData) statePtr); } else { statePtr->timer = NULL; UpdateInterest(chanPtr); } }
︙
7401 7402 7403 7404 7405 7406 7407 7408 7409 7410 7411 7412 7413 7414 7415 7416 7417 7418 7419 7420 7421	7678 7679 7680 7681 7682 7683 7684 7685 7686 7687 7688 7689 7690 7691 7692 7693 7694 7695 7696 7697 7698 7699 7700 7701 7702	+ - - + + + + - - + + +	CopyState *csPtr; int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0; inStatePtr = inPtr->state; outStatePtr = outPtr->state; if (inStatePtr->csPtr) { if (interp) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"", Tcl_GetChannelName(inChan), "\" is busy", NULL); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"", Tcl_GetChannelName(inChan), "\" is busy", NULL); } return TCL_ERROR; } if (outStatePtr->csPtr) { if (interp) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"", Tcl_GetChannelName(outChan), "\" is busy", NULL); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"", Tcl_GetChannelName(outChan), "\" is busy", NULL); } return TCL_ERROR; } readFlags = inStatePtr->flags; writeFlags = outStatePtr->flags; /*
︙
7709 7710 7711 7712 7713 7714 7715 7716 7717 7718 7719 7720 7721 7722 7723	7990 7991 7992 7993 7994 7995 7996 7997 7998 7999 8000 8001 8002 8003 8004	- +	/* * Make the callback or return the number of bytes transferred. * The local total is used because StopCopy frees csPtr. */ total = csPtr->total; if (cmdPtr) { if (cmdPtr && interp) { /* * Get a private copy of the command so we can mutate it * by adding arguments. Note that StopCopy frees our saved * reference to the original command obj. */ cmdPtr = Tcl_DuplicateObj(cmdPtr);
︙
7733 7734 7735 7736 7737 7738 7739 7740 7741 7742 7743 7744 7745 7746 7747 7748 7749 7750 7751 7752	8014 8015 8016 8017 8018 8019 8020 8021 8022 8023 8024 8025 8026 8027 8028 8029 8030 8031 8032 8033 8034 8035	+ - - - - - - + + + + + + +	Tcl_BackgroundError(interp); result = TCL_ERROR; } Tcl_DecrRefCount(cmdPtr); Tcl_Release((ClientData) interp); } else { StopCopy(csPtr); if (interp) { if (errObj) { Tcl_SetObjResult(interp, errObj); result = TCL_ERROR; } else { Tcl_ResetResult(interp); Tcl_SetIntObj(Tcl_GetObjResult(interp), total); if (errObj) { Tcl_SetObjResult(interp, errObj); result = TCL_ERROR; } else { Tcl_ResetResult(interp); Tcl_SetIntObj(Tcl_GetObjResult(interp), total); } } } return result; }  /* *----------------------------------------------------------------------
︙
8757 8758 8759 8760 8761 8762 8763 8764 8765 8766 8767 8768 8769 8770	9040 9041 9042 9043 9044 9045 9046 9047 9048 9049 9050 9051 9052 9053 9054 9055	+ +	Tcl_ChannelVersion(chanTypePtr) Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ { if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) { return TCL_CHANNEL_VERSION_2; } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_3) { return TCL_CHANNEL_VERSION_3; } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_4) { return TCL_CHANNEL_VERSION_4; } else { /* * In <v2 channel versions, the version field is occupied * by the Tcl_DriverBlockModeProc */ return TCL_CHANNEL_VERSION_1; }
︙
9109 9110 9111 9112 9113 9114 9115	9394 9395 9396 9397 9398 9399 9400 9401 9402 9403 9404 9405 9406 9407 9408 9409 9410 9411 9412 9413 9414 9415 9416 9417 9418 9419 9420 9421 9422 9423 9424 9425 9426 9427 9428 9429 9430 9431 9432 9433 9434 9435 9436 9437 9438 9439 9440 9441 9442 9443 9444 9445 9446 9447 9448 9449 9450 9451 9452 9453 9454 9455 9456 9457 9458 9459 9460 9461 9462 9463 9464 9465 9466 9467	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	{ if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) { return chanTypePtr->wideSeekProc; } else { return NULL; } }  /* *---------------------------------------------------------------------- * * Tcl_ChannelThreadActionProc -- * * Return the Tcl_DriverThreadActionProc of the channel type. * * Results: * A pointer to the proc. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc(chanTypePtr) Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */ { if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) { return chanTypePtr->threadActionProc; } else { return NULL; } } #if 0 /* For future debugging work, a simple function to print the flags of * a channel in semi-readable form. */ static int DumpFlags (str, flags) char* str; int flags; { char buf [20]; int i = 0; if (flags & TCL_READABLE) {buf[i] = 'r';} else {buf [i]='_';}; i++; if (flags & TCL_WRITABLE) {buf[i] = 'w';} else {buf [i]='_';}; i++; if (flags & CHANNEL_NONBLOCKING) {buf[i] = 'n';} else {buf [i]='_';}; i++; if (flags & CHANNEL_LINEBUFFERED) {buf[i] = 'l';} else {buf [i]='_';}; i++; if (flags & CHANNEL_UNBUFFERED) {buf[i] = 'u';} else {buf [i]='_';}; i++; if (flags & BUFFER_READY) {buf[i] = 'R';} else {buf [i]='_';}; i++; if (flags & BG_FLUSH_SCHEDULED) {buf[i] = 'F';} else {buf [i]='_';}; i++; if (flags & CHANNEL_CLOSED) {buf[i] = 'c';} else {buf [i]='_';}; i++; if (flags & CHANNEL_EOF) {buf[i] = 'E';} else {buf [i]='_';}; i++; if (flags & CHANNEL_STICKY_EOF) {buf[i] = 'S';} else {buf [i]='_';}; i++; if (flags & CHANNEL_BLOCKED) {buf[i] = 'B';} else {buf [i]='_';}; i++; if (flags & INPUT_SAW_CR) {buf[i] = '/';} else {buf [i]='_';}; i++; if (flags & INPUT_NEED_NL) {buf[i] = '*';} else {buf [i]='_';}; i++; if (flags & CHANNEL_DEAD) {buf[i] = 'D';} else {buf [i]='_';}; i++; if (flags & CHANNEL_RAW_MODE) {buf[i] = 'R';} else {buf [i]='_';}; i++; #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING if (flags & CHANNEL_TIMER_FEV) {buf[i] = 'T';} else {buf [i]='_';}; i++; if (flags & CHANNEL_HAS_MORE_DATA) {buf[i] = 'H';} else {buf [i]='_';}; i++; #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ if (flags & CHANNEL_INCLOSE) {buf[i] = 'x';} else {buf [i]='_';}; i++; buf [i] ='\0'; fprintf (stderr,"%s: %s\n", str, buf); fflush(stderr); return 0; } #endif

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclIO.h -- * * This file provides the generic portions (those that are the same on * all platforms and for all channel types) of Tcl's IO facilities. * * Copyright (c) 1998-2000 Ajuba Solutions * Copyright (c) 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. * * RCS: @(#) $Id: tclIO.h,v 1.5 2002/01/15 17:55:30 dgp Exp $ * RCS: @(#) $Id: tclIO.h,v 1.5.4.2 2004/07/15 20:46:19 andreas_kupries Exp $ */ /* * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not * compile on systems where neither is defined. We want both defined so * that we can test safely for both. In the code we still have to test for * both because there may be systems on which both are defined and have
︙
292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316	292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341	+ + + + + + + + + + + + + + + + + + + + + + + + +	* get a complete line or when read * fails to get a complete character. * When set, file events will not be * delivered for buffered data until * the state of the channel changes. */ #define CHANNEL_RAW_MODE (1<<16) /* When set, notes that the Raw API is * being used. */ #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING #define CHANNEL_TIMER_FEV (1<<17) /* When set the event we are * notified by is a fileevent * generated by a timer. We * don't know if the driver * has more data and should * not try to read from it. If * the system needs more than * is in the buffers out read * routines will simulate a * short read (0 characters * read) */ #define CHANNEL_HAS_MORE_DATA (1<<18) /* Set by NotifyChannel for a * channel if and only if the * channel is configured * non-blocking, the driver * for said channel has no * blockmodeproc, and data has * arrived for reading at the * OS level). A GetInput will * pass reading from the * driver if the channel is * non-blocking, without * blockmode proc and the flag * has not been set. A read * will be performed if the * flag is set. This will * reset the flag as well. */ #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ #define CHANNEL_INCLOSE (1<<19) /* Channel is currently being * closed. Its structures are * still live and usable, but * it may not be closed again * from within the close handler. */ /* * For each channel handler registered in a call to Tcl_CreateChannelHandler, * there is one record of the following type. All of records for a specific * channel are chained together in a singly linked list which is stored in * the channel structure. */
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	- +	/* * tclIOCmd.c -- * * Contains the definitions of most of the Tcl commands relating to IO. * * Copyright (c) 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. * * RCS: @(#) $Id: tclIOCmd.c,v 1.15 2002/02/15 14:28:49 dkf Exp $ * RCS: @(#) $Id: tclIOCmd.c,v 1.15.2.2 2004/07/16 22:38:37 andreas_kupries Exp $ */ #include "tclInt.h" #include "tclPort.h" /* * Callback structure for accept callback in a TCP server.
︙
98 99 100 101 102 103 104 105 106 107 108 109 110 111 112	98 99 100 101 102 103 104 105 106 107 108 109 110 111 112	- +	* or documented. */ char *arg; int length; arg = Tcl_GetStringFromObj(objv[3], &length); if (strncmp(arg, "nonewline", (size_t) length) != 0) { if ((length != 9) || (strncmp(arg, "nonewline", (size_t) length) != 0)) { Tcl_AppendResult(interp, "bad argument \"", arg, "\": should be \"nonewline\"", (char *) NULL); return TCL_ERROR; } channelId = Tcl_GetString(objv[1]); string = objv[2];
︙
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	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	- + - +	arg = Tcl_GetString(objv[1]); inChan = Tcl_GetChannel(interp, arg, &mode); if (inChan == (Tcl_Channel) NULL) { return TCL_ERROR; } if ((mode & TCL_READABLE) == 0) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"", Tcl_GetString(objv[1]), arg, "\" wasn't opened for reading", (char *) NULL); return TCL_ERROR; } arg = Tcl_GetString(objv[2]); outChan = Tcl_GetChannel(interp, arg, &mode); if (outChan == (Tcl_Channel) NULL) { return TCL_ERROR; } if ((mode & TCL_WRITABLE) == 0) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"", Tcl_GetString(objv[1]), arg, "\" wasn't opened for writing", (char *) NULL); return TCL_ERROR; } toRead = -1; cmdPtr = NULL; for (i = 3; i < objc; i += 2) {
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclIOGT.c -- * * Implements a generic transformation exposing the underlying API * at the script level. Contributed by Andreas Kupries. * * Copyright (c) 2000 Ajuba Solutions * Copyright (c) 1999-2000 Andreas Kupries (a.kupries@westend.com) * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * CVS: $Id: tclIOGT.c,v 1.7 2002/05/24 21:19:06 dkf Exp $ * CVS: $Id: tclIOGT.c,v 1.7.2.2 2006/08/30 17:24:07 hobbs Exp $ */ #include "tclInt.h" #include "tclPort.h" #include "tclIO.h"
︙
127 128 129 130 131 132 133 134 135 136 137 138 139 140 141	127 128 129 130 131 132 133 134 135 136 137 138 139 140 141	- +	/* * This structure describes the channel type structure for tcl based * transformations. */ static Tcl_ChannelType transformChannelType = { "transform", /* Type name. */ TCL_CHANNEL_VERSION_2, TCL_CHANNEL_VERSION_3, TransformCloseProc, /* Close proc. */ TransformInputProc, /* Input proc. */ TransformOutputProc, /* Output proc. */ TransformSeekProc, /* Seek proc. */ TransformSetOptionProc, /* Set option proc. */ TransformGetOptionProc, /* Get option proc. */ TransformWatchProc, /* Initialize notifier. */
︙
436 437 438 439 440 441 442 443 444 445 446 447 448 449 450	436 437 438 439 440 441 442 443 444 445 446 447 448 449 450	- +	* Step 2, execute the command at the global level of the interpreter * used to create the transformation. Destroy the command afterward. * If an error occured and the current interpreter is defined and not * equal to the interpreter for the callback, then copy the error * message into current interpreter. Don't copy if in preservation mode. */ res = Tcl_GlobalEvalObj (dataPtr->interp, command); res = Tcl_EvalObjEx(dataPtr->interp, command, TCL_EVAL_GLOBAL); Tcl_DecrRefCount (command); command = (Tcl_Obj*) NULL; if ((res != TCL_OK) && (interp != NO_INTERP) && (dataPtr->interp != interp) && !preserve) { Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp)); return res;
︙

︙
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	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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119	- + - - + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + - + + + + - - + - + - - - - - - + + + + + + + + + +	* * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-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. * * RCS: @(#) $Id: tclIOUtil.c,v 1.77 2003/03/03 20:22:41 das Exp $ * RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.34 2007/02/19 23:49:05 hobbs Exp $ */ #include "tclInt.h" #include "tclPort.h" #ifdef MAC_TCL #include "tclMacInt.h" #endif #ifdef __WIN32__ /* for tclWinProcs->useWide */ #include "tclWinInt.h" #endif /* * Prototypes for procedures defined later in this file. /* * struct FilesystemRecord -- * * A filesystem record is used to keep track of each * filesystem currently registered with the core, * in a linked list. Pointers to these structures * are also kept by each "path" Tcl_Obj, and we must * retain a refCount on the number of such references. */ typedef struct FilesystemRecord { ClientData clientData; /* Client specific data for the new * filesystem (can be NULL) */ Tcl_Filesystem *fsPtr; /* Pointer to filesystem dispatch * table. */ int fileRefCount; /* How many Tcl_Obj's use this * filesystem. */ struct FilesystemRecord *nextPtr; /* The next filesystem registered * to Tcl, or NULL if no more. */ struct FilesystemRecord *prevPtr; /* The previous filesystem registered * to Tcl, or NULL if no more. */ } FilesystemRecord; /* static void DupFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)); static void FreeFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr)); static void UpdateStringOfFsPath _ANSI_ARGS_((Tcl_Obj *objPtr)); static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static Tcl_Obj* MakeFsPathFromRelative _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *cwdPtr)); static Tcl_Obj* FSNormalizeAbsolutePath _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr)); static int TclNormalizeToUniquePath _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, int startAt)); static int SetFsPathFromAbsoluteNormalized _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); * The internal TclFS API provides routines for handling and * manipulating paths efficiently, taking direct advantage of * the "path" Tcl_Obj type. * * These functions are not exported at all at present. */ int TclFSCwdPointerEquals _ANSI_ARGS_((Tcl_Obj* objPtr)); int TclFSMakePathFromNormalized _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData clientData)); int TclFSNormalizeToUniquePath _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, int startAt, ClientData *clientDataPtr)); Tcl_Obj* TclFSMakePathRelative _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *cwdPtr)); Tcl_Obj* TclFSInternalToNormalized _ANSI_ARGS_(( Tcl_Filesystem *fromFilesystem, ClientData clientData, FilesystemRecord **fsRecPtrPtr)); int TclFSEnsureEpochOk _ANSI_ARGS_((Tcl_Obj* pathObjPtr, Tcl_Filesystem **fsPtrPtr)); void TclFSSetPathDetails _ANSI_ARGS_((Tcl_Obj *pathObjPtr, FilesystemRecord *fsRecPtr, ClientData clientData)); /* * Private variables for use in this file */ extern Tcl_Filesystem tclNativeFilesystem; extern int theFilesystemEpoch; static int FindSplitPos _ANSI_ARGS_((char *path, char *separator)); /* * Private functions for use in this file */ static Tcl_PathType FSGetPathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr, Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr)); static Tcl_PathType GetPathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr, Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr, Tcl_Obj **driveNameRef)); static Tcl_FSPathInFilesystemProc NativePathInFilesystem; static Tcl_Obj* TclFSNormalizeAbsolutePath _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr, ClientData *clientDataPtr)); /* * Define the 'path' object type, which Tcl uses to represent * file paths internally. * Prototypes for procedures defined later in this file. */ Tcl_ObjType tclFsPathType = { "path", /* name */ FreeFsPathInternalRep, /* freeIntRepProc */ DupFsPathInternalRep, /* dupIntRepProc */ UpdateStringOfFsPath, /* updateStringProc */ SetFsPathFromAny /* setFromAnyProc */ }; static FilesystemRecord* FsGetFirstFilesystem(void); static void FsThrExitProc(ClientData cd); static Tcl_Obj* FsListMounts _ANSI_ARGS_((Tcl_Obj *pathPtr, CONST char *pattern)); static Tcl_Obj* FsAddMountsToGlobResult _ANSI_ARGS_((Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types)); #ifdef TCL_THREADS static void FsRecacheFilesystemList(void); #endif /* * These form part of the native filesystem support. They are needed * here because we have a few native filesystem functions (which are * the same for mac/win/unix) in this file. There is no need to place * them in tclInt.h, because they are not (and should not be) used * anywhere else.
︙
98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113	140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166	+ + + + + + + + + + +	ret = Tcl_FSStat(pathPtr, &buf); Tcl_DecrRefCount(pathPtr); if (ret != -1) { #ifndef TCL_WIDE_INT_IS_LONG # define OUT_OF_RANGE(x) \ (((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \ ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX)) #if defined(__GNUC__) && __GNUC__ >= 2 /* * Workaround gcc warning of "comparison is always false due to limited range of * data type" in this macro by checking max type size, and when necessary ANDing * with the complement of ULONG_MAX instead of the comparison: */ # define OUT_OF_URANGE(x) \ ((((Tcl_WideUInt)(~ (__typeof__(x)) 0)) > (Tcl_WideUInt)ULONG_MAX) && \ (((Tcl_WideUInt)(x)) & ~(Tcl_WideUInt)ULONG_MAX)) #else # define OUT_OF_URANGE(x) \ (((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX) #endif /* * Perform the result-buffer overflow check manually. * * Note that ino_t/ino64_t is unsigned... */
︙
301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351	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	- - - - - - - - - - - - - - - - - - - - - -	static AccessProc *accessProcList = NULL; static OpenFileChannelProc *openFileChannelProcList = NULL; TCL_DECLARE_MUTEX(obsoleteFsHookMutex) #endif /* USE_OBSOLETE_FS_HOOKS */ /* * A filesystem record is used to keep track of each * filesystem currently registered with the core, * in a linked list. */ typedef struct FilesystemRecord { ClientData clientData; /* Client specific data for the new * filesystem (can be NULL) */ Tcl_Filesystem *fsPtr; /* Pointer to filesystem dispatch * table. */ int fileRefCount; /* How many Tcl_Obj's use this * filesystem. */ struct FilesystemRecord *nextPtr; /* The next filesystem registered * to Tcl, or NULL if no more. */ } FilesystemRecord; static FilesystemRecord* GetFilesystemRecord _ANSI_ARGS_((Tcl_Filesystem *fromFilesystem, int *epoch)); /* * Declare the native filesystem support. These functions should * be considered private to Tcl, and should really not be called * directly by any code other than this file (i.e. neither by * Tcl's core nor by extensions). Similarly, the old string-based * Tclp... native filesystem functions should not be called. * * The correct API to use now is the Tcl_FS... set of functions, * which ensure correct and complete virtual filesystem support. * * We cannot make all of these static, since some of them * are implemented in the platform-specific directories. */ static Tcl_FSPathInFilesystemProc NativePathInFilesystem; static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator; static Tcl_FSFreeInternalRepProc NativeFreeInternalRep; static Tcl_FSDupInternalRepProc NativeDupInternalRep; static Tcl_FSCreateInternalRepProc NativeCreateNativeRep; static Tcl_FSFileAttrStringsProc NativeFileAttrStrings; static Tcl_FSFileAttrsGetProc NativeFileAttrsGet; static Tcl_FSFileAttrsSetProc NativeFileAttrsSet; /* * The only reason these functions are not static is that they
︙
379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398	410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429	- + - +	* Define the native filesystem dispatch table. If necessary, it * is ok to make this non-static, but it should only be accessed * by the functions actually listed within it (or perhaps other * helper functions of them). Anything which is not part of this * 'native filesystem implementation' should not be delving inside * here! */ static Tcl_Filesystem tclNativeFilesystem = { Tcl_Filesystem tclNativeFilesystem = { "native", sizeof(Tcl_Filesystem), TCL_FILESYSTEM_VERSION_1, &NativePathInFilesystem, &NativeDupInternalRep, &TclNativeDupInternalRep, &NativeFreeInternalRep, &TclpNativeToNormalized, &NativeCreateNativeRep, &TclpObjNormalizePath, &TclpFilesystemPathType, &NativeFilesystemSeparator, &TclpObjStat,
︙
433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530	464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520	- - - - - + + - + - + + + - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + - - - + - - - - - - + - - - - + - - - - - - - - - - - + - - - - + + - - - + - - - - - - - + -	static FilesystemRecord nativeFilesystemRecord = { NULL, &tclNativeFilesystem, 1, NULL }; /* * The following few variables are protected by the * filesystemMutex just below. */ /* * This is incremented each time we modify the linked list of * filesystems. Any time it changes, all cached filesystem * representations are suspect and must be freed. * For multithreading builds, change of the filesystem epoch * will trigger cache cleanup in all threads. */ static int theFilesystemEpoch = 0; int theFilesystemEpoch = 0; /* * Stores the linked list of filesystems. * Stores the linked list of filesystems. A 1:1 copy of this * list is also maintained in the TSD for each thread. This * is to avoid synchronization issues. */ static FilesystemRecord *filesystemList = &nativeFilesystemRecord; /* * The number of loops which are currently iterating over the linked * list. If this is greater than zero, we can't modify the list. */ static int filesystemIteratorsInProgress = 0; /* * Someone wants to modify the list of filesystems if this is set. */ static int filesystemWantToModify = 0; #ifdef TCL_THREADS static Tcl_Condition filesystemOkToModify = NULL; #endif TCL_DECLARE_MUTEX(filesystemMutex) /* * struct FsPath -- * * Internal representation of a Tcl_Obj of "path" type. This * can be used to represent relative or absolute paths, and has * certain optimisations when used to represent paths which are * already normalized and absolute. * Used to implement Tcl_FSGetCwd in a file-system independent way. */ static Tcl_Obj* cwdPathPtr = NULL; static int cwdPathEpoch = 0; TCL_DECLARE_MUTEX(cwdMutex) /* * This structure holds per-thread private copies of * some global data. This way we avoid most of the * synchronization calls which boosts performance, at * cost of having to update this information each * time the corresponding epoch counter changes. * * Note that 'normPathPtr' can be a circular reference to the * container Tcl_Obj of this FsPath. */ typedef struct FsPath { typedef struct ThreadSpecificData { Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. * If this is NULL, then this is a * pure normalized, absolute path * object, in which the parent Tcl_Obj's * string rep is already both translated * and normalized. */ int initialized; Tcl_Obj *normPathPtr; /* Normalized absolute path, without * ., .. or ~user sequences. If the * Tcl_Obj containing * this FsPath is already normalized, int cwdPathEpoch; * this may be a circular reference back * to the container. If that is NOT the * case, we have a refCount on the object. */ Tcl_Obj *cwdPtr; /* If null, path is absolute, else * this points to the cwd object used * for this path. We have a refCount * on the object. */ int flags; /* Flags to describe interpretation */ ClientData nativePathPtr; /* Native representation of this path, * which is filesystem dependent. */ int filesystemEpoch; /* Used to ensure the path representation int filesystemEpoch; * was generated during the correct * filesystem epoch. The epoch changes * when filesystem-mounts are changed. */ struct FilesystemRecord *fsRecPtr; Tcl_Obj *cwdPathPtr; FilesystemRecord *filesystemList; /* Pointer to the filesystem record * entry to use for this path. */ } FsPath; } ThreadSpecificData; #define TCLPATH_APPENDED 1 #define TCLPATH_RELATIVE 2 /* * Used to implement Tcl_FSGetCwd in a file-system independent way. * This is protected by the cwdMutex below. */ static Tcl_Obj* cwdPathPtr = NULL; static Tcl_ThreadDataKey dataKey; TCL_DECLARE_MUTEX(cwdMutex) /* * Declare fallback support function and * information for Tcl_FSLoadFile */ static Tcl_FSUnloadFileProc FSUnloadTempFile; /*
︙
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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590	531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710	+ + + - - - + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + +	Tcl_Obj *divertedFile; Tcl_Filesystem *divertedFilesystem; ClientData divertedFileNativeRep; } FsDivertLoad; /* Now move on to the basic filesystem implementation */ static void FsThrExitProc(cd) ClientData cd;  static int FsCwdPointerEquals(objPtr) { ThreadSpecificData *tsdPtr = (ThreadSpecificData*)cd; FilesystemRecord *fsRecPtr = NULL, *tmpFsRecPtr = NULL; /* Trash the cwd copy */ if (tsdPtr->cwdPathPtr != NULL) { Tcl_DecrRefCount(tsdPtr->cwdPathPtr); tsdPtr->cwdPathPtr = NULL; } /* Trash the filesystems cache */ fsRecPtr = tsdPtr->filesystemList; while (fsRecPtr != NULL) { tmpFsRecPtr = fsRecPtr->nextPtr; if (--fsRecPtr->fileRefCount <= 0) { ckfree((char *)fsRecPtr); } fsRecPtr = tmpFsRecPtr; } tsdPtr->initialized = 0; }  int TclFSCwdPointerEquals(objPtr) Tcl_Obj* objPtr; { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_MutexLock(&cwdMutex); if (tsdPtr->cwdPathPtr == NULL) { if (cwdPathPtr == objPtr) { Tcl_MutexUnlock(&cwdMutex); return 1; } else { Tcl_MutexUnlock(&cwdMutex); return 0; if (cwdPathPtr == NULL) { tsdPtr->cwdPathPtr = NULL; } else { tsdPtr->cwdPathPtr = Tcl_DuplicateObj(cwdPathPtr); Tcl_IncrRefCount(tsdPtr->cwdPathPtr); } tsdPtr->cwdPathEpoch = cwdPathEpoch; } else if (tsdPtr->cwdPathEpoch != cwdPathEpoch) { Tcl_DecrRefCount(tsdPtr->cwdPathPtr); if (cwdPathPtr == NULL) { tsdPtr->cwdPathPtr = NULL; } else { tsdPtr->cwdPathPtr = Tcl_DuplicateObj(cwdPathPtr); Tcl_IncrRefCount(tsdPtr->cwdPathPtr); } } Tcl_MutexUnlock(&cwdMutex); if (tsdPtr->initialized == 0) { Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData)tsdPtr); tsdPtr->initialized = 1; } return (tsdPtr->cwdPathPtr == objPtr); } #ifdef TCL_THREADS  static FilesystemRecord* FsGetIterator(void) { Tcl_MutexLock(&filesystemMutex); filesystemIteratorsInProgress++; Tcl_MutexUnlock(&filesystemMutex); /* Now we know the list of filesystems cannot be modified */ return filesystemList; }  static void FsReleaseIterator(void) {  static void FsRecacheFilesystemList(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL; /* Trash the current cache */ fsRecPtr = tsdPtr->filesystemList; while (fsRecPtr != NULL) { tmpFsRecPtr = fsRecPtr->nextPtr; if (--fsRecPtr->fileRefCount <= 0) { ckfree((char *)fsRecPtr); } fsRecPtr = tmpFsRecPtr; } tsdPtr->filesystemList = NULL; /* * Code below operates on shared data. We * are already called under mutex lock so * we can safely proceed. */ /* Locate tail of the global filesystem list */ fsRecPtr = filesystemList; while (fsRecPtr != NULL) { tmpFsRecPtr = fsRecPtr; fsRecPtr = fsRecPtr->nextPtr; } /* Refill the cache honouring the order */ fsRecPtr = tmpFsRecPtr; while (fsRecPtr != NULL) { tmpFsRecPtr = (FilesystemRecord *)ckalloc(sizeof(FilesystemRecord)); *tmpFsRecPtr = *fsRecPtr; tmpFsRecPtr->nextPtr = tsdPtr->filesystemList; tmpFsRecPtr->prevPtr = NULL; if (tsdPtr->filesystemList) { tsdPtr->filesystemList->prevPtr = tmpFsRecPtr; } tsdPtr->filesystemList = tmpFsRecPtr; fsRecPtr = fsRecPtr->prevPtr; } /* Make sure the above gets released on thread exit */ if (tsdPtr->initialized == 0) { Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData)tsdPtr); tsdPtr->initialized = 1; } } #endif  static FilesystemRecord * FsGetFirstFilesystem(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FilesystemRecord *fsRecPtr; #ifndef TCL_THREADS tsdPtr->filesystemEpoch = theFilesystemEpoch; fsRecPtr = filesystemList; #else Tcl_MutexLock(&filesystemMutex); if (tsdPtr->filesystemList == NULL || (tsdPtr->filesystemEpoch != theFilesystemEpoch)) { filesystemIteratorsInProgress--; if (filesystemIteratorsInProgress == 0) { /* Notify any waiting threads that things are ok now */ if (filesystemWantToModify > 0) { Tcl_ConditionNotify(&filesystemOkToModify); } FsRecacheFilesystemList(); tsdPtr->filesystemEpoch = theFilesystemEpoch; } Tcl_MutexUnlock(&filesystemMutex); fsRecPtr = tsdPtr->filesystemList; #endif return fsRecPtr; }  static void FsUpdateCwd(cwdObj) Tcl_Obj *cwdObj; { int len; char *str = NULL; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (cwdObj != NULL) { str = Tcl_GetStringFromObj(cwdObj, &len); } Tcl_MutexLock(&cwdMutex); if (cwdPathPtr != NULL) { Tcl_DecrRefCount(cwdPathPtr); } if (cwdObj == NULL) { cwdPathPtr = NULL; } else { /* This MUST be stored as string object! */ cwdPathPtr = Tcl_NewStringObj(str, len); Tcl_IncrRefCount(cwdPathPtr); } cwdPathEpoch++; tsdPtr->cwdPathEpoch = cwdPathEpoch; Tcl_MutexUnlock(&filesystemMutex); Tcl_MutexUnlock(&cwdMutex); if (tsdPtr->cwdPathPtr) { Tcl_DecrRefCount(tsdPtr->cwdPathPtr); } if (cwdObj == NULL) { tsdPtr->cwdPathPtr = NULL; } else { tsdPtr->cwdPathPtr = Tcl_NewStringObj(str, len); Tcl_IncrRefCount(tsdPtr->cwdPathPtr); } }  /* *---------------------------------------------------------------------- * * TclFinalizeFilesystem -- *
︙
602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650	722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771	+ + + + - - - + + + + - - - - - - - - - + + + + - - + + +	* *---------------------------------------------------------------------- */ void TclFinalizeFilesystem() { FilesystemRecord *fsRecPtr; /* * Assumption that only one thread is active now. Otherwise * we would need to put various mutexes around this code. */ if (cwdPathPtr != NULL) { Tcl_DecrRefCount(cwdPathPtr); cwdPathPtr = NULL; cwdPathEpoch = 0; } /* * Remove all filesystems, freeing any allocated memory * that is no longer needed */ while (filesystemList != NULL) { FilesystemRecord *tmpFsRecPtr = filesystemList->nextPtr; if (filesystemList->fileRefCount > 0) { fsRecPtr = filesystemList; while (fsRecPtr != NULL) { FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr; if (fsRecPtr->fileRefCount <= 0) { /* * This filesystem must have some path objects still * around which will be freed later (e.g. when unloading * any shared libraries). If not, then someone is * causing us to leak memory. */ } else { /* The native filesystem is static, so we don't free it */ if (filesystemList != &nativeFilesystemRecord) { ckfree((char *)filesystemList); if (fsRecPtr->fsPtr != &tclNativeFilesystem) { ckfree((char *)fsRecPtr); } } fsRecPtr = tmpFsRecPtr; } filesystemList = tmpFsRecPtr; } filesystemList = NULL; /* * Now filesystemList is NULL. This means that any attempt * to use the filesystem is likely to fail. */ statProcList = NULL; accessProcList = NULL; openFileChannelProcList = NULL; #ifdef __WIN32__ TclWinEncodingsCleanup(); #endif }
︙
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	786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806	+ - - - - -	*---------------------------------------------------------------------- */ void TclResetFilesystem() { filesystemList = &nativeFilesystemRecord; /* * Note, at this point, I believe nativeFilesystemRecord -> * fileRefCount should equal 1 and if not, we should try to track * down the cause. */ filesystemIteratorsInProgress = 0; filesystemWantToModify = 0; #ifdef TCL_THREADS filesystemOkToModify = NULL; #endif #ifdef __WIN32__ /* * Cleans up the win32 API filesystem proc lookup table. This must * happen very late in finalization so that deleting of copied * dlls can occur. */ TclWinResetInterfaces();
︙
752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773	869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890	- - - - + + + + + - - +	* cached representations calculated by existing iterators are * going to have to be thrown away anyway. * * However, since registering and unregistering filesystems is * a very rare action, this is not a very important point. */ Tcl_MutexLock(&filesystemMutex); if (filesystemIteratorsInProgress) { filesystemWantToModify++; Tcl_ConditionWait(&filesystemOkToModify, &filesystemMutex, NULL); filesystemWantToModify--; newFilesystemPtr->nextPtr = filesystemList; newFilesystemPtr->prevPtr = NULL; if (filesystemList) { filesystemList->prevPtr = newFilesystemPtr; } newFilesystemPtr->nextPtr = filesystemList; filesystemList = newFilesystemPtr; /* * Increment the filesystem epoch counter, since existing paths * might conceivably now belong to different filesystems. */ theFilesystemEpoch++; Tcl_MutexUnlock(&filesystemMutex);
︙
800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861	917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194	- + - - - - - - + - + - - - - + + + + + + - + + - - - + + + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	*/ int Tcl_FSUnregister(fsPtr) Tcl_Filesystem *fsPtr; /* The filesystem record to remove. */ { int retVal = TCL_ERROR; FilesystemRecord *tmpFsRecPtr; FilesystemRecord *fsRecPtr; FilesystemRecord *prevFsRecPtr = NULL; Tcl_MutexLock(&filesystemMutex); if (filesystemIteratorsInProgress) { filesystemWantToModify++; Tcl_ConditionWait(&filesystemOkToModify, &filesystemMutex, NULL); filesystemWantToModify--; } tmpFsRecPtr = filesystemList; /* * Traverse the 'filesystemList' looking for the particular node * whose 'fsPtr' member matches 'fsPtr' and remove that one from * the list. Ensure that the "default" node cannot be removed. */ fsRecPtr = filesystemList; while ((retVal == TCL_ERROR) && (tmpFsRecPtr != &nativeFilesystemRecord)) { if (tmpFsRecPtr->fsPtr == fsPtr) { if (prevFsRecPtr == NULL) { filesystemList = filesystemList->nextPtr; while ((retVal == TCL_ERROR) && (fsRecPtr->fsPtr != &tclNativeFilesystem)) { if (fsRecPtr->fsPtr == fsPtr) { if (fsRecPtr->prevPtr) { fsRecPtr->prevPtr->nextPtr = fsRecPtr->nextPtr; } else { filesystemList = fsRecPtr->nextPtr; } prevFsRecPtr->nextPtr = tmpFsRecPtr->nextPtr; if (fsRecPtr->nextPtr) { fsRecPtr->nextPtr->prevPtr = fsRecPtr->prevPtr; } /* * Increment the filesystem epoch counter, since existing * paths might conceivably now belong to different * filesystems. This should also ensure that paths which * have cached the filesystem which is about to be deleted * do not reference that filesystem (which would of course * lead to memory exceptions). */ theFilesystemEpoch++; tmpFsRecPtr->fileRefCount--; if (tmpFsRecPtr->fileRefCount <= 0) { ckfree((char *)tmpFsRecPtr); fsRecPtr->fileRefCount--; if (fsRecPtr->fileRefCount <= 0) { ckfree((char *)fsRecPtr); } retVal = TCL_OK; } else { prevFsRecPtr = tmpFsRecPtr; fsRecPtr = fsRecPtr->nextPtr; tmpFsRecPtr = tmpFsRecPtr->nextPtr; } } Tcl_MutexUnlock(&filesystemMutex); return (retVal); }  /* *---------------------------------------------------------------------- * * Tcl_FSMatchInDirectory -- * * This routine is used by the globbing code to search a directory * for all files which match a given pattern. The appropriate * function for the filesystem to which pathPtr belongs will be * called. If pathPtr does not belong to any filesystem and if it * is NULL or the empty string, then we assume the pattern is to be * matched in the current working directory. To avoid each * filesystem's Tcl_FSMatchInDirectoryProc having to deal with this * issue, we create a pathPtr on the fly (equal to the cwd), and * then remove it from the results returned. This makes filesystems * easy to write, since they can assume the pathPtr passed to them * is an ordinary path. In fact this means we could remove such * special case handling from Tcl's native filesystems. * * If 'pattern' is NULL, then pathPtr is assumed to be a fully * specified path of a single file/directory which must be * checked for existence and correct type. * * Results: * * The return value is a standard Tcl result indicating whether an * error occurred in globbing. Error messages are placed in * interp, but good results are placed in the resultPtr given. * * Recursive searches, e.g. * * glob -dir $dir -join * pkgIndex.tcl * * which must recurse through each directory matching '*' are * handled internally by Tcl, by passing specific flags in a * modified 'types' parameter. This means the actual filesystem * only ever sees patterns which match in a single directory. * * Side effects: * The interpreter may have an error message inserted into it. * *---------------------------------------------------------------------- */ int Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types) Tcl_Interp *interp; /* Interpreter to receive error messages. */ Tcl_Obj *result; /* List object to receive results. */ Tcl_Obj *pathPtr; /* Contains path to directory to search. */ CONST char *pattern; /* Pattern to match against. */ Tcl_GlobTypeData *types; /* Object containing list of acceptable types. * May be NULL. In particular the directory * flag is very important. */ { Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL) { Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc; if (proc != NULL) { int ret = (*proc)(interp, result, pathPtr, pattern, types); if (ret == TCL_OK && pattern != NULL) { result = FsAddMountsToGlobResult(result, pathPtr, pattern, types); } return ret; } } else { Tcl_Obj* cwd; int ret = -1; if (pathPtr != NULL) { int len; Tcl_GetStringFromObj(pathPtr,&len); if (len != 0) { /* * We have no idea how to match files in a directory * which belongs to no known filesystem */ Tcl_SetErrno(ENOENT); return -1; } } /* * We have an empty or NULL path. This is defined to mean we * must search for files within the current 'cwd'. We * therefore use that, but then since the proc we call will * return results which include the cwd we must then trim it * off the front of each path in the result. We choose to deal * with this here (in the generic code), since if we don't, * every single filesystem's implementation of * Tcl_FSMatchInDirectory will have to deal with it for us. */ cwd = Tcl_FSGetCwd(NULL); if (cwd == NULL) { if (interp != NULL) { Tcl_SetResult(interp, "glob couldn't determine " "the current working directory", TCL_STATIC); } return TCL_ERROR; } fsPtr = Tcl_FSGetFileSystemForPath(cwd); if (fsPtr != NULL) { Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc; if (proc != NULL) { Tcl_Obj* tmpResultPtr = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(tmpResultPtr); ret = (*proc)(interp, tmpResultPtr, cwd, pattern, types); if (ret == TCL_OK) { int resLength; tmpResultPtr = FsAddMountsToGlobResult(tmpResultPtr, cwd, pattern, types); ret = Tcl_ListObjLength(interp, tmpResultPtr, &resLength); if (ret == TCL_OK) { int i; for (i = 0; i < resLength; i++) { Tcl_Obj *elt; Tcl_ListObjIndex(interp, tmpResultPtr, i, &elt); Tcl_ListObjAppendElement(interp, result, TclFSMakePathRelative(interp, elt, cwd)); } } } Tcl_DecrRefCount(tmpResultPtr); } } Tcl_DecrRefCount(cwd); return ret; } Tcl_SetErrno(ENOENT); return -1; }  /* *---------------------------------------------------------------------- * * FsAddMountsToGlobResult -- * * This routine is used by the globbing code to take the results * of a directory listing and add any mounted paths to that * listing. This is required so that simple things like * 'glob *' merge mounts and listings correctly. * * Results: * * The passed in 'result' may be modified (in place, if * necessary), and the correct list is returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ static Tcl_Obj* FsAddMountsToGlobResult(result, pathPtr, pattern, types) Tcl_Obj *result; /* The current list of matching paths */ Tcl_Obj *pathPtr; /* The directory in question */ CONST char *pattern; Tcl_GlobTypeData *types; { int mLength, gLength, i; int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR)); Tcl_Obj *mounts = FsListMounts(pathPtr, pattern); if (mounts == NULL) return result; if (Tcl_ListObjLength(NULL, mounts, &mLength) != TCL_OK || mLength == 0) { goto endOfMounts; } if (Tcl_ListObjLength(NULL, result, &gLength) != TCL_OK) { goto endOfMounts; } for (i = 0; i < mLength; i++) { Tcl_Obj *mElt; int j; int found = 0; Tcl_ListObjIndex(NULL, mounts, i, &mElt); for (j = 0; j < gLength; j++) { Tcl_Obj *gElt; Tcl_ListObjIndex(NULL, result, j, &gElt); if (Tcl_FSEqualPaths(mElt, gElt)) { found = 1; if (!dir) { /* We don't want to list this */ if (Tcl_IsShared(result)) { Tcl_Obj *newList; newList = Tcl_DuplicateObj(result); Tcl_DecrRefCount(result); result = newList; } Tcl_ListObjReplace(NULL, result, j, 1, 0, NULL); gLength--; } /* Break out of for loop */ break; } } if (!found && dir) { if (Tcl_IsShared(result)) { Tcl_Obj *newList; newList = Tcl_DuplicateObj(result); Tcl_DecrRefCount(result); result = newList; } Tcl_ListObjAppendElement(NULL, result, mElt); /* * No need to increment gLength, since we * don't want to compare mounts against * mounts. */ } } endOfMounts: Tcl_DecrRefCount(mounts); return result; }  /* *---------------------------------------------------------------------- * * Tcl_FSMountsChanged -- * * Notify the filesystem that the available mounted filesystems
︙
942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979	1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310	- + - - - - + + + - + - - + - +	*/ ClientData Tcl_FSData(fsPtr) Tcl_Filesystem *fsPtr; /* The filesystem record to query. */ { ClientData retVal = NULL; FilesystemRecord *tmpFsRecPtr; FilesystemRecord *fsRecPtr = FsGetFirstFilesystem(); tmpFsRecPtr = FsGetIterator(); /* * Traverse the 'filesystemList' looking for the particular node * whose 'fsPtr' member matches 'fsPtr' and remove that one from * the list. Ensure that the "default" node cannot be removed. */ while ((retVal == NULL) && (tmpFsRecPtr != NULL)) { if (tmpFsRecPtr->fsPtr == fsPtr) { retVal = tmpFsRecPtr->clientData; while ((retVal == NULL) && (fsRecPtr != NULL)) { if (fsRecPtr->fsPtr == fsPtr) { retVal = fsRecPtr->clientData; } tmpFsRecPtr = tmpFsRecPtr->nextPtr; fsRecPtr = fsRecPtr->nextPtr; } FsReleaseIterator(); return (retVal); return retVal; }  /* *--------------------------------------------------------------------------- * * FSNormalizeAbsolutePath -- * TclFSNormalizeAbsolutePath -- * * Description: * Takes an absolute path specification and computes a 'normalized' * path from it. * * A normalized path is one which has all '../', './' removed. * Also it is one which is in the 'standard' format for the native
︙
996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013	1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345	- - + + +	* Special note: * This code is based on code from Matt Newman and Jean-Claude * Wippler, with additions from Vince Darley and is copyright * those respective authors. * *--------------------------------------------------------------------------- */ static Tcl_Obj* FSNormalizeAbsolutePath(interp, pathPtr) static Tcl_Obj * TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) Tcl_Interp* interp; /* Interpreter to use */ Tcl_Obj *pathPtr; /* Absolute path to normalize */ ClientData *clientDataPtr; { int splen = 0, nplen, eltLen, i; char *eltName; Tcl_Obj *retVal; Tcl_Obj *split; Tcl_Obj *elt;
︙
1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068	1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405	+ + - + - + - + + + +	Tcl_ListObjReplace(NULL, split, nplen, 1, 0, NULL); } } else { nplen++; } } if (nplen > 0) { ClientData clientData = NULL; retVal = Tcl_FSJoinPath(split, nplen); /* * Now we have an absolute path, with no '..', '.' sequences, * but it still may not be in 'unique' form, depending on the * platform. For instance, Unix is case-sensitive, so the * path is ok. Windows is case-insensitive, and also has the * weird 'longname/shortname' thing (e.g. C:/Program Files/ and * C:/Progra~1/ are equivalent). MacOS is case-insensitive. * * Virtual file systems which may be registered may have * other criteria for normalizing a path. */ Tcl_IncrRefCount(retVal); TclNormalizeToUniquePath(interp, retVal, 0); TclFSNormalizeToUniquePath(interp, retVal, 0, &clientData); /* * Since we know it is a normalized path, we can * actually convert this object into an FsPath for * actually convert this object into an "path" object for * greater efficiency */ SetFsPathFromAbsoluteNormalized(interp, retVal); TclFSMakePathFromNormalized(interp, retVal, clientData); if (clientDataPtr != NULL) { *clientDataPtr = clientData; } } else { /* Init to an empty string */ retVal = Tcl_NewStringObj("",0); Tcl_IncrRefCount(retVal); } /* * We increment and then decrement the refCount of split to free
︙
1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093	1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430	- +	/* This has a refCount of 1 for the caller */ return retVal; }  /* *--------------------------------------------------------------------------- * * TclNormalizeToUniquePath -- * TclFSNormalizeToUniquePath -- * * Description: * Takes a path specification containing no ../, ./ sequences, * and converts it into a unique path for the given platform. * On MacOS, Unix, this means the path must be free of * symbolic links/aliases, and on Windows it means we want the * long form, with that long form's case-dependence (which gives
︙
1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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	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	- - + + + - - + + + + - + + + - + - - + - + - - +	* * Important assumption: if startAt is non-zero, it must point * to a directory separator that we know exists and is already * normalized (so it is important not to point to the char just * after the separator). *--------------------------------------------------------------------------- */ static int TclNormalizeToUniquePath(interp, pathPtr, startAt) int TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr) Tcl_Interp *interp; Tcl_Obj *pathPtr; int startAt; ClientData *clientDataPtr; { FilesystemRecord *fsRecPtr; FilesystemRecord *fsRecPtr, *firstFsRecPtr; /* Ignore this variable */ (void)clientDataPtr; /* * Call each of the "normalise path" functions in succession. This is * a special case, in which if we have a native filesystem handler, * we call it first. This is because the root of Tcl's filesystem * is always a native filesystem (i.e. '/' on unix is native). */ fsRecPtr = FsGetIterator(); firstFsRecPtr = FsGetFirstFilesystem(); fsRecPtr = firstFsRecPtr; while (fsRecPtr != NULL) { if (fsRecPtr == &nativeFilesystemRecord) { if (fsRecPtr->fsPtr == &tclNativeFilesystem) { Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc; if (proc != NULL) { startAt = (*proc)(interp, pathPtr, startAt); } break; } fsRecPtr = fsRecPtr->nextPtr; } FsReleaseIterator(); fsRecPtr = FsGetIterator(); fsRecPtr = firstFsRecPtr; while (fsRecPtr != NULL) { /* Skip the native system next time through */ if (fsRecPtr != &nativeFilesystemRecord) { if (fsRecPtr->fsPtr != &tclNativeFilesystem) { Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc; if (proc != NULL) { startAt = (*proc)(interp, pathPtr, startAt); } /* * We could add an efficiency check like this: * * if (retVal == length-of(pathPtr)) {break;} * * but there's not much benefit. */ } fsRecPtr = fsRecPtr->nextPtr; } FsReleaseIterator(); return (startAt); return startAt; }  /* *--------------------------------------------------------------------------- * * TclGetOpenMode -- *
︙
1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238	1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582	+ + + + - +	case 'r': mode = O_RDONLY; break; case 'w': mode = O_WRONLY|O_CREAT|O_TRUNC; break; case 'a': /* [Bug 680143]. * Added O_APPEND for proper automatic * seek-to-end-on-write by the OS. */ mode = O_WRONLY|O_CREAT; mode = O_WRONLY|O_CREAT|O_APPEND; *seekFlagPtr = 1; break; default: error: if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, "illegal access mode \"", string, "\"",
︙
1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389	1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734	- + +	Tcl_StatBuf statBuf; Tcl_Obj *oldScriptFile; Interp *iPtr; char *string; Tcl_Channel chan; Tcl_Obj *objPtr; if (Tcl_FSGetTranslatedPath(interp, pathPtr) == NULL) { if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) { return TCL_ERROR; } result = TCL_ERROR; objPtr = Tcl_NewObj(); Tcl_IncrRefCount(objPtr); if (Tcl_FSStat(pathPtr, &statBuf) == -1) { Tcl_SetErrno(errno); Tcl_AppendResult(interp, "couldn't read file \"", Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), (char *) NULL); goto end;
︙
1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427	1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778	+ + + + + +	} iPtr = (Interp *) interp; oldScriptFile = iPtr->scriptFile; iPtr->scriptFile = pathPtr; Tcl_IncrRefCount(iPtr->scriptFile); string = Tcl_GetStringFromObj(objPtr, &length); #ifdef TCL_TIP280 /* TIP #280 Force the evaluator to open a frame for a sourced * file. */ iPtr->evalFlags |= TCL_EVAL_FILE; #endif result = Tcl_EvalEx(interp, string, length, 0); /* * Now we have to be careful; the script may have changed the * iPtr->scriptFile value, so we must reset it without * assuming it still points to 'pathPtr'. */ if (iPtr->scriptFile != NULL) {
︙
1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535	1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888	+ - + +	Tcl_Interp *interp; /* Interpreter whose $errorCode variable * is to be changed. */ { CONST char *id, *msg; msg = Tcl_ErrnoMsg(errno); id = Tcl_ErrnoId(); if (interp) { Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL); Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL); } return msg; }  /* *---------------------------------------------------------------------- * * Tcl_FSStat --
︙
1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589	1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945	+ + +	} statProcPtr = statProcList; while ((retVal == -1) && (statProcPtr != NULL)) { retVal = (*statProcPtr->proc)(path, &oldStyleStatBuffer); statProcPtr = statProcPtr->nextPtr; } if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } } Tcl_MutexUnlock(&obsoleteFsHookMutex); if (retVal != -1) { /* * Note that EOVERFLOW is not a problem here, and these * assignments should all be widening (if not identity.)
︙
1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716	2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075	+ + +	} accessProcPtr = accessProcList; while ((retVal == -1) && (accessProcPtr != NULL)) { retVal = (*accessProcPtr->proc)(path, mode); accessProcPtr = accessProcPtr->nextPtr; } if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } } Tcl_MutexUnlock(&obsoleteFsHookMutex); if (retVal != -1) { return retVal; } #endif /* USE_OBSOLETE_FS_HOOKS */
︙
1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799	2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170	- - - - - - - + - - - - - - - - + + + + + + + + + + + + - - - - - + + + + + + + + + + + + + + + + + + +	* a string such as "rw". */ int permissions; /* If the open involves creating a * file, with what modes to create * it? */ { Tcl_Filesystem *fsPtr; #ifdef USE_OBSOLETE_FS_HOOKS OpenFileChannelProc *openFileChannelProcPtr; Tcl_Channel retVal = NULL; char *path; #endif /* USE_OBSOLETE_FS_HOOKS */ Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (transPtr == NULL) { return NULL; } #ifdef USE_OBSOLETE_FS_HOOKS if (transPtr == NULL) { path = NULL; } else { path = Tcl_GetString(transPtr); } /* * Call each of the "Tcl_OpenFileChannel" function in succession. * Call each of the "Tcl_OpenFileChannel" functions in succession. * A non-NULL return value indicates the particular function has * succeeded. */ Tcl_MutexLock(&obsoleteFsHookMutex); if (openFileChannelProcList != NULL) { OpenFileChannelProc *openFileChannelProcPtr; char *path; Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (transPtr == NULL) { path = NULL; } else { path = Tcl_GetString(transPtr); } openFileChannelProcPtr = openFileChannelProcList; while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) { retVal = (*openFileChannelProcPtr->proc)(interp, path, modeString, permissions); openFileChannelProcPtr = openFileChannelProcPtr->nextPtr; openFileChannelProcPtr = openFileChannelProcList; while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) { retVal = (*openFileChannelProcPtr->proc)(interp, path, modeString, permissions); openFileChannelProcPtr = openFileChannelProcPtr->nextPtr; } if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } } Tcl_MutexUnlock(&obsoleteFsHookMutex); if (retVal != NULL) { return retVal; } #endif /* USE_OBSOLETE_FS_HOOKS */ /* * We need this just to ensure we return the correct error messages * under some circumstances. */ if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) { return NULL; } fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL) { Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc; if (proc != NULL) { int mode, seekFlag; mode = TclGetOpenMode(interp, modeString, &seekFlag); if (mode == -1) {
︙
1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 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 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 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 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201	2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -	if (interp != NULL) { Tcl_AppendResult(interp, "couldn't open \"", Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), (char *) NULL); } return NULL; }  /* *---------------------------------------------------------------------- * * Tcl_FSMatchInDirectory -- * * This routine is used by the globbing code to search a directory * for all files which match a given pattern. The appropriate * function for the filesystem to which pathPtr belongs will be * called. If pathPtr does not belong to any filesystem and if it * is NULL or the empty string, then we assume the pattern is to be * matched in the current working directory. To avoid each * filesystem's Tcl_FSMatchInDirectoryProc having to deal with this * issue, we create a pathPtr on the fly (equal to the cwd), and * then remove it from the results returned. This makes filesystems * easy to write, since they can assume the pathPtr passed to them * is an ordinary path. In fact this means we could remove such * special case handling from Tcl's native filesystems. * * If 'pattern' is NULL, then pathPtr is assumed to be a fully * specified path of a single file/directory which must be * checked for existence and correct type. * * Results: * * The return value is a standard Tcl result indicating whether an * error occurred in globbing. Error messages are placed in * interp, but good results are placed in the resultPtr given. * * Recursive searches, e.g. * * glob -dir $dir -join * pkgIndex.tcl * * which must recurse through each directory matching '*' are * handled internally by Tcl, by passing specific flags in a * modified 'types' parameter. This means the actual filesystem * only ever sees patterns which match in a single directory. * * Side effects: * The interpreter may have an error message inserted into it. * *---------------------------------------------------------------------- */ int Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types) Tcl_Interp *interp; /* Interpreter to receive error messages. */ Tcl_Obj *result; /* List object to receive results. */ Tcl_Obj *pathPtr; /* Contains path to directory to search. */ CONST char *pattern; /* Pattern to match against. */ Tcl_GlobTypeData *types; /* Object containing list of acceptable types. * May be NULL. In particular the directory * flag is very important. */ { Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL) { Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc; if (proc != NULL) { return (*proc)(interp, result, pathPtr, pattern, types); } } else { Tcl_Obj* cwd; int ret = -1; if (pathPtr != NULL) { int len; Tcl_GetStringFromObj(pathPtr,&len); if (len != 0) { /* * We have no idea how to match files in a directory * which belongs to no known filesystem */ Tcl_SetErrno(ENOENT); return -1; } } /* * We have an empty or NULL path. This is defined to mean we * must search for files within the current 'cwd'. We * therefore use that, but then since the proc we call will * return results which include the cwd we must then trim it * off the front of each path in the result. We choose to deal * with this here (in the generic code), since if we don't, * every single filesystem's implementation of * Tcl_FSMatchInDirectory will have to deal with it for us. */ cwd = Tcl_FSGetCwd(NULL); if (cwd == NULL) { if (interp != NULL) { Tcl_SetResult(interp, "glob couldn't determine " "the current working directory", TCL_STATIC); } return TCL_ERROR; } fsPtr = Tcl_FSGetFileSystemForPath(cwd); if (fsPtr != NULL) { Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc; if (proc != NULL) { int cwdLen; char *cwdStr; Tcl_Obj* tmpResultPtr = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(tmpResultPtr); /* * We know the cwd is a normalised object which does * not end in a directory delimiter, unless the cwd * is the name of a volume, in which case it will * end in a delimiter! We handle this situation here. * A better test than the '!= sep' might be to simply * check if 'cwd' is a root volume. * * Note that if we get this wrong, we will strip off * either too much or too little below, leading to * wrong answers returned by glob. */ cwdStr = Tcl_GetStringFromObj(cwd, &cwdLen); /* * Should we perhaps use 'Tcl_FSPathSeparator'? * But then what about the Windows special case? * Perhaps we should just check if cwd is a root * volume. */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: if (cwdStr[cwdLen-1] != '/') { cwdLen++; } break; case TCL_PLATFORM_WINDOWS: if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') { cwdLen++; } break; case TCL_PLATFORM_MAC: if (cwdStr[cwdLen-1] != ':') { cwdLen++; } break; } ret = (*proc)(interp, tmpResultPtr, cwd, pattern, types); if (ret == TCL_OK) { int resLength; ret = Tcl_ListObjLength(interp, tmpResultPtr, &resLength); if (ret == TCL_OK) { int i; for (i = 0; i < resLength; i++) { Tcl_Obj *cutElt, *elt; char *eltStr; int eltLen; Tcl_ListObjIndex(interp, tmpResultPtr, i, &elt); if (elt->typePtr == &tclFsPathType) { FsPath* fsPathPtr = (FsPath*) elt->internalRep.otherValuePtr; if (fsPathPtr->flags != 0 && fsPathPtr->cwdPtr == cwd) { Tcl_ListObjAppendElement(interp, result, MakeFsPathFromRelative(interp, fsPathPtr->normPathPtr, cwd)); continue; } } eltStr = Tcl_GetStringFromObj(elt, &eltLen); cutElt = Tcl_NewStringObj(eltStr + cwdLen, eltLen - cwdLen); Tcl_ListObjAppendElement(interp, result, cutElt); } } } Tcl_DecrRefCount(tmpResultPtr); } } Tcl_DecrRefCount(cwd); return ret; } Tcl_SetErrno(ENOENT); return -1; }  /* *---------------------------------------------------------------------- * * Tcl_FSGetCwd -- * * This function replaces the library version of getcwd(). * * Most VFS's will *not* implement a 'cwdProc'. Tcl now maintains * its own record (in a Tcl_Obj) of the cwd, and an attempt * is made to synchronise this with the cwd's containing filesystem, * if that filesystem provides a cwdProc (e.g. the native filesystem). * * Note that if Tcl's cwd is not in the native filesystem, then of * course Tcl's cwd and the native cwd are different: extensions * should therefore ensure they only access the cwd through this * function to avoid confusion. * * If a global cwdPathPtr already exists, it is returned, subject * to a synchronisation attempt in that cwdPathPtr's fs. * Otherwise, the chain of functions that have been "inserted" * into the filesystem will be called in succession until either a * value other than NULL is returned, or the entire list is * visited. * * Results: * The result is a pointer to a Tcl_Obj specifying the current * directory, or NULL if the current directory could not be * determined. If NULL is returned, an error message is left in the * interp's result. * * The result already has its refCount incremented for the caller. * When it is no longer needed, that refCount should be decremented. * This is needed for thread-safety purposes, to allow multiple * threads to access this and related functions, while ensuring the * results are always valid. * * Of course it is probably a bad idea for multiple threads to * be *setting* the cwd anyway, but we can at least try to * help the case of multiple reads with occasional sets. * * Side effects: * Various objects may be freed and allocated. * *---------------------------------------------------------------------- */ Tcl_Obj* Tcl_FSGetCwd(interp) Tcl_Interp *interp; { Tcl_Obj *cwdToReturn; if (FsCwdPointerEquals(NULL)) { FilesystemRecord *fsRecPtr; Tcl_Obj *retVal = NULL; /* * We've never been called before, try to find a cwd. Call * each of the "Tcl_GetCwd" function in succession. A non-NULL * return value indicates the particular function has * succeeded. */ fsRecPtr = FsGetIterator(); while ((retVal == NULL) && (fsRecPtr != NULL)) { Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc; if (proc != NULL) { retVal = (*proc)(interp); } fsRecPtr = fsRecPtr->nextPtr; } FsReleaseIterator(); /* * Now the 'cwd' may NOT be normalized, at least on some * platforms. For the sake of efficiency, we want a completely * normalized cwd at all times. * * Finally, if retVal is NULL, we do not have a cwd, which * could be problematic. */ if (retVal != NULL) { Tcl_Obj *norm = FSNormalizeAbsolutePath(interp, retVal); if (norm != NULL) { /* * We found a cwd, which is now in our global storage. * We must make a copy. Norm already has a refCount of * 1. * * Threading issue: note that multiple threads at system * startup could in principle call this procedure * simultaneously. They will therefore each set the * cwdPathPtr independently. That behaviour is a bit * peculiar, but should be fine. Once we have a cwd, * we'll always be in the 'else' branch below which * is simpler. */ Tcl_MutexLock(&cwdMutex); /* Just in case the pointer has been set by another * thread between now and the test above */ if (cwdPathPtr != NULL) { Tcl_DecrRefCount(cwdPathPtr); } cwdPathPtr = norm; Tcl_MutexUnlock(&cwdMutex); } Tcl_DecrRefCount(retVal); } } else { /* * We already have a cwd cached, but we want to give the * filesystem it is in a chance to check whether that cwd * has changed, or is perhaps no longer accessible. This * allows an error to be thrown if, say, the permissions on * that directory have changed. */ Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(cwdPathPtr); /* * If the filesystem couldn't be found, or if no cwd function * exists for this filesystem, then we simply assume the cached * cwd is ok. If we do call a cwd, we must watch for errors * (if the cwd returns NULL). This ensures that, say, on Unix * if the permissions of the cwd change, 'pwd' does actually * throw the correct error in Tcl. (This is tested for in the * test suite on unix). */ if (fsPtr != NULL) { Tcl_FSGetCwdProc *proc = fsPtr->getCwdProc; if (proc != NULL) { Tcl_Obj *retVal = (*proc)(interp); if (retVal != NULL) { Tcl_Obj *norm = FSNormalizeAbsolutePath(interp, retVal); /* * Check whether cwd has changed from the value * previously stored in cwdPathPtr. Really 'norm' * shouldn't be null, but we are careful. */ if (norm == NULL) { /* Do nothing */ } else if (Tcl_FSEqualPaths(cwdPathPtr, norm)) { /* * If the paths were equal, we can be more * efficient and retain the old path object * which will probably already be shared. In * this case we can simply free the normalized * path we just calculated. */ Tcl_DecrRefCount(norm); } else { /* The cwd has in fact changed, so we must * lock down the cwdMutex to modify. */ Tcl_MutexLock(&cwdMutex); Tcl_DecrRefCount(cwdPathPtr); cwdPathPtr = norm; Tcl_MutexUnlock(&cwdMutex); } Tcl_DecrRefCount(retVal); } else { /* The 'cwd' function returned an error, so we * reset the cwd after locking down the mutex. */ Tcl_MutexLock(&cwdMutex); Tcl_DecrRefCount(cwdPathPtr); cwdPathPtr = NULL; Tcl_MutexUnlock(&cwdMutex); } } } } /* * The paths all eventually fall through to here. Note that * we use a bunch of separate mutex locks throughout this * code to help prevent deadlocks between threads. Really * the only weirdness will arise if multiple threads are setting * and reading the cwd, and that behaviour is always going to be * a little suspect. */ Tcl_MutexLock(&cwdMutex); cwdToReturn = cwdPathPtr; if (cwdToReturn != NULL) { Tcl_IncrRefCount(cwdToReturn); } Tcl_MutexUnlock(&cwdMutex); return (cwdToReturn); }  /* *---------------------------------------------------------------------- * * Tcl_FSUtime -- * * This procedure replaces the library version of utime.
︙
2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451	2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	Tcl_SetErrno(ENOENT); return -1; }  /* *---------------------------------------------------------------------- * * Tcl_FSGetCwd -- * * This function replaces the library version of getcwd(). * * Most VFS's will *not* implement a 'cwdProc'. Tcl now maintains * its own record (in a Tcl_Obj) of the cwd, and an attempt * is made to synchronise this with the cwd's containing filesystem, * if that filesystem provides a cwdProc (e.g. the native filesystem). * * Note that if Tcl's cwd is not in the native filesystem, then of * course Tcl's cwd and the native cwd are different: extensions * should therefore ensure they only access the cwd through this * function to avoid confusion. * * If a global cwdPathPtr already exists, it is cached in the thread's * private data structures and reference to the cached copy is returned, * subject to a synchronisation attempt in that cwdPathPtr's fs. * * Otherwise, the chain of functions that have been "inserted" * into the filesystem will be called in succession until either a * value other than NULL is returned, or the entire list is * visited. * * Results: * The result is a pointer to a Tcl_Obj specifying the current * directory, or NULL if the current directory could not be * determined. If NULL is returned, an error message is left in the * interp's result. * * The result already has its refCount incremented for the caller. * When it is no longer needed, that refCount should be decremented. * * Side effects: * Various objects may be freed and allocated. * *---------------------------------------------------------------------- */ Tcl_Obj* Tcl_FSGetCwd(interp) Tcl_Interp *interp; { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (TclFSCwdPointerEquals(NULL)) { FilesystemRecord *fsRecPtr; Tcl_Obj *retVal = NULL; /* * We've never been called before, try to find a cwd. Call * each of the "Tcl_GetCwd" function in succession. A non-NULL * return value indicates the particular function has * succeeded. */ fsRecPtr = FsGetFirstFilesystem(); while ((retVal == NULL) && (fsRecPtr != NULL)) { Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc; if (proc != NULL) { retVal = (*proc)(interp); } fsRecPtr = fsRecPtr->nextPtr; } /* * Now the 'cwd' may NOT be normalized, at least on some * platforms. For the sake of efficiency, we want a completely * normalized cwd at all times. * * Finally, if retVal is NULL, we do not have a cwd, which * could be problematic. */ if (retVal != NULL) { Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL); if (norm != NULL) { /* * We found a cwd, which is now in our global storage. * We must make a copy. Norm already has a refCount of 1. * * Threading issue: note that multiple threads at system * startup could in principle call this procedure * simultaneously. They will therefore each set the * cwdPathPtr independently. That behaviour is a bit * peculiar, but should be fine. Once we have a cwd, * we'll always be in the 'else' branch below which * is simpler. */ FsUpdateCwd(norm); Tcl_DecrRefCount(norm); } Tcl_DecrRefCount(retVal); } } else { /* * We already have a cwd cached, but we want to give the * filesystem it is in a chance to check whether that cwd * has changed, or is perhaps no longer accessible. This * allows an error to be thrown if, say, the permissions on * that directory have changed. */ Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr); /* * If the filesystem couldn't be found, or if no cwd function * exists for this filesystem, then we simply assume the cached * cwd is ok. If we do call a cwd, we must watch for errors * (if the cwd returns NULL). This ensures that, say, on Unix * if the permissions of the cwd change, 'pwd' does actually * throw the correct error in Tcl. (This is tested for in the * test suite on unix). */ if (fsPtr != NULL) { Tcl_FSGetCwdProc *proc = fsPtr->getCwdProc; if (proc != NULL) { Tcl_Obj *retVal = (*proc)(interp); if (retVal != NULL) { Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL); /* * Check whether cwd has changed from the value * previously stored in cwdPathPtr. Really 'norm' * shouldn't be null, but we are careful. */ if (norm == NULL) { /* Do nothing */ } else if (Tcl_FSEqualPaths(tsdPtr->cwdPathPtr, norm)) { /* * If the paths were equal, we can be more * efficient and retain the old path object * which will probably already be shared. In * this case we can simply free the normalized * path we just calculated. */ Tcl_DecrRefCount(norm); } else { FsUpdateCwd(norm); Tcl_DecrRefCount(norm); } Tcl_DecrRefCount(retVal); } else { /* The 'cwd' function returned an error; reset the cwd */ FsUpdateCwd(NULL); } } } } if (tsdPtr->cwdPathPtr != NULL) { Tcl_IncrRefCount(tsdPtr->cwdPathPtr); } return tsdPtr->cwdPathPtr; }  /* *---------------------------------------------------------------------- * * Tcl_FSChdir -- * * This function replaces the library version of chdir(). * * The path is normalized and then passed to the filesystem * which claims it. *
︙
2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478	2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 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	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - +	int Tcl_FSChdir(pathPtr) Tcl_Obj *pathPtr; { Tcl_Filesystem *fsPtr; int retVal = -1; #ifdef WIN32 /* * This complete hack addresses the bug tested in winFCmd-16.12, * where having your HOME as "C:" (IOW, a seemingly path relative * dir) would cause a crash when you cd'd to it and requested 'pwd'. * The work-around is to force such a dir into an absolute path by * tacking on '/'. * * We check for '~' specifically because that's what Tcl_CdObjCmd * passes in that triggers the bug. A direct 'cd C:' call will not * because that gets the volumerelative pwd. * * This is not an issue for 8.5 as that has a more elaborate change * that requires the use of TCL_FILESYSTEM_VERSION_2. */ Tcl_Obj *objPtr = NULL; if (pathPtr->bytes && pathPtr->length == 1 && pathPtr->bytes[0] == '~') { int len; char *str; objPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); if (objPtr == NULL) { Tcl_SetErrno(ENOENT); return -1; } Tcl_IncrRefCount(objPtr); str = Tcl_GetStringFromObj(objPtr, &len); if (len == 2 && str[1] == ':') { pathPtr = Tcl_NewStringObj(str, len); Tcl_AppendToObj(pathPtr, "/", 1); Tcl_IncrRefCount(pathPtr); Tcl_DecrRefCount(objPtr); objPtr = pathPtr; } else { Tcl_DecrRefCount(objPtr); objPtr = NULL; } } #endif if (Tcl_FSGetNormalizedPath(NULL, pathPtr) == NULL) { #ifdef WIN32 if (objPtr) { Tcl_DecrRefCount(objPtr); } #endif Tcl_SetErrno(ENOENT); return TCL_ERROR; return -1; } fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL) { Tcl_FSChdirProc *proc = fsPtr->chdirProc; if (proc != NULL) { retVal = (*proc)(pathPtr);
︙
2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539	2698 2699 2700 2701 2702 2703 2704 2705 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	- + + + + + - + - - - - - + - - - - - - - + + - - - - - + + + + + +	* The cwd changed, or an error was thrown. If an error was * thrown, we can just continue (and that will report the error * to the user). If there was no error we must assume that the * cwd was actually changed to the normalized value we * calculated above, and we must therefore cache that * information. */ if (retVal == TCL_OK) { if (retVal == 0) { /* * Note that this normalized path may be different to what * we found above (or at least a different object), if the * filesystem epoch changed recently. This can actually * happen with scripted documents very easily. Therefore * we ask for the normalized path again (the correct value * will have been cached as a result of the * Tcl_FSGetFileSystemForPath call above anyway). */ Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normDirName == NULL) { #ifdef WIN32 if (objPtr) { Tcl_DecrRefCount(objPtr); } #endif Tcl_SetErrno(ENOENT); return TCL_ERROR; return -1; } /* * We will be adding a reference to this object when * we store it in the cwdPathPtr. */ Tcl_IncrRefCount(normDirName); FsUpdateCwd(normDirName); /* Get a lock on the cwd while we modify it */ Tcl_MutexLock(&cwdMutex); /* Free up the previous cwd we stored */ if (cwdPathPtr != NULL) { Tcl_DecrRefCount(cwdPathPtr); } /* Now remember the current cwd */ } } else { cwdPathPtr = normDirName; Tcl_MutexUnlock(&cwdMutex); } } Tcl_SetErrno(ENOENT); } #ifdef WIN32 if (objPtr) { Tcl_DecrRefCount(objPtr); } #endif return (retVal); }  /* *---------------------------------------------------------------------- * * Tcl_FSLoadFile --
︙
2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620	2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	if (Tcl_FSAccess(pathPtr, R_OK) != 0) { Tcl_AppendResult(interp, "couldn't load library \"", Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } #ifdef TCL_LOAD_FROM_MEMORY /* * The platform supports loading code from memory, so ask for a * buffer of the appropriate size, read the file into it and * load the code from the buffer: */ do { int ret, size; void *buffer; Tcl_StatBuf statBuf; Tcl_Channel data; ret = Tcl_FSStat(pathPtr, &statBuf); if (ret < 0) { break; } size = (int) statBuf.st_size; /* Tcl_Read takes an int: check that file size isn't wide */ if (size != (Tcl_WideInt)statBuf.st_size) { break; } data = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0666); if (!data) { break; } buffer = TclpLoadMemoryGetBuffer(interp, size); if (!buffer) { Tcl_Close(interp, data); break; } Tcl_SetChannelOption(interp, data, "-translation", "binary"); ret = Tcl_Read(data, buffer, size); Tcl_Close(interp, data); ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr, unloadProcPtr); if (ret == TCL_OK) { if (*handlePtr == NULL) { break; } if (sym1 != NULL) { *proc1Ptr = TclpFindSymbol(interp, *handlePtr, sym1); } if (sym2 != NULL) { *proc2Ptr = TclpFindSymbol(interp, *handlePtr, sym2); } return TCL_OK; } } while (0); Tcl_ResetResult(interp); #endif /* * Get a temporary filename to use, first to * copy the file into, and then to load. */ copyToPtr = TclpTempFileName(); if (copyToPtr == NULL) { return -1;
︙
2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733	2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982	- +	* need to worry about it disappearing on us. */ tvdlPtr->divertedFilesystem = copyFsPtr; tvdlPtr->divertedFileNativeRep = NULL; } else { /* We need the native rep */ tvdlPtr->divertedFileNativeRep = NativeDupInternalRep(Tcl_FSGetInternalRep(copyToPtr, TclNativeDupInternalRep(Tcl_FSGetInternalRep(copyToPtr, copyFsPtr)); /* * We don't need or want references to the copied * Tcl_Obj or the filesystem if it is the native * one. */ tvdlPtr->divertedFile = NULL;
︙
2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 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 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081	3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309	- + - - + - + + - + - - - + + + - + - + - - - + + + + - - - + - - - - - - - - - - + + - - + - - - - - - + + + + + + - - - + - - - + - - - - + + - - - + - - + + - - - - + + - - + - - + - - - - - + + + + + +	/* * Call each of the "listVolumes" function in succession. * A non-NULL return value indicates the particular function has * succeeded. We call all the functions registered, since we want * a list of all drives from all filesystems. */ fsRecPtr = FsGetIterator(); fsRecPtr = FsGetFirstFilesystem(); while (fsRecPtr != NULL) { Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc; if (proc != NULL) { Tcl_Obj *thisFsVolumes = (*proc)(); if (thisFsVolumes != NULL) { Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes); Tcl_DecrRefCount(thisFsVolumes); } } fsRecPtr = fsRecPtr->nextPtr; } FsReleaseIterator(); return resultPtr; }  /* *---------------------------------------------------------------------- *--------------------------------------------------------------------------- * * Tcl_FSGetPathType -- * FsListMounts -- * * List all mounts within the given directory, which match the * Determines whether a given path is relative to the current * given pattern. * directory, relative to the current volume, or absolute. * * Results: * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or * TCL_PATH_VOLUME_RELATIVE. * The list of mounts, in a list object which has refCount 0, or * NULL if we didn't even find any filesystems to try to list * mounts. * * Side effects: * None. * None * *---------------------------------------------------------------------- *--------------------------------------------------------------------------- */ Tcl_PathType Tcl_FSGetPathType(pathObjPtr) Tcl_Obj *pathObjPtr; static Tcl_Obj* FsListMounts(pathPtr, pattern) Tcl_Obj *pathPtr; /* Contains path to directory to search. */ CONST char *pattern; /* Pattern to match against. */ { return FSGetPathType(pathObjPtr, NULL, NULL); }  FilesystemRecord *fsRecPtr; /* *---------------------------------------------------------------------- * * FSGetPathType -- * * Determines whether a given path is relative to the current * directory, relative to the current volume, or absolute. If the * caller wishes to know which filesystem claimed the path (in the * case for which the path is absolute), then a reference to a * filesystem pointer can be passed in (but passing NULL is Tcl_GlobTypeData mountsOnly = { TCL_GLOB_TYPE_MOUNT, 0, NULL, NULL }; Tcl_Obj *resultPtr = NULL; * acceptable). * * Results: * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or * TCL_PATH_VOLUME_RELATIVE. The filesystem reference will * be set if and only if it is non-NULL and the function's * return value is TCL_PATH_ABSOLUTE. * /* * Call each of the "listMounts" functions in succession. * A non-NULL return value indicates the particular function has * succeeded. We call all the functions registered, since we want * a list from each filesystems. */ * Side effects: * None. * *---------------------------------------------------------------------- */ fsRecPtr = FsGetFirstFilesystem(); static Tcl_PathType FSGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr) Tcl_Obj *pathObjPtr; Tcl_Filesystem **filesystemPtrPtr; while (fsRecPtr != NULL) { if (fsRecPtr->fsPtr != &tclNativeFilesystem) { int *driveNameLengthPtr; { if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) { Tcl_FSMatchInDirectoryProc *proc = return GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, NULL); fsRecPtr->fsPtr->matchInDirectoryProc; if (proc != NULL) { } else { FsPath *fsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr; if (fsPathPtr->cwdPtr != NULL) { if (fsPathPtr->flags == 0) { if (resultPtr == NULL) { resultPtr = Tcl_NewObj(); return TCL_PATH_RELATIVE; } } return FSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, driveNameLengthPtr); (*proc)(NULL, resultPtr, pathPtr, pattern, &mountsOnly); } else { return GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, NULL); } } } } fsRecPtr = fsRecPtr->nextPtr; } return resultPtr; }  /* *--------------------------------------------------------------------------- * * Tcl_FSSplitPath -- *
︙
3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362	3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431	- - - - - - - - - - - - - - - - + - - - - - + - - - - - - - + + - - - - - - - - - - - - - - - - - - - + - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - + - - - - - - - + - - - - - - - - - - + + + - - - - - - - - - + - - + - - - - - - - - + - - - - - - + - - - + - - - - + - - - - - - + - - - - - - - - - - - - + - - - - - - - + + - -	if (lenPtr != NULL) { Tcl_ListObjLength(NULL, result, lenPtr); } return result; }  /* *--------------------------------------------------------------------------- * * Tcl_FSJoinPath -- * * This function takes the given Tcl_Obj, which should be a valid * list, and returns the path object given by considering the * first 'elements' elements as valid path segments. If elements < 0, * we use the entire list. * * Results: * Returns object with refCount of zero, (or if non-zero, it has * references elsewhere in Tcl). Either way, the caller must * increment its refCount before use. * * Side effects: /* Simple helper function */ * None. * *--------------------------------------------------------------------------- */ Tcl_Obj* Tcl_FSJoinPath(listObj, elements) TclFSInternalToNormalized(fromFilesystem, clientData, fsRecPtrPtr) Tcl_Obj *listObj; int elements; { Tcl_Obj *res; int i; Tcl_Filesystem *fsPtr = NULL; Tcl_Filesystem *fromFilesystem; ClientData clientData; if (elements < 0) { if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) { return NULL; } } else { /* Just make sure it is a valid list */ int listTest; if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) { return NULL; } /* * Correct this if it is too large, otherwise we will * waste our time joining null elements to the path */ if (elements > listTest) { elements = listTest; } } FilesystemRecord **fsRecPtrPtr; if (elements == 2) { /* * This is a special case where we can be much more * efficient */ Tcl_Obj *base; { Tcl_ListObjIndex(NULL, listObj, 0, &base); /* * There is only any value in doing this if the first object is * of path type, otherwise we'll never actually get any * efficiency benefit elsewhere in the code (from re-using the * normalized representation of the base object). */ if (base->typePtr == &tclFsPathType && !(base->bytes != NULL && base->bytes[0] == '\0')) { Tcl_Obj *tail; Tcl_PathType type; Tcl_ListObjIndex(NULL, listObj, 1, &tail); type = GetPathType(tail, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { CONST char *str; int len; str = Tcl_GetStringFromObj(tail,&len); if (len == 0) { /* * This happens if we try to handle the root volume * '/'. There's no need to return a special path * object, when the base itself is just fine! */ return base; } if (str[0] != '.') { return TclNewFSPathObj(base, str, len); } /* * Otherwise we don't have an easy join, and * we must let the more general code below handle * things */ } else { return tail; } } } FilesystemRecord *fsRecPtr = FsGetFirstFilesystem(); res = Tcl_NewObj(); for (i = 0; i < elements; i++) { Tcl_Obj *elt; int driveNameLength; Tcl_PathType type; char *strElt; int strEltLen; int length; char *ptr; Tcl_Obj *driveName = NULL; Tcl_ListObjIndex(NULL, listObj, i, &elt); strElt = Tcl_GetStringFromObj(elt, &strEltLen); type = GetPathType(elt, &fsPtr, &driveNameLength, &driveName); if (type != TCL_PATH_RELATIVE) { /* Zero out the current result */ Tcl_DecrRefCount(res); if (driveName != NULL) { while (fsRecPtr != NULL) { res = Tcl_DuplicateObj(driveName); Tcl_DecrRefCount(driveName); } else { res = Tcl_NewStringObj(strElt, driveNameLength); } strElt += driveNameLength; } ptr = Tcl_GetStringFromObj(res, &length); if (fsRecPtr->fsPtr == fromFilesystem) { *fsRecPtrPtr = fsRecPtr; break; /* * Strip off any './' before a tilde, unless this is the * beginning of the path. */ if (length > 0 && strEltLen > 0) { if ((strElt[0] == '.') && (strElt[1] == '/') && (strElt[2] == '~')) { strElt += 2; } } } fsRecPtr = fsRecPtr->nextPtr; /* * A NULL value for fsPtr at this stage basically means * we're trying to join a relative path onto something * which is also relative (or empty). There's nothing * particularly wrong with that. */ if (*strElt == '\0') continue; } if (fsPtr == &tclNativeFilesystem || fsPtr == NULL) { TclpNativeJoinPath(res, strElt); } else { char separator = '/'; int needsSep = 0; if (fsPtr->filesystemSeparatorProc != NULL) { Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res); if (sep != NULL) { if ((fsRecPtr != NULL) separator = Tcl_GetString(sep)[0]; } } && (fromFilesystem->internalToNormalizedProc != NULL)) { if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); length++; } Tcl_SetObjLength(res, length + (int) strlen(strElt)); return (*fromFilesystem->internalToNormalizedProc)(clientData); ptr = Tcl_GetString(res) + length; for (; *strElt != '\0'; strElt++) { if (*strElt == separator) { while (strElt[1] == separator) { strElt++; } if (strElt[1] != '\0') { if (needsSep) { *ptr++ = separator; } } } else { } else { *ptr++ = *strElt; needsSep = 1; } } length = ptr - Tcl_GetString(res); Tcl_SetObjLength(res, length); } return NULL; } } return res; }  /* *---------------------------------------------------------------------- * * GetPathType -- *
︙
3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405	3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474	- +	/* * Call each of the "listVolumes" function in succession, checking * whether the given path is an absolute path on any of the volumes * returned (this is done by checking whether the path's prefix * matches). */ fsRecPtr = FsGetIterator(); fsRecPtr = FsGetFirstFilesystem(); while (fsRecPtr != NULL) { Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc; /* * We want to skip the native filesystem in this loop because * otherwise we won't necessarily pass all the Tcl testsuite -- * this is because some of the tests artificially change the * current platform (between mac, win, unix) but the list
︙
3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479	3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547	-	/* We don't need to examine any more filesystems */ break; } } } fsRecPtr = fsRecPtr->nextPtr; } FsReleaseIterator(); if (type != TCL_PATH_ABSOLUTE) { type = TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef); if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) { *filesystemPtrPtr = &tclNativeFilesystem; }
︙
3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948	3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - - - - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - + - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - - - + + - - - + - - - - + - - + - - - - + - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - + - - - + - - - - - - - - - - - + - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - + - - - - - - - + + - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - + - - - - - - - - - - + - - - + - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - + - - - + - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - + - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - + + + - - - + - - - - - + - - - + - - - - - - - - - - - - - - - - - + - - - - - - - - - + - - - - - - - + - - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - + - - - - + - - + - - - - + - - - - + - - - - + - - - - - - - - - - - - - - - - - - - - + - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -	Tcl_SetErrno(ENOENT); return -1; }  /* *--------------------------------------------------------------------------- * * Tcl_FSConvertToPathType -- * * This function tries to convert the given Tcl_Obj to a valid * Tcl path type, taking account of the fact that the cwd may * have changed even if this object is already supposedly of * the correct type. * * The filename may begin with "~" (to indicate current user's * home directory) or "~<user>" (to indicate any user's home * directory). * * Results: * Standard Tcl error code. * * Side effects: * The old representation may be freed, and new memory allocated. * *--------------------------------------------------------------------------- */ int Tcl_FSConvertToPathType(interp, objPtr) Tcl_Interp *interp; /* Interpreter in which to store error * message (if necessary). */ Tcl_Obj *objPtr; /* Object to convert to a valid, current * path type. */ { /* * While it is bad practice to examine an object's type directly, * this is actually the best thing to do here. The reason is that * if we are converting this object to FsPath type for the first * time, we don't need to worry whether the 'cwd' has changed. * On the other hand, if this object is already of FsPath type, * and is a relative path, we do have to worry about the cwd. * If the cwd has changed, we must recompute the path. */ if (objPtr->typePtr == &tclFsPathType) { FsPath *fsPathPtr = (FsPath*) objPtr->internalRep.otherValuePtr; if (fsPathPtr->filesystemEpoch != theFilesystemEpoch) { if (objPtr->bytes == NULL) { UpdateStringOfFsPath(objPtr); } FreeFsPathInternalRep(objPtr); objPtr->typePtr = NULL; return Tcl_ConvertToType(interp, objPtr, &tclFsPathType); } return TCL_OK; /* * This code is intentionally never reached. Once fs-optimisation * is complete, it will be removed/replaced */ if (fsPathPtr->cwdPtr == NULL) { return TCL_OK; } else { if (FsCwdPointerEquals(fsPathPtr->cwdPtr)) { return TCL_OK; } else { if (objPtr->bytes == NULL) { UpdateStringOfFsPath(objPtr); } FreeFsPathInternalRep(objPtr); objPtr->typePtr = NULL; return Tcl_ConvertToType(interp, objPtr, &tclFsPathType); } } } else { return Tcl_ConvertToType(interp, objPtr, &tclFsPathType); } }  * Tcl_FSGetFileSystemForPath -- * /* * Helper function for SetFsPathFromAny. Returns position of first * directory delimiter in the path. */ static int FindSplitPos(path, separator) char *path; char *separator; { int count = 0; switch (tclPlatform) { case TCL_PLATFORM_UNIX: case TCL_PLATFORM_MAC: while (path[count] != 0) { if (path[count] == *separator) { return count; } count++; } break; * This function determines which filesystem to use for a case TCL_PLATFORM_WINDOWS: while (path[count] != 0) { if (path[count] == *separator || path[count] == '\\') { return count; } count++; } break; } return count; }  * particular path object, and returns the filesystem which /* *--------------------------------------------------------------------------- * * UpdateStringOfFsPath -- * * Gives an object a valid string rep. * * Results: * None. * * Side effects: * Memory may be allocated. * *--------------------------------------------------------------------------- */ * accepts this file. If no filesystem will accept this object static void UpdateStringOfFsPath(objPtr) register Tcl_Obj *objPtr; /* path obj with string rep to update. */ { register FsPath* fsPathPtr = (FsPath*) objPtr->internalRep.otherValuePtr; CONST char *cwdStr; int cwdLen; Tcl_Obj *copy; if (fsPathPtr->flags == 0 || fsPathPtr->cwdPtr == NULL) { panic("Called UpdateStringOfFsPath with invalid object"); } copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr); Tcl_IncrRefCount(copy); cwdStr = Tcl_GetStringFromObj(copy, &cwdLen); /* * Should we perhaps use 'Tcl_FSPathSeparator'? * But then what about the Windows special case? * Perhaps we should just check if cwd is a root volume. * We should never get cwdLen == 0 in this code path. */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: if (cwdStr[cwdLen-1] != '/') { Tcl_AppendToObj(copy, "/", 1); cwdLen++; } break; case TCL_PLATFORM_WINDOWS: /* * We need the extra 'cwdLen != 2', and ':' checks because * a volume relative path doesn't get a '/'. For example * 'glob C:*cat*.exe' will return 'C:cat32.exe' */ if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') { if (cwdLen != 2 || cwdStr[1] != ':') { Tcl_AppendToObj(copy, "/", 1); cwdLen++; } } break; case TCL_PLATFORM_MAC: if (cwdStr[cwdLen-1] != ':') { Tcl_AppendToObj(copy, ":", 1); cwdLen++; } break; } Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr); objPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen); objPtr->length = cwdLen; copy->bytes = tclEmptyStringRep; copy->length = 0; Tcl_DecrRefCount(copy); }  * as a valid file path, then NULL is returned. /* *--------------------------------------------------------------------------- * * TclNewFSPathObj -- * * Creates a path object whose string representation is * '[file join dirPtr addStrRep]', but does so in a way that * allows for more efficient caching of normalized paths. * * Assumptions: * 'dirPtr' must be an absolute path. * 'len' may not be zero. * * Results: * The new Tcl object. * * Side effects: * Memory is allocated. 'dirPtr' gets an additional refCount. * *--------------------------------------------------------------------------- */ .* NULL or a filesystem which will accept this path. Tcl_Obj* TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len) { FsPath *fsPathPtr; Tcl_Obj *objPtr; objPtr = Tcl_NewObj(); fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); if (tclPlatform == TCL_PLATFORM_MAC) { /* * Mac relative paths may begin with a directory separator ':'. * If present, we need to skip this ':' because we assume that * we can join dirPtr and addStrRep by concatenating them as * strings (and we ensure that dirPtr is terminated by a ':'). */ if (addStrRep[0] == ':') { addStrRep++; len--; } } /* Setup the path */ fsPathPtr->translatedPathPtr = NULL; fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len); Tcl_IncrRefCount(fsPathPtr->normPathPtr); fsPathPtr->cwdPtr = dirPtr; Tcl_IncrRefCount(dirPtr); fsPathPtr->flags = TCLPATH_RELATIVE | TCLPATH_APPENDED; fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsRecPtr = NULL; fsPathPtr->filesystemEpoch = theFilesystemEpoch; objPtr->internalRep.otherValuePtr = (VOID *) fsPathPtr; objPtr->typePtr = &tclFsPathType; objPtr->bytes = NULL; objPtr->length = 0; return objPtr; }  /* *--------------------------------------------------------------------------- * * MakeFsPathFromRelative -- * * Like SetFsPathFromAny, but assumes the given object is an * absolute normalized path. Only for internal use. * * Results: * Standard Tcl error code. * * Side effects: * The old representation may be freed, and new memory allocated. * *--------------------------------------------------------------------------- */ static Tcl_Obj* MakeFsPathFromRelative(interp, objPtr, cwdPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr; /* The object to convert. */ Tcl_Obj *cwdPtr; /* The object to convert. */ { FsPath *fsPathPtr; /* Free old representation */ if (objPtr->typePtr != NULL) { if (objPtr->bytes == NULL) { if (objPtr->typePtr->updateStringProc == NULL) { if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "can't find object", "string representation", (char *) NULL); } return NULL; } objPtr->typePtr->updateStringProc(objPtr); } if ((objPtr->typePtr->freeIntRepProc) != NULL) { (*objPtr->typePtr->freeIntRepProc)(objPtr); } } * fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); /* Circular reference, by design */ fsPathPtr->translatedPathPtr = objPtr; fsPathPtr->normPathPtr = NULL; fsPathPtr->flags = 0; fsPathPtr->cwdPtr = cwdPtr; Tcl_IncrRefCount(cwdPtr); fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsRecPtr = NULL; fsPathPtr->filesystemEpoch = theFilesystemEpoch; objPtr->internalRep.otherValuePtr = (VOID *) fsPathPtr; objPtr->typePtr = &tclFsPathType; return objPtr; }  /* *--------------------------------------------------------------------------- * * SetFsPathFromAbsoluteNormalized -- * * Like SetFsPathFromAny, but assumes the given object is an * absolute normalized path. Only for internal use. * * Results: * Standard Tcl error code. * * Side effects: * The old representation may be freed, and new memory allocated. * *--------------------------------------------------------------------------- */ * The object may be converted to a path type. static int SetFsPathFromAbsoluteNormalized(interp, objPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr; /* The object to convert. */ { FsPath *fsPathPtr; * if (objPtr->typePtr == &tclFsPathType) { return TCL_OK; } /* Free old representation */ if (objPtr->typePtr != NULL) { if (objPtr->bytes == NULL) { if (objPtr->typePtr->updateStringProc == NULL) { if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "can't find object", "string representation", (char *) NULL); } return TCL_ERROR; } objPtr->typePtr->updateStringProc(objPtr); } if ((objPtr->typePtr->freeIntRepProc) != NULL) { (*objPtr->typePtr->freeIntRepProc)(objPtr); } } fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); /* It's a pure normalized absolute path */ fsPathPtr->translatedPathPtr = NULL; fsPathPtr->normPathPtr = objPtr; fsPathPtr->flags = 0; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsRecPtr = NULL; fsPathPtr->filesystemEpoch = theFilesystemEpoch; objPtr->internalRep.otherValuePtr = (VOID *) fsPathPtr; objPtr->typePtr = &tclFsPathType; return TCL_OK; }  /* *--------------------------------------------------------------------------- * * SetFsPathFromAny -- * * This function tries to convert the given Tcl_Obj to a valid * Tcl path type. * * The filename may begin with "~" (to indicate current user's * home directory) or "~<user>" (to indicate any user's home * directory). * * Results: * Standard Tcl error code. * * Side effects: * The old representation may be freed, and new memory allocated. * *--------------------------------------------------------------------------- */ static int SetFsPathFromAny(interp, objPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr; /* The object to convert. */ { int len; FsPath *fsPathPtr; Tcl_Obj *transPtr; char *name; if (objPtr->typePtr == &tclFsPathType) { return TCL_OK; } /* * First step is to translate the filename. This is similar to * Tcl_TranslateFilename, but shouldn't convert everything to * windows backslashes on that platform. The current * implementation of this piece is a slightly optimised version * of the various Tilde/Split/Join stuff to avoid multiple * split/join operations. * * We remove any trailing directory separator. * * However, the split/join routines are quite complex, and * one has to make sure not to break anything on Unix, Win * or MacOS (fCmd.test, fileName.test and cmdAH.test exercise * most of the code). */ name = Tcl_GetStringFromObj(objPtr,&len); /* * Handle tilde substitutions, if needed. */ if (name[0] == '~') { char *expandedUser; Tcl_DString temp; int split; char separator='/'; if (tclPlatform==TCL_PLATFORM_MAC) { if (strchr(name, ':') != NULL) separator = ':'; } split = FindSplitPos(name, &separator); if (split != len) { /* We have multiple pieces '~user/foo/bar...' */ name[split] = '\0'; } /* Do some tilde substitution */ if (name[1] == '\0') { /* We have just '~' */ CONST char *dir; Tcl_DString dirString; if (split != len) { name[split] = separator; } dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { if (interp) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't find HOME environment ", "variable to expand path", (char *) NULL); } return TCL_ERROR; } Tcl_DStringInit(&temp); Tcl_JoinPath(1, &dir, &temp); Tcl_DStringFree(&dirString); } else { /* We have a user name '~user' */ Tcl_DStringInit(&temp); if (TclpGetUserHome(name+1, &temp) == NULL) { if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "user \"", (name+1), "\" doesn't exist", (char *) NULL); } Tcl_DStringFree(&temp); if (split != len) { name[split] = separator; } return TCL_ERROR; } if (split != len) { name[split] = separator; } } expandedUser = Tcl_DStringValue(&temp); transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp)); if (split != len) { /* Join up the tilde substitution with the rest */ if (name[split+1] == separator) { /* * Somewhat tricky case like ~//foo/bar. * Make use of Split/Join machinery to get it right. * Assumes all paths beginning with ~ are part of the * native filesystem. Tcl_Filesystem* */ Tcl_FSGetFileSystemForPath(pathObjPtr) int objc; Tcl_Obj **objv; Tcl_Obj *parts = TclpNativeSplitPath(objPtr, NULL); Tcl_ListObjGetElements(NULL, parts, &objc, &objv); /* Skip '~'. It's replaced by its expansion */ objc--; objv++; while (objc--) { TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++)); } Tcl_DecrRefCount(parts); } else { /* Simple case. "rest" is relative path. Just join it. */ Tcl_Obj *rest = Tcl_NewStringObj(name+split+1,-1); transPtr = Tcl_FSJoinToPath(transPtr, 1, &rest); } } Tcl_DStringFree(&temp); } else { transPtr = Tcl_FSJoinToPath(objPtr,0,NULL); } /* * Now we have a translated filename in 'transPtr'. This will have * forward slashes on Windows, and will not contain any ~user * sequences. */ fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); fsPathPtr->translatedPathPtr = transPtr; Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); fsPathPtr->normPathPtr = NULL; fsPathPtr->flags = 0; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsRecPtr = NULL; fsPathPtr->filesystemEpoch = theFilesystemEpoch; /* * Free old representation before installing our new one. */ if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) { (objPtr->typePtr->freeIntRepProc)(objPtr); } objPtr->internalRep.otherValuePtr = (VOID *) fsPathPtr; objPtr->typePtr = &tclFsPathType; return TCL_OK; }  /* *--------------------------------------------------------------------------- * * Tcl_FSNewNativePath -- * * This function performs the something like that reverse of the * usual obj->path->nativerep conversions. If some code retrieves * a path in native form (from, e.g. readlink or a native dialog), * and that path is to be used at the Tcl level, then calling * this function is an efficient way of creating the appropriate * path object type. * * Any memory which is allocated for 'clientData' should be retained * until clientData is passed to the filesystem's freeInternalRepProc * when it can be freed. The built in platform-specific filesystems * use 'ckalloc' to allocate clientData, and ckfree to free it. * * Results: * NULL or a valid path object pointer, with refCount zero. * * Side effects: * New memory may be allocated. * *--------------------------------------------------------------------------- */ Tcl_Obj * Tcl_Obj* pathObjPtr; Tcl_FSNewNativePath(fromFilesystem, clientData) Tcl_Filesystem* fromFilesystem; ClientData clientData; { Tcl_Obj *objPtr; FsPath *fsPathPtr; FilesystemRecord *fsFromPtr; Tcl_FSInternalToNormalizedProc *proc; FilesystemRecord *fsRecPtr; Tcl_Filesystem* retVal = NULL; int epoch; fsFromPtr = GetFilesystemRecord(fromFilesystem, &epoch); /* if (fsFromPtr == NULL) { return NULL; } * If the object has a refCount of zero, we reject it. This proc = fsFromPtr->fsPtr->internalToNormalizedProc; * is to avoid possible segfaults or nondeterministic memory if (proc == NULL) { return NULL; } * leaks (i.e. the user doesn't know if they should decrement objPtr = (*proc)(clientData); if (objPtr == NULL) { return NULL; } * the ref count on return or not). /* * Free old representation; shouldn't normally be any, * but best to be safe. */ if (objPtr->typePtr != NULL) { if (objPtr->bytes == NULL) { if (objPtr->typePtr->updateStringProc == NULL) { return NULL; } objPtr->typePtr->updateStringProc(objPtr); } if ((objPtr->typePtr->freeIntRepProc) != NULL) { (*objPtr->typePtr->freeIntRepProc)(objPtr); } } fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); fsPathPtr->translatedPathPtr = NULL; /* Circular reference, by design */ fsPathPtr->normPathPtr = objPtr; fsPathPtr->flags = 0; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = clientData; fsPathPtr->fsRecPtr = fsFromPtr; /* We must increase the refCount for this filesystem. */ fsPathPtr->fsRecPtr->fileRefCount++; fsPathPtr->filesystemEpoch = epoch; objPtr->internalRep.otherValuePtr = (VOID *) fsPathPtr; objPtr->typePtr = &tclFsPathType; return objPtr; } static void FreeFsPathInternalRep(pathObjPtr) Tcl_Obj *pathObjPtr; /* Path object with internal rep to free. */ { register FsPath* fsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr; if (fsPathPtr->translatedPathPtr != NULL) { if (fsPathPtr->translatedPathPtr != pathObjPtr) { Tcl_DecrRefCount(fsPathPtr->translatedPathPtr); } } if (fsPathPtr->normPathPtr != NULL) { if (fsPathPtr->normPathPtr != pathObjPtr) { Tcl_DecrRefCount(fsPathPtr->normPathPtr); } fsPathPtr->normPathPtr = NULL; } if (fsPathPtr->cwdPtr != NULL) { Tcl_DecrRefCount(fsPathPtr->cwdPtr); } if (fsPathPtr->nativePathPtr != NULL) { if (fsPathPtr->fsRecPtr != NULL) { if (fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc != NULL) { (*fsPathPtr->fsRecPtr->fsPtr ->freeInternalRepProc)(fsPathPtr->nativePathPtr); fsPathPtr->nativePathPtr = NULL; } } } if (fsPathPtr->fsRecPtr != NULL) { fsPathPtr->fsRecPtr->fileRefCount--; if (fsPathPtr->fsRecPtr->fileRefCount <= 0) { /* It has been unregistered already */ ckfree((char *)fsPathPtr->fsRecPtr); } } if (pathObjPtr->refCount == 0) { ckfree((char*) fsPathPtr); } panic("Tcl_FSGetFileSystemForPath called with object with refCount == 0"); static void DupFsPathInternalRep(srcPtr, copyPtr) Tcl_Obj *srcPtr; /* Path obj with internal rep to copy. */ Tcl_Obj *copyPtr; /* Path obj with internal rep to set. */ { register FsPath* srcFsPathPtr = (FsPath*) srcPtr->internalRep.otherValuePtr; register FsPath* copyFsPathPtr = (FsPath*) ckalloc((unsigned)sizeof(FsPath)); Tcl_FSDupInternalRepProc *dupProc; return NULL; copyPtr->internalRep.otherValuePtr = (VOID *) copyFsPathPtr; } if (srcFsPathPtr->translatedPathPtr != NULL) { copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr; if (copyFsPathPtr->translatedPathPtr != copyPtr) { Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr); } } else { copyFsPathPtr->translatedPathPtr = NULL; } if (srcFsPathPtr->normPathPtr != NULL) { copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr; if (copyFsPathPtr->normPathPtr != copyPtr) { Tcl_IncrRefCount(copyFsPathPtr->normPathPtr); } } else { copyFsPathPtr->normPathPtr = NULL; } if (srcFsPathPtr->cwdPtr != NULL) { copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr; Tcl_IncrRefCount(copyFsPathPtr->cwdPtr); } else { copyFsPathPtr->cwdPtr = NULL; } copyFsPathPtr->flags = srcFsPathPtr->flags; if (srcFsPathPtr->fsRecPtr != NULL && srcFsPathPtr->nativePathPtr != NULL) { dupProc = srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc; if (dupProc != NULL) { copyFsPathPtr->nativePathPtr = (*dupProc)(srcFsPathPtr->nativePathPtr); } else { copyFsPathPtr->nativePathPtr = NULL; } } else { copyFsPathPtr->nativePathPtr = NULL; } copyFsPathPtr->fsRecPtr = srcFsPathPtr->fsRecPtr; copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch; if (copyFsPathPtr->fsRecPtr != NULL) { copyFsPathPtr->fsRecPtr->fileRefCount++; } copyPtr->typePtr = &tclFsPathType; }  /* /* *--------------------------------------------------------------------------- * * Tcl_FSGetTranslatedPath -- * * This function attempts to extract the translated path * from the given Tcl_Obj. If the translation succeeds (i.e. the * object is a valid path), then it is returned. Otherwise NULL * Check if the filesystem has changed in some way since * this object's internal representation was calculated. * will be returned, and an error message may be left in the * interpreter (if it is non-NULL) * * Results: * NULL or a valid Tcl_Obj pointer. * * Side effects: * Only those of 'Tcl_FSConvertToPathType' * *--------------------------------------------------------------------------- */ * Before doing that, assure we have the most up-to-date Tcl_Obj* Tcl_FSGetTranslatedPath(interp, pathPtr) Tcl_Interp *interp; Tcl_Obj* pathPtr; { register FsPath* srcFsPathPtr; if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { return NULL; } srcFsPathPtr = (FsPath*) pathPtr->internalRep.otherValuePtr; if (srcFsPathPtr->translatedPathPtr == NULL) { if (srcFsPathPtr->flags != 0) { return Tcl_FSGetNormalizedPath(interp, pathPtr); } /* * It is a pure absolute, normalized path object. * This is something like being a 'pure list'. The * copy of the master filesystem. This is accomplished * object's string, translatedPath and normalizedPath * are all identical. */ return srcFsPathPtr->normPathPtr; } else { /* It is an ordinary path object */ return srcFsPathPtr->translatedPathPtr; } }  * by the FsGetFirstFilesystem() call. /* *--------------------------------------------------------------------------- * */ * Tcl_FSGetTranslatedStringPath -- * * This function attempts to extract the translated path * from the given Tcl_Obj. If the translation succeeds (i.e. the * object is a valid path), then the path is returned. Otherwise NULL * will be returned, and an error message may be left in the * interpreter (if it is non-NULL) * * Results: * NULL or a valid string. * * Side effects: * Only those of 'Tcl_FSConvertToPathType' * *--------------------------------------------------------------------------- */ CONST char* Tcl_FSGetTranslatedStringPath(interp, pathPtr) Tcl_Interp *interp; Tcl_Obj* pathPtr; { Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (transPtr == NULL) { return NULL; } else { return Tcl_GetString(transPtr); } }  fsRecPtr = FsGetFirstFilesystem(); /* *--------------------------------------------------------------------------- * * Tcl_FSGetNormalizedPath -- * * This important function attempts to extract from the given Tcl_Obj * a unique normalised path representation, whose string value can * be used as a unique identifier for the file. * * Results: * NULL or a valid path object pointer. * * Side effects: * New memory may be allocated. The Tcl 'errno' may be modified * in the process of trying to examine various path possibilities. * *--------------------------------------------------------------------------- */ if (TclFSEnsureEpochOk(pathObjPtr, &retVal) != TCL_OK) { Tcl_Obj* Tcl_FSGetNormalizedPath(interp, pathObjPtr) Tcl_Interp *interp; Tcl_Obj* pathObjPtr; { register FsPath* fsPathPtr; if (Tcl_FSConvertToPathType(interp, pathObjPtr) != TCL_OK) { return NULL; } fsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr; if (fsPathPtr->flags != 0) { /* * This is a special path object which is the result of * something like 'file join' */ Tcl_Obj *dir, *copy; int cwdLen; int pathType; CONST char *cwdStr; pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr); if (dir == NULL) { return NULL; } if (pathObjPtr->bytes == NULL) { UpdateStringOfFsPath(pathObjPtr); } } copy = Tcl_DuplicateObj(dir); Tcl_IncrRefCount(copy); Tcl_IncrRefCount(dir); /* We now own a reference on both 'dir' and 'copy' */ cwdStr = Tcl_GetStringFromObj(copy, &cwdLen); /* /* * Should we perhaps use 'Tcl_FSPathSeparator'? * But then what about the Windows special case? * Perhaps we should just check if cwd is a root volume. * We should never get cwdLen == 0 in this code path. */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: if (cwdStr[cwdLen-1] != '/') { Tcl_AppendToObj(copy, "/", 1); cwdLen++; } break; case TCL_PLATFORM_WINDOWS: if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') { Tcl_AppendToObj(copy, "/", 1); cwdLen++; } break; case TCL_PLATFORM_MAC: if (cwdStr[cwdLen-1] != ':') { Tcl_AppendToObj(copy, ":", 1); cwdLen++; } break; } Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr); /* * Normalize the combined string, but only starting after * the end of the previously normalized 'dir'. This should * Call each of the "pathInFilesystem" functions in succession. A * be much faster! We use 'cwdLen-1' so that we are * already pointing at the dir-separator that we know about. * The normalization code will actually start off directly * after that separator. */ * non-return value of -1 indicates the particular function has * succeeded. */ TclNormalizeToUniquePath(interp, copy, cwdLen-1); /* Now we need to construct the new path object */ if (pathType == TCL_PATH_RELATIVE) { register FsPath* origDirFsPathPtr; Tcl_Obj *origDir = fsPathPtr->cwdPtr; origDirFsPathPtr = (FsPath*) origDir->internalRep.otherValuePtr; while ((retVal == NULL) && (fsRecPtr != NULL)) { fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr; Tcl_IncrRefCount(fsPathPtr->cwdPtr); Tcl_FSPathInFilesystemProc *proc = fsRecPtr->fsPtr->pathInFilesystemProc; Tcl_DecrRefCount(fsPathPtr->normPathPtr); fsPathPtr->normPathPtr = copy; /* That's our reference to copy used */ Tcl_DecrRefCount(dir); Tcl_DecrRefCount(origDir); } else { Tcl_DecrRefCount(fsPathPtr->cwdPtr); fsPathPtr->cwdPtr = NULL; Tcl_DecrRefCount(fsPathPtr->normPathPtr); fsPathPtr->normPathPtr = copy; /* That's our reference to copy used */ Tcl_DecrRefCount(dir); } fsPathPtr->flags = 0; } /* Ensure cwd hasn't changed */ if (fsPathPtr->cwdPtr != NULL) { if (proc != NULL) { if (!FsCwdPointerEquals(fsPathPtr->cwdPtr)) { if (pathObjPtr->bytes == NULL) { UpdateStringOfFsPath(pathObjPtr); } FreeFsPathInternalRep(pathObjPtr); pathObjPtr->typePtr = NULL; if (Tcl_ConvertToType(interp, pathObjPtr, &tclFsPathType) != TCL_OK) { return NULL; ClientData clientData = NULL; } fsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr; } else if (fsPathPtr->normPathPtr == NULL) { int cwdLen; Tcl_Obj *copy; CONST char *cwdStr; int ret = (*proc)(pathObjPtr, &clientData); copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr); Tcl_IncrRefCount(copy); cwdStr = Tcl_GetStringFromObj(copy, &cwdLen); /* * Should we perhaps use 'Tcl_FSPathSeparator'? * But then what about the Windows special case? * Perhaps we should just check if cwd is a root volume. * We should never get cwdLen == 0 in this code path. */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: if (cwdStr[cwdLen-1] != '/') { Tcl_AppendToObj(copy, "/", 1); cwdLen++; } break; case TCL_PLATFORM_WINDOWS: if (cwdStr[cwdLen-1] != '/' if (ret != -1) { && cwdStr[cwdLen-1] != '\\') { Tcl_AppendToObj(copy, "/", 1); cwdLen++; } break; case TCL_PLATFORM_MAC: if (cwdStr[cwdLen-1] != ':') { Tcl_AppendToObj(copy, ":", 1); cwdLen++; } break; } Tcl_AppendObjToObj(copy, pathObjPtr); /* /* * Normalize the combined string, but only starting after * the end of the previously normalized 'dir'. This should * be much faster! */ TclNormalizeToUniquePath(interp, copy, cwdLen-1); fsPathPtr->normPathPtr = copy; } } if (fsPathPtr->normPathPtr == NULL) { int relative = 0; /* * Since normPathPtr is NULL, but this is a valid path * object, we know that the translatedPathPtr cannot be NULL. */ Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr; char *path = Tcl_GetString(absolutePath); * We assume the type of pathObjPtr hasn't been changed /* * We have to be a little bit careful here to avoid infinite loops * we're asking Tcl_FSGetPathType to return the path's type, but * that call can actually result in a lot of other filesystem * by the above call to the pathInFilesystemProc. * action, which might loop back through here. */ */ if ((path[0] != '\0') && (Tcl_FSGetPathType(pathObjPtr) == TCL_PATH_RELATIVE)) { Tcl_Obj *cwd = Tcl_FSGetCwd(interp); TclFSSetPathDetails(pathObjPtr, fsRecPtr, clientData); if (cwd == NULL) { return NULL; } retVal = fsRecPtr->fsPtr; absolutePath = Tcl_FSJoinToPath(cwd, 1, &absolutePath); Tcl_IncrRefCount(absolutePath); Tcl_DecrRefCount(cwd); } relative = 1; } /* Already has refCount incremented */ fsPathPtr->normPathPtr = FSNormalizeAbsolutePath(interp, absolutePath); if (!strcmp(Tcl_GetString(fsPathPtr->normPathPtr), Tcl_GetString(pathObjPtr))) { /* * The path was already normalized. * Get rid of the duplicate. */ Tcl_DecrRefCount(fsPathPtr->normPathPtr); /* * We do *not* increment the refCount for * this circular reference */ fsPathPtr->normPathPtr = pathObjPtr; } if (relative) { /* This was returned by Tcl_FSJoinToPath above */ Tcl_DecrRefCount(absolutePath); fsRecPtr = fsRecPtr->nextPtr; /* Get a quick, temporary lock on the cwd while we copy it */ Tcl_MutexLock(&cwdMutex); fsPathPtr->cwdPtr = cwdPathPtr; Tcl_IncrRefCount(fsPathPtr->cwdPtr); Tcl_MutexUnlock(&cwdMutex); } } } return fsPathPtr->normPathPtr; }  /* *--------------------------------------------------------------------------- * * Tcl_FSGetInternalRep -- * * Extract the internal representation of a given path object, * in the given filesystem. If the path object belongs to a * different filesystem, we return NULL. * * If the internal representation is currently NULL, we attempt * to generate it, by calling the filesystem's * 'Tcl_FSCreateInternalRepProc'. * * Results: * NULL or a valid internal representation. * * Side effects: * An attempt may be made to convert the object. * *--------------------------------------------------------------------------- */ ClientData Tcl_FSGetInternalRep(pathObjPtr, fsPtr) Tcl_Obj* pathObjPtr; Tcl_Filesystem *fsPtr; { register FsPath* srcFsPathPtr; if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) { return NULL; return retVal; } srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr; /* * We will only return the native representation for the caller's * filesystem. Otherwise we will simply return NULL. This means * that there must be a unique bi-directional mapping between paths * and filesystems, and that this mapping will not allow 'remapped' * files -- files which are in one filesystem but mapped into * another. Another way of putting this is that 'stacked' * filesystems are not allowed. We recognise that this is a * potentially useful feature for the future. * * Even something simple like a 'pass through' filesystem which * logs all activity and passes the calls onto the native system * would be nice, but not easily achievable with the current * implementation. */ if (srcFsPathPtr->fsRecPtr == NULL) { /* * This only usually happens in wrappers like TclpStat which * create a string object and pass it to TclpObjStat. Code * which calls the Tcl_FS.. functions should always have a * filesystem already set. Whether this code path is legal or * not depends on whether we decide to allow external code to * call the native filesystem directly. It is at least safer * to allow this sub-optimal routing. */ Tcl_FSGetFileSystemForPath(pathObjPtr); /* * If we fail through here, then the path is probably not a * valid path in the filesystsem, and is most likely to be a * use of the empty path "" via a direct call to one of the * objectified interfaces (e.g. from the Tcl testsuite). */ srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr; if (srcFsPathPtr->fsRecPtr == NULL) { return NULL; } } if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) { /* * There is still one possibility we should consider; if the * file belongs to a different filesystem, perhaps it is * actually linked through to a file in our own filesystem * which we do care about. The way we can check for this * is we ask what filesystem this path belongs to. */ Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathObjPtr); if (actualFs == fsPtr) { return Tcl_FSGetInternalRep(pathObjPtr, fsPtr); } return NULL; } if (srcFsPathPtr->nativePathPtr == NULL) { Tcl_FSCreateInternalRepProc *proc; proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc; if (proc == NULL) { return NULL; } srcFsPathPtr->nativePathPtr = (*proc)(pathObjPtr); } return srcFsPathPtr->nativePathPtr; }  /* *--------------------------------------------------------------------------- * * Tcl_FSGetNativePath -- *
︙
5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 5028 5029 5030 5031 5032	4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047	+ + + - +	Tcl_DString ds; Tcl_Obj* validPathObjPtr; int len; char *str; /* Make sure the normalized path is set */ validPathObjPtr = Tcl_FSGetNormalizedPath(NULL, pathObjPtr); if (validPathObjPtr == NULL) { return NULL; } str = Tcl_GetStringFromObj(validPathObjPtr, &len); #ifdef __WIN32__ Tcl_WinUtfToTChar(str, len, &ds); if (tclWinProcs->useWide) { len = Tcl_DStringLength(&ds) + sizeof(WCHAR); } else { len = Tcl_DStringLength(&ds) + sizeof(char); } #else Tcl_UtfToExternalDString(NULL, str, len, &ds); len = Tcl_DStringLength(&ds) + sizeof(char); #endif nativePathPtr = ckalloc((unsigned) len); memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), (size_t) len); Tcl_DStringFree(&ds); return (ClientData)nativePathPtr; }  /* *--------------------------------------------------------------------------- *
︙
5084 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104 5105 5106 5107 5108 5109 5110 5111 5112	4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127	- + - - + +	return objPtr; }  /* *--------------------------------------------------------------------------- * * NativeDupInternalRep -- * TclNativeDupInternalRep -- * * Duplicate the native representation. * * Results: * The copied native representation, or NULL if it is not possible * to copy the representation. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static ClientData NativeDupInternalRep(clientData) ClientData TclNativeDupInternalRep(clientData) ClientData clientData; { ClientData copy; size_t len; if (clientData == NULL) { return NULL;
︙
5125 5126 5127 5128 5129 5130 5131 5132 5133 5134 5135 5136 5137 5138 5139 5140 5141 5142 5143 5144 5145 5146 5147 5148 5149 5150 5151 5152 5153 5154 5155 5156 5157 5158 5159 5160 5161 5162 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175	4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -	len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char)); #endif copy = (ClientData) ckalloc(len); memcpy((VOID*)copy, (VOID*)clientData, len); return copy; }  /* *--------------------------------------------------------------------------- * * NativePathInFilesystem -- * * Any path object is acceptable to the native filesystem, by * default (we will throw errors when illegal paths are actually * tried to be used). * * However, this behavior means the native filesystem must be * the last filesystem in the lookup list (otherwise it will * claim all files belong to it, and other filesystems will * never get a look in). * * Results: * TCL_OK, to indicate 'yes', -1 to indicate no. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static int NativePathInFilesystem(pathPtr, clientDataPtr) Tcl_Obj *pathPtr; ClientData *clientDataPtr; { int len; Tcl_GetStringFromObj(pathPtr,&len); if (len == 0) { return -1; } else { /* We accept any path as valid */ return TCL_OK; } }  /* *--------------------------------------------------------------------------- * * NativeFreeInternalRep -- * * Free a native internal representation, which will be non-NULL.
︙
5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 5338 5339 5340 5341 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 5359 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 5426 5427 5428 5429 5430 5431 5432 5433 5434 5435 5436 5437 5438 5439 5440 5441 5442 5443 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 5456 5457 5458 5459 5460 5461 5462 5463 5464 5465 5466 5467 5468 5469 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 5483 5484 5485 5486 5487 5488 5489 5490 5491 5492 5493 5494 5495 5496 5497 5498 5499 5500 5501 5502 5503 5504 5505 5506 5507 5508 5509	4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -	break; case TCL_PLATFORM_MAC: separator = ":"; break; } return Tcl_NewStringObj(separator,1); }  /* *--------------------------------------------------------------------------- * * Tcl_FSGetFileSystemForPath -- * * This function determines which filesystem to use for a * particular path object, and returns the filesystem which * accepts this file. If no filesystem will accept this object * as a valid file path, then NULL is returned. * * Results: .* NULL or a filesystem which will accept this path. * * Side effects: * The object may be converted to a path type. * *--------------------------------------------------------------------------- */ Tcl_Filesystem* Tcl_FSGetFileSystemForPath(pathObjPtr) Tcl_Obj* pathObjPtr; { FilesystemRecord *fsRecPtr; Tcl_Filesystem* retVal = NULL; FsPath* srcFsPathPtr; /* * If the object has a refCount of zero, we reject it. This * is to avoid possible segfaults or nondeterministic memory * leaks (i.e. the user doesn't know if they should decrement * the ref count on return or not). */ if (pathObjPtr->refCount == 0) { panic("Tcl_FSGetFileSystemForPath called with object with refCount == 0"); return NULL; } /* * This will ensure the pathObjPtr can be converted into a * "path" type, and that we are able to generate a complete * normalized path which is used to determine the filesystem * match. */ if (Tcl_FSGetNormalizedPath(NULL, pathObjPtr) == NULL) { return NULL; } /* * Get a lock on theFilesystemEpoch and the filesystemList * * While we don't need the fsRecPtr until the while loop below, we * do want to make sure the theFilesystemEpoch doesn't change * between the 'if' and 'while' blocks, getting this iterator will * ensure that everything is consistent */ fsRecPtr = FsGetIterator(); /* Make sure pathObjPtr is of the correct epoch */ srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr; /* * Check if the filesystem has changed in some way since * this object's internal representation was calculated. */ if (srcFsPathPtr->filesystemEpoch != theFilesystemEpoch) { /* * We have to discard the stale representation and * recalculate it */ if (pathObjPtr->bytes == NULL) { UpdateStringOfFsPath(pathObjPtr); } FreeFsPathInternalRep(pathObjPtr); pathObjPtr->typePtr = NULL; if (SetFsPathFromAny(NULL, pathObjPtr) != TCL_OK) { goto done; } srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr; } /* Check whether the object is already assigned to a fs */ if (srcFsPathPtr->fsRecPtr != NULL) { retVal = srcFsPathPtr->fsRecPtr->fsPtr; goto done; } /* * Call each of the "pathInFilesystem" functions in succession. A * non-return value of -1 indicates the particular function has * succeeded. */ while ((retVal == NULL) && (fsRecPtr != NULL)) { Tcl_FSPathInFilesystemProc *proc = fsRecPtr->fsPtr->pathInFilesystemProc; if (proc != NULL) { ClientData clientData = NULL; int ret = (*proc)(pathObjPtr, &clientData); if (ret != -1) { /* * We assume the srcFsPathPtr hasn't been changed * by the above call to the pathInFilesystemProc. */ srcFsPathPtr->fsRecPtr = fsRecPtr; srcFsPathPtr->nativePathPtr = clientData; srcFsPathPtr->filesystemEpoch = theFilesystemEpoch; fsRecPtr->fileRefCount++; retVal = fsRecPtr->fsPtr; } } fsRecPtr = fsRecPtr->nextPtr; } done: FsReleaseIterator(); return retVal; }  /* Simple helper function */ static FilesystemRecord* GetFilesystemRecord(fromFilesystem, epoch) Tcl_Filesystem *fromFilesystem; int *epoch; { FilesystemRecord *fsRecPtr = FsGetIterator(); while (fsRecPtr != NULL) { if (fsRecPtr->fsPtr == fromFilesystem) { *epoch = theFilesystemEpoch; break; } fsRecPtr = fsRecPtr->nextPtr; } FsReleaseIterator(); return fsRecPtr; }  /* *--------------------------------------------------------------------------- * * Tcl_FSEqualPaths -- * * This function tests whether the two paths given are equal path * objects. If either or both is NULL, 0 is always returned. * * Results: * 1 or 0. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int Tcl_FSEqualPaths(firstPtr, secondPtr) Tcl_Obj* firstPtr; Tcl_Obj* secondPtr; { if (firstPtr == secondPtr) { return 1; } else { char *firstStr, *secondStr; int firstLen, secondLen, tempErrno; if (firstPtr == NULL || secondPtr == NULL) { return 0; } firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) { return 1; } /* * Try the most thorough, correct method of comparing fully * normalized paths */ tempErrno = Tcl_GetErrno(); firstPtr = Tcl_FSGetNormalizedPath(NULL, firstPtr); secondPtr = Tcl_FSGetNormalizedPath(NULL, secondPtr); Tcl_SetErrno(tempErrno); if (firstPtr == NULL || secondPtr == NULL) { return 0; } firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) { return 1; } } return 0; } /* Everything from here on is contained in this obsolete ifdef */ #ifdef USE_OBSOLETE_FS_HOOKS  /* *---------------------------------------------------------------------- *
︙
5544 5545 5546 5547 5548 5549 5550 5551 5552 5553 5554 5555 5556 5557 5558	4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339	- +	statProcList = newStatProcPtr; Tcl_MutexUnlock(&obsoleteFsHookMutex); retVal = TCL_OK; } } return (retVal); return retVal; }  /* *---------------------------------------------------------------------- * * TclStatDeleteProc -- *
︙
5600 5601 5602 5603 5604 5605 5606 5607 5608 5609 5610 5611 5612 5613 5614	4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396	+ - +	} else { prevStatProcPtr = tmpStatProcPtr; tmpStatProcPtr = tmpStatProcPtr->nextPtr; } } Tcl_MutexUnlock(&obsoleteFsHookMutex); return (retVal); return retVal; }  /* *---------------------------------------------------------------------- * * TclAccessInsertProc -- *
︙
5648 5649 5650 5651 5652 5653 5654 5655 5656 5657 5658 5659 5660 5661 5662	4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444	- +	accessProcList = newAccessProcPtr; Tcl_MutexUnlock(&obsoleteFsHookMutex); retVal = TCL_OK; } } return (retVal); return retVal; }  /* *---------------------------------------------------------------------- * * TclAccessDeleteProc -- *
︙
5704 5705 5706 5707 5708 5709 5710 5711 5712 5713 5714 5715 5716 5717 5718	4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500	- +	} else { prevAccessProcPtr = tmpAccessProcPtr; tmpAccessProcPtr = tmpAccessProcPtr->nextPtr; } } Tcl_MutexUnlock(&obsoleteFsHookMutex); return (retVal); return retVal; }  /* *---------------------------------------------------------------------- * * TclOpenFileChannelInsertProc -- *
︙
5753 5754 5755 5756 5757 5758 5759 5760 5761 5762 5763 5764 5765 5766 5767	4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549	- +	openFileChannelProcList = newOpenFileChannelProcPtr; Tcl_MutexUnlock(&obsoleteFsHookMutex); retVal = TCL_OK; } } return (retVal); return retVal; }  /* *---------------------------------------------------------------------- * * TclOpenFileChannelDeleteProc -- *
︙
5811 5812 5813 5814 5815 5816 5817 5818 5819 5820	4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 5028 5029 5030 5031 5032 5033 5034 5035 5036 5037 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104 5105 5106 5107 5108 5109 5110 5111 5112 5113 5114 5115 5116 5117 5118 5119 5120 5121 5122 5123 5124 5125 5126 5127 5128 5129 5130 5131 5132 5133 5134 5135 5136 5137 5138 5139 5140 5141 5142 5143 5144 5145 5146 5147 5148 5149 5150 5151 5152 5153 5154 5155 5156 5157 5158 5159 5160 5161 5162 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 5211 5212 5213 5214 5215 5216 5217 5218 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248 5249 5250 5251 5252 5253 5254 5255 5256 5257 5258 5259 5260 5261 5262 5263 5264 5265 5266 5267 5268 5269 5270 5271 5272 5273 5274 5275 5276 5277 5278 5279 5280 5281 5282 5283 5284 5285 5286 5287 5288 5289 5290 5291 5292 5293 5294 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 5338 5339 5340 5341 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 5359 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 5426 5427 5428 5429 5430 5431 5432 5433 5434 5435 5436 5437 5438 5439 5440 5441 5442 5443 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 5456 5457 5458 5459 5460 5461 5462 5463 5464 5465 5466 5467 5468 5469 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 5483 5484 5485 5486 5487 5488 5489 5490 5491 5492 5493 5494 5495 5496 5497 5498 5499 5500 5501 5502 5503 5504 5505 5506 5507 5508 5509 5510 5511 5512 5513 5514 5515 5516 5517 5518 5519 5520 5521 5522 5523 5524 5525 5526 5527 5528 5529 5530 5531 5532 5533 5534 5535 5536 5537 5538 5539 5540 5541 5542 5543 5544 5545 5546 5547 5548 5549 5550 5551 5552 5553 5554 5555 5556 5557 5558 5559 5560 5561 5562 5563 5564 5565 5566 5567 5568 5569 5570 5571 5572 5573 5574 5575 5576 5577 5578 5579 5580 5581 5582 5583 5584 5585 5586 5587 5588 5589 5590 5591 5592 5593 5594 5595 5596 5597 5598 5599 5600 5601 5602 5603 5604 5605 5606 5607 5608 5609 5610 5611 5612 5613 5614 5615 5616 5617 5618 5619 5620 5621 5622 5623 5624 5625 5626 5627 5628 5629 5630 5631 5632 5633 5634 5635 5636 5637 5638 5639 5640 5641 5642 5643 5644 5645 5646 5647 5648 5649 5650 5651 5652 5653 5654 5655 5656 5657 5658 5659 5660 5661 5662 5663 5664 5665 5666 5667 5668 5669 5670 5671 5672 5673 5674 5675 5676 5677 5678 5679 5680 5681 5682 5683 5684 5685 5686 5687 5688 5689 5690 5691 5692 5693 5694 5695 5696 5697 5698 5699 5700 5701 5702 5703 5704 5705 5706 5707 5708 5709 5710 5711 5712 5713 5714 5715 5716 5717 5718 5719 5720 5721 5722 5723 5724 5725 5726 5727 5728 5729 5730 5731 5732 5733 5734 5735 5736 5737 5738 5739 5740 5741 5742 5743 5744 5745 5746 5747 5748 5749 5750 5751 5752 5753 5754 5755 5756 5757 5758 5759 5760 5761 5762 5763 5764 5765 5766 5767 5768 5769 5770 5771 5772 5773 5774 5775 5776 5777 5778 5779 5780 5781 5782 5783 5784 5785 5786 5787 5788 5789 5790 5791 5792 5793 5794 5795 5796 5797 5798 5799 5800 5801 5802 5803 5804 5805 5806 5807 5808 5809 5810 5811 5812 5813 5814 5815 5816 5817 5818 5819 5820 5821 5822 5823 5824 5825 5826 5827 5828 5829 5830 5831 5832 5833 5834 5835 5836 5837 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 5859 5860 5861 5862 5863 5864 5865 5866 5867 5868 5869 5870 5871 5872 5873 5874 5875 5876 5877 5878 5879 5880 5881 5882 5883 5884 5885 5886 5887 5888 5889 5890 5891 5892 5893 5894 5895 5896 5897 5898 5899 5900 5901 5902 5903 5904 5905 5906 5907 5908 5909 5910 5911 5912 5913 5914 5915 5916 5917 5918 5919 5920 5921 5922 5923 5924 5925 5926 5927 5928 5929 5930 5931 5932 5933 5934 5935 5936 5937 5938 5939 5940 5941 5942 5943 5944 5945 5946 5947 5948 5949 5950 5951 5952 5953 5954 5955 5956 5957 5958 5959 5960 5961 5962 5963 5964 5965 5966 5967 5968 5969 5970 5971 5972 5973 5974 5975 5976 5977 5978 5979 5980 5981 5982 5983 5984 5985 5986 5987 5988 5989 5990 5991 5992 5993 5994 5995 5996 5997 5998 5999 6000 6001 6002 6003 6004 6005 6006 6007 6008 6009 6010 6011 6012 6013 6014 6015 6016 6017 6018 6019 6020 6021 6022 6023 6024 6025 6026 6027 6028 6029 6030 6031 6032 6033 6034 6035 6036 6037 6038 6039 6040 6041 6042 6043 6044 6045 6046 6047 6048 6049 6050 6051 6052 6053 6054 6055 6056 6057 6058 6059 6060 6061 6062 6063 6064 6065 6066 6067 6068 6069 6070 6071 6072 6073 6074 6075 6076 6077 6078 6079 6080 6081 6082 6083 6084 6085 6086 6087 6088 6089 6090 6091 6092 6093 6094 6095 6096 6097 6098 6099 6100 6101 6102 6103 6104 6105 6106 6107 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 6118 6119 6120 6121 6122 6123 6124 6125 6126 6127 6128 6129 6130 6131 6132 6133 6134 6135 6136 6137 6138 6139 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 6157 6158 6159 6160 6161 6162 6163 6164 6165 6166 6167 6168 6169 6170 6171 6172 6173 6174 6175 6176 6177 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 6215 6216 6217 6218 6219 6220 6221 6222 6223 6224 6225 6226 6227 6228 6229 6230 6231 6232 6233 6234 6235 6236 6237 6238 6239 6240 6241 6242 6243 6244 6245 6246 6247 6248 6249 6250 6251 6252 6253 6254 6255 6256 6257 6258 6259 6260 6261 6262 6263 6264 6265 6266 6267 6268 6269 6270 6271 6272 6273 6274 6275 6276 6277 6278 6279 6280 6281 6282 6283 6284 6285 6286 6287 6288 6289 6290 6291 6292 6293 6294 6295 6296 6297 6298 6299 6300 6301 6302 6303 6304 6305 6306 6307 6308 6309 6310 6311 6312 6313 6314 6315 6316 6317 6318 6319 6320 6321 6322 6323 6324 6325 6326 6327 6328 6329 6330 6331 6332 6333 6334 6335 6336 6337 6338 6339 6340 6341 6342 6343 6344 6345 6346 6347 6348 6349 6350 6351 6352 6353 6354 6355 6356 6357 6358 6359 6360 6361 6362 6363 6364 6365 6366 6367 6368 6369 6370 6371 6372 6373 6374 6375 6376 6377 6378 6379 6380 6381 6382 6383 6384 6385 6386 6387 6388 6389 6390 6391 6392 6393 6394 6395 6396 6397 6398 6399 6400 6401 6402 6403 6404 6405 6406 6407 6408 6409 6410 6411 6412 6413 6414 6415 6416 6417 6418 6419 6420 6421 6422 6423 6424 6425 6426 6427 6428 6429 6430 6431 6432 6433 6434 6435 6436 6437 6438 6439 6440 6441 6442 6443 6444 6445 6446 6447 6448 6449 6450 6451 6452 6453 6454 6455 6456 6457 6458 6459 6460 6461 6462 6463 6464 6465	- + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	} else { prevOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr; tmpOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr->nextPtr; } } Tcl_MutexUnlock(&obsoleteFsHookMutex); return (retVal); return retVal; } #endif /* USE_OBSOLETE_FS_HOOKS */ /* * Prototypes for procedures defined later in this file. */ static void DupFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)); static void FreeFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr)); static void UpdateStringOfFsPath _ANSI_ARGS_((Tcl_Obj *objPtr)); static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static int FindSplitPos _ANSI_ARGS_((char *path, char *separator)); /* * Define the 'path' object type, which Tcl uses to represent * file paths internally. */ static Tcl_ObjType tclFsPathType = { "path", /* name */ FreeFsPathInternalRep, /* freeIntRepProc */ DupFsPathInternalRep, /* dupIntRepProc */ UpdateStringOfFsPath, /* updateStringProc */ SetFsPathFromAny /* setFromAnyProc */ }; /* * struct FsPath -- * * Internal representation of a Tcl_Obj of "path" type. This * can be used to represent relative or absolute paths, and has * certain optimisations when used to represent paths which are * already normalized and absolute. * * Note that 'normPathPtr' can be a circular reference to the * container Tcl_Obj of this FsPath. */ typedef struct FsPath { Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. * If this is NULL, then this is a * pure normalized, absolute path * object, in which the parent Tcl_Obj's * string rep is already both translated * and normalized. */ Tcl_Obj *normPathPtr; /* Normalized absolute path, without * ., .. or ~user sequences. If the * Tcl_Obj containing * this FsPath is already normalized, * this may be a circular reference back * to the container. If that is NOT the * case, we have a refCount on the object. */ Tcl_Obj *cwdPtr; /* If null, path is absolute, else * this points to the cwd object used * for this path. We have a refCount * on the object. */ int flags; /* Flags to describe interpretation */ ClientData nativePathPtr; /* Native representation of this path, * which is filesystem dependent. */ int filesystemEpoch; /* Used to ensure the path representation * was generated during the correct * filesystem epoch. The epoch changes * when filesystem-mounts are changed. */ struct FilesystemRecord *fsRecPtr; /* Pointer to the filesystem record * entry to use for this path. */ } FsPath; /* * Define some macros to give us convenient access to path-object * specific fields. */ #define PATHOBJ(objPtr) (objPtr->internalRep.otherValuePtr) #define PATHFLAGS(objPtr) \ (((FsPath*)(objPtr->internalRep.otherValuePtr))->flags) #define TCLPATH_APPENDED 1 #define TCLPATH_RELATIVE 2  /* *---------------------------------------------------------------------- * * Tcl_FSGetPathType -- * * Determines whether a given path is relative to the current * directory, relative to the current volume, or absolute. * * Results: * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or * TCL_PATH_VOLUME_RELATIVE. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_PathType Tcl_FSGetPathType(pathObjPtr) Tcl_Obj *pathObjPtr; { return FSGetPathType(pathObjPtr, NULL, NULL); }  /* *---------------------------------------------------------------------- * * FSGetPathType -- * * Determines whether a given path is relative to the current * directory, relative to the current volume, or absolute. If the * caller wishes to know which filesystem claimed the path (in the * case for which the path is absolute), then a reference to a * filesystem pointer can be passed in (but passing NULL is * acceptable). * * Results: * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or * TCL_PATH_VOLUME_RELATIVE. The filesystem reference will * be set if and only if it is non-NULL and the function's * return value is TCL_PATH_ABSOLUTE. * * Side effects: * None. * *---------------------------------------------------------------------- */ static Tcl_PathType FSGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr) Tcl_Obj *pathObjPtr; Tcl_Filesystem **filesystemPtrPtr; int *driveNameLengthPtr; { if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) { return GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, NULL); } else { FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); if (fsPathPtr->cwdPtr != NULL) { if (PATHFLAGS(pathObjPtr) == 0) { return TCL_PATH_RELATIVE; } return FSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, driveNameLengthPtr); } else { return GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, NULL); } } }  /* *--------------------------------------------------------------------------- * * Tcl_FSJoinPath -- * * This function takes the given Tcl_Obj, which should be a valid * list, and returns the path object given by considering the * first 'elements' elements as valid path segments. If elements < 0, * we use the entire list. * * Results: * Returns object with refCount of zero, (or if non-zero, it has * references elsewhere in Tcl). Either way, the caller must * increment its refCount before use. * * Side effects: * None. * *--------------------------------------------------------------------------- */ Tcl_Obj* Tcl_FSJoinPath(listObj, elements) Tcl_Obj *listObj; int elements; { Tcl_Obj *res; int i; Tcl_Filesystem *fsPtr = NULL; if (elements < 0) { if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) { return NULL; } } else { /* Just make sure it is a valid list */ int listTest; if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) { return NULL; } /* * Correct this if it is too large, otherwise we will * waste our time joining null elements to the path */ if (elements > listTest) { elements = listTest; } } res = Tcl_NewObj(); for (i = 0; i < elements; i++) { Tcl_Obj *elt; int driveNameLength; Tcl_PathType type; char *strElt; int strEltLen; int length; char *ptr; Tcl_Obj *driveName = NULL; Tcl_ListObjIndex(NULL, listObj, i, &elt); /* * This is a special case where we can be much more * efficient, where we are joining a single relative path * onto an object that is already of path type. The * 'TclNewFSPathObj' call below creates an object which * can be normalized more efficiently. Currently we only * use the special case when we have exactly two elements, * but we could expand that in the future. */ if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType) && !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) { Tcl_Obj *tail; Tcl_PathType type; Tcl_ListObjIndex(NULL, listObj, i+1, &tail); type = GetPathType(tail, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { CONST char *str; int len; str = Tcl_GetStringFromObj(tail,&len); if (len == 0) { /* * This happens if we try to handle the root volume * '/'. There's no need to return a special path * object, when the base itself is just fine! */ Tcl_DecrRefCount(res); return elt; } /* * If it doesn't begin with '.' and is a mac or unix * path or it a windows path without backslashes, then we * can be very efficient here. (In fact even a windows * path with backslashes can be joined efficiently, but * the path object would not have forward slashes only, * and this would therefore contradict our 'file join' * documentation). */ if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS) || (strchr(str, '\\') == NULL))) { /* * Finally, on Windows, 'file join' is defined to * convert all backslashes to forward slashes, * so the base part cannot have backslashes either. */ if ((tclPlatform != TCL_PLATFORM_WINDOWS) || (strchr(Tcl_GetString(elt), '\\') == NULL)) { if (res != NULL) { TclDecrRefCount(res); } return TclNewFSPathObj(elt, str, len); } } /* * Otherwise we don't have an easy join, and * we must let the more general code below handle * things */ } else { if (tclPlatform == TCL_PLATFORM_UNIX) { Tcl_DecrRefCount(res); return tail; } else { CONST char *str; int len; str = Tcl_GetStringFromObj(tail,&len); if (tclPlatform == TCL_PLATFORM_WINDOWS) { if (strchr(str, '\\') == NULL) { Tcl_DecrRefCount(res); return tail; } } else if (tclPlatform == TCL_PLATFORM_MAC) { if (strchr(str, '/') == NULL) { Tcl_DecrRefCount(res); return tail; } } } } } strElt = Tcl_GetStringFromObj(elt, &strEltLen); type = GetPathType(elt, &fsPtr, &driveNameLength, &driveName); if (type != TCL_PATH_RELATIVE) { /* Zero out the current result */ Tcl_DecrRefCount(res); if (driveName != NULL) { res = Tcl_DuplicateObj(driveName); Tcl_DecrRefCount(driveName); } else { res = Tcl_NewStringObj(strElt, driveNameLength); } strElt += driveNameLength; } ptr = Tcl_GetStringFromObj(res, &length); /* * Strip off any './' before a tilde, unless this is the * beginning of the path. */ if (length > 0 && strEltLen > 0) { if ((strElt[0] == '.') && (strElt[1] == '/') && (strElt[2] == '~')) { strElt += 2; } } /* * A NULL value for fsPtr at this stage basically means * we're trying to join a relative path onto something * which is also relative (or empty). There's nothing * particularly wrong with that. */ if (*strElt == '\0') continue; if (fsPtr == &tclNativeFilesystem || fsPtr == NULL) { TclpNativeJoinPath(res, strElt); } else { char separator = '/'; int needsSep = 0; if (fsPtr->filesystemSeparatorProc != NULL) { Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res); if (sep != NULL) { separator = Tcl_GetString(sep)[0]; } } if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); length++; } Tcl_SetObjLength(res, length + (int) strlen(strElt)); ptr = Tcl_GetString(res) + length; for (; *strElt != '\0'; strElt++) { if (*strElt == separator) { while (strElt[1] == separator) { strElt++; } if (strElt[1] != '\0') { if (needsSep) { *ptr++ = separator; } } } else { *ptr++ = *strElt; needsSep = 1; } } length = ptr - Tcl_GetString(res); Tcl_SetObjLength(res, length); } } return res; }  /* *--------------------------------------------------------------------------- * * Tcl_FSConvertToPathType -- * * This function tries to convert the given Tcl_Obj to a valid * Tcl path type, taking account of the fact that the cwd may * have changed even if this object is already supposedly of * the correct type. * * The filename may begin with "~" (to indicate current user's * home directory) or "~<user>" (to indicate any user's home * directory). * * Results: * Standard Tcl error code. * * Side effects: * The old representation may be freed, and new memory allocated. * *--------------------------------------------------------------------------- */ int Tcl_FSConvertToPathType(interp, objPtr) Tcl_Interp *interp; /* Interpreter in which to store error * message (if necessary). */ Tcl_Obj *objPtr; /* Object to convert to a valid, current * path type. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * While it is bad practice to examine an object's type directly, * this is actually the best thing to do here. The reason is that * if we are converting this object to FsPath type for the first * time, we don't need to worry whether the 'cwd' has changed. * On the other hand, if this object is already of FsPath type, * and is a relative path, we do have to worry about the cwd. * If the cwd has changed, we must recompute the path. */ if (objPtr->typePtr == &tclFsPathType) { FsPath *fsPathPtr = (FsPath*) PATHOBJ(objPtr); if (fsPathPtr->filesystemEpoch != tsdPtr->filesystemEpoch) { if (objPtr->bytes == NULL) { UpdateStringOfFsPath(objPtr); } FreeFsPathInternalRep(objPtr); objPtr->typePtr = NULL; return Tcl_ConvertToType(interp, objPtr, &tclFsPathType); } return TCL_OK; } else { return Tcl_ConvertToType(interp, objPtr, &tclFsPathType); } }  /* * Helper function for SetFsPathFromAny. Returns position of first * directory delimiter in the path. */ static int FindSplitPos(path, separator) char *path; char *separator; { int count = 0; switch (tclPlatform) { case TCL_PLATFORM_UNIX: case TCL_PLATFORM_MAC: while (path[count] != 0) { if (path[count] == *separator) { return count; } count++; } break; case TCL_PLATFORM_WINDOWS: while (path[count] != 0) { if (path[count] == *separator || path[count] == '\\') { return count; } count++; } break; } return count; }  /* *--------------------------------------------------------------------------- * * TclNewFSPathObj -- * * Creates a path object whose string representation is * '[file join dirPtr addStrRep]', but does so in a way that * allows for more efficient caching of normalized paths. * * Assumptions: * 'dirPtr' must be an absolute path. * 'len' may not be zero. * * Results: * The new Tcl object, with refCount zero. * * Side effects: * Memory is allocated. 'dirPtr' gets an additional refCount. * *--------------------------------------------------------------------------- */ Tcl_Obj* TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len) { FsPath *fsPathPtr; Tcl_Obj *objPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); objPtr = Tcl_NewObj(); fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); if (tclPlatform == TCL_PLATFORM_MAC) { /* * Mac relative paths may begin with a directory separator ':'. * If present, we need to skip this ':' because we assume that * we can join dirPtr and addStrRep by concatenating them as * strings (and we ensure that dirPtr is terminated by a ':'). */ if (addStrRep[0] == ':') { addStrRep++; len--; } } /* Setup the path */ fsPathPtr->translatedPathPtr = NULL; fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len); Tcl_IncrRefCount(fsPathPtr->normPathPtr); fsPathPtr->cwdPtr = dirPtr; Tcl_IncrRefCount(dirPtr); fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsRecPtr = NULL; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; PATHOBJ(objPtr) = (VOID *) fsPathPtr; PATHFLAGS(objPtr) = TCLPATH_RELATIVE | TCLPATH_APPENDED; objPtr->typePtr = &tclFsPathType; objPtr->bytes = NULL; objPtr->length = 0; return objPtr; }  /* *--------------------------------------------------------------------------- * * TclFSMakePathRelative -- * * Only for internal use. * * Takes a path and a directory, where we _assume_ both path and * directory are absolute, normalized and that the path lies * inside the directory. Returns a Tcl_Obj representing filename * of the path relative to the directory. * * In the case where the resulting path would start with a '~', we * take special care to return an ordinary string. This means to * use that path (and not have it interpreted as a user name), * one must prepend './'. This may seem strange, but that is how * 'glob' is currently defined. * * Results: * NULL on error, otherwise a valid object, typically with * refCount of zero, which it is assumed the caller will * increment. * * Side effects: * The old representation may be freed, and new memory allocated. * *--------------------------------------------------------------------------- */ Tcl_Obj* TclFSMakePathRelative(interp, objPtr, cwdPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr; /* The object we have. */ Tcl_Obj *cwdPtr; /* Make it relative to this. */ { int cwdLen, len; CONST char *tempStr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (objPtr->typePtr == &tclFsPathType) { FsPath *fsPathPtr = (FsPath*) PATHOBJ(objPtr); if (PATHFLAGS(objPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) { objPtr = fsPathPtr->normPathPtr; /* Free old representation */ if (objPtr->typePtr != NULL) { if (objPtr->bytes == NULL) { if (objPtr->typePtr->updateStringProc == NULL) { if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "can't find object", "string representation", (char *) NULL); } return NULL; } objPtr->typePtr->updateStringProc(objPtr); } if ((objPtr->typePtr->freeIntRepProc) != NULL) { (*objPtr->typePtr->freeIntRepProc)(objPtr); } } /* Now objPtr is a string object */ if (Tcl_GetString(objPtr)[0] == '~') { /* * If the first character of the path is a tilde, * we must just return the path as is, to agree * with the defined behaviour of 'glob'. */ return objPtr; } fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); /* Circular reference, by design */ fsPathPtr->translatedPathPtr = objPtr; fsPathPtr->normPathPtr = NULL; fsPathPtr->cwdPtr = cwdPtr; Tcl_IncrRefCount(cwdPtr); fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsRecPtr = NULL; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; PATHOBJ(objPtr) = (VOID *) fsPathPtr; PATHFLAGS(objPtr) = 0; objPtr->typePtr = &tclFsPathType; return objPtr; } } /* * We know the cwd is a normalised object which does * not end in a directory delimiter, unless the cwd * is the name of a volume, in which case it will * end in a delimiter! We handle this situation here. * A better test than the '!= sep' might be to simply * check if 'cwd' is a root volume. * * Note that if we get this wrong, we will strip off * either too much or too little below, leading to * wrong answers returned by glob. */ tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen); /* * Should we perhaps use 'Tcl_FSPathSeparator'? * But then what about the Windows special case? * Perhaps we should just check if cwd is a root * volume. */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: if (tempStr[cwdLen-1] != '/') { cwdLen++; } break; case TCL_PLATFORM_WINDOWS: if (tempStr[cwdLen-1] != '/' && tempStr[cwdLen-1] != '\\') { cwdLen++; } break; case TCL_PLATFORM_MAC: if (tempStr[cwdLen-1] != ':') { cwdLen++; } break; } tempStr = Tcl_GetStringFromObj(objPtr, &len); return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen); }  /* *--------------------------------------------------------------------------- * * TclFSMakePathFromNormalized -- * * Like SetFsPathFromAny, but assumes the given object is an * absolute normalized path. Only for internal use. * * Results: * Standard Tcl error code. * * Side effects: * The old representation may be freed, and new memory allocated. * *--------------------------------------------------------------------------- */ int TclFSMakePathFromNormalized(interp, objPtr, nativeRep) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr; /* The object to convert. */ ClientData nativeRep; /* The native rep for the object, if known * else NULL. */ { FsPath *fsPathPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (objPtr->typePtr == &tclFsPathType) { return TCL_OK; } /* Free old representation */ if (objPtr->typePtr != NULL) { if (objPtr->bytes == NULL) { if (objPtr->typePtr->updateStringProc == NULL) { if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "can't find object", "string representation", (char *) NULL); } return TCL_ERROR; } objPtr->typePtr->updateStringProc(objPtr); } if ((objPtr->typePtr->freeIntRepProc) != NULL) { (*objPtr->typePtr->freeIntRepProc)(objPtr); } } fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); /* It's a pure normalized absolute path */ fsPathPtr->translatedPathPtr = NULL; fsPathPtr->normPathPtr = objPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = nativeRep; fsPathPtr->fsRecPtr = NULL; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; PATHOBJ(objPtr) = (VOID *) fsPathPtr; PATHFLAGS(objPtr) = 0; objPtr->typePtr = &tclFsPathType; return TCL_OK; }  /* *--------------------------------------------------------------------------- * * Tcl_FSNewNativePath -- * * This function performs the something like that reverse of the * usual obj->path->nativerep conversions. If some code retrieves * a path in native form (from, e.g. readlink or a native dialog), * and that path is to be used at the Tcl level, then calling * this function is an efficient way of creating the appropriate * path object type. * * Any memory which is allocated for 'clientData' should be retained * until clientData is passed to the filesystem's freeInternalRepProc * when it can be freed. The built in platform-specific filesystems * use 'ckalloc' to allocate clientData, and ckfree to free it. * * Results: * NULL or a valid path object pointer, with refCount zero. * * Side effects: * New memory may be allocated. * *--------------------------------------------------------------------------- */ Tcl_Obj * Tcl_FSNewNativePath(fromFilesystem, clientData) Tcl_Filesystem* fromFilesystem; ClientData clientData; { Tcl_Obj *objPtr; FsPath *fsPathPtr; FilesystemRecord *fsFromPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); objPtr = TclFSInternalToNormalized(fromFilesystem, clientData, &fsFromPtr); if (objPtr == NULL) { return NULL; } /* * Free old representation; shouldn't normally be any, * but best to be safe. */ if (objPtr->typePtr != NULL) { if (objPtr->bytes == NULL) { if (objPtr->typePtr->updateStringProc == NULL) { return NULL; } objPtr->typePtr->updateStringProc(objPtr); } if ((objPtr->typePtr->freeIntRepProc) != NULL) { (*objPtr->typePtr->freeIntRepProc)(objPtr); } } fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); fsPathPtr->translatedPathPtr = NULL; /* Circular reference, by design */ fsPathPtr->normPathPtr = objPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = clientData; fsPathPtr->fsRecPtr = fsFromPtr; fsPathPtr->fsRecPtr->fileRefCount++; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; PATHOBJ(objPtr) = (VOID *) fsPathPtr; PATHFLAGS(objPtr) = 0; objPtr->typePtr = &tclFsPathType; return objPtr; }  /* *--------------------------------------------------------------------------- * * Tcl_FSGetTranslatedPath -- * * This function attempts to extract the translated path * from the given Tcl_Obj. If the translation succeeds (i.e. the * object is a valid path), then it is returned. Otherwise NULL * will be returned, and an error message may be left in the * interpreter (if it is non-NULL) * * Results: * NULL or a valid Tcl_Obj pointer. * * Side effects: * Only those of 'Tcl_FSConvertToPathType' * *--------------------------------------------------------------------------- */ Tcl_Obj* Tcl_FSGetTranslatedPath(interp, pathPtr) Tcl_Interp *interp; Tcl_Obj* pathPtr; { Tcl_Obj *retObj = NULL; FsPath *srcFsPathPtr; if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { return NULL; } srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); if (srcFsPathPtr->translatedPathPtr == NULL) { if (PATHFLAGS(pathPtr) != 0) { retObj = Tcl_FSGetNormalizedPath(interp, pathPtr); } else { /* * It is a pure absolute, normalized path object. * This is something like being a 'pure list'. The * object's string, translatedPath and normalizedPath * are all identical. */ retObj = srcFsPathPtr->normPathPtr; } } else { /* It is an ordinary path object */ retObj = srcFsPathPtr->translatedPathPtr; } if (retObj) { Tcl_IncrRefCount(retObj); } return retObj; }  /* *--------------------------------------------------------------------------- * * Tcl_FSGetTranslatedStringPath -- * * This function attempts to extract the translated path * from the given Tcl_Obj. If the translation succeeds (i.e. the * object is a valid path), then the path is returned. Otherwise NULL * will be returned, and an error message may be left in the * interpreter (if it is non-NULL) * * Results: * NULL or a valid string. * * Side effects: * Only those of 'Tcl_FSConvertToPathType' * *--------------------------------------------------------------------------- */ CONST char* Tcl_FSGetTranslatedStringPath(interp, pathPtr) Tcl_Interp *interp; Tcl_Obj* pathPtr; { Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (transPtr != NULL) { int len; CONST char *result, *orig; orig = Tcl_GetStringFromObj(transPtr, &len); result = (char*) ckalloc((unsigned)(len+1)); memcpy((VOID*) result, (VOID*) orig, (size_t) (len+1)); Tcl_DecrRefCount(transPtr); return result; } return NULL; }  /* *--------------------------------------------------------------------------- * * Tcl_FSGetNormalizedPath -- * * This important function attempts to extract from the given Tcl_Obj * a unique normalised path representation, whose string value can * be used as a unique identifier for the file. * * Results: * NULL or a valid path object pointer. * * Side effects: * New memory may be allocated. The Tcl 'errno' may be modified * in the process of trying to examine various path possibilities. * *--------------------------------------------------------------------------- */ Tcl_Obj* Tcl_FSGetNormalizedPath(interp, pathObjPtr) Tcl_Interp *interp; Tcl_Obj* pathObjPtr; { FsPath *fsPathPtr; if (Tcl_FSConvertToPathType(interp, pathObjPtr) != TCL_OK) { return NULL; } fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); if (PATHFLAGS(pathObjPtr) != 0) { /* * This is a special path object which is the result of * something like 'file join' */ Tcl_Obj *dir, *copy; int cwdLen; int pathType; CONST char *cwdStr; ClientData clientData = NULL; pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr); if (dir == NULL) { return NULL; } if (pathObjPtr->bytes == NULL) { UpdateStringOfFsPath(pathObjPtr); } copy = Tcl_DuplicateObj(dir); Tcl_IncrRefCount(copy); Tcl_IncrRefCount(dir); /* We now own a reference on both 'dir' and 'copy' */ cwdStr = Tcl_GetStringFromObj(copy, &cwdLen); /* * Should we perhaps use 'Tcl_FSPathSeparator'? * But then what about the Windows special case? * Perhaps we should just check if cwd is a root volume. * We should never get cwdLen == 0 in this code path. */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: if (cwdStr[cwdLen-1] != '/') { Tcl_AppendToObj(copy, "/", 1); cwdLen++; } break; case TCL_PLATFORM_WINDOWS: if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') { Tcl_AppendToObj(copy, "/", 1); cwdLen++; } break; case TCL_PLATFORM_MAC: if (cwdStr[cwdLen-1] != ':') { Tcl_AppendToObj(copy, ":", 1); cwdLen++; } break; } Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr); /* * Normalize the combined string, but only starting after * the end of the previously normalized 'dir'. This should * be much faster! We use 'cwdLen-1' so that we are * already pointing at the dir-separator that we know about. * The normalization code will actually start off directly * after that separator. */ TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); /* Now we need to construct the new path object */ if (pathType == TCL_PATH_RELATIVE) { FsPath* origDirFsPathPtr; Tcl_Obj *origDir = fsPathPtr->cwdPtr; origDirFsPathPtr = (FsPath*) PATHOBJ(origDir); fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr; Tcl_IncrRefCount(fsPathPtr->cwdPtr); Tcl_DecrRefCount(fsPathPtr->normPathPtr); fsPathPtr->normPathPtr = copy; /* That's our reference to copy used */ Tcl_DecrRefCount(dir); Tcl_DecrRefCount(origDir); } else { Tcl_DecrRefCount(fsPathPtr->cwdPtr); fsPathPtr->cwdPtr = NULL; Tcl_DecrRefCount(fsPathPtr->normPathPtr); fsPathPtr->normPathPtr = copy; /* That's our reference to copy used */ Tcl_DecrRefCount(dir); } if (clientData != NULL) { fsPathPtr->nativePathPtr = clientData; } PATHFLAGS(pathObjPtr) = 0; } /* Ensure cwd hasn't changed */ if (fsPathPtr->cwdPtr != NULL) { if (!TclFSCwdPointerEquals(fsPathPtr->cwdPtr)) { if (pathObjPtr->bytes == NULL) { UpdateStringOfFsPath(pathObjPtr); } FreeFsPathInternalRep(pathObjPtr); pathObjPtr->typePtr = NULL; if (Tcl_ConvertToType(interp, pathObjPtr, &tclFsPathType) != TCL_OK) { return NULL; } fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); } else if (fsPathPtr->normPathPtr == NULL) { int cwdLen; Tcl_Obj *copy; CONST char *cwdStr; ClientData clientData = NULL; copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr); Tcl_IncrRefCount(copy); cwdStr = Tcl_GetStringFromObj(copy, &cwdLen); /* * Should we perhaps use 'Tcl_FSPathSeparator'? * But then what about the Windows special case? * Perhaps we should just check if cwd is a root volume. * We should never get cwdLen == 0 in this code path. */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: if (cwdStr[cwdLen-1] != '/') { Tcl_AppendToObj(copy, "/", 1); cwdLen++; } break; case TCL_PLATFORM_WINDOWS: if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') { Tcl_AppendToObj(copy, "/", 1); cwdLen++; } break; case TCL_PLATFORM_MAC: if (cwdStr[cwdLen-1] != ':') { Tcl_AppendToObj(copy, ":", 1); cwdLen++; } break; } Tcl_AppendObjToObj(copy, pathObjPtr); /* * Normalize the combined string, but only starting after * the end of the previously normalized 'dir'. This should * be much faster! */ TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); fsPathPtr->normPathPtr = copy; if (clientData != NULL) { fsPathPtr->nativePathPtr = clientData; } } } if (fsPathPtr->normPathPtr == NULL) { ClientData clientData = NULL; Tcl_Obj *useThisCwd = NULL; /* * Since normPathPtr is NULL, but this is a valid path * object, we know that the translatedPathPtr cannot be NULL. */ Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr; char *path = Tcl_GetString(absolutePath); /* * We have to be a little bit careful here to avoid infinite loops * we're asking Tcl_FSGetPathType to return the path's type, but * that call can actually result in a lot of other filesystem * action, which might loop back through here. */ if (path[0] != '\0') { Tcl_PathType type = Tcl_FSGetPathType(pathObjPtr); if (type == TCL_PATH_RELATIVE) { useThisCwd = Tcl_FSGetCwd(interp); if (useThisCwd == NULL) return NULL; absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath); Tcl_IncrRefCount(absolutePath); /* We have a refCount on the cwd */ #ifdef __WIN32__ } else if (type == TCL_PATH_VOLUME_RELATIVE) { /* * Only Windows has volume-relative paths. These * paths are rather rare, but is is nice if Tcl can * handle them. It is much better if we can * handle them here, rather than in the native fs code, * because we really need to have a real absolute path * just below. * * We do not let this block compile on non-Windows * platforms because the test suite's manual forcing * of tclPlatform can otherwise cause this code path * to be executed, causing various errors because * volume-relative paths really do not exist. */ useThisCwd = Tcl_FSGetCwd(interp); if (useThisCwd == NULL) return NULL; if (path[0] == '/') { /* * Path of form /foo/bar which is a path in the * root directory of the current volume. */ CONST char *drive = Tcl_GetString(useThisCwd); absolutePath = Tcl_NewStringObj(drive,2); Tcl_AppendToObj(absolutePath, path, -1); Tcl_IncrRefCount(absolutePath); /* We have a refCount on the cwd */ } else { /* * Path of form C:foo/bar, but this only makes * sense if the cwd is also on drive C. */ CONST char *drive = Tcl_GetString(useThisCwd); char drive_c = path[0]; if (drive_c >= 'a') { drive_c -= ('a' - 'A'); } if (drive[0] == drive_c) { absolutePath = Tcl_DuplicateObj(useThisCwd); /* We have a refCount on the cwd */ } else { Tcl_DecrRefCount(useThisCwd); useThisCwd = NULL; /* * The path is not in the current drive, but * is volume-relative. The way Tcl 8.3 handles * this is that it treats such a path as * relative to the root of the drive. We * therefore behave the same here. */ absolutePath = Tcl_NewStringObj(path, 2); } Tcl_IncrRefCount(absolutePath); Tcl_AppendToObj(absolutePath, "/", 1); Tcl_AppendToObj(absolutePath, path+2, -1); } #endif /* __WIN32__ */ } } /* Already has refCount incremented */ fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, absolutePath, (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); if (0 && (clientData != NULL)) { fsPathPtr->nativePathPtr = (*fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc)(clientData); } if (!strcmp(Tcl_GetString(fsPathPtr->normPathPtr), Tcl_GetString(pathObjPtr))) { /* * The path was already normalized. * Get rid of the duplicate. */ Tcl_DecrRefCount(fsPathPtr->normPathPtr); /* * We do *not* increment the refCount for * this circular reference */ fsPathPtr->normPathPtr = pathObjPtr; } if (useThisCwd != NULL) { /* This was returned by Tcl_FSJoinToPath above */ Tcl_DecrRefCount(absolutePath); fsPathPtr->cwdPtr = useThisCwd; } } return fsPathPtr->normPathPtr; }  /* *--------------------------------------------------------------------------- * * Tcl_FSGetInternalRep -- * * Extract the internal representation of a given path object, * in the given filesystem. If the path object belongs to a * different filesystem, we return NULL. * * If the internal representation is currently NULL, we attempt * to generate it, by calling the filesystem's * 'Tcl_FSCreateInternalRepProc'. * * Results: * NULL or a valid internal representation. * * Side effects: * An attempt may be made to convert the object. * *--------------------------------------------------------------------------- */ ClientData Tcl_FSGetInternalRep(pathObjPtr, fsPtr) Tcl_Obj* pathObjPtr; Tcl_Filesystem *fsPtr; { FsPath *srcFsPathPtr; if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) { return NULL; } srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); /* * We will only return the native representation for the caller's * filesystem. Otherwise we will simply return NULL. This means * that there must be a unique bi-directional mapping between paths * and filesystems, and that this mapping will not allow 'remapped' * files -- files which are in one filesystem but mapped into * another. Another way of putting this is that 'stacked' * filesystems are not allowed. We recognise that this is a * potentially useful feature for the future. * * Even something simple like a 'pass through' filesystem which * logs all activity and passes the calls onto the native system * would be nice, but not easily achievable with the current * implementation. */ if (srcFsPathPtr->fsRecPtr == NULL) { /* * This only usually happens in wrappers like TclpStat which * create a string object and pass it to TclpObjStat. Code * which calls the Tcl_FS.. functions should always have a * filesystem already set. Whether this code path is legal or * not depends on whether we decide to allow external code to * call the native filesystem directly. It is at least safer * to allow this sub-optimal routing. */ Tcl_FSGetFileSystemForPath(pathObjPtr); /* * If we fail through here, then the path is probably not a * valid path in the filesystsem, and is most likely to be a * use of the empty path "" via a direct call to one of the * objectified interfaces (e.g. from the Tcl testsuite). */ srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); if (srcFsPathPtr->fsRecPtr == NULL) { return NULL; } } if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) { /* * There is still one possibility we should consider; if the * file belongs to a different filesystem, perhaps it is * actually linked through to a file in our own filesystem * which we do care about. The way we can check for this * is we ask what filesystem this path belongs to. */ Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathObjPtr); if (actualFs == fsPtr) { return Tcl_FSGetInternalRep(pathObjPtr, fsPtr); } return NULL; } if (srcFsPathPtr->nativePathPtr == NULL) { Tcl_FSCreateInternalRepProc *proc; char *nativePathPtr; proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc; if (proc == NULL) { return NULL; } nativePathPtr = (*proc)(pathObjPtr); srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); srcFsPathPtr->nativePathPtr = nativePathPtr; } return srcFsPathPtr->nativePathPtr; }  /* *--------------------------------------------------------------------------- * * TclFSEnsureEpochOk -- * * This will ensure the pathObjPtr is up to date and can be * converted into a "path" type, and that we are able to generate a * complete normalized path which is used to determine the * filesystem match. * * Results: * Standard Tcl return code. * * Side effects: * An attempt may be made to convert the object. * *--------------------------------------------------------------------------- */ int TclFSEnsureEpochOk(pathObjPtr, fsPtrPtr) Tcl_Obj* pathObjPtr; Tcl_Filesystem **fsPtrPtr; { FsPath *srcFsPathPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * SHOULD BE ABLE TO IMPROVE EFFICIENCY HERE. */ if (Tcl_FSGetNormalizedPath(NULL, pathObjPtr) == NULL) { return TCL_ERROR; } srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); /* * Check if the filesystem has changed in some way since * this object's internal representation was calculated. */ if (srcFsPathPtr->filesystemEpoch != tsdPtr->filesystemEpoch) { /* * We have to discard the stale representation and * recalculate it */ if (pathObjPtr->bytes == NULL) { UpdateStringOfFsPath(pathObjPtr); } FreeFsPathInternalRep(pathObjPtr); pathObjPtr->typePtr = NULL; if (SetFsPathFromAny(NULL, pathObjPtr) != TCL_OK) { return TCL_ERROR; } srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); } /* Check whether the object is already assigned to a fs */ if (srcFsPathPtr->fsRecPtr != NULL) { *fsPtrPtr = srcFsPathPtr->fsRecPtr->fsPtr; } return TCL_OK; }  void TclFSSetPathDetails(pathObjPtr, fsRecPtr, clientData) Tcl_Obj *pathObjPtr; FilesystemRecord *fsRecPtr; ClientData clientData; { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* We assume pathObjPtr is already of the correct type */ FsPath *srcFsPathPtr; srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); srcFsPathPtr->fsRecPtr = fsRecPtr; srcFsPathPtr->nativePathPtr = clientData; srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; fsRecPtr->fileRefCount++; }  /* *--------------------------------------------------------------------------- * * Tcl_FSEqualPaths -- * * This function tests whether the two paths given are equal path * objects. If either or both is NULL, 0 is always returned. * * Results: * 1 or 0. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int Tcl_FSEqualPaths(firstPtr, secondPtr) Tcl_Obj* firstPtr; Tcl_Obj* secondPtr; { if (firstPtr == secondPtr) { return 1; } else { char *firstStr, *secondStr; int firstLen, secondLen, tempErrno; if (firstPtr == NULL || secondPtr == NULL) { return 0; } firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) { return 1; } /* * Try the most thorough, correct method of comparing fully * normalized paths */ tempErrno = Tcl_GetErrno(); firstPtr = Tcl_FSGetNormalizedPath(NULL, firstPtr); secondPtr = Tcl_FSGetNormalizedPath(NULL, secondPtr); Tcl_SetErrno(tempErrno); if (firstPtr == NULL || secondPtr == NULL) { return 0; } firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) { return 1; } } return 0; }  /* *--------------------------------------------------------------------------- * * SetFsPathFromAny -- * * This function tries to convert the given Tcl_Obj to a valid * Tcl path type. * * The filename may begin with "~" (to indicate current user's * home directory) or "~<user>" (to indicate any user's home * directory). * * Results: * Standard Tcl error code. * * Side effects: * The old representation may be freed, and new memory allocated. * *--------------------------------------------------------------------------- */ static int SetFsPathFromAny(interp, objPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr; /* The object to convert. */ { int len; FsPath *fsPathPtr; Tcl_Obj *transPtr; char *name; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (objPtr->typePtr == &tclFsPathType) { return TCL_OK; } /* * First step is to translate the filename. This is similar to * Tcl_TranslateFilename, but shouldn't convert everything to * windows backslashes on that platform. The current * implementation of this piece is a slightly optimised version * of the various Tilde/Split/Join stuff to avoid multiple * split/join operations. * * We remove any trailing directory separator. * * However, the split/join routines are quite complex, and * one has to make sure not to break anything on Unix, Win * or MacOS (fCmd.test, fileName.test and cmdAH.test exercise * most of the code). */ name = Tcl_GetStringFromObj(objPtr,&len); /* * Handle tilde substitutions, if needed. */ if (name[0] == '~') { char *expandedUser; Tcl_DString temp; int split; char separator='/'; if (tclPlatform==TCL_PLATFORM_MAC) { if (strchr(name, ':') != NULL) separator = ':'; } split = FindSplitPos(name, &separator); if (split != len) { /* We have multiple pieces '~user/foo/bar...' */ name[split] = '\0'; } /* Do some tilde substitution */ if (name[1] == '\0') { /* We have just '~' */ CONST char *dir; Tcl_DString dirString; if (split != len) { name[split] = separator; } dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { if (interp) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't find HOME environment ", "variable to expand path", (char *) NULL); } return TCL_ERROR; } Tcl_DStringInit(&temp); Tcl_JoinPath(1, &dir, &temp); Tcl_DStringFree(&dirString); } else { /* We have a user name '~user' */ Tcl_DStringInit(&temp); if (TclpGetUserHome(name+1, &temp) == NULL) { if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "user \"", (name+1), "\" doesn't exist", (char *) NULL); } Tcl_DStringFree(&temp); if (split != len) { name[split] = separator; } return TCL_ERROR; } if (split != len) { name[split] = separator; } } expandedUser = Tcl_DStringValue(&temp); transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp)); if (split != len) { /* Join up the tilde substitution with the rest */ if (name[split+1] == separator) { /* * Somewhat tricky case like ~//foo/bar. * Make use of Split/Join machinery to get it right. * Assumes all paths beginning with ~ are part of the * native filesystem. */ int objc; Tcl_Obj **objv; Tcl_Obj *parts = TclpNativeSplitPath(objPtr, NULL); Tcl_ListObjGetElements(NULL, parts, &objc, &objv); /* Skip '~'. It's replaced by its expansion */ objc--; objv++; while (objc--) { TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++)); } Tcl_DecrRefCount(parts); } else { /* Simple case. "rest" is relative path. Just join it. */ Tcl_Obj *rest = Tcl_NewStringObj(name+split+1,-1); transPtr = Tcl_FSJoinToPath(transPtr, 1, &rest); } } Tcl_DStringFree(&temp); } else { transPtr = Tcl_FSJoinToPath(objPtr,0,NULL); } #if defined(__CYGWIN__) && defined(__WIN32__) { extern int cygwin_conv_to_win32_path _ANSI_ARGS_((CONST char *, char *)); char winbuf[MAX_PATH+1]; /* * In the Cygwin world, call conv_to_win32_path in order to use the * mount table to translate the file name into something Windows will * understand. Take care when converting empty strings! */ name = Tcl_GetStringFromObj(transPtr, &len); if (len > 0) { cygwin_conv_to_win32_path(name, winbuf); TclWinNoBackslash(winbuf); Tcl_SetStringObj(transPtr, winbuf, -1); } } #endif /* __CYGWIN__ && __WIN32__ */ /* * Now we have a translated filename in 'transPtr'. This will have * forward slashes on Windows, and will not contain any ~user * sequences. */ fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); fsPathPtr->translatedPathPtr = transPtr; Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); fsPathPtr->normPathPtr = NULL; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsRecPtr = NULL; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; /* * Free old representation before installing our new one. */ if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) { (objPtr->typePtr->freeIntRepProc)(objPtr); } PATHOBJ(objPtr) = (VOID *) fsPathPtr; PATHFLAGS(objPtr) = 0; objPtr->typePtr = &tclFsPathType; return TCL_OK; }  static void FreeFsPathInternalRep(pathObjPtr) Tcl_Obj *pathObjPtr; /* Path object with internal rep to free. */ { FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); if (fsPathPtr->translatedPathPtr != NULL) { if (fsPathPtr->translatedPathPtr != pathObjPtr) { Tcl_DecrRefCount(fsPathPtr->translatedPathPtr); } } if (fsPathPtr->normPathPtr != NULL) { if (fsPathPtr->normPathPtr != pathObjPtr) { Tcl_DecrRefCount(fsPathPtr->normPathPtr); } fsPathPtr->normPathPtr = NULL; } if (fsPathPtr->cwdPtr != NULL) { Tcl_DecrRefCount(fsPathPtr->cwdPtr); } if (fsPathPtr->nativePathPtr != NULL) { if (fsPathPtr->fsRecPtr != NULL) { if (fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc != NULL) { (*fsPathPtr->fsRecPtr->fsPtr ->freeInternalRepProc)(fsPathPtr->nativePathPtr); fsPathPtr->nativePathPtr = NULL; } } } if (fsPathPtr->fsRecPtr != NULL) { fsPathPtr->fsRecPtr->fileRefCount--; if (fsPathPtr->fsRecPtr->fileRefCount <= 0) { /* It has been unregistered already, so simply free it */ ckfree((char *)fsPathPtr->fsRecPtr); } } ckfree((char*) fsPathPtr); }  static void DupFsPathInternalRep(srcPtr, copyPtr) Tcl_Obj *srcPtr; /* Path obj with internal rep to copy. */ Tcl_Obj *copyPtr; /* Path obj with internal rep to set. */ { FsPath *srcFsPathPtr = (FsPath*) PATHOBJ(srcPtr); FsPath *copyFsPathPtr = (FsPath*) ckalloc((unsigned)sizeof(FsPath)); Tcl_FSDupInternalRepProc *dupProc; PATHOBJ(copyPtr) = (VOID *) copyFsPathPtr; if (srcFsPathPtr->translatedPathPtr != NULL) { copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr; if (copyFsPathPtr->translatedPathPtr != copyPtr) { Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr); } } else { copyFsPathPtr->translatedPathPtr = NULL; } if (srcFsPathPtr->normPathPtr != NULL) { copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr; if (copyFsPathPtr->normPathPtr != copyPtr) { Tcl_IncrRefCount(copyFsPathPtr->normPathPtr); } } else { copyFsPathPtr->normPathPtr = NULL; } if (srcFsPathPtr->cwdPtr != NULL) { copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr; Tcl_IncrRefCount(copyFsPathPtr->cwdPtr); } else { copyFsPathPtr->cwdPtr = NULL; } copyFsPathPtr->flags = srcFsPathPtr->flags; if (srcFsPathPtr->fsRecPtr != NULL && srcFsPathPtr->nativePathPtr != NULL) { dupProc = srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc; if (dupProc != NULL) { copyFsPathPtr->nativePathPtr = (*dupProc)(srcFsPathPtr->nativePathPtr); } else { copyFsPathPtr->nativePathPtr = NULL; } } else { copyFsPathPtr->nativePathPtr = NULL; } copyFsPathPtr->fsRecPtr = srcFsPathPtr->fsRecPtr; copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch; if (copyFsPathPtr->fsRecPtr != NULL) { copyFsPathPtr->fsRecPtr->fileRefCount++; } copyPtr->typePtr = &tclFsPathType; }  /* *--------------------------------------------------------------------------- * * UpdateStringOfFsPath -- * * Gives an object a valid string rep. * * Results: * None. * * Side effects: * Memory may be allocated. * *--------------------------------------------------------------------------- */ static void UpdateStringOfFsPath(objPtr) register Tcl_Obj *objPtr; /* path obj with string rep to update. */ { FsPath *fsPathPtr = (FsPath*) PATHOBJ(objPtr); CONST char *cwdStr; int cwdLen; Tcl_Obj *copy; if (PATHFLAGS(objPtr) == 0 || fsPathPtr->cwdPtr == NULL) { panic("Called UpdateStringOfFsPath with invalid object"); } copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr); Tcl_IncrRefCount(copy); cwdStr = Tcl_GetStringFromObj(copy, &cwdLen); /* * Should we perhaps use 'Tcl_FSPathSeparator'? * But then what about the Windows special case? * Perhaps we should just check if cwd is a root volume. * We should never get cwdLen == 0 in this code path. */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: if (cwdStr[cwdLen-1] != '/') { Tcl_AppendToObj(copy, "/", 1); cwdLen++; } break; case TCL_PLATFORM_WINDOWS: /* * We need the extra 'cwdLen != 2', and ':' checks because * a volume relative path doesn't get a '/'. For example * 'glob C:*cat*.exe' will return 'C:cat32.exe' */ if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') { if (cwdLen != 2 || cwdStr[1] != ':') { Tcl_AppendToObj(copy, "/", 1); cwdLen++; } } break; case TCL_PLATFORM_MAC: if (cwdStr[cwdLen-1] != ':') { Tcl_AppendToObj(copy, ":", 1); cwdLen++; } break; } Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr); objPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen); objPtr->length = cwdLen; copy->bytes = tclEmptyStringRep; copy->length = 0; Tcl_DecrRefCount(copy); }  /* *--------------------------------------------------------------------------- * * NativePathInFilesystem -- * * Any path object is acceptable to the native filesystem, by * default (we will throw errors when illegal paths are actually * tried to be used). * * However, this behavior means the native filesystem must be * the last filesystem in the lookup list (otherwise it will * claim all files belong to it, and other filesystems will * never get a look in). * * Results: * TCL_OK, to indicate 'yes', -1 to indicate no. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static int NativePathInFilesystem(pathPtr, clientDataPtr) Tcl_Obj *pathPtr; ClientData *clientDataPtr; { /* * A special case is required to handle the empty path "". * This is a valid path (i.e. the user should be able * to do 'file exists ""' without throwing an error), but * equally the path doesn't exist. Those are the semantics * of Tcl (at present anyway), so we have to abide by them * here. */ if (pathPtr->typePtr == &tclFsPathType) { if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') { /* We reject the empty path "" */ return -1; } /* Otherwise there is no way this path can be empty */ } else { /* * It is somewhat unusual to reach this code path without * the object being of tclFsPathType. However, we do * our best to deal with the situation. */ int len; Tcl_GetStringFromObj(pathPtr,&len); if (len == 0) { /* We reject the empty path "" */ return -1; } } /* * Path is of correct type, or is of non-zero length, * so we accept it. */ return TCL_OK; }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclIndexObj.c -- * * This file implements objects of type "index". This object type * is used to lookup a keyword in a table of valid values and cache * the index of the matching entry. * * Copyright (c) 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. * * RCS: @(#) $Id: tclIndexObj.c,v 1.16 2002/02/28 05:11:25 dgp Exp $ * RCS: @(#) $Id: tclIndexObj.c,v 1.16.2.5 2006/04/06 18:57:24 dgp Exp $ */ #include "tclInt.h" #include "tclPort.h" /* * Prototypes for procedures defined later in this file:
︙
167 168 169 170 171 172 173 174 175 176 177 178 179 180 181	167 168 169 170 171 172 173 174 175 176 177 178 179 180 181	- +	* etc. The last entry must be NULL * and there must not be duplicate entries. */ int offset; /* The number of bytes between entries */ CONST char *msg; /* Identifying word to use in error messages. */ int flags; /* 0 or TCL_EXACT */ int *indexPtr; /* Place to store resulting integer index. */ { int index, length, i, numAbbrev; int index, i, numAbbrev; char *key, *p1; CONST char *p2; CONST char * CONST *entryPtr; Tcl_Obj *resultPtr; IndexRep *indexRep; /*
︙
191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216	191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208	- + - - - - - - - -	} /* * Lookup the value of the object in the table. Accept unique * abbreviations unless TCL_EXACT is set in flags. */ key = Tcl_GetStringFromObj(objPtr, &length); key = TclGetString(objPtr); index = -1; numAbbrev = 0; /* * The key should not be empty, otherwise it's not a match. */ if (key[0] == '\0') { goto error; } /* * Scan the table looking for one of: * - An exact match (always preferred) * - A single abbreviation (allowed depending on flags) * - Several abbreviations (never allowed, but overridden by exact match) */ for (entryPtr = tablePtr, i = 0; *entryPtr != NULL;
︙
231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247	223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239	- + - +	*/ numAbbrev++; index = i; } } /* * Check if we were instructed to disallow abbreviations. * Check if we were instructed to disallow abbreviations. */ if ((flags & TCL_EXACT) || (numAbbrev != 1)) { if ((flags & TCL_EXACT) || (key[0] == '\0') || (numAbbrev != 1)) { goto error; } done: /* * Cache the found representation. Note that we want to avoid * allocating a new internal-rep if at all possible since that is
︙
267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283	259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277	+ + - - - + + +	error: if (interp != NULL) { /* * Produce a fancy error message. */ int count; TclNewObj(resultPtr); resultPtr = Tcl_GetObjResult(interp); Tcl_AppendStringsToObj(resultPtr, (numAbbrev > 1) ? "ambiguous " : "bad ", msg, " \"", Tcl_SetObjResult(interp, resultPtr); Tcl_AppendStringsToObj(resultPtr, (numAbbrev > 1) && !(flags & TCL_EXACT) ? "ambiguous " : "bad ", msg, " \"", key, "\": must be ", STRING_AT(tablePtr,offset,0), (char*)NULL); for (entryPtr = NEXT_ENTRY(tablePtr, offset), count = 0; *entryPtr != NULL; entryPtr = NEXT_ENTRY(entryPtr, offset), count++) { if (*NEXT_ENTRY(entryPtr, offset) == NULL) { Tcl_AppendStringsToObj(resultPtr, (count > 0) ? ", or " : " or ", *entryPtr,
︙
446 447 448 449 450 451 452 453 454 455 456 457 458 459 460	440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455	+ - +	* leading objects in objv. The * message may be NULL. */ { Tcl_Obj *objPtr; int i; register IndexRep *indexRep; TclNewObj(objPtr); objPtr = Tcl_GetObjResult(interp); Tcl_SetObjResult(interp, objPtr); Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1); for (i = 0; i < objc; i++) { /* * If the object is an index type use the index table which allows * for the correct error message even if the subcommand was * abbreviated. Otherwise, just use the string rep. */
︙

︙
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	- +	# # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: tclInt.decls,v 1.59 2003/02/18 02:25:45 hobbs Exp $ # RCS: @(#) $Id: tclInt.decls,v 1.59.2.7 2007/04/21 19:52:14 kennykb Exp $ library tcl # Define the unsupported generic interfaces. interface tclInt
︙
120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135	120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135	- - + +	void TclFreePackageInfo(Interp *iPtr) } # Removed in 8.1: # declare 26 generic { # char * TclGetCwd(Tcl_Interp *interp) # } declare 27 generic { int TclGetDate(char *p, unsigned long now, long zone, unsigned long *timePtr) int TclGetDate(char *p, Tcl_WideInt now, long zone, Tcl_WideInt *timePtr) } declare 28 generic { Tcl_Channel TclpGetDefaultStdChannel(int type) } # Removed in 8.4b2: #declare 29 generic { # Tcl_Obj * TclGetElementOfIndexedArray(Tcl_Interp *interp,
︙
308 309 310 311 312 313 314 315 316 317 318 319 320 321 322	308 309 310 311 312 313 314 315 316 317 318 319 320 321 322	- +	# deprecated declare 77 generic { void TclpGetTime(Tcl_Time *time) } declare 78 generic { int TclpGetTimeZone(unsigned long time) int TclpGetTimeZone(Tcl_WideInt time) } # Replaced by Tcl_FSListVolumes in 8.4: #declare 79 generic { # int TclpListVolumes(Tcl_Interp *interp) #} # Replaced by Tcl_FSOpenFileChannel in 8.4: #declare 80 generic {
︙
692 693 694 695 696 697 698 699 700 701 702 703 704 705	692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718	+ + + + + + + + + + + + +	# added for 8.4.2 declare 173 generic { int TclUniCharMatch (CONST Tcl_UniChar *string, int strLen, \ CONST Tcl_UniChar *pattern, int ptnLen, int nocase) } # TclpGmtime and TclpLocaltime promoted to the generic interface from unix declare 182 generic { struct tm *TclpLocaltime(TclpTime_t_CONST clock) } declare 183 generic { struct tm *TclpGmtime(TclpTime_t_CONST clock) } declare 199 generic { int TclMatchIsTrivial(CONST char *pattern) } ############################################################################## # Define the platform specific internal Tcl interface. These functions are # only available on the designated platform. interface tclIntPlat
︙
923 924 925 926 927 928 929 930 931 932 933 934 935 936	936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953	+ + + +	} # Added in 8.4.2 declare 28 win { void TclWinResetInterfaces(void) } declare 29 win { int TclWinCPUID( unsigned int index, unsigned int *regs ) } ######################### # Unix specific internals # Pipe channel functions declare 0 unix {
︙
972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991	989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011	+ + + - + - +	} # Added in 8.4: declare 10 unix { Tcl_DirEntry * TclpReaddir(DIR * dir) } # Slots 11 and 12 are forwarders for functions that were promoted to # generic Stubs declare 11 unix { struct tm * TclpLocaltime(time_t * clock) struct tm * TclpLocaltime_unix(TclpTime_t_CONST clock) } declare 12 unix { struct tm * TclpGmtime(time_t * clock) struct tm * TclpGmtime_unix(TclpTime_t_CONST clock) } declare 13 unix { char * TclpInetNtoa(struct in_addr addr) }

︙
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	- +	* Copyright (c) 1994-1998 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 2001, 2002 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclInt.h,v 1.118 2003/02/10 10:26:25 vincentdarley Exp $ * RCS: @(#) $Id: tclInt.h,v 1.118.2.28 2007/05/10 21:32:17 dgp Exp $ */ #ifndef _TCLINT #define _TCLINT /* * Common include files needed by most of the Tcl source files are
︙
47 48 49 50 51 52 53 54 55 56 57 58 59 60	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	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	#endif #ifdef NO_STRING_H #include "../compat/string.h" #else #include <string.h> #endif /* * Ensure WORDS_BIGENDIAN is defined correcly: * Needs to happen here in addition to configure to work with fat compiles on * Darwin (where configure runs only once for multiple architectures). */ #ifdef HAVE_SYS_TYPES_H # include <sys/types.h> #endif #ifdef HAVE_SYS_PARAM_H # include <sys/param.h> #endif #ifdef BYTE_ORDER # ifdef BIG_ENDIAN # if BYTE_ORDER == BIG_ENDIAN # undef WORDS_BIGENDIAN # define WORDS_BIGENDIAN # endif # endif # ifdef LITTLE_ENDIAN # if BYTE_ORDER == LITTLE_ENDIAN # undef WORDS_BIGENDIAN # endif # endif #endif /* * Used to tag functions that are only to be visible within the module being * built and not outside it (where this is supported by the linker). */ #ifndef MODULE_SCOPE # ifdef __cplusplus # define MODULE_SCOPE extern "C" # else # define MODULE_SCOPE extern # endif #endif #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl # define TCL_STORAGE_CLASS DLLEXPORT #else # ifdef USE_TCL_STUBS # define TCL_STORAGE_CLASS # else
︙
227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244	266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286	+ + +	* namespace and no call frames still refer to it. Its * variables and command have already been destroyed. This bit * allows the namespace resolution code to recognize that the * namespace is "deleted". When the last namespaceName object * in any byte code code unit that refers to the namespace has * been freed (i.e., when the namespace's refCount is 0), the * namespace's storage will be freed. * NS_KILLED 1 means that TclTeardownNamespace has already been called on * this namespace and it should not be called again [Bug 1355942] */ #define NS_DYING 0x01 #define NS_DEAD 0x02 #define NS_KILLED 0x04 /* * Flag passed to TclGetNamespaceForQualName to have it create all namespace * components of a namespace-qualified name that cannot be found. The new * namespaces are created within their specified parent. Note that this * flag's value must not conflict with the values of the flags * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, and FIND_ONLY_NS (defined in
︙
307 308 309 310 311 312 313 314 315 316 317 318 319 320	349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364	+ +	/* Next in list of all active command * traces for the interpreter, or NULL * if no more. */ CommandTrace *nextTracePtr; /* Next trace to check after current * trace procedure returns; if this * trace gets deleted, must update pointer * to avoid using free'd memory. */ int reverseScan; /* Boolean set true when the traces * are scanning in reverse order. */ } ActiveCommandTrace; /* * When a variable trace is active (i.e. its associated procedure is * executing), one of the following structures is linked into a list * associated with the variable's interpreter. The information in * the structure is needed in order for Tcl to behave reasonably
︙
680 681 682 683 684 685 686 687 688 689 690 691 692 693	724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739	+ +	/* Next in list of all active command * traces for the interpreter, or NULL * if no more. */ Trace *nextTracePtr; /* Next trace to check after current * trace procedure returns; if this * trace gets deleted, must update pointer * to avoid using free'd memory. */ int reverseScan; /* Boolean set true when the traces * are scanning in reverse order. */ } ActiveInterpTrace; /* * The structure below defines an entry in the assocData hash table which * is associated with an interpreter. The entry contains a pointer to a * function to call when the interpreter is deleted, and a pointer to * a user-defined piece of data.
︙
753 754 755 756 757 758 759 760 761 762 763 764 765 766	799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	int numCompiledLocals; /* Count of local variables recognized by * the compiler including arguments. */ Var* compiledLocals; /* Points to the array of local variables * recognized by the compiler. The compiler * emits code that refers to these variables * using an index into this array. */ } CallFrame; #ifdef TCL_TIP280 /* * TIP #280 * The structure below defines a command frame. A command frame * provides location information for all commands executing a tcl * script (source, eval, uplevel, procedure bodies, ...). The runtime * structure essentially contains the stack trace as it would be if * the currently executing command were to throw an error. * * For commands where it makes sense it refers to the associated * CallFrame as well. * * The structures are chained in a single list, with the top of the * stack anchored in the Interp structure. * * Instances can be allocated on the C stack, or the heap, the former * making cleanup a bit simpler. */ typedef struct CmdFrame { /* General data. Always available. */ int type; /* Values see below */ int level; /* #Frames in stack, prevent O(n) scan of list */ int* line; /* Lines the words of the command start on */ int nline; CallFrame* framePtr; /* Procedure activation record, may be NULL */ struct CmdFrame* nextPtr; /* Link to calling frame */ /* Data needed for Eval vs TEBC * * EXECUTION CONTEXTS and usage of CmdFrame * * Field TEBC EvalEx EvalObjEx * ======= ==== ====== ========= * level yes yes yes * type BC/PREBC SRC/EVAL EVAL_LIST * line0 yes yes yes * framePtr yes yes yes * ======= ==== ====== ========= * * ======= ==== ====== ========= union data * line1 - yes - * line3 - yes - * path - yes - * ------- ---- ------ --------- * codePtr yes - - * pc yes - - * ======= ==== ====== ========= * * ======= ==== ====== ========= | union cmd * listPtr - - yes | * ------- ---- ------ --------- | * cmd yes yes - | * cmdlen yes yes - | * ------- ---- ------ --------- | */ union { struct { Tcl_Obj* path; /* Path of the sourced file the command * is in. */ } eval; struct { CONST void* codePtr; /* Byte code currently executed */ CONST char* pc; /* and instruction pointer. */ } tebc; } data; union { struct { CONST char* cmd; /* The executed command, if possible */ int len; /* And its length */ } str; Tcl_Obj* listPtr; /* Tcl_EvalObjEx, cmd list */ } cmd; } CmdFrame; /* The following macros define the allowed values for the type field * of the CmdFrame structure above. Some of the values occur only in * the extended location data referenced via the 'baseLocPtr'. * * TCL_LOCATION_EVAL : Frame is for a script evaluated by EvalEx. * TCL_LOCATION_EVAL_LIST : Frame is for a script evaluated by the list * optimization path of EvalObjEx. * TCL_LOCATION_BC : Frame is for bytecode. * TCL_LOCATION_PREBC : Frame is for precompiled bytecode. * TCL_LOCATION_SOURCE : Frame is for a script evaluated by EvalEx, * from a sourced file. * TCL_LOCATION_PROC : Frame is for bytecode of a procedure. * * A TCL_LOCATION_BC type in a frame can be overridden by _SOURCE and * _PROC types, per the context of the byte code in execution. */ #define TCL_LOCATION_EVAL (0) /* Location in a dynamic eval script */ #define TCL_LOCATION_EVAL_LIST (1) /* Location in a dynamic eval script, list-path */ #define TCL_LOCATION_BC (2) /* Location in byte code */ #define TCL_LOCATION_PREBC (3) /* Location in precompiled byte code, no location */ #define TCL_LOCATION_SOURCE (4) /* Location in a file */ #define TCL_LOCATION_PROC (5) /* Location in a dynamic proc */ #define TCL_LOCATION_LAST (6) /* Number of values in the enum */ #endif /* *---------------------------------------------------------------- * Data structures and procedures related to TclHandles, which * are a very lightweight method of preserving enough information * to determine if an arbitrary malloc'd block has been deleted. *----------------------------------------------------------------
︙
1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124	1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288	+ + + + + + + + + + +	/* Procedure handling variable name * resolution at compile time. */ struct ResolverScheme *nextPtr; /* Pointer to next record in linked list. */ } ResolverScheme; #ifdef TCL_TIP268 /* * TIP #268. * Values for the selection mode, i.e the package require preferences. */ enum PkgPreferOptions { PKG_PREFER_LATEST, PKG_PREFER_STABLE }; #endif /* *---------------------------------------------------------------- * This structure defines an interpreter, which is a collection of * commands plus other state information related to interpreting * commands, such as variable storage. Primary responsibility for * this data structure is in tclBasic.c, but almost every Tcl * source file uses something in here.
︙
1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315	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	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	ActiveInterpTrace *activeInterpTracePtr; /* First in list of active traces for * interp, or NULL if no active traces. */ int tracesForbiddingInline; /* Count of traces (in the list headed by * tracePtr) that forbid inline bytecode * compilation */ #ifdef TCL_TIP280 /* TIP #280 */ CmdFrame* cmdFramePtr; /* Points to the command frame containing * the location information for the current * command. */ CONST CmdFrame* invokeCmdFramePtr; /* Points to the command frame which is the * invoking context of the bytecode compiler. * NULL when the byte code compiler is not * active */ int invokeWord; /* Index of the word in the command which * is getting compiled. */ Tcl_HashTable* linePBodyPtr; /* This table remembers for each * statically defined procedure the * location information for its * body. It is keyed by the address of * the Proc structure for a procedure. */ Tcl_HashTable* lineBCPtr; /* This table remembers for each * ByteCode object the location * information for its body. It is * keyed by the address of the Proc * structure for a procedure. */ #endif #ifdef TCL_TIP268 /* * TIP #268. * The currently active selection mode, * i.e the package require preferences. */ int packagePrefer; /* Current package selection mode. */ #endif /* * Statistical information about the bytecode compiler and interpreter's * operation. */ #ifdef TCL_COMPILE_STATS ByteCodeStats stats; /* Holds compilation and execution
︙
1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338	1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541	+ + + +	* TCL_ALLOW_EXCEPTIONS 1 means it's OK for the script to terminate with * a code other than TCL_OK or TCL_ERROR; 0 means * codes other than these should be turned into errors. */ #define TCL_BRACKET_TERM 1 #define TCL_ALLOW_EXCEPTIONS 4 #ifdef TCL_TIP280 #define TCL_EVAL_FILE 2 #define TCL_EVAL_CTX 8 #endif /* * Flag bits for Interp structures: * * DELETED: Non-zero means the interpreter has been deleted: * don't process any more commands for it, and destroy * the structure as soon as all nested invocations of
︙
1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419	1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -	#define ERROR_CODE_SET 8 #define EXPR_INITIALIZED 0x10 #define DONT_COMPILE_CMDS_INLINE 0x20 #define RAND_SEED_INITIALIZED 0x40 #define SAFE_INTERP 0x80 #define USE_EVAL_DIRECT 0x100 #define INTERP_TRACE_IN_PROGRESS 0x200 /* *---------------------------------------------------------------- * Data structures related to command parsing. These are used in * tclParse.c and its clients. *---------------------------------------------------------------- */ /* * The following data structure is used by various parsing procedures * to hold information about where to store the results of parsing * (e.g. the substituted contents of a quoted argument, or the result * of a nested command). At any given time, the space available * for output is fixed, but a procedure may be called to expand the * space available if the current space runs out. */ typedef struct ParseValue { char *buffer; /* Address of first character in * output buffer. */ char *next; /* Place to store next character in * output buffer. */ char *end; /* Address of the last usable character * in the buffer. */ void (*expandProc) _ANSI_ARGS_((struct ParseValue *pvPtr, int needed)); /* Procedure to call when space runs out; * it will make more space. */ ClientData clientData; /* Arbitrary information for use of * expandProc. */ } ParseValue; /* * Maximum number of levels of nesting permitted in Tcl commands (used * to catch infinite recursion). */ #define MAX_NESTING_DEPTH 1000
︙
1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539	1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712	+	typedef struct TclFile_ *TclFile; /* * Opaque names for platform specific types. */ typedef struct TclpTime_t_ *TclpTime_t; typedef struct TclpTime_t_ *CONST TclpTime_t_CONST; /* * The "globParameters" argument of the function TclGlob is an * or'ed combination of the following values: */ #define TCL_GLOBMODE_NO_COMPLAIN 1
︙
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	1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778	+ - -	extern int tclBlockTimeSet; extern char * tclExecutableName; extern char * tclNativeExecutableName; extern char * tclDefaultEncodingDir; extern Tcl_ChannelType tclFileChannelType; extern char * tclMemDumpFileName; extern TclPlatformType tclPlatform; extern Tcl_NotifierProcs tclOriginalNotifier; /* * Variables denoting the Tcl object types defined in the core. */ extern Tcl_ObjType tclBooleanType; extern Tcl_ObjType tclByteArrayType; extern Tcl_ObjType tclByteCodeType; extern Tcl_ObjType tclDoubleType; extern Tcl_ObjType tclEndOffsetType; extern Tcl_ObjType tclIntType; extern Tcl_ObjType tclListType; extern Tcl_ObjType tclProcBodyType; extern Tcl_ObjType tclStringType; extern Tcl_ObjType tclArraySearchType; extern Tcl_ObjType tclIndexType; extern Tcl_ObjType tclNsNameType; #ifndef TCL_WIDE_INT_IS_LONG extern Tcl_ObjType tclWideIntType; #endif /* * Variables denoting the hash key types defined in the core. */ extern Tcl_HashKeyType tclArrayHashKeyType; extern Tcl_HashKeyType tclOneWordHashKeyType;
︙
1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678	1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871	+ + + + + + + + + + + + + + - + + - + + + - + + + + +	/* *---------------------------------------------------------------- * Procedures shared among Tcl modules but not used by the outside * world: *---------------------------------------------------------------- */ #ifdef TCL_TIP280 EXTERN void TclAdvanceLines _ANSI_ARGS_((int* line, CONST char* start, CONST char* end)); #endif EXTERN int TclArraySet _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj)); EXTERN int TclCheckBadOctal _ANSI_ARGS_((Tcl_Interp *interp, CONST char *value)); EXTERN void TclDeleteNamespaceVars _ANSI_ARGS_((Namespace *nsPtr)); #ifdef TCL_TIP280 EXTERN int TclEvalObjEx _ANSI_ARGS_((Tcl_Interp *interp, register Tcl_Obj *objPtr, int flags, CONST CmdFrame* invoker, int word)); #endif EXTERN void TclExpandTokenArray _ANSI_ARGS_(( Tcl_Parse *parsePtr)); EXTERN int TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int TclFileCopyCmd _ANSI_ARGS_((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) ; EXTERN int TclFileDeleteCmd _ANSI_ARGS_((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int TclFileMakeDirsCmd _ANSI_ARGS_((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) ; EXTERN int TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) ; EXTERN void TclFinalizeAllocSubsystem _ANSI_ARGS_((void)); EXTERN void TclFinalizeCompExecEnv _ANSI_ARGS_((void)); EXTERN void TclFinalizeAsync _ANSI_ARGS_((void)); EXTERN void TclFinalizeCompilation _ANSI_ARGS_((void)); EXTERN void TclFinalizeEncodingSubsystem _ANSI_ARGS_((void)); EXTERN void TclFinalizeEnvironment _ANSI_ARGS_((void)); EXTERN void TclFinalizeExecution _ANSI_ARGS_((void)); EXTERN void TclFinalizeIOSubsystem _ANSI_ARGS_((void)); EXTERN void TclFinalizeFilesystem _ANSI_ARGS_((void)); EXTERN void TclResetFilesystem _ANSI_ARGS_((void)); EXTERN void TclFinalizeLoad _ANSI_ARGS_((void)); EXTERN void TclFinalizeLock _ANSI_ARGS_((void)); EXTERN void TclFinalizeMemorySubsystem _ANSI_ARGS_((void)); EXTERN void TclFinalizeNotifier _ANSI_ARGS_((void)); EXTERN void TclFinalizeAsync _ANSI_ARGS_((void)); EXTERN void TclFinalizeObjects _ANSI_ARGS_((void)); EXTERN void TclFinalizePreserve _ANSI_ARGS_((void)); EXTERN void TclFinalizeSynchronization _ANSI_ARGS_((void)); EXTERN void TclFinalizeThreadAlloc _ANSI_ARGS_((void)); EXTERN void TclFinalizeThreadData _ANSI_ARGS_((void)); EXTERN void TclFindEncodings _ANSI_ARGS_((CONST char *argv0)); EXTERN int TclGetEncodingFromObj _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr)); #ifdef TCL_TIP280 EXTERN void TclGetSrcInfoForPc _ANSI_ARGS_((CmdFrame* cfPtr)); #endif EXTERN int TclGlob _ANSI_ARGS_((Tcl_Interp *interp, char *pattern, Tcl_Obj *unquotedPrefix, int globFlags, Tcl_GlobTypeData* types)); EXTERN void TclInitAlloc _ANSI_ARGS_((void)); EXTERN void TclInitDbCkalloc _ANSI_ARGS_((void)); EXTERN void TclInitEncodingSubsystem _ANSI_ARGS_((void)); EXTERN void TclInitIOSubsystem _ANSI_ARGS_((void));
︙
1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741	1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939	+ + + + + - +	int numBytes, int *readPtr, char *dst)); EXTERN int TclParseHex _ANSI_ARGS_((CONST char *src, int numBytes, Tcl_UniChar *resultPtr)); EXTERN int TclParseInteger _ANSI_ARGS_((CONST char *string, int numBytes)); EXTERN int TclParseWhiteSpace _ANSI_ARGS_((CONST char *src, int numBytes, Tcl_Parse *parsePtr, char *typePtr)); #ifdef TCL_TIP280 EXTERN int TclWordKnownAtCompileTime _ANSI_ARGS_((Tcl_Token* token)); #endif EXTERN int TclpObjAccess _ANSI_ARGS_((Tcl_Obj *filename, int mode)); EXTERN int TclpObjLstat _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf)); EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void)); EXTERN Tcl_Obj* TclpTempFileName _ANSI_ARGS_((void)); EXTERN Tcl_Obj* TclNewFSPathObj _ANSI_ARGS_((Tcl_Obj *dirPtr, CONST char *addStrRep, int len)); EXTERN int TclpDeleteFile _ANSI_ARGS_((CONST char *path)); EXTERN void TclpFinalizeCondition _ANSI_ARGS_(( Tcl_Condition *condPtr)); EXTERN void TclpFinalizeMutex _ANSI_ARGS_((Tcl_Mutex *mutexPtr)); EXTERN void TclpFinalizePipes _ANSI_ARGS_((void)); EXTERN void TclpFinalizeSockets _ANSI_ARGS_((void)); EXTERN void TclpFinalizeThreadData _ANSI_ARGS_(( Tcl_ThreadDataKey *keyPtr)); EXTERN void TclpFinalizeThreadDataKey _ANSI_ARGS_(( Tcl_ThreadDataKey *keyPtr)); EXTERN char * TclpFindExecutable _ANSI_ARGS_(( CONST char *argv0)); EXTERN int TclpFindVariable _ANSI_ARGS_((CONST char *name, int *lengthPtr)); EXTERN void TclpInitLibraryPath _ANSI_ARGS_((CONST char *argv0)); EXTERN int TclpInitLibraryPath _ANSI_ARGS_((CONST char *argv0)); EXTERN void TclpInitLock _ANSI_ARGS_((void)); EXTERN void TclpInitPlatform _ANSI_ARGS_((void)); EXTERN void TclpInitUnlock _ANSI_ARGS_((void)); EXTERN int TclpLoadFile _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *sym1, CONST char *sym2, Tcl_PackageInitProc **proc1Ptr,
︙
1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805	1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007	+ - - + + + + +	int recursive, Tcl_Obj **errorPtr)); EXTERN int TclpObjRenameFile _ANSI_ARGS_((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)); EXTERN int TclpMatchInDirectory _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types)); EXTERN Tcl_Obj* TclpObjGetCwd _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN Tcl_FSDupInternalRepProc TclNativeDupInternalRep; EXTERN Tcl_Obj* TclpObjLink _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkType)); EXTERN int TclpObjChdir _ANSI_ARGS_((Tcl_Obj *pathPtr)); EXTERN Tcl_Obj* TclFileDirname _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj*pathPtr)); EXTERN int TclpObjStat _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf)); EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions)); EXTERN void TclpCutFileChannel _ANSI_ARGS_((Tcl_Channel chan)); EXTERN void TclpSpliceFileChannel _ANSI_ARGS_((Tcl_Channel chan)); EXTERN void TclpPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *, format)); EXTERN char * TclpReadlink _ANSI_ARGS_((CONST char *fileName, Tcl_DString *linkPtr)); EXTERN void TclpReleaseFile _ANSI_ARGS_((TclFile file)); EXTERN void TclpSetVariables _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN void TclpUnloadFile _ANSI_ARGS_((Tcl_LoadHandle loadHandle)); EXTERN VOID * TclpThreadDataKeyGet _ANSI_ARGS_(( Tcl_ThreadDataKey *keyPtr)); EXTERN void TclpThreadDataKeyInit _ANSI_ARGS_(( Tcl_ThreadDataKey *keyPtr)); EXTERN void TclpThreadDataKeySet _ANSI_ARGS_(( Tcl_ThreadDataKey *keyPtr, VOID *data)); EXTERN int TclpThreadCreate _ANSI_ARGS_(( Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)); EXTERN void TclpThreadExit _ANSI_ARGS_((int status)); EXTERN void TclRememberCondition _ANSI_ARGS_((Tcl_Condition *mutex)); EXTERN void TclRememberDataKey _ANSI_ARGS_((Tcl_ThreadDataKey *mutex)); EXTERN VOID TclRememberJoinableThread _ANSI_ARGS_((Tcl_ThreadId id)); EXTERN void TclRememberMutex _ANSI_ARGS_((Tcl_Mutex *mutex)); EXTERN VOID TclSignalExitThread _ANSI_ARGS_((Tcl_ThreadId id, int result));
︙
1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826	2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037	+ + + + + + + + +	Tcl_LoadHandle loadHandle, CONST char *symbol)); EXTERN int TclpDlopen _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr)); EXTERN int TclpUtime _ANSI_ARGS_((Tcl_Obj *pathPtr, struct utimbuf *tval)); #ifdef TCL_LOAD_FROM_MEMORY EXTERN void* TclpLoadMemoryGetBuffer _ANSI_ARGS_(( Tcl_Interp *interp, int size)); EXTERN int TclpLoadMemory _ANSI_ARGS_((Tcl_Interp *interp, void *buffer, int size, int codeSize, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr)); #endif /* *---------------------------------------------------------------- * Command procedures in the generic core: *---------------------------------------------------------------- */
︙
2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129	2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346	+ + - + + + + +	TclAllocObjStorage(objPtr); \ TclIncrObjsAllocated(); \ (objPtr)->refCount = 0; \ (objPtr)->bytes = tclEmptyStringRep; \ (objPtr)->length = 0; \ (objPtr)->typePtr = NULL #ifdef TCL_MEM_DEBUG #define TclDecrRefCount(objPtr) \ # define TclDecrRefCount(objPtr) \ Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__) #else # define TclDecrRefCount(objPtr) \ if (--(objPtr)->refCount <= 0) { \ if (((objPtr)->typePtr != NULL) \ && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \ (objPtr)->typePtr->freeIntRepProc(objPtr); \ } \ if (((objPtr)->bytes != NULL) \ && ((objPtr)->bytes != tclEmptyStringRep)) { \ ckfree((char *) (objPtr)->bytes); \ } \ TclFreeObjStorage(objPtr); \ TclIncrObjsFreed(); \ } #endif #ifdef TCL_MEM_DEBUG # define TclAllocObjStorage(objPtr) \ (objPtr) = (Tcl_Obj *) \ Tcl_DbCkalloc(sizeof(Tcl_Obj), __FILE__, __LINE__) # define TclFreeObjStorage(objPtr) \
︙
2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174	2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395	+ + + +	/* * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's * from per-thread caches. */ EXTERN Tcl_Obj *TclThreadAllocObj _ANSI_ARGS_((void)); EXTERN void TclThreadFreeObj _ANSI_ARGS_((Tcl_Obj *)); EXTERN void TclFreeAllocCache _ANSI_ARGS_((void *)); EXTERN void TclpFreeAllocMutex _ANSI_ARGS_((Tcl_Mutex* mutex)); EXTERN void TclpFreeAllocCache _ANSI_ARGS_((void *)); # define TclAllocObjStorage(objPtr) \ (objPtr) = TclThreadAllocObj() # define TclFreeObjStorage(objPtr) \ TclThreadFreeObj((objPtr))
︙
2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248	2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489	+ + + + + + + + + + + + + + + + + + + +	* EXTERN char * TclGetString _ANSI_ARGS_((Tcl_Obj *objPtr)); *---------------------------------------------------------------- */ #define TclGetString(objPtr) \ ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString((objPtr))) /* *---------------------------------------------------------------- * Macro used by the Tcl core to get a Tcl_WideInt value out of * a Tcl_Obj of the "wideInt" type. Different implementation on * different platforms depending whether TCL_WIDE_INT_IS_LONG. *---------------------------------------------------------------- */ #ifdef TCL_WIDE_INT_IS_LONG # define TclGetWide(resultVar, objPtr) \ (resultVar) = (objPtr)->internalRep.longValue # define TclGetLongFromWide(resultVar, objPtr) \ (resultVar) = (objPtr)->internalRep.longValue #else # define TclGetWide(resultVar, objPtr) \ (resultVar) = (objPtr)->internalRep.wideValue # define TclGetLongFromWide(resultVar, objPtr) \ (resultVar) = Tcl_WideAsLong((objPtr)->internalRep.wideValue) #endif /* *---------------------------------------------------------------- * Macro used by the Tcl core get a unicode char from a utf string. * It checks to see if we have a one-byte utf char before calling * the real Tcl_UtfToUniChar, as this will save a lot of time for * primarily ascii string handling. The macro's expression result * is 1 for the 1-byte case or the result of Tcl_UtfToUniChar.
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	/* * tclIntDecls.h -- * * This file contains the declarations for all unsupported * functions that are exported by the Tcl library. These * interfaces are not guaranteed to remain the same between * versions. Use at your own risk. * * 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. * * RCS: @(#) $Id: tclIntDecls.h,v 1.49 2003/02/18 02:25:45 hobbs Exp $ * RCS: @(#) $Id: tclIntDecls.h,v 1.49.2.9 2007/04/21 19:52:14 kennykb Exp $ */ #ifndef _TCLINTDECLS #define _TCLINTDECLS /* * WARNING: This file is automatically generated by the tools/genStubs.tcl
︙
111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126	111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126	- - + +	CONST char * procName)); /* 24 */ EXTERN int TclFormatInt _ANSI_ARGS_((char * buffer, long n)); /* 25 */ EXTERN void TclFreePackageInfo _ANSI_ARGS_((Interp * iPtr)); /* Slot 26 is reserved */ /* 27 */ EXTERN int TclGetDate _ANSI_ARGS_((char * p, unsigned long now, long zone, unsigned long * timePtr)); EXTERN int TclGetDate _ANSI_ARGS_((char * p, Tcl_WideInt now, long zone, Tcl_WideInt * timePtr)); /* 28 */ EXTERN Tcl_Channel TclpGetDefaultStdChannel _ANSI_ARGS_((int type)); /* Slot 29 is reserved */ /* Slot 30 is reserved */ /* 31 */ EXTERN char * TclGetExtension _ANSI_ARGS_((char * name)); /* 32 */
︙
237 238 239 240 241 242 243 244 245 246 247 248 249 250 251	237 238 239 240 241 242 243 244 245 246 247 248 249 250 251	- +	/* 75 */ EXTERN unsigned long TclpGetClicks _ANSI_ARGS_((void)); /* 76 */ EXTERN unsigned long TclpGetSeconds _ANSI_ARGS_((void)); /* 77 */ EXTERN void TclpGetTime _ANSI_ARGS_((Tcl_Time * time)); /* 78 */ EXTERN int TclpGetTimeZone _ANSI_ARGS_((unsigned long time)); EXTERN int TclpGetTimeZone _ANSI_ARGS_((Tcl_WideInt time)); /* Slot 79 is reserved */ /* Slot 80 is reserved */ /* 81 */ EXTERN char * TclpRealloc _ANSI_ARGS_((char * ptr, unsigned int size)); /* Slot 82 is reserved */ /* Slot 83 is reserved */
︙
499 500 501 502 503 504 505 506 507 508 509 510 511 512	499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +	/* 172 */ EXTERN int TclInThreadExit _ANSI_ARGS_((void)); /* 173 */ EXTERN int TclUniCharMatch _ANSI_ARGS_(( CONST Tcl_UniChar * string, int strLen, CONST Tcl_UniChar * pattern, int ptnLen, int nocase)); /* Slot 174 is reserved */ /* Slot 175 is reserved */ /* Slot 176 is reserved */ /* Slot 177 is reserved */ /* Slot 178 is reserved */ /* Slot 179 is reserved */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ /* 182 */ EXTERN struct tm * TclpLocaltime _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 183 */ EXTERN struct tm * TclpGmtime _ANSI_ARGS_((TclpTime_t_CONST clock)); /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ /* Slot 187 is reserved */ /* Slot 188 is reserved */ /* Slot 189 is reserved */ /* Slot 190 is reserved */ /* Slot 191 is reserved */ /* Slot 192 is reserved */ /* Slot 193 is reserved */ /* Slot 194 is reserved */ /* Slot 195 is reserved */ /* Slot 196 is reserved */ /* Slot 197 is reserved */ /* Slot 198 is reserved */ /* 199 */ EXTERN int TclMatchIsTrivial _ANSI_ARGS_((CONST char * pattern)); typedef struct TclIntStubs { int magic; struct TclIntStubHooks *hooks; void *reserved0; int (*tclAccessDeleteProc) _ANSI_ARGS_((TclAccessProc_ * proc)); /* 1 */
︙
547 548 549 550 551 552 553 554 555 556 557 558 559 560 561	576 577 578 579 580 581 582 583 584 585 586 587 588 589 590	- +	void *reserved20; void *reserved21; int (*tclFindElement) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * listStr, int listLength, CONST char ** elementPtr, CONST char ** nextPtr, int * sizePtr, int * bracePtr)); /* 22 */ Proc * (*tclFindProc) _ANSI_ARGS_((Interp * iPtr, CONST char * procName)); /* 23 */ int (*tclFormatInt) _ANSI_ARGS_((char * buffer, long n)); /* 24 */ void (*tclFreePackageInfo) _ANSI_ARGS_((Interp * iPtr)); /* 25 */ void *reserved26; int (*tclGetDate) _ANSI_ARGS_((char * p, unsigned long now, long zone, unsigned long * timePtr)); /* 27 */ int (*tclGetDate) _ANSI_ARGS_((char * p, Tcl_WideInt now, long zone, Tcl_WideInt * timePtr)); /* 27 */ Tcl_Channel (*tclpGetDefaultStdChannel) _ANSI_ARGS_((int type)); /* 28 */ void *reserved29; void *reserved30; char * (*tclGetExtension) _ANSI_ARGS_((char * name)); /* 31 */ int (*tclGetFrame) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, CallFrame ** framePtrPtr)); /* 32 */ TclCmdProcType (*tclGetInterpProc) _ANSI_ARGS_((void)); /* 33 */ int (*tclGetIntForIndex) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int endValue, int * indexPtr)); /* 34 */
︙
598 599 600 601 602 603 604 605 606 607 608 609 610 611 612	627 628 629 630 631 632 633 634 635 636 637 638 639 640 641	- +	void *reserved71; void *reserved72; void *reserved73; void (*tclpFree) _ANSI_ARGS_((char * ptr)); /* 74 */ unsigned long (*tclpGetClicks) _ANSI_ARGS_((void)); /* 75 */ unsigned long (*tclpGetSeconds) _ANSI_ARGS_((void)); /* 76 */ void (*tclpGetTime) _ANSI_ARGS_((Tcl_Time * time)); /* 77 */ int (*tclpGetTimeZone) _ANSI_ARGS_((unsigned long time)); /* 78 */ int (*tclpGetTimeZone) _ANSI_ARGS_((Tcl_WideInt time)); /* 78 */ void *reserved79; void *reserved80; char * (*tclpRealloc) _ANSI_ARGS_((char * ptr, unsigned int size)); /* 81 */ void *reserved82; void *reserved83; void *reserved84; void *reserved85;
︙
702 703 704 705 706 707 708 709 710 711 712 713 714 715	731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770	+ + + + + + + + + + + + + + + + + + + + + + + + + +	void (*tclSetStartupScriptPath) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 167 */ Tcl_Obj * (*tclGetStartupScriptPath) _ANSI_ARGS_((void)); /* 168 */ int (*tclpUtfNcmp2) _ANSI_ARGS_((CONST char * s1, CONST char * s2, unsigned long n)); /* 169 */ int (*tclCheckInterpTraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 170 */ int (*tclCheckExecutionTraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 171 */ int (*tclInThreadExit) _ANSI_ARGS_((void)); /* 172 */ int (*tclUniCharMatch) _ANSI_ARGS_((CONST Tcl_UniChar * string, int strLen, CONST Tcl_UniChar * pattern, int ptnLen, int nocase)); /* 173 */ void *reserved174; void *reserved175; void *reserved176; void *reserved177; void *reserved178; void *reserved179; void *reserved180; void *reserved181; struct tm * (*tclpLocaltime) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 182 */ struct tm * (*tclpGmtime) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 183 */ void *reserved184; void *reserved185; void *reserved186; void *reserved187; void *reserved188; void *reserved189; void *reserved190; void *reserved191; void *reserved192; void *reserved193; void *reserved194; void *reserved195; void *reserved196; void *reserved197; void *reserved198; int (*tclMatchIsTrivial) _ANSI_ARGS_((CONST char * pattern)); /* 199 */ } TclIntStubs; #ifdef __cplusplus extern "C" { #endif extern TclIntStubs *tclIntStubsPtr; #ifdef __cplusplus
︙
1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324	1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	#define TclInThreadExit \ (tclIntStubsPtr->tclInThreadExit) /* 172 */ #endif #ifndef TclUniCharMatch #define TclUniCharMatch \ (tclIntStubsPtr->tclUniCharMatch) /* 173 */ #endif /* Slot 174 is reserved */ /* Slot 175 is reserved */ /* Slot 176 is reserved */ /* Slot 177 is reserved */ /* Slot 178 is reserved */ /* Slot 179 is reserved */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ #ifndef TclpLocaltime #define TclpLocaltime \ (tclIntStubsPtr->tclpLocaltime) /* 182 */ #endif #ifndef TclpGmtime #define TclpGmtime \ (tclIntStubsPtr->tclpGmtime) /* 183 */ #endif /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ /* Slot 187 is reserved */ /* Slot 188 is reserved */ /* Slot 189 is reserved */ /* Slot 190 is reserved */ /* Slot 191 is reserved */ /* Slot 192 is reserved */ /* Slot 193 is reserved */ /* Slot 194 is reserved */ /* Slot 195 is reserved */ /* Slot 196 is reserved */ /* Slot 197 is reserved */ /* Slot 198 is reserved */ #ifndef TclMatchIsTrivial #define TclMatchIsTrivial \ (tclIntStubsPtr->tclMatchIsTrivial) /* 199 */ #endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ /* !END!: Do not edit above this line. */ #endif /* _TCLINTDECLS */

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	/* * tclIntPlatDecls.h -- * * This file contains the declarations for all platform dependent * unsupported functions that are exported by the Tcl library. These * interfaces are not guaranteed to remain the same between * versions. Use at your own risk. * * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. * * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.19 2002/12/06 23:22:59 hobbs Exp $ * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.19.2.7 2007/04/21 19:52:14 kennykb Exp $ */ #ifndef _TCLINTPLATDECLS #define _TCLINTPLATDECLS /* * WARNING: This file is automatically generated by the tools/genStubs.tcl
︙
58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74	58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75	- + + - +	int timeout)); /* 9 */ EXTERN TclFile TclpCreateTempFile _ANSI_ARGS_(( CONST char * contents)); /* 10 */ EXTERN Tcl_DirEntry * TclpReaddir _ANSI_ARGS_((DIR * dir)); /* 11 */ EXTERN struct tm * TclpLocaltime _ANSI_ARGS_((time_t * clock)); EXTERN struct tm * TclpLocaltime_unix _ANSI_ARGS_(( TclpTime_t_CONST clock)); /* 12 */ EXTERN struct tm * TclpGmtime _ANSI_ARGS_((time_t * clock)); EXTERN struct tm * TclpGmtime_unix _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 13 */ EXTERN char * TclpInetNtoa _ANSI_ARGS_((struct in_addr addr)); #endif /* UNIX */ #ifdef __WIN32__ /* 0 */ EXTERN void TclWinConvertError _ANSI_ARGS_((DWORD errCode)); /* 1 */
︙
135 136 137 138 139 140 141 142 143 144 145 146 147 148	136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152	+ + +	EXTERN TclPlatformType * TclWinGetPlatform _ANSI_ARGS_((void)); /* 26 */ EXTERN void TclWinSetInterfaces _ANSI_ARGS_((int wide)); /* 27 */ EXTERN void TclWinFlushDirtyChannels _ANSI_ARGS_((void)); /* 28 */ EXTERN void TclWinResetInterfaces _ANSI_ARGS_((void)); /* 29 */ EXTERN int TclWinCPUID _ANSI_ARGS_((unsigned int index, unsigned int * regs)); #endif /* __WIN32__ */ #ifdef MAC_TCL /* 0 */ EXTERN VOID * TclpSysAlloc _ANSI_ARGS_((long size, int isBin)); /* 1 */ EXTERN void TclpSysFree _ANSI_ARGS_((VOID * ptr)); /* 2 */
︙
225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240	229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244	- - + +	int (*tclpCreateProcess) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST char ** argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid * pidPtr)); /* 4 */ void *reserved5; TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 6 */ TclFile (*tclpOpenFile) _ANSI_ARGS_((CONST char * fname, int mode)); /* 7 */ int (*tclUnixWaitForFile) _ANSI_ARGS_((int fd, int mask, int timeout)); /* 8 */ TclFile (*tclpCreateTempFile) _ANSI_ARGS_((CONST char * contents)); /* 9 */ Tcl_DirEntry * (*tclpReaddir) _ANSI_ARGS_((DIR * dir)); /* 10 */ struct tm * (*tclpLocaltime) _ANSI_ARGS_((time_t * clock)); /* 11 */ struct tm * (*tclpGmtime) _ANSI_ARGS_((time_t * clock)); /* 12 */ struct tm * (*tclpLocaltime_unix) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 11 */ struct tm * (*tclpGmtime_unix) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 12 */ char * (*tclpInetNtoa) _ANSI_ARGS_((struct in_addr addr)); /* 13 */ #endif /* UNIX */ #ifdef __WIN32__ void (*tclWinConvertError) _ANSI_ARGS_((DWORD errCode)); /* 0 */ void (*tclWinConvertWSAError) _ANSI_ARGS_((DWORD errCode)); /* 1 */ struct servent * (*tclWinGetServByName) _ANSI_ARGS_((CONST char * nm, CONST char * proto)); /* 2 */ int (*tclWinGetSockOpt) _ANSI_ARGS_((SOCKET s, int level, int optname, char FAR * optval, int FAR * optlen)); /* 3 */
︙
259 260 261 262 263 264 265 266 267 268 269 270 271 272	263 264 265 266 267 268 269 270 271 272 273 274 275 276 277	+	TclFile (*tclpCreateTempFile) _ANSI_ARGS_((CONST char * contents)); /* 22 */ char * (*tclpGetTZName) _ANSI_ARGS_((int isdst)); /* 23 */ char * (*tclWinNoBackslash) _ANSI_ARGS_((char * path)); /* 24 */ TclPlatformType * (*tclWinGetPlatform) _ANSI_ARGS_((void)); /* 25 */ void (*tclWinSetInterfaces) _ANSI_ARGS_((int wide)); /* 26 */ void (*tclWinFlushDirtyChannels) _ANSI_ARGS_((void)); /* 27 */ void (*tclWinResetInterfaces) _ANSI_ARGS_((void)); /* 28 */ int (*tclWinCPUID) _ANSI_ARGS_((unsigned int index, unsigned int * regs)); /* 29 */ #endif /* __WIN32__ */ #ifdef MAC_TCL VOID * (*tclpSysAlloc) _ANSI_ARGS_((long size, int isBin)); /* 0 */ void (*tclpSysFree) _ANSI_ARGS_((VOID * ptr)); /* 1 */ VOID * (*tclpSysRealloc) _ANSI_ARGS_((VOID * cp, unsigned int size)); /* 2 */ void (*tclpExit) _ANSI_ARGS_((int status)); /* 3 */ int (*fSpGetDefaultDir) _ANSI_ARGS_((FSSpecPtr theSpec)); /* 4 */
︙
347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367	352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372	- - - + + + - - - + + +	#define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #endif #ifndef TclpReaddir #define TclpReaddir \ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ #endif #ifndef TclpLocaltime #define TclpLocaltime \ (tclIntPlatStubsPtr->tclpLocaltime) /* 11 */ #ifndef TclpLocaltime_unix #define TclpLocaltime_unix \ (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ #endif #ifndef TclpGmtime #define TclpGmtime \ (tclIntPlatStubsPtr->tclpGmtime) /* 12 */ #ifndef TclpGmtime_unix #define TclpGmtime_unix \ (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ #endif #ifndef TclpInetNtoa #define TclpInetNtoa \ (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ #endif #endif /* UNIX */ #ifdef __WIN32__
︙
462 463 464 465 466 467 468 469 470 471 472 473 474 475	467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484	+ + + +	#define TclWinFlushDirtyChannels \ (tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */ #endif #ifndef TclWinResetInterfaces #define TclWinResetInterfaces \ (tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */ #endif #ifndef TclWinCPUID #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #endif #endif /* __WIN32__ */ #ifdef MAC_TCL #ifndef TclpSysAlloc #define TclpSysAlloc \ (tclIntPlatStubsPtr->tclpSysAlloc) /* 0 */ #endif #ifndef TclpSysFree
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	/* * tclInterp.c -- * * This file implements the "interp" command which allows creation * and manipulation of Tcl interpreters from within Tcl scripts. * * Copyright (c) 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. * * RCS: @(#) $Id: tclInterp.c,v 1.20 2002/11/27 02:54:00 hobbs Exp $ * RCS: @(#) $Id: tclInterp.c,v 1.20.2.3 2006/11/28 22:20:02 andreas_kupries Exp $ */ #include "tclInt.h" #include "tclPort.h" #include <stdio.h>  /*
︙
457 458 459 460 461 462 463 464 465 466 467 468 469 470 471	457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473	+ - + +	i++; last = 1; } if (slavePtr != NULL) { Tcl_WrongNumArgs(interp, 2, objv, "?-safe? ?--? ?path?"); return TCL_ERROR; } if (i < objc) { slavePtr = objv[i]; slavePtr = objv[i]; } } buf[0] = '\0'; if (slavePtr == NULL) { /* * Create an anonymous interpreter -- we choose its name and * the name of the command. We check that the command name * that we use for the interpreter does not collide with an
︙
1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454	1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456	- +	Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument vector. */ { #define ALIAS_CMDV_PREALLOC 10 Tcl_Interp *targetInterp; Alias *aliasPtr; int result, prefc, cmdc; int result, prefc, cmdc, i; Tcl_Obj **prefv, **cmdv; Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC]; aliasPtr = (Alias *) clientData; targetInterp = aliasPtr->targetInterp; /* * Append the arguments to the command prefix and invoke the command
︙
1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488	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	+ + + + + +	memcpy((VOID *) cmdv, (VOID *) prefv, (size_t) (prefc * sizeof(Tcl_Obj *))); memcpy((VOID *) (cmdv+prefc), (VOID *) (objv+1), (size_t) ((objc-1) * sizeof(Tcl_Obj *))); Tcl_ResetResult(targetInterp); for (i=0; i<cmdc; i++) { Tcl_IncrRefCount(cmdv[i]); } if (targetInterp != interp) { Tcl_Preserve((ClientData) targetInterp); result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE); TclTransferResult(targetInterp, result, interp); Tcl_Release((ClientData) targetInterp); } else { result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE); } for (i=0; i<cmdc; i++) { Tcl_DecrRefCount(cmdv[i]); } if (cmdv != cmdArr) { ckfree((char *) cmdv); } return result; #undef ALIAS_CMDV_PREALLOC
︙
2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093	2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107	+ + + + + +	int result; Tcl_Obj *objPtr; Tcl_Preserve((ClientData) slaveInterp); Tcl_AllowExceptions(slaveInterp); if (objc == 1) { #ifndef TCL_TIP280 result = Tcl_EvalObjEx(slaveInterp, objv[0], 0); #else /* TIP #280 : Make invoker available to eval'd script */ Interp* iPtr = (Interp*) interp; result = TclEvalObjEx(slaveInterp, objv[0], 0, iPtr->cmdFramePtr,0); #endif } else { objPtr = Tcl_ConcatObj(objc, objv); Tcl_IncrRefCount(objPtr); result = Tcl_EvalObjEx(slaveInterp, objPtr, 0); Tcl_DecrRefCount(objPtr); } TclTransferResult(slaveInterp, result, interp);
︙

︙
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	- +	* * Copyright (c) 1993 The Regents of the University of California. * Copyright (c) 1994-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. * * RCS: @(#) $Id: tclLink.c,v 1.8 2002/08/05 03:24:41 dgp Exp $ * RCS: @(#) $Id: tclLink.c,v 1.8.2.2 2007/05/10 18:23:58 dgp Exp $ */ #include "tclInt.h" /* * For each linked variable there is a data structure of the following * type, which describes the link and is the clientData for the trace
︙
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 116 117 118 119 120 121 122 123 124	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 116 117 118 119 120 121 122 123 124 125 126	- + + - - - - + + + + +	CONST char *varName; /* Name of a global variable in interp. */ char *addr; /* Address of a C variable to be linked * to varName. */ int type; /* Type of C variable: TCL_LINK_INT, etc. * Also may have TCL_LINK_READ_ONLY * OR'ed in. */ { Tcl_Obj *objPtr; Tcl_Obj *objPtr, *resPtr; Link *linkPtr; int code; linkPtr = (Link *) ckalloc(sizeof(Link)); linkPtr->interp = interp; linkPtr->varName = Tcl_NewStringObj(varName, -1); Tcl_IncrRefCount(linkPtr->varName); linkPtr->addr = addr; linkPtr->type = type & ~TCL_LINK_READ_ONLY; if (type & TCL_LINK_READ_ONLY) { linkPtr->flags = LINK_READ_ONLY; } else { linkPtr->flags = 0; } objPtr = ObjValue(linkPtr); Tcl_IncrRefCount(objPtr); if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DecrRefCount(linkPtr->varName); Tcl_DecrRefCount(objPtr); resPtr = Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); Tcl_DecrRefCount(objPtr); if (resPtr == NULL) { Tcl_DecrRefCount(linkPtr->varName); ckfree((char *) linkPtr); return TCL_ERROR; } code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr); if (code != TCL_OK) {
︙
187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210	189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215	+ + + - + - +	void Tcl_UpdateLinkedVar(interp, varName) Tcl_Interp *interp; /* Interpreter containing variable. */ CONST char *varName; /* Name of global variable that is linked. */ { Link *linkPtr; int savedFlag; Tcl_Obj *objPtr; linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY, LinkTraceProc, (ClientData) NULL); if (linkPtr == NULL) { return; } savedFlag = linkPtr->flags & LINK_BEING_UPDATED; linkPtr->flags |= LINK_BEING_UPDATED; objPtr = ObjValue(linkPtr); Tcl_IncrRefCount(objPtr); Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr, TCL_GLOBAL_ONLY); TCL_GLOBAL_ONLY); Tcl_DecrRefCount(objPtr); linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag; }  /* *---------------------------------------------------------------------- * * LinkTraceProc --
︙
233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260	238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268	- + - + + + - + +	CONST char *name2; /* Second part of variable name. */ int flags; /* Miscellaneous additional information. */ { Link *linkPtr = (Link *) clientData; int changed, valueLength; CONST char *value; char **pp, *result; Tcl_Obj *objPtr, *valueObj; Tcl_Obj *objPtr, *valueObj, *tmpPtr; /* * If the variable is being unset, then just re-create it (with a * trace) unless the whole interpreter is going away. */ if (flags & TCL_TRACE_UNSETS) { if (flags & TCL_INTERP_DESTROYED) { if (Tcl_InterpDeleted(interp)) { Tcl_DecrRefCount(linkPtr->varName); ckfree((char *) linkPtr); } else if (flags & TCL_TRACE_DESTROYED) { tmpPtr = ObjValue(linkPtr); Tcl_IncrRefCount(tmpPtr); Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(tmpPtr); Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName), TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES |TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr); } return NULL; }
︙
289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378	297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404	+ + - + + + + - + + + + - + + + + - + + + + - + + + + - + +	case TCL_LINK_STRING: changed = 1; break; default: return "internal error: bad linked variable type"; } if (changed) { tmpPtr = ObjValue(linkPtr); Tcl_IncrRefCount(tmpPtr); Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(tmpPtr); } return NULL; } /* * For writes, first make sure that the variable is writable. Then * convert the Tcl value to C if possible. If the variable isn't * writable or can't be converted, then restore the varaible's old * value and return an error. Another tricky thing: we have to save * and restore the interpreter's result, since the variable access * could occur when the result has been partially set. */ if (linkPtr->flags & LINK_READ_ONLY) { tmpPtr = ObjValue(linkPtr); Tcl_IncrRefCount(tmpPtr); Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(tmpPtr); return "linked variable is read-only"; } valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY); if (valueObj == NULL) { /* * This shouldn't ever happen. */ return "internal error: linked variable couldn't be read"; } objPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(objPtr); Tcl_ResetResult(interp); result = NULL; switch (linkPtr->type) { case TCL_LINK_INT: if (Tcl_GetIntFromObj(interp, valueObj, &linkPtr->lastValue.i) != TCL_OK) { Tcl_SetObjResult(interp, objPtr); tmpPtr = ObjValue(linkPtr); Tcl_IncrRefCount(tmpPtr); Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(tmpPtr); result = "variable must have integer value"; goto end; } *(int *)(linkPtr->addr) = linkPtr->lastValue.i; break; case TCL_LINK_WIDE_INT: if (Tcl_GetWideIntFromObj(interp, valueObj, &linkPtr->lastValue.w) != TCL_OK) { Tcl_SetObjResult(interp, objPtr); tmpPtr = ObjValue(linkPtr); Tcl_IncrRefCount(tmpPtr); Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(tmpPtr); result = "variable must have integer value"; goto end; } *(Tcl_WideInt *)(linkPtr->addr) = linkPtr->lastValue.w; break; case TCL_LINK_DOUBLE: if (Tcl_GetDoubleFromObj(interp, valueObj, &linkPtr->lastValue.d) != TCL_OK) { Tcl_SetObjResult(interp, objPtr); tmpPtr = ObjValue(linkPtr); Tcl_IncrRefCount(tmpPtr); Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(tmpPtr); result = "variable must have real value"; goto end; } *(double *)(linkPtr->addr) = linkPtr->lastValue.d; break; case TCL_LINK_BOOLEAN: if (Tcl_GetBooleanFromObj(interp, valueObj, &linkPtr->lastValue.i) != TCL_OK) { Tcl_SetObjResult(interp, objPtr); tmpPtr = ObjValue(linkPtr); Tcl_IncrRefCount(tmpPtr); Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(tmpPtr); result = "variable must have boolean value"; goto end; } *(int *)(linkPtr->addr) = linkPtr->lastValue.i; break; case TCL_LINK_STRING:
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	/* * tclListObj.c -- * * This file contains procedures that implement the Tcl list object * type. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1998 by Scriptics Corporation. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclListObj.c,v 1.13 2002/01/07 23:09:13 dgp Exp $ * RCS: @(#) $Id: tclListObj.c,v 1.13.4.2 2005/08/25 22:27:08 dkf Exp $ */ #include "tclInt.h" /* * Prototypes for procedures defined later in this file: */
︙
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	676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692	- - + - - + - - - - + - - -	start = (first + count); numAfterLast = (numElems - start); shift = (objc - count); /* numNewElems - numDeleted */ if ((numAfterLast > 0) && (shift != 0)) { Tcl_Obj **src, **dst; if (shift < 0) { for (src = elemPtrs + start, dst = src + shift; src = elemPtrs + start; dst = src + shift; numAfterLast > 0; numAfterLast--, src++, dst++) { *dst = *src; memmove((VOID*) dst, (VOID*) src, } } else { for (src = elemPtrs + numElems - 1, dst = src + shift; numAfterLast > 0; numAfterLast--, src--, dst--) { (size_t) (numAfterLast * sizeof(Tcl_Obj*))); *dst = *src; } } } /* * Insert the new elements into elemPtrs before "first". */ for (i = 0, j = first; i < objc; i++, j++) {
︙
1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640	1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638	+ + + + + +	flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int)); } listPtr->length = 1; for (i = 0; i < numElems; i++) { elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length); listPtr->length += Tcl_ScanCountedElement(elem, length, &flagPtr[i]) + 1; /* * Check for continued sanity. [Bug 1267380] */ if (listPtr->length < 1) { Tcl_Panic("string representation size exceeds sane bounds"); } } /* * Pass 2: copy into string rep buffer. */ listPtr->bytes = ckalloc((unsigned) listPtr->length);
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclMain.c -- * * Main program for Tcl shells and other Tcl-based applications. * * Copyright (c) 1988-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 2000 Ajuba Solutions. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclMain.c,v 1.20 2002/05/29 22:59:33 dgp Exp $ * RCS: @(#) $Id: tclMain.c,v 1.20.2.3 2006/05/05 18:08:58 dgp Exp $ */ #include "tcl.h" #include "tclInt.h" # undef TCL_STORAGE_CLASS # define TCL_STORAGE_CLASS DLLEXPORT
︙
200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264	200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267	- + - - - + - - + + - - - - - - - - - - - - - + - + + + + + - - - + + + + + + + + + + + + + + + +	char **argv; /* Array of argument strings. */ Tcl_AppInitProc *appInitProc; /* Application-specific initialization * procedure to call after most * initialization but before starting to * execute commands. */ { Tcl_Obj *resultPtr; Tcl_Obj *resultPtr, *argvPtr, *commandPtr = NULL; Tcl_Obj *commandPtr = NULL; char buffer[TCL_INTEGER_SPACE + 5], *args; PromptType prompt = PROMPT_START; int code, length, tty; int code, length, tty, exitCode = 0; int exitCode = 0; Tcl_Channel inChannel, outChannel, errChannel; Tcl_Interp *interp; Tcl_DString argString; Tcl_DString appName; Tcl_Obj *objPtr; Tcl_FindExecutable(argv[0]); interp = Tcl_CreateInterp(); Tcl_InitMemory(interp); /* * Make command-line arguments available in the Tcl variables "argc" * and "argv". If the first argument doesn't start with a "-" then * strip it off and use it as the name of a script file to process. */ if (TclGetStartupScriptPath() == NULL) { if ((argc > 1) && (argv[1][0] != '-')) { TclSetStartupScriptFileName(argv[1]); argc--; argv++; } } /* * The CONST casting is safe, and better we do it here than force * all callers of Tcl_Main to do it. (Those callers are likely * in a main() that can't easily change its signature.) */ args = Tcl_Merge(argc-1, (CONST char **)argv+1); Tcl_ExternalToUtfDString(NULL, args, -1, &argString); Tcl_SetVar(interp, "argv", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY); Tcl_DStringFree(&argString); ckfree(args); if (TclGetStartupScriptPath() == NULL) { Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString); Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName); } else { TclSetStartupScriptFileName(Tcl_ExternalToUtfDString(NULL, TclGetStartupScriptFileName(), -1, &argString)); TclGetStartupScriptFileName(), -1, &appName)); } Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY); Tcl_DStringFree(&appName); argc--; argv++; TclFormatInt(buffer, (long) argc-1); Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY); objPtr = Tcl_NewIntObj(argc); Tcl_IncrRefCount(objPtr); Tcl_SetVar2Ex(interp, "argc", NULL, objPtr, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(objPtr); argvPtr = Tcl_NewListObj(0, NULL); while (argc--) { Tcl_DString ds; Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds); Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj( Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); Tcl_DStringFree(&ds); } Tcl_IncrRefCount(argvPtr); Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(argvPtr); /* * Set the "tcl_interactive" variable. */ tty = isatty(0); Tcl_SetVar(interp, "tcl_interactive",
︙
304 305 306 307 308 309 310 311 312 313 314 315 316 317 318	307 308 309 310 311 312 313 314 315 316 317 318 319 320	-	NULL, TCL_GLOBAL_ONLY)); Tcl_WriteChars(errChannel, "\n", 1); } exitCode = 1; } goto done; } Tcl_DStringFree(&argString); /* * We're running interactively. Source a user-specific startup * file if the application specified one and if the file exists. */ Tcl_SourceRCFile(interp);
︙
329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420	331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422	+ - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + - - - - - - - - + + + + + + + + - - + + - - - + + + - - + + - - - + + + - - - - - - - - - - + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + -	/* * Get a new value for tty if anyone writes to ::tcl_interactive */ Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN); inChannel = Tcl_GetStdChannel(TCL_STDIN); outChannel = Tcl_GetStdChannel(TCL_STDOUT); while ((inChannel != (Tcl_Channel) NULL) && !Tcl_InterpDeleted(interp)) { if (mainLoopProc == NULL) { if (tty) { Prompt(interp, &prompt); if (Tcl_InterpDeleted(interp)) { break; } inChannel = Tcl_GetStdChannel(TCL_STDIN); if (inChannel == (Tcl_Channel) NULL) { break; } } if (Tcl_IsShared(commandPtr)) { Tcl_DecrRefCount(commandPtr); commandPtr = Tcl_DuplicateObj(commandPtr); Tcl_IncrRefCount(commandPtr); } length = Tcl_GetsObj(inChannel, commandPtr); if (length < 0) { if (Tcl_InputBlocked(inChannel)) { if (tty) { Prompt(interp, &prompt); if (Tcl_InterpDeleted(interp)) { break; } inChannel = Tcl_GetStdChannel(TCL_STDIN); if (inChannel == (Tcl_Channel) NULL) { break; } } if (Tcl_IsShared(commandPtr)) { Tcl_DecrRefCount(commandPtr); commandPtr = Tcl_DuplicateObj(commandPtr); Tcl_IncrRefCount(commandPtr); } length = Tcl_GetsObj(inChannel, commandPtr); if (length < 0) { if (Tcl_InputBlocked(inChannel)) { /* * This can only happen if stdin has been set to * non-blocking. In that case cycle back and try * again. This sets up a tight polling loop (since * we have no event loop running). If this causes * bad CPU hogging, we might try toggling the blocking * on stdin instead. */ /* * This can only happen if stdin has been set to * non-blocking. In that case cycle back and try * again. This sets up a tight polling loop (since * we have no event loop running). If this causes * bad CPU hogging, we might try toggling the blocking * on stdin instead. */ continue; } continue; } /* * Either EOF, or an error on stdin; we're done */ /* * Either EOF, or an error on stdin; we're done */ break; } break; } /* * Add the newline removed by Tcl_GetsObj back to the string. */ /* * Add the newline removed by Tcl_GetsObj back to the string. */ if (Tcl_IsShared(commandPtr)) { Tcl_DecrRefCount(commandPtr); commandPtr = Tcl_DuplicateObj(commandPtr); Tcl_IncrRefCount(commandPtr); } Tcl_AppendToObj(commandPtr, "\n", 1); if (!TclObjCommandComplete(commandPtr)) { prompt = PROMPT_CONTINUE; continue; } if (Tcl_IsShared(commandPtr)) { Tcl_DecrRefCount(commandPtr); commandPtr = Tcl_DuplicateObj(commandPtr); Tcl_IncrRefCount(commandPtr); } Tcl_AppendToObj(commandPtr, "\n", 1); if (!TclObjCommandComplete(commandPtr)) { prompt = PROMPT_CONTINUE; continue; } prompt = PROMPT_START; code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL); inChannel = Tcl_GetStdChannel(TCL_STDIN); outChannel = Tcl_GetStdChannel(TCL_STDOUT); errChannel = Tcl_GetStdChannel(TCL_STDERR); Tcl_DecrRefCount(commandPtr); commandPtr = Tcl_NewObj(); Tcl_IncrRefCount(commandPtr); if (code != TCL_OK) { if (errChannel) { Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); Tcl_WriteChars(errChannel, "\n", 1); } } else if (tty) { resultPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultPtr); Tcl_GetStringFromObj(resultPtr, &length); if ((length > 0) && outChannel) { Tcl_WriteObj(outChannel, resultPtr); Tcl_WriteChars(outChannel, "\n", 1); } Tcl_DecrRefCount(resultPtr); } if (mainLoopProc != NULL) { prompt = PROMPT_START; code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL); inChannel = Tcl_GetStdChannel(TCL_STDIN); outChannel = Tcl_GetStdChannel(TCL_STDOUT); errChannel = Tcl_GetStdChannel(TCL_STDERR); Tcl_DecrRefCount(commandPtr); commandPtr = Tcl_NewObj(); Tcl_IncrRefCount(commandPtr); if (code != TCL_OK) { if (errChannel) { Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); Tcl_WriteChars(errChannel, "\n", 1); } } else if (tty) { resultPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultPtr); Tcl_GetStringFromObj(resultPtr, &length); if ((length > 0) && outChannel) { Tcl_WriteObj(outChannel, resultPtr); Tcl_WriteChars(outChannel, "\n", 1); } Tcl_DecrRefCount(resultPtr); } } else { /* (mainLoopProc != NULL) */ /* * If a main loop has been defined while running interactively, * we want to start a fileevent based prompt by establishing a * channel handler for stdin. */ InteractiveState *isPtr = NULL;
︙
492 493 494 495 496 497 498 499 500 501 502 503 504 505	494 495 496 497 498 499 500 501 502 503 504 505 506 507 508	+	/* * Rather than calling exit, invoke the "exit" command so that * users can replace "exit" with some other command to do additional * cleanup on exit. The Tcl_Eval call should never return. */ if (!Tcl_InterpDeleted(interp)) { char buffer[TCL_INTEGER_SPACE + 5]; sprintf(buffer, "exit %d", exitCode); Tcl_Eval(interp, buffer); /* * If Tcl_Eval returns, trying to eval [exit], something * unusual is happening. Maybe interp has been deleted; * maybe [exit] was redefined. We still want to cleanup
︙

︙
15 16 17 18 19 20 21 22 23 24 25 26 27 28 29	15 16 17 18 19 20 21 22 23 24 25 26 27 28 29	- +	* Michael J. McLennan * Bell Labs Innovations for Lucent Technologies * mmclennan@lucent.com * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclNamesp.c,v 1.31 2002/07/15 22:18:07 msofer Exp $ * RCS: @(#) $Id: tclNamesp.c,v 1.31.2.14 2007/05/15 18:32:18 dgp Exp $ */ #include "tclInt.h" /* * Flag passed to TclGetNamespaceForQualName to indicate that it should * search for a namespace rather than a command or variable inside a
︙
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	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	- - - - - - - - - - - - - - - - - -	void Tcl_PopCallFrame(interp) Tcl_Interp* interp; /* Interpreter with call frame to pop. */ { register Interp *iPtr = (Interp *) interp; register CallFrame *framePtr = iPtr->framePtr; int saveErrFlag; Namespace *nsPtr; /* * It's important to remove the call frame from the interpreter's stack * of call frames before deleting local variables, so that traces * invoked by the variable deletion don't see the partially-deleted * frame. */ iPtr->framePtr = framePtr->callerPtr; iPtr->varFramePtr = framePtr->callerVarPtr; /* * Delete the local variables. As a hack, we save then restore the * ERR_IN_PROGRESS flag in the interpreter. The problem is that there * could be unset traces on the variables, which cause scripts to be * evaluated. This will clear the ERR_IN_PROGRESS flag, losing stack * trace information if the procedure was exiting with an error. The * code below preserves the flag. Unfortunately, that isn't really * enough: we really should preserve the errorInfo variable too * (otherwise a nested error in the trace script will trash errorInfo). * What's really needed is a general-purpose mechanism for saving and * restoring interpreter state. */ saveErrFlag = (iPtr->flags & ERR_IN_PROGRESS); if (framePtr->varTablePtr != NULL) { TclDeleteVars(iPtr, framePtr->varTablePtr); ckfree((char *) framePtr->varTablePtr); framePtr->varTablePtr = NULL; } if (framePtr->numCompiledLocals > 0) { TclDeleteCompiledLocalVars(iPtr, framePtr); } iPtr->flags |= saveErrFlag; /* * Decrement the namespace's count of active call frames. If the * namespace is "dying" and there are no more active call frames, * call Tcl_DeleteNamespace to destroy it. */ nsPtr = framePtr->nsPtr;
︙
626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672	608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664	- + - + + + + + - + + + + + + + - +	entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable, nsPtr->name); if (entryPtr != NULL) { Tcl_DeleteHashEntry(entryPtr); } } nsPtr->parentPtr = NULL; } else { } else if (!(nsPtr->flags & NS_KILLED)) { /* * Delete the namespace and everything in it. If this is the global * namespace, then clear it but don't free its storage unless the * interpreter is being torn down. * interpreter is being torn down. Set the NS_KILLED flag to avoid * recursive calls here - if the namespace is really in the process of * being deleted, ignore any second call. */ nsPtr->flags |= (NS_DYING|NS_KILLED); TclTeardownNamespace(nsPtr); if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) { /* * If this is the global namespace, then it may have residual * "errorInfo" and "errorCode" variables for errors that * occurred while it was being torn down. Try to clear the * variable list one last time. */ TclDeleteVars((Interp *) nsPtr->interp, &nsPtr->varTable); TclDeleteNamespaceVars(nsPtr); Tcl_DeleteHashTable(&nsPtr->childTable); Tcl_DeleteHashTable(&nsPtr->cmdTable); /* * If the reference count is 0, then discard the namespace. * Otherwise, mark it as "dead" so that it can't be used. */ if (nsPtr->refCount == 0) { NamespaceFree(nsPtr); } else { nsPtr->flags |= NS_DEAD; } } else { /* * We didn't really kill it, so remove the KILLED marks, so * it can get killed later, avoiding mem leaks */ nsPtr->flags &= ~(NS_DYING|NS_KILLED); } } } }  /* *---------------------------------------------------------------------- * * TclTeardownNamespace --
︙
709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771	701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770	- - + + - - - + + + - - + + + - - - - + - - - + + - - - - - + - - - + + - + - - - - - - - - - - + + + + + + + + + + - + + + + + + + + + + + + + + + +	/* * Start by destroying the namespace's variable table, * since variables might trigger traces. */ if (nsPtr == globalNsPtr) { /* * This is the global namespace, so be careful to preserve the * "errorInfo" and "errorCode" variables. These might be needed * This is the global namespace. Tearing it down will destroy the * ::errorInfo and ::errorCode variables. We save and restore them * later on if errors occur while deleting commands. We are careful * to destroy and recreate the "errorInfo" and "errorCode" * variables, in case they had any traces on them. * in case there are any errors in progress, so the error details * they contain will not be lost. See test namespace-8.5 */ Tcl_Obj *errorInfo = Tcl_GetVar2Ex(nsPtr->interp, "errorInfo", CONST char *str; char *errorInfoStr, *errorCodeStr; NULL, TCL_GLOBAL_ONLY); Tcl_Obj *errorCode = Tcl_GetVar2Ex(nsPtr->interp, "errorCode", NULL, TCL_GLOBAL_ONLY); str = Tcl_GetVar((Tcl_Interp *) iPtr, "errorInfo", TCL_GLOBAL_ONLY); if (str != NULL) { errorInfoStr = ckalloc((unsigned) (strlen(str)+1)); strcpy(errorInfoStr, str); if (errorInfo) { } else { errorInfoStr = NULL; } Tcl_IncrRefCount(errorInfo); } str = Tcl_GetVar((Tcl_Interp *) iPtr, "errorCode", TCL_GLOBAL_ONLY); if (str != NULL) { errorCodeStr = ckalloc((unsigned) (strlen(str)+1)); strcpy(errorCodeStr, str); if (errorCode) { } else { errorCodeStr = NULL; } Tcl_IncrRefCount(errorCode); } TclDeleteVars(iPtr, &nsPtr->varTable); TclDeleteNamespaceVars(nsPtr); Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS); if (errorInfoStr != NULL) { Tcl_SetVar((Tcl_Interp *) iPtr, "errorInfo", errorInfoStr, TCL_GLOBAL_ONLY); ckfree(errorInfoStr); } if (errorCodeStr != NULL) { Tcl_SetVar((Tcl_Interp *) iPtr, "errorCode", errorCodeStr, TCL_GLOBAL_ONLY); ckfree(errorCodeStr); } if (errorInfo) { Tcl_SetVar2Ex(nsPtr->interp, "errorInfo", NULL, errorInfo, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(errorInfo); } if (errorCode) { Tcl_SetVar2Ex(nsPtr->interp, "errorCode", NULL, errorCode, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(errorCode); } } else { /* * Variable table should be cleared but not freed! TclDeleteVars * frees it, so we reinitialize it afterwards. */ TclDeleteVars(iPtr, &nsPtr->varTable); TclDeleteNamespaceVars(nsPtr); Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS); } /* * Delete all commands in this namespace. Be careful when traversing the * hash table: when each command is deleted, it removes itself from the * command table. */ for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); entryPtr != NULL; entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) { cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr); Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd); } Tcl_DeleteHashTable(&nsPtr->cmdTable); Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS); /* * Remove the namespace from its parent's child hashtable. */ if (nsPtr->parentPtr != NULL) { entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable, nsPtr->name);
︙
787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815	786 787 788 789 790 791 792 793 794 795 796 797 798 799	- - - - - - - - - - - - - - -	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search); entryPtr != NULL; entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) { childNsPtr = (Tcl_Namespace *) Tcl_GetHashValue(entryPtr); Tcl_DeleteNamespace(childNsPtr); } /* * Delete all commands in this namespace. Be careful when traversing the * hash table: when each command is deleted, it removes itself from the * command table. */ for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); entryPtr != NULL; entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) { cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr); Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd); } Tcl_DeleteHashTable(&nsPtr->cmdTable); Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS); /* * Free the namespace's export pattern array. */ if (nsPtr->exportArrayPtr != NULL) { for (i = 0; i < nsPtr->numExportPatterns; i++) { ckfree(nsPtr->exportArrayPtr[i]);
︙
904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920	888 889 890 891 892 893 894 895 896 897 898 899 900 901 902	- + - -	* the current namespace. */ CONST char *pattern; /* String pattern indicating which commands * to export. This pattern may not include * any namespace qualifiers; only commands * in the specified namespace may be * exported. */ int resetListFirst; /* If nonzero, resets the namespace's * export list before appending. * export list before appending. */ * If 0, return an error if an imported * cmd conflicts with an existing one. */ { #define INIT_EXPORT_PATTERNS 5 Namespace *nsPtr, *exportNsPtr, *dummyPtr; Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); CONST char *simplePattern; char *patternCpy; int neededElems, len, i;
︙
947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962	929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944	- - + +	} /* * Check that the pattern doesn't have namespace qualifiers. */ TclGetNamespaceForQualName(interp, pattern, nsPtr, /*flags*/ TCL_LEAVE_ERR_MSG, &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern); /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY), &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern); if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "invalid export pattern \"", pattern, "\": pattern can't specify a namespace", (char *) NULL); return TCL_ERROR;
︙
1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129	1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111	- +	Interp *iPtr = (Interp *) interp; Namespace *nsPtr, *importNsPtr, *dummyPtr; Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); CONST char *simplePattern; char *cmdName; register Tcl_HashEntry *hPtr; Tcl_HashSearch search; Command *cmdPtr, *realCmdPtr; Command *cmdPtr; ImportRef *refPtr; Tcl_Command autoCmd, importedCmd; ImportedCmdData *dataPtr; int wasExported, i, result; /* * If the specified namespace is NULL, use the current namespace.
︙
1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190	1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172	- - + +	if (strlen(pattern) == 0) { Tcl_SetStringObj(Tcl_GetObjResult(interp), "empty import pattern", -1); return TCL_ERROR; } TclGetNamespaceForQualName(interp, pattern, nsPtr, /*flags*/ TCL_LEAVE_ERR_MSG, &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern); /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY), &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern); if (importNsPtr == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "unknown namespace in import pattern \"", pattern, "\"", (char *) NULL); return TCL_ERROR; }
︙
1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284	1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272	+ - - - + + + - - + + - + - - - - - + + + + + + + + + - - - - - - - - + + + + + + + + +	cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr); if (Tcl_StringMatch(cmdName, simplePattern)) { /* * The command cmdName in the source namespace matches the * pattern. Check whether it was exported. If it wasn't, * we ignore it. */ Tcl_HashEntry *found; wasExported = 0; for (i = 0; i < importNsPtr->numExportPatterns; i++) { if (Tcl_StringMatch(cmdName, importNsPtr->exportArrayPtr[i])) { wasExported = 1; break; } } if (!wasExported) { continue; } /* * Unless there is a name clash, create an imported command * in the current namespace that refers to cmdPtr. */ if ((Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) || allowOverwrite) { found = Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName); if ((found == NULL) || allowOverwrite) { /* * Create the imported command and its client data. * To create the new command in the current namespace, * generate a fully qualified name for it. */ Tcl_DString ds; Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, nsPtr->fullName, -1); if (nsPtr != iPtr->globalNsPtr) { Tcl_DStringAppend(&ds, "::", 2); } Tcl_DStringAppend(&ds, cmdName, -1); /* * Check whether creating the new imported command in the * current namespace would create a cycle of imported->real * command references that also would destroy an existing * current namespace would create a cycle of imported * command references. * "real" command already in the current namespace. */ cmdPtr = (Command *) Tcl_GetHashValue(hPtr); if ((found != NULL) if (cmdPtr->deleteProc == DeleteImportedCmd) { realCmdPtr = (Command *) TclGetOriginalCommand( (Tcl_Command) cmdPtr); if ((realCmdPtr != NULL) && (realCmdPtr->nsPtr == currNsPtr) && cmdPtr->deleteProc == DeleteImportedCmd) { Command *overwrite = (Command *) Tcl_GetHashValue(found); Command *link = cmdPtr; while (link->deleteProc == DeleteImportedCmd) { ImportedCmdData *dataPtr; dataPtr = (ImportedCmdData *) link->objClientData; link = dataPtr->realCmdPtr; && (Tcl_FindHashEntry(&currNsPtr->cmdTable, cmdName) != NULL)) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "import pattern \"", pattern, "\" would create a loop containing command \"", Tcl_DStringValue(&ds), "\"", (char *) NULL); Tcl_DStringFree(&ds); return TCL_ERROR; if (overwrite == link) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "import pattern \"", pattern, "\" would create a loop containing ", "command \"", Tcl_DStringValue(&ds), "\"", (char *) NULL); Tcl_DStringFree(&ds); return TCL_ERROR; } } } dataPtr = (ImportedCmdData *) ckalloc(sizeof(ImportedCmdData)); importedCmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds), InvokeImportedCmd,
︙
1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407	1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438	+ + + + + + + + + + - - - - - + + + + + + + + + + + - - - + - + + - + - - - - + - - - + + - - - + + - + + - + - - + + - - - + - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	*/ refPtr = (ImportRef *) ckalloc(sizeof(ImportRef)); refPtr->importedCmdPtr = (Command *) importedCmd; refPtr->nextPtr = cmdPtr->importRefPtr; cmdPtr->importRefPtr = refPtr; } else { Command *overwrite = (Command *) Tcl_GetHashValue(found); if (overwrite->deleteProc == DeleteImportedCmd) { ImportedCmdData *dataPtr = (ImportedCmdData *) overwrite->objClientData; if (dataPtr->realCmdPtr == (Command *) Tcl_GetHashValue(hPtr)) { /* Repeated import of same command -- acceptable */ return TCL_OK; } } Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't import command \"", cmdName, "\": already exists", (char *) NULL); return TCL_ERROR; } } } return TCL_OK; }  /* *---------------------------------------------------------------------- * * Tcl_ForgetImport -- * * Deletes previously imported commands. Given a pattern that may * include the name of an exporting namespace, this procedure first * finds all matching exported commands. It then looks in the namespace * specified by namespacePtr for any corresponding previously imported * commands, which it deletes. If namespacePtr is NULL, commands are * Deletes commands previously imported into the namespace indicated. The * by namespacePtr, or the current namespace of interp, when * namespacePtr is NULL. The pattern controls which imported commands * are deleted. A simple pattern, one without namespace separators, * matches the current command names of imported commands in the * namespace. Matching imported commands are deleted. A qualified * pattern is interpreted as deletion selection on the basis of where * the command is imported from. The original command and "first link" * command for each imported command are determined, and they are matched * against the pattern. A match leads to deletion of the imported * command. * deleted from the current namespace. * * Results: * Returns TCL_OK if successful. If there is an error, returns * TCL_ERROR and puts an error message in the interpreter's result * Returns TCL_ERROR and records an error message in the interp * object. * result if a namespace qualified pattern refers to a namespace * that does not exist. Otherwise, returns TCL_OK. * * Side effects: * May delete commands. * *---------------------------------------------------------------------- */ int Tcl_ForgetImport(interp, namespacePtr, pattern) Tcl_Interp *interp; /* Current interpreter. */ Tcl_Namespace *namespacePtr; /* Points to the namespace from which * previously imported commands should be * removed. NULL for current namespace. */ CONST char *pattern; /* String pattern indicating which imported * commands to remove. This pattern should * commands to remove. */ * be qualified by the name of the * namespace from which the command(s) were * imported. */ { Namespace *nsPtr, *importNsPtr, *dummyPtr, *actualCtxPtr; Namespace *nsPtr, *sourceNsPtr, *dummyPtr; CONST char *simplePattern; char *cmdName; register Tcl_HashEntry *hPtr; Tcl_HashSearch search; Command *cmdPtr; /* * If the specified namespace is NULL, use the current namespace. */ if (namespacePtr == NULL) { nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); } else { nsPtr = (Namespace *) namespacePtr; } /* * From the pattern, find the namespace from which we are importing * and get the simple pattern (no namespace qualifiers or ::'s) at * Parse the pattern into its namespace-qualification (if any) * and the simple pattern. * the end. */ TclGetNamespaceForQualName(interp, pattern, nsPtr, /*flags*/ TCL_LEAVE_ERR_MSG, &importNsPtr, &dummyPtr, &actualCtxPtr, &simplePattern); /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY), &sourceNsPtr, &dummyPtr, &dummyPtr, &simplePattern); if (importNsPtr == NULL) { if (sourceNsPtr == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "unknown namespace in namespace forget pattern \"", pattern, "\"", (char *) NULL); return TCL_ERROR; } if (strcmp(pattern, simplePattern) == 0) { /* /* * Scan through the command table in the source namespace and look for * exported commands that match the string pattern. If the current * The pattern is simple. * Delete any imported commands that match it. * namespace has an imported command that refers to one of those real * commands, delete it. */ */ for (hPtr = Tcl_FirstHashEntry(&importNsPtr->cmdTable, &search); (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) { cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr); if (Tcl_StringMatch(cmdName, simplePattern)) { hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName); if (hPtr != NULL) { /* cmd of same name in current namespace */ cmdPtr = (Command *) Tcl_GetHashValue(hPtr); if (cmdPtr->deleteProc == DeleteImportedCmd) { Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); } } } for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) { Command *cmdPtr = (Command *) Tcl_GetHashValue(hPtr); if (cmdPtr->deleteProc != DeleteImportedCmd) { continue; } cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, hPtr); if (Tcl_StringMatch(cmdName, simplePattern)) { Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); } } return TCL_OK; } /* The pattern was namespace-qualified */ for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) { Tcl_CmdInfo info; Tcl_Command token = (Tcl_Command) Tcl_GetHashValue(hPtr); Tcl_Command origin = TclGetOriginalCommand(token); if (Tcl_GetCommandInfoFromToken(origin, &info) == 0) { continue; /* Not an imported command */ } if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) { /* * Original not in namespace we're matching. * Check the first link in the import chain. */ Command *cmdPtr = (Command *) token; ImportedCmdData *dataPtr = (ImportedCmdData *) cmdPtr->objClientData; Tcl_Command firstToken = (Tcl_Command) dataPtr->realCmdPtr; if (firstToken == origin) { continue; } Tcl_GetCommandInfoFromToken(firstToken, &info); if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) { continue; } origin = firstToken; } if (Tcl_StringMatch(Tcl_GetCommandName(NULL, origin), simplePattern)) { Tcl_DeleteCommandFromToken(interp, token); } } return TCL_OK; }  /* *---------------------------------------------------------------------- *
︙
1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632	1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662	- + -	Tcl_Interp *interp; /* Interpreter in which to find the * namespace containing qualName. */ CONST char *qualName; /* A namespace-qualified name of an * command, variable, or namespace. */ Namespace *cxtNsPtr; /* The namespace in which to start the * search for qualName's namespace. If NULL * start from the current namespace. * Ignored if TCL_GLOBAL_ONLY or * Ignored if TCL_GLOBAL_ONLY is set. */ * TCL_NAMESPACE_ONLY are set. */ int flags; /* Flags controlling the search: an OR'd * combination of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY, * CREATE_NS_IF_UNKNOWN, and * FIND_ONLY_NS. */ Namespace **nsPtrPtr; /* Address where procedure stores a pointer * to containing namespace if qualName is
︙
1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685	1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712	- - - - - - + + + + + - - - +	CONST char *nsName; Tcl_HashEntry *entryPtr; Tcl_DString buffer; int len; /* * Determine the context namespace nsPtr in which to start the primary * search. If TCL_NAMESPACE_ONLY or FIND_ONLY_NS was specified, search * from the current namespace. If the qualName name starts with a "::" * or TCL_GLOBAL_ONLY was specified, search from the global * namespace. Otherwise, use the given namespace given in cxtNsPtr, or * if that is NULL, use the current namespace context. Note that we * always treat two or more adjacent ":"s as a namespace separator. * search. If the qualName name starts with a "::" or TCL_GLOBAL_ONLY * was specified, search from the global namespace. Otherwise, use the * namespace given in cxtNsPtr, or if that is NULL, use the current * namespace context. Note that we always treat two or more * adjacent ":"s as a namespace separator. */ if (flags & (TCL_NAMESPACE_ONLY | FIND_ONLY_NS)) { nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); } else if (flags & TCL_GLOBAL_ONLY) { if (flags & TCL_GLOBAL_ONLY) { nsPtr = globalNsPtr; } else if (nsPtr == NULL) { if (iPtr->varFramePtr != NULL) { nsPtr = iPtr->varFramePtr->nsPtr; } else { nsPtr = iPtr->globalNsPtr; }
︙
2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045	2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073	- - - - + + + + +	*/ cmdPtr = NULL; for (search = 0; (search < 2) && (cmdPtr == NULL); search++) { if ((nsPtr[search] != NULL) && (simpleName != NULL)) { entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable, simpleName); if (entryPtr != NULL) { cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); } } if (entryPtr != NULL) { cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); } } } if (cmdPtr != NULL) { return (Tcl_Command) cmdPtr; } else if (flags & TCL_LEAVE_ERR_MSG) { Tcl_ResetResult(interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "unknown command \"", name, "\"", (char *) NULL); }
︙
2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880	2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908	- +	* the command line are valid, and report any errors. */ for (i = 2; i < objc; i++) { name = Tcl_GetString(objv[i]); namespacePtr = Tcl_FindNamespace(interp, name, (Tcl_Namespace *) NULL, /*flags*/ 0); if (namespacePtr == NULL) { if (namespacePtr == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "unknown namespace \"", Tcl_GetString(objv[i]), "\" in namespace delete command", (char *) NULL); return TCL_ERROR; } }
︙
2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993	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 3028 3029 3030 3031 3032	+ + + + + + + + + + +	if (result != TCL_OK) { return TCL_ERROR; } frame.objc = objc; frame.objv = objv; /* ref counts do not need to be incremented here */ if (objc == 4) { #ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, objv[3], 0); #else /* TIP #280 : Make invoker available to eval'd script */ Interp* iPtr = (Interp*) interp; result = TclEvalObjEx(interp, objv[3], 0, iPtr->cmdFramePtr,3); #endif } else { /* * More than one argument: concatenate them together with spaces * between, then evaluate the result. Tcl_EvalObjEx will delete * the object when it decrements its refcount after eval'ing it. */ objPtr = Tcl_ConcatObj(objc-3, objv+3); #ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT); #else /* TIP #280. Make invoking context available to eval'd script */ result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0); #endif } if (result == TCL_ERROR) { char msg[256 + TCL_INTEGER_SPACE]; sprintf(msg, "\n (in namespace eval \"%.200s\" script line %d)", namespacePtr->fullName, interp->errorLine); Tcl_AddObjErrorInfo(interp, msg, -1);
︙

︙
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	- +	* Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1998 by Scriptics Corporation. * Copyright (c) 2003 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclNotify.c,v 1.11 2003/02/15 20:24:10 kennykb Exp $ * RCS: @(#) $Id: tclNotify.c,v 1.11.2.2 2005/04/26 00:46:02 das Exp $ */ #include "tclInt.h" #include "tclPort.h" extern TclStubs tclStubs;
︙
64 65 66 67 68 69 70 71 72 73 74 75 76 77	64 65 66 67 68 69 70 71 72 73 74 75 76 77 78	+	* called during an event source traversal. */ EventSource *firstEventSourcePtr; /* Pointer to first event source in * list of event sources for this thread. */ Tcl_ThreadId threadId; /* Thread that owns this notifier instance. */ ClientData clientData; /* Opaque handle for platform specific * notifier. */ int initialized; /* 1 if notifier has been initialized. */ struct ThreadSpecificData *nextPtr; /* Next notifier in global list of notifiers. * Access is controlled by the listLock global * mutex. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey;
︙
114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157	115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171	+ - + + + + + + + + + + + + +	{ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_MutexLock(&listLock); tsdPtr->threadId = Tcl_GetCurrentThread(); tsdPtr->clientData = tclStubs.tcl_InitNotifier(); tsdPtr->initialized = 1; tsdPtr->nextPtr = firstNotifierPtr; firstNotifierPtr = tsdPtr; Tcl_MutexUnlock(&listLock); }  /* *---------------------------------------------------------------------- * * TclFinalizeNotifier -- * * Finalize the thread local data structures for the notifier * subsystem. * * Results: * None. * * Side effects: * Removes the notifier associated with the current thread from * the global notifier list. * the global notifier list. This is done only if the notifier * was initialized for this thread by call to TclInitNotifier(). * This is always true for threads which have been seeded with * an Tcl interpreter, since the call to Tcl_CreateInterp will, * among other things, call TclInitializeSubsystems() and this * one will, in turn, call the TclInitNotifier() for the thread. * For threads created without the Tcl interpreter, though, * nobody is explicitly nor implicitly calling the TclInitNotifier * hence, TclFinalizeNotifier should not be performed at all. * *---------------------------------------------------------------------- */ void TclFinalizeNotifier() { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ThreadSpecificData **prevPtrPtr; Tcl_Event *evPtr, *hold; if (!tsdPtr->initialized) { return; /* Notifier not initialized for the current thread */ } Tcl_MutexLock(&(tsdPtr->queueMutex)); for (evPtr = tsdPtr->firstEventPtr; evPtr != (Tcl_Event *) NULL; ) { hold = evPtr; evPtr = evPtr->nextPtr; ckfree((char *) hold); }
︙
168 169 170 171 172 173 174 175 176 177 178 179 180 181	182 183 184 185 186 187 188 189 190 191 192 193 194 195 196	+	for (prevPtrPtr = &firstNotifierPtr; *prevPtrPtr != NULL; prevPtrPtr = &((*prevPtrPtr)->nextPtr)) { if (*prevPtrPtr == tsdPtr) { *prevPtrPtr = tsdPtr->nextPtr; break; } } tsdPtr->initialized = 0; Tcl_MutexUnlock(&listLock); }  /* *---------------------------------------------------------------------- *
︙
860 861 862 863 864 865 866 867 868 869 870 871 872 873 874	875 876 877 878 879 880 881 882 883 884 885 886 887 888 889	- +	} /* * Ask Tcl to service a queued event, if there are any. */ if (Tcl_ServiceEvent(flags)) { result = 1; result = 1; break; } /* * If TCL_DONT_WAIT is set, be sure to poll rather than * blocking, otherwise reset the block time to infinity. */
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	/* * tclObj.c -- * * This file contains Tcl object-related procedures that are used by * many Tcl commands. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation. * Copyright (c) 2001 by ActiveState Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclObj.c,v 1.42 2003/01/17 22:11:02 mdejong Exp $ * RCS: @(#) $Id: tclObj.c,v 1.42.2.14 2005/11/29 14:02:04 dkf Exp $ */ #include "tclInt.h" #include "tclCompile.h" #include "tclPort.h" /*
︙
56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75	56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78	+ + - + +	static int SetBooleanFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static int SetDoubleFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static int SetIntFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static int SetIntOrWideFromAny _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *objPtr)); static void UpdateStringOfBoolean _ANSI_ARGS_((Tcl_Obj *objPtr)); static void UpdateStringOfDouble _ANSI_ARGS_((Tcl_Obj *objPtr)); static void UpdateStringOfInt _ANSI_ARGS_((Tcl_Obj *objPtr)); #ifndef TCL_WIDE_INT_IS_LONG static int SetWideIntFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); #ifndef TCL_WIDE_INT_IS_LONG static void UpdateStringOfWideInt _ANSI_ARGS_((Tcl_Obj *objPtr)); #endif /* * Prototypes for the array hash key methods. */
︙
122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163	125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175	- + + + + - + + + + + + +	"int", /* name */ (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */ UpdateStringOfInt, /* updateStringProc */ SetIntFromAny /* setFromAnyProc */ }; #ifndef TCL_WIDE_INT_IS_LONG Tcl_ObjType tclWideIntType = { "wideInt", /* name */ (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */ #ifdef TCL_WIDE_INT_IS_LONG UpdateStringOfInt, /* updateStringProc */ #else /* !TCL_WIDE_INT_IS_LONG */ UpdateStringOfWideInt, /* updateStringProc */ #endif SetWideIntFromAny /* setFromAnyProc */ }; #endif /* * The structure below defines the Tcl obj hash key type. */ Tcl_HashKeyType tclObjHashKeyType = { TCL_HASH_KEY_TYPE_VERSION, /* version */ 0, /* flags */ HashObjKey, /* hashKeyProc */ CompareObjKeys, /* compareKeysProc */ AllocObjEntry, /* allocEntryProc */ FreeObjEntry /* freeEntryProc */ }; /* * The structure below defines the command name Tcl object type by means of * procedures that can be invoked by generic object code. Objects of this * type cache the Command pointer that results from looking up command names * in the command hashtable. Such objects appear as the zeroth ("command * name") argument in a Tcl command. * * NOTE: the ResolvedCmdName that gets cached is stored in the * twoPtrValue.ptr1 field, and the twoPtrValue.ptr2 field is unused. * You might think you could use the simpler otherValuePtr field to * store the single ResolvedCmdName pointer, but DO NOT DO THIS. It * seems that some extensions use the second internal pointer field * of the twoPtrValue field for their own purposes. */ static Tcl_ObjType tclCmdNameType = { "cmdName", /* name */ FreeCmdNameInternalRep, /* freeIntRepProc */ DupCmdNameInternalRep, /* dupIntRepProc */ (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
︙
229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245	241 242 243 244 245 246 247 248 249 250 251 252 253 254 255	- -	Tcl_MutexUnlock(&tableMutex); Tcl_RegisterObjType(&tclBooleanType); Tcl_RegisterObjType(&tclByteArrayType); Tcl_RegisterObjType(&tclDoubleType); Tcl_RegisterObjType(&tclEndOffsetType); Tcl_RegisterObjType(&tclIntType); #ifndef TCL_WIDE_INT_IS_LONG Tcl_RegisterObjType(&tclWideIntType); #endif Tcl_RegisterObjType(&tclStringType); Tcl_RegisterObjType(&tclListType); Tcl_RegisterObjType(&tclByteCodeType); Tcl_RegisterObjType(&tclProcBodyType); Tcl_RegisterObjType(&tclArraySearchType); Tcl_RegisterObjType(&tclIndexType); Tcl_RegisterObjType(&tclNsNameType);
︙
258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301	268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313	- + - + - - + - + - + + + + + + + - - -	Tcl_MutexUnlock(&tclObjMutex); #endif }  /* *---------------------------------------------------------------------- * * TclFinalizeCompExecEnv -- * TclFinalizeObjects -- * * This procedure is called by Tcl_Finalize to clean up the Tcl * This procedure is called by Tcl_Finalize to clean up all * compilation and execution environment so it can later be properly * reinitialized. * registered Tcl_ObjType's and to reset the tclFreeObjList. * * Results: * None. * * Side effects: * Cleans up the compilation and execution environment * None. * *---------------------------------------------------------------------- */ void TclFinalizeCompExecEnv() TclFinalizeObjects() { Tcl_MutexLock(&tableMutex); if (typeTableInitialized) { Tcl_DeleteHashTable(&typeTable); typeTableInitialized = 0; } Tcl_MutexUnlock(&tableMutex); /* * All we do here is reset the head pointer of the linked list of * free Tcl_Obj's to NULL; the memory finalization will take care * of releasing memory for us. */ Tcl_MutexLock(&tclObjMutex); tclFreeObjList = NULL; Tcl_MutexUnlock(&tclObjMutex); TclFinalizeCompilation(); TclFinalizeExecution(); }  /* *-------------------------------------------------------------- * * Tcl_RegisterObjType -- *
︙
315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348	327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344	- - - - - - - - - - + - - - - - + - - -	void Tcl_RegisterObjType(typePtr) Tcl_ObjType *typePtr; /* Information about object type; * storage must be statically * allocated (must live forever). */ { register Tcl_HashEntry *hPtr; int new; /* * If there's already an object type with the given name, remove it. */ Tcl_MutexLock(&tableMutex); hPtr = Tcl_FindHashEntry(&typeTable, typePtr->name); if (hPtr != (Tcl_HashEntry *) NULL) { Tcl_DeleteHashEntry(hPtr); } Tcl_SetHashValue( /* * Now insert the new object type. */ hPtr = Tcl_CreateHashEntry(&typeTable, typePtr->name, &new); Tcl_CreateHashEntry(&typeTable, typePtr->name, &new), typePtr); if (new) { Tcl_SetHashValue(hPtr, typePtr); } Tcl_MutexUnlock(&tableMutex); }  /* *---------------------------------------------------------------------- * * Tcl_AppendAllObjTypes --
︙
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 402	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 402	+ - - - + + + + + + + + + + + - + - - - + + - - - -	Tcl_Interp *interp; /* Interpreter used for error reporting. */ Tcl_Obj *objPtr; /* Points to the Tcl object onto which the * name of each registered type is appended * as a list element. */ { register Tcl_HashEntry *hPtr; Tcl_HashSearch search; int objc; Tcl_ObjType *typePtr; int result; Tcl_Obj **objv; /* * Get the test for a valid list out of the way first. */ if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) { return TCL_ERROR; } /* * Type names are NUL-terminated, not counted strings. * This code assumes that types names do not contain embedded NULLs. * This code relies on that. */ Tcl_MutexLock(&tableMutex); for (hPtr = Tcl_FirstHashEntry(&typeTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr); result = Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(typePtr->name, -1)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(Tcl_GetHashKey(&typeTable, hPtr), -1)); if (result == TCL_ERROR) { Tcl_MutexUnlock(&tableMutex); return result; } } Tcl_MutexUnlock(&tableMutex); return TCL_OK; }  /* *----------------------------------------------------------------------
︙
417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441	417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439	- + - - - +	*/ Tcl_ObjType * Tcl_GetObjType(typeName) CONST char *typeName; /* Name of Tcl object type to look up. */ { register Tcl_HashEntry *hPtr; Tcl_ObjType *typePtr; Tcl_ObjType *typePtr = NULL; Tcl_MutexLock(&tableMutex); hPtr = Tcl_FindHashEntry(&typeTable, typeName); if (hPtr != (Tcl_HashEntry *) NULL) { typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr); Tcl_MutexUnlock(&tableMutex); return typePtr; } Tcl_MutexUnlock(&tableMutex); return NULL; return typePtr; }  /* *---------------------------------------------------------------------- * * Tcl_ConvertToType -- *
︙
615 616 617 618 619 620 621 622 623 624 625 626 627 628 629	613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630	- + + + +	register Tcl_Obj *prevPtr, *objPtr; register int i; /* * This has been noted by Purify to be a potential leak. The problem is * that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated * Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of * actually freeing the memory. These never do get freed properly. * actually freeing the memory. TclFinalizeObjects() does not ckfree() * this memory, but leaves it to Tcl's memory subsystem finalziation to * release it. Purify apparently can't figure that out, and fires a * false alarm. */ basePtr = (char *) ckalloc(bytesToAlloc); memset(basePtr, 0, bytesToAlloc); prevPtr = NULL; objPtr = (Tcl_Obj *) basePtr;
︙
873 874 875 876 877 878 879 880 881 882 883 884 885 886 887	874 875 876 877 878 879 880 881 882 883 884 885 886 887 888	- +	/* *---------------------------------------------------------------------- * * Tcl_NewBooleanObj -- * * This procedure is normally called when not debugging: i.e., when * TCL_MEM_DEBUG is not defined. It creates a new boolean object and * TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and * initializes it from the argument boolean value. A nonzero * "boolValue" is coerced to 1. * * When TCL_MEM_DEBUG is defined, this procedure just returns the * result of calling the debugging version Tcl_DbNewBooleanObj. * * Results:
︙
1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120	1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119	- - + -	* of numerical type, parse its string rep. */ if (objPtr->typePtr == &tclIntType) { newBool = (objPtr->internalRep.longValue != 0); } else if (objPtr->typePtr == &tclDoubleType) { newBool = (objPtr->internalRep.doubleValue != 0.0); #ifndef TCL_WIDE_INT_IS_LONG } else if (objPtr->typePtr == &tclWideIntType) { newBool = (objPtr->internalRep.wideValue != Tcl_LongAsWide(0)); newBool = (objPtr->internalRep.wideValue != 0); #endif /* TCL_WIDE_INT_IS_LONG */ } else { /* * Copy the string converting its characters to lower case. */ for (i = 0; (i < 9) && (i < length); i++) { c = string[i];
︙
1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843	1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902	- + - - - + + + + + + + + + + + + + + + - - - + + + + + - + + + - + - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - + + + - - + - - - - - - + + + + + +	int Tcl_GetIntFromObj(interp, objPtr, intPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr; /* The object from which to get a int. */ register int *intPtr; /* Place to store resulting int. */ { register long l; int result; Tcl_WideInt w = 0; if (objPtr->typePtr != &tclIntType) { result = SetIntFromAny(interp, objPtr); /* * If the object isn't already an integer of any width, try to * convert it to one. */ if (objPtr->typePtr != &tclIntType && objPtr->typePtr != &tclWideIntType) { result = SetIntOrWideFromAny(interp, objPtr); if (result != TCL_OK) { return result; } } /* * Object should now be either int or wide. Get its value. */ #ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { l = objPtr->internalRep.longValue; if (((long)((int)l)) == l) { *intPtr = (int)objPtr->internalRep.longValue; w = objPtr->internalRep.wideValue; } else #endif { w = Tcl_LongAsWide(objPtr->internalRep.longValue); return TCL_OK; } if ((LLONG_MAX > UINT_MAX) && ((w > UINT_MAX) || (w < -(Tcl_WideInt)UINT_MAX))) { if (interp != NULL) { if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "integer value too large to represent as non-long integer", -1); } return TCL_ERROR; Tcl_SetObjResult(interp, Tcl_NewStringObj( "integer value too large to represent as non-long integer", -1)); } return TCL_ERROR; } *intPtr = (int)w; return TCL_OK; }  /* *---------------------------------------------------------------------- * * SetIntFromAny -- * * Attempts to force the internal representation for a Tcl object * to tclIntType, specifically. * * Results: * The return value is a standard object Tcl result. If an * error occurs during conversion, an error message is left in * the interpreter's result unless "interp" is NULL. * *---------------------------------------------------------------------- */ static int SetIntFromAny( Tcl_Interp* interp, /* Tcl interpreter */ Tcl_Obj* objPtr ) /* Pointer to the object to convert */ { int result; result = SetIntOrWideFromAny( interp, objPtr ); if ( result != TCL_OK ) { return result; } if ( objPtr->typePtr != &tclIntType ) { if ( interp != NULL ) { char *s = "integer value too large to represent"; Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL); } return TCL_ERROR; } return TCL_OK; }  /* *---------------------------------------------------------------------- * * SetIntOrWideFromAny -- * * Attempt to generate an integer internal form for the Tcl object * "objPtr". * * Results: * The return value is a standard object Tcl result. If an error occurs * during conversion, an error message is left in the interpreter's * result unless "interp" is NULL. * * Side effects: * If no error occurs, an int is stored as "objPtr"s internal * representation. * *---------------------------------------------------------------------- */ static int SetIntFromAny(interp, objPtr) SetIntOrWideFromAny(interp, objPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr; /* The object to convert. */ { Tcl_ObjType *oldTypePtr = objPtr->typePtr; char *string, *end; int length; register char *p; long newLong; unsigned long newLong; int isNegative = 0; int isWide = 0; /* * Get the string representation. Make it up-to-date if necessary. */ p = string = Tcl_GetStringFromObj(objPtr, &length); /* * Now parse "objPtr"s string as an int. We use an implementation here * that doesn't report errors in interp if interp is NULL. Note: use * strtoul instead of strtol for integer conversions to allow full-size * unsigned numbers, but don't depend on strtoul to handle sign * characters; it won't in some implementations. */ errno = 0; #ifdef TCL_STRTOUL_SIGN_CHECK for ( ; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */ /* Empty loop body. */ } if (*p == '-') { p++; newLong = -((long)strtoul(p, &end, 0)); isNegative = 1; } else if (*p == '+') { p++; newLong = strtoul(p, &end, 0); } else #else newLong = strtoul(p, &end, 0); #endif if (end == p) { } if (!isdigit(UCHAR(*p))) { badInteger: if (interp != NULL) { /* * Must copy string before resetting the result in case a caller * is trying to convert the interpreter's result to an int. */ char buf[100]; sprintf(buf, "expected integer but got \"%.50s\"", string); Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1); TclCheckBadOctal(interp, string); } return TCL_ERROR; } newLong = strtoul(p, &end, 0); if (end == p) { goto badInteger; } if (errno == ERANGE) { if (interp != NULL) { char *s = "integer value too large to represent"; Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
︙
1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879	1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957	+ + + + + + + + + + + + + + + + + - - + + + +	&& isspace(UCHAR(*end))) { /* INTL: ISO space. */ end++; } if (end != (string+length)) { goto badInteger; } /* * If the resulting integer will exceed the range of a long, * put it into a wide instead. (Tcl Bug #868489) */ #ifndef TCL_WIDE_INT_IS_LONG if ((isNegative && newLong > (unsigned long) (LONG_MAX) + 1) || (!isNegative && newLong > LONG_MAX)) { isWide = 1; } #endif /* * The conversion to int succeeded. Free the old internalRep before * setting the new one. We do this as late as possible to allow the * conversion code, in particular Tcl_GetStringFromObj, to use that old * internalRep. */ if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) { oldTypePtr->freeIntRepProc(objPtr); } if (isWide) { objPtr->internalRep.wideValue = (isNegative ? -(Tcl_WideInt)newLong : (Tcl_WideInt)newLong); objPtr->typePtr = &tclWideIntType; } else { objPtr->internalRep.longValue = newLong; objPtr->typePtr = &tclIntType; objPtr->internalRep.longValue = (isNegative ? -(long)newLong : (long)newLong); objPtr->typePtr = &tclIntType; } return TCL_OK; }  /* *---------------------------------------------------------------------- * * UpdateStringOfInt --
︙
2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120	2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224	+ + + + + + + + - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + - - + - - +	Tcl_GetLongFromObj(interp, objPtr, longPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr; /* The object from which to get a long. */ register long *longPtr; /* Place to store resulting long. */ { register int result; if (objPtr->typePtr != &tclIntType && objPtr->typePtr != &tclWideIntType) { result = SetIntOrWideFromAny(interp, objPtr); if (result != TCL_OK) { return result; } } #ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclIntType) { *longPtr = objPtr->internalRep.longValue; return TCL_OK; } result = SetIntFromAny(interp, objPtr); if (objPtr->typePtr == &tclWideIntType) { /* * If the object is already a wide integer, don't convert it. * This code allows for any integer in the range -ULONG_MAX to * ULONG_MAX to be 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)(ULONG_MAX) && w <= (Tcl_WideInt)(ULONG_MAX)) { *longPtr = Tcl_WideAsLong(w); return TCL_OK; } else { if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "integer value too large to represent", -1); } return TCL_ERROR; } } #endif if (result == TCL_OK) { *longPtr = objPtr->internalRep.longValue; *longPtr = objPtr->internalRep.longValue; } return result; return TCL_OK; }  /* *---------------------------------------------------------------------- * * SetWideIntFromAny -- *
︙
2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148	2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252	- +	* Side effects: * If no error occurs, an int is stored as "objPtr"s internal * representation. * *---------------------------------------------------------------------- */ #ifndef TCL_WIDE_INT_IS_LONG static int SetWideIntFromAny(interp, objPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr; /* The object to convert. */ { #ifndef TCL_WIDE_INT_IS_LONG Tcl_ObjType *oldTypePtr = objPtr->typePtr; char *string, *end; int length; register char *p; Tcl_WideInt newWide; /*
︙
2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237	2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345	+ + + + + -	*/ if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) { oldTypePtr->freeIntRepProc(objPtr); } objPtr->internalRep.wideValue = newWide; #else if (TCL_ERROR == SetIntFromAny(interp, objPtr)) { return TCL_ERROR; } #endif objPtr->typePtr = &tclWideIntType; return TCL_OK; } #endif  /* *---------------------------------------------------------------------- * * UpdateStringOfWideInt -- * * Update the string representation for a wide integer object.
︙
2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335	2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439	- - - -	#else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewWideIntObj(wideValue) register Tcl_WideInt wideValue; /* Wide integer used to initialize * the new object. */ { #ifdef TCL_WIDE_INT_IS_LONG return Tcl_NewLongObj(wideValue); #else register Tcl_Obj *objPtr; TclNewObj(objPtr); objPtr->bytes = NULL; objPtr->internalRep.wideValue = wideValue; objPtr->typePtr = &tclWideIntType; return objPtr; #endif /* TCL_WIDE_INT_IS_LONG */ } #endif /* if TCL_MEM_DEBUG */  /* *---------------------------------------------------------------------- * * Tcl_DbNewWideIntObj --
︙
2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396	2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496	- - - -	* the new object. */ CONST char *file; /* The name of the source file * calling this procedure; used for * debugging. */ int line; /* Line number in the source file; * used for debugging. */ { #ifdef TCL_WIDE_INT_IS_LONG return Tcl_DbNewLongObj(wideValue, file, line); #else register Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); objPtr->bytes = NULL; objPtr->internalRep.wideValue = wideValue; objPtr->typePtr = &tclWideIntType; return objPtr; #endif } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewWideIntObj(wideValue, file, line) register Tcl_WideInt wideValue; /* Long integer used to initialize
︙
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 2451 2452 2453 2454 2455	2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551	- - - -	void Tcl_SetWideIntObj(objPtr, wideValue) register Tcl_Obj *objPtr; /* Object w. internal rep to init. */ register Tcl_WideInt wideValue; /* Wide integer used to initialize * the object's value. */ { #ifdef TCL_WIDE_INT_IS_LONG Tcl_SetLongObj(objPtr, wideValue); #else register Tcl_ObjType *oldTypePtr = objPtr->typePtr; if (Tcl_IsShared(objPtr)) { panic("Tcl_SetWideIntObj called with shared object"); } if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) { oldTypePtr->freeIntRepProc(objPtr); } objPtr->internalRep.wideValue = wideValue; objPtr->typePtr = &tclWideIntType; Tcl_InvalidateStringRep(objPtr); #endif }  /* *---------------------------------------------------------------------- * * Tcl_GetWideIntFromObj -- *
︙
2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502	2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602	- - - - - - + + + + + + + + + + + -	int Tcl_GetWideIntFromObj(interp, objPtr, wideIntPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr; /* Object from which to get a wide int. */ register Tcl_WideInt *wideIntPtr; /* Place to store resulting long. */ { #ifdef TCL_WIDE_INT_IS_LONG /* * Next line is type-safe because we only do this when long = Tcl_WideInt */ return Tcl_GetLongFromObj(interp, objPtr, wideIntPtr); #else register int result; if (objPtr->typePtr == &tclWideIntType) { gotWide: *wideIntPtr = objPtr->internalRep.wideValue; return TCL_OK; } if (objPtr->typePtr == &tclIntType) { /* * This cast is safe; all valid ints/longs are wides. */ objPtr->internalRep.wideValue = Tcl_LongAsWide(objPtr->internalRep.longValue); objPtr->typePtr = &tclWideIntType; goto gotWide; } result = SetWideIntFromAny(interp, objPtr); if (result == TCL_OK) { *wideIntPtr = objPtr->internalRep.wideValue; } return result; #endif }  /* *---------------------------------------------------------------------- * * Tcl_DbIncrRefCount -- *
︙
2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735	2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835	- + - +	return 1; } /* * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being * in a register. */ p1 = Tcl_GetString (objPtr1); p1 = TclGetString(objPtr1); l1 = objPtr1->length; p2 = Tcl_GetString (objPtr2); p2 = TclGetString(objPtr2); l2 = objPtr2->length; /* * Only compare if the string representations are of the same length. */ if (l1 == l2) { for (;; p1++, p2++, l1--) {
︙
2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837	2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928	- - - - + + + + - - - - - - - + - - - - +	static unsigned int HashObjKey(tablePtr, keyPtr) Tcl_HashTable *tablePtr; /* Hash table. */ VOID *keyPtr; /* Key from which to compute hash value. */ { Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr; register CONST char *string; register int length; register unsigned int result; register int c; CONST char *string = TclGetString(objPtr); int length = objPtr->length; unsigned int result; int i; string = Tcl_GetString (objPtr); length = objPtr->length; /* * I tried a zillion different hash functions and asked many other * people for advice. Many people had their own favorite functions, * all different, but no-one had much idea why they were good ones. * I chose the one below (multiply by 9 and add new character) * because of the following reasons: * * 1. Multiplying by 10 is perfect for keys that are decimal strings, * and multiplying by 9 is just about as good. * 2. Times-9 is (shift-left-3) plus (old). This means that each * character's bits hang around in the low-order bits of the * hash value for ever, plus they spread fairly rapidly up to * the high-order bits to fill out the hash value. This seems * works well both for decimal and non-decimal strings. */ result = 0; while (length) { c = *string; string++; length--; for (i=0 ; i<length ; i++) { if (length == 0) { break; } result += (result<<3) + c; result += (result<<3) + string[i]; } return result; }  /* *---------------------------------------------------------------------- *
︙
2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906	2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997	- +	if (objPtr->typePtr != &tclCmdNameType) { result = tclCmdNameType.setFromAnyProc(interp, objPtr); if (result != TCL_OK) { iPtr->varFramePtr = savedFramePtr; return (Tcl_Command) NULL; } } resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr; resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1; /* * Get the current namespace. */ if (iPtr->varFramePtr != NULL) { currNsPtr = iPtr->varFramePtr->nsPtr;
︙
2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945	3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036	- +	if (cmdPtr == NULL) { result = tclCmdNameType.setFromAnyProc(interp, objPtr); if (result != TCL_OK) { iPtr->varFramePtr = savedFramePtr; return (Tcl_Command) NULL; } resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr; resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1; if (resPtr != NULL) { cmdPtr = resPtr->cmdPtr; } } iPtr->varFramePtr = savedFramePtr; return (Tcl_Command) cmdPtr; }
︙
3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046	3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137	- +	static void FreeCmdNameInternalRep(objPtr) register Tcl_Obj *objPtr; /* CmdName object with internal * representation to free. */ { register ResolvedCmdName *resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr; (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1; if (resPtr != NULL) { /* * Decrement the reference count of the ResolvedCmdName structure. * If there are no more uses, free the ResolvedCmdName structure. */
︙
3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095	3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186	- +	static void DupCmdNameInternalRep(srcPtr, copyPtr) Tcl_Obj *srcPtr; /* Object with internal rep to copy. */ register Tcl_Obj *copyPtr; /* Object with internal rep to set. */ { register ResolvedCmdName *resPtr = (ResolvedCmdName *) srcPtr->internalRep.otherValuePtr; (ResolvedCmdName *) srcPtr->internalRep.twoPtrValue.ptr1; copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr; copyPtr->internalRep.twoPtrValue.ptr2 = NULL; if (resPtr != NULL) { resPtr->refCount++; } copyPtr->typePtr = &tclCmdNameType;
︙

︙
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	- +	* Copyright (c) 1988-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. * * RCS: @(#) $Id: tclPanic.c,v 1.4 2001/06/17 03:48:19 dgp Exp $ * RCS: @(#) $Id: tclPanic.c,v 1.4.12.2 2006/03/09 23:11:23 dgp Exp $ */ #include "tclInt.h" #include "tclPort.h" /* * The panicProc variable contains a pointer to an application
︙

︙
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	- +	* Copyright (c) 1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Ajuba Solutions. * Contributions from Don Porter, NIST, 2002. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclParse.c,v 1.25 2003/02/16 01:36:32 msofer Exp $ * RCS: @(#) $Id: tclParse.c,v 1.25.2.1 2006/09/24 21:15:10 msofer Exp $ */ #include "tclInt.h" #include "tclPort.h" /* * The following table provides parsing information about each possible
︙
234 235 236 237 238 239 240 241 242 243 244 245 246 247 248	234 235 236 237 238 239 240 241 242 243 244 245 246 247 248	- +	int wordIndex; /* Index of word token for current word. */ int terminators; /* CHAR_TYPE bits that indicate the end * of a command. */ CONST char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to * point to char after terminating one. */ int scanned; if ((string == NULL) && (numBytes>0)) { if ((string == NULL) && (numBytes!=0)) { if (interp != NULL) { Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC); } return TCL_ERROR; } if (numBytes < 0) { numBytes = strlen(string);
︙

︙
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	- +	* Copyright (c) 1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 by Scriptics Corporation. * Contributions from Don Porter, NIST, 2002. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclParseExpr.c,v 1.17 2003/02/16 01:36:32 msofer Exp $ * RCS: @(#) $Id: tclParseExpr.c,v 1.17.2.2 2005/05/20 17:19:10 vasiljevic Exp $ */ #include "tclInt.h" /* * The stuff below is a bit of a hack so that this file can be used in * environments that include no UNIX, i.e. no errno: just arrange to use
︙
1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190	1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191	+	firstIndex = parsePtr->numTokens; switch (lexeme) { case LITERAL: /* * Int or double number. */ tokenizeLiteral: if (parsePtr->numTokens == parsePtr->tokensAvailable) { TclExpandTokenArray(parsePtr); } tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->start = infoPtr->start; tokenPtr->size = infoPtr->size;
︙
1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435	1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 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	+ + - + - + - - - - - - - + - - + + + + + + + + + + + + + + + - - - - - + + + + + + + + + + + + +	tokenPtr->type = TCL_TOKEN_WORD; tokenPtr->start = exprTokenPtr->start; tokenPtr->size = exprTokenPtr->size; tokenPtr->numComponents = exprTokenPtr->numComponents-1; } break; case STREQ: case STRNEQ: case FUNC_NAME: case FUNC_NAME: { /* * math_func '(' expr {',' expr} ')' */ if (parsePtr->numTokens == parsePtr->tokensAvailable) { TclExpandTokenArray(parsePtr); } tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; tokenPtr->type = TCL_TOKEN_OPERATOR; tokenPtr->start = infoPtr->start; tokenPtr->size = infoPtr->size; ParseInfo savedInfo = *infoPtr; tokenPtr->numComponents = 0; parsePtr->numTokens++; code = GetLexeme(infoPtr); /* skip over function name */ if (code != TCL_OK) { return code; } if (infoPtr->lexeme != OPEN_PAREN) { int code; Tcl_DString functionName; Tcl_HashEntry *hPtr; Interp *iPtr = (Interp *) infoPtr->parsePtr->interp; Tcl_Obj *objPtr = Tcl_NewStringObj(savedInfo.start, savedInfo.size); /* Check for boolean literals (true, false, yes, no, on, off) */ Tcl_IncrRefCount(objPtr); code = Tcl_ConvertToType(NULL, objPtr, &tclBooleanType); Tcl_DecrRefCount(objPtr); if (code == TCL_OK) { *infoPtr = savedInfo; goto tokenizeLiteral; } /* * Guess what kind of error we have by trying to tell * whether we have a function or variable name here. * Alas, this makes the parser more tightly bound with the * rest of the interpreter, but that is the only way to * give a sensible message here. Still, it is not too * serious as this is only done when generating an error. */ Interp *iPtr = (Interp *) infoPtr->parsePtr->interp; Tcl_DString functionName; Tcl_HashEntry *hPtr; /* * Look up the name as a function name. We need a writable * copy (DString) so we can terminate it with a NULL for * the benefit of Tcl_FindHashEntry which operates on * NULL-terminated string keys. */ Tcl_DStringInit(&functionName); hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, Tcl_DStringAppend(&functionName, tokenPtr->start, tokenPtr->size)); Tcl_DStringAppend(&functionName, savedInfo.start, savedInfo.size)); Tcl_DStringFree(&functionName); /* * Assume that we have an attempted variable reference * unless we've got a function name, as the set of * potential function names is typically much smaller. */ if (hPtr != NULL) { LogSyntaxError(infoPtr, "expected parenthesis enclosing function arguments"); } else { LogSyntaxError(infoPtr, "variable references require preceding $"); } return TCL_ERROR; } if (parsePtr->numTokens == parsePtr->tokensAvailable) { TclExpandTokenArray(parsePtr); } tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; tokenPtr->type = TCL_TOKEN_OPERATOR; tokenPtr->start = savedInfo.start; tokenPtr->size = savedInfo.size; tokenPtr->numComponents = 0; parsePtr->numTokens++; code = GetLexeme(infoPtr); /* skip over '(' */ if (code != TCL_OK) { return code; } while (infoPtr->lexeme != CLOSE_PAREN) { code = ParseCondExpr(infoPtr);
︙
1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462	1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481	+	} } exprTokenPtr = &parsePtr->tokenPtr[exprIndex]; exprTokenPtr->size = (infoPtr->next - exprTokenPtr->start); exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex; break; } case COMMA: LogSyntaxError(infoPtr, "commas can only separate function arguments"); return TCL_ERROR; case END: LogSyntaxError(infoPtr, "premature end of expression");
︙
1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897	1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -	offset = Tcl_UtfToUniChar(utfBytes, &ch); } c = UCHAR(ch); } infoPtr->size = (src - infoPtr->start); infoPtr->next = src; parsePtr->term = infoPtr->next; /* * Check for boolean literals (true, false, yes, no, on, off) */ switch (infoPtr->start[0]) { case 'f': if (infoPtr->size == 5 && strncmp("false", infoPtr->start, 5) == 0) { infoPtr->lexeme = LITERAL; return TCL_OK; } break; case 'n': if (infoPtr->size == 2 && strncmp("no", infoPtr->start, 2) == 0) { infoPtr->lexeme = LITERAL; return TCL_OK; } break; case 'o': if (infoPtr->size == 3 && strncmp("off", infoPtr->start, 3) == 0) { infoPtr->lexeme = LITERAL; return TCL_OK; } else if (infoPtr->size == 2 && strncmp("on", infoPtr->start, 2) == 0) { infoPtr->lexeme = LITERAL; return TCL_OK; } break; case 't': if (infoPtr->size == 4 && strncmp("true", infoPtr->start, 4) == 0) { infoPtr->lexeme = LITERAL; return TCL_OK; } break; case 'y': if (infoPtr->size == 3 && strncmp("yes", infoPtr->start, 3) == 0) { infoPtr->lexeme = LITERAL; return TCL_OK; } break; } return TCL_OK; } infoPtr->lexeme = UNKNOWN_CHAR; return TCL_OK; } }
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclPipe.c -- * * This file contains the generic portion of the command channel * driver as well as various utility routines used in managing * subprocesses. * * Copyright (c) 1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclPipe.c,v 1.7 2002/12/17 02:47:39 davygrvy Exp $ * RCS: @(#) $Id: tclPipe.c,v 1.7.2.5 2006/03/16 00:35:58 andreas_kupries Exp $ */ #include "tclInt.h" #include "tclPort.h" /* * A linked list of the following structures is used to keep track
︙
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84	64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84	- + - - + +	*---------------------------------------------------------------------- */ static TclFile FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr, releasePtr) Tcl_Interp *interp; /* Intepreter to use for error reporting. */ CONST char *spec; /* Points to character just after CONST char *spec; /* Points to character just after * redirection character. */ CONST char *arg; /* Pointer to entire argument containing * spec: used for error reporting. */ int atOK; /* Non-zero means that '@' notation can be * used to specify a channel, zero means that * it isn't. */ CONST char *arg; /* Pointer to entire argument containing * spec: used for error reporting. */ CONST char *nextArg; /* Next argument in argc/argv array, if needed * for file name or channel name. May be * NULL. */ int flags; /* Flags to use for opening file or to * specify mode for channel. */ int *skipPtr; /* Filled with 1 if redirection target was * in spec, 2 if it was in nextArg. */
︙
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119	103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119	- - - + + +	} chan = Tcl_GetChannel(interp, spec, NULL); if (chan == (Tcl_Channel) NULL) { return NULL; } file = TclpMakeFile(chan, writing ? TCL_WRITABLE : TCL_READABLE); if (file == NULL) { Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan), "\" wasn't opened for ", ((writing) ? "writing" : "reading"), (char *) NULL); Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan), "\" wasn't opened for ", ((writing) ? "writing" : "reading"), (char *) NULL); return NULL; } *releasePtr = 1; if (writing) { /* * Be sure to flush output to the file, so that anything
︙
131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149	131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148	- + - - - + +	spec = nextArg; if (spec == NULL) { goto badLastArg; } *skipPtr = 2; } name = Tcl_TranslateFileName(interp, spec, &nameString); if (name != NULL) { if (name == NULL) { file = TclpOpenFile(name, flags); } else { file = NULL; return NULL; } file = TclpOpenFile(name, flags); Tcl_DStringFree(&nameString); if (file == NULL) { Tcl_AppendResult(interp, "couldn't ", ((writing) ? "write" : "read"), " file \"", spec, "\": ", Tcl_PosixError(interp), (char *) NULL); return NULL; }
︙
504 505 506 507 508 509 510 511 512 513 514 515 516 517 518	503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518	+ - +	TclFile errorFile = NULL; /* Writable file for error output from all * commands in pipeline. NULL means use * stderr. */ int errorClose = 0; /* If non-zero, then errorFile should be * closed when cleaning up. */ int errorRelease = 0; CONST char *p; CONST char *nextArg; int skip, lastBar, lastArg, i, j, atOK, flags, errorToOutput; int skip, lastBar, lastArg, i, j, atOK, flags, needCmd, errorToOutput = 0; Tcl_DString execBuffer; TclFile pipeIn; TclFile curInFile, curOutFile, curErrFile; Tcl_Channel channel; if (inPipePtr != NULL) { *inPipePtr = NULL;
︙
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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615	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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624	+ + - + + - + + - + - + + + + + + - +	* because the redirection symbols may appear anywhere in the * command line -- e.g., the '<' that specifies the input to the * entire pipe may appear at the very end of the argument list. */ lastBar = -1; cmdCount = 1; needCmd = 1; for (i = 0; i < argc; i++) { errorToOutput = 0; skip = 0; skip = 0; p = argv[i]; switch (*p++) { case '|': if (*p == '&') { p++; } if (*p == '\0') { if ((i == (lastBar + 1)) || (i == (argc - 1))) { Tcl_SetResult(interp, "illegal use of | or |& in command", TCL_STATIC); goto error; } } lastBar = i; cmdCount++; needCmd = 1; break; case '<': if (inputClose != 0) { inputClose = 0; TclpCloseFile(inputFile); } if (inputRelease != 0) { inputRelease = 0; TclpReleaseFile(inputFile); } if (*p == '<') { inputFile = NULL; inputLiteral = p + 1; skip = 1; if (*inputLiteral == '\0') { inputLiteral = argv[i + 1]; inputLiteral = ((i + 1) == argc) ? NULL : argv[i + 1]; if (inputLiteral == NULL) { Tcl_AppendResult(interp, "can't specify \"", argv[i], "\" as last word in command", (char *) NULL); goto error; } skip = 2; } } else { nextArg = ((i + 1) == argc) ? NULL : argv[i + 1]; inputLiteral = NULL; inputFile = FileForRedirect(interp, p, 1, argv[i], argv[i + 1], O_RDONLY, &skip, &inputClose, &inputRelease); nextArg, O_RDONLY, &skip, &inputClose, &inputRelease); if (inputFile == NULL) { goto error; } } break; case '>': atOK = 1; flags = O_WRONLY | O_CREAT | O_TRUNC; errorToOutput = 0; if (*p == '>') { p++; atOK = 0; /* * Note that the O_APPEND flag only has an effect on POSIX * platforms. On Windows, we just have to carry on regardless. */ flags = O_WRONLY | O_CREAT; flags = O_WRONLY | O_CREAT | O_APPEND; } if (*p == '&') { if (errorClose != 0) { errorClose = 0; TclpCloseFile(errorFile); } errorToOutput = 1;
︙
633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648	642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658	+ - +	outputRelease = 0; if (errorFile == outputFile) { errorRelease = 1; } else { TclpReleaseFile(outputFile); } } nextArg = ((i + 1) == argc) ? NULL : argv[i + 1]; outputFile = FileForRedirect(interp, p, atOK, argv[i], argv[i + 1], flags, &skip, &outputClose, &outputRelease); nextArg, flags, &skip, &outputClose, &outputRelease); if (outputFile == NULL) { goto error; } if (errorToOutput) { if (errorClose != 0) { errorClose = 0; TclpCloseFile(errorFile);
︙
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	681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741	+ + + + + + + + + + + + + + + + - - - - - + + + + + + + + + + + + + + + + + + + +	errorClose = 0; TclpCloseFile(errorFile); } if (errorRelease != 0) { errorRelease = 0; TclpReleaseFile(errorFile); } if (atOK && p[0] == '@' && p[1] == '1' && p[2] == '\0') { /* * Special case handling of 2>@1 to redirect stderr to the * exec/open output pipe as well. This is meant for the end * of the command string, otherwise use |& between commands. */ if (i != argc - 1) { Tcl_AppendResult(interp, "must specify \"", argv[i], "\" as last word in command", (char *) NULL); goto error; } errorFile = outputFile; errorToOutput = 2; skip = 1; } else { nextArg = ((i + 1) == argc) ? NULL : argv[i + 1]; errorFile = FileForRedirect(interp, p, atOK, argv[i], argv[i + 1], flags, &skip, &errorClose, &errorRelease); if (errorFile == NULL) { goto error; } errorFile = FileForRedirect(interp, p, atOK, argv[i], nextArg, flags, &skip, &errorClose, &errorRelease); if (errorFile == NULL) { goto error; } } break; default: /* Got a command word, not a redirection */ needCmd = 0; break; } if (skip != 0) { for (j = i + skip; j < argc; j++) { argv[j - skip] = argv[j]; } argc -= skip; i -= 1; } } if (needCmd) { /* We had a bar followed only by redirections. */ Tcl_SetResult(interp, "illegal use of | or |& in command", TCL_STATIC); goto error; } if (inputFile == NULL) { if (inputLiteral != NULL) { /* * The input for the first process is immediate data coming from * Tcl. Create a temporary file for it and put the data into the * file.
︙
761 762 763 764 765 766 767 768 769 770 771 772 773 774 775	802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821	+ + + + + - +	outputRelease = 1; } } } } if (errorFile == NULL) { if (errorToOutput == 2) { /* * Handle 2>@1 special case at end of cmd line */ errorFile = outputFile; if (errFilePtr != NULL) { } else if (errFilePtr != NULL) { /* * Set up the standard error output sink for the pipeline, if * requested. Use a temporary file which is opened, then deleted. * Could potentially just use pipe, but if it filled up it could * cause the pipeline to deadlock: we'd be waiting for processes * to complete before reading stderr, and processes couldn't * complete because stderr was backed up.
︙
833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857	879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903	- - + +	} if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == '\0')) { joinThisError = 1; break; } } } argv[lastArg] = NULL; /* * If this is the last segment, use the specified outputFile. * Otherwise create an intermediate pipe. pipeIn will become the * curInFile for the next segment of the pipe. */ if (lastArg == argc) { if (lastArg == argc) { curOutFile = outputFile; } else { argv[lastArg] = NULL; if (TclpCreatePipe(&pipeIn, &curOutFile) == 0) { Tcl_AppendResult(interp, "couldn't create pipe: ", Tcl_PosixError(interp), (char *) NULL); goto error; } }
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	+ - + + + + +	/* * tclPkg.c -- * * This file implements package and version control for Tcl via * the "package" command and a few C APIs. * * Copyright (c) 1996 Sun Microsystems, Inc. * Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclPkg.c,v 1.9 2002/02/22 22:36:09 dgp Exp $ * RCS: @(#) $Id: tclPkg.c,v 1.9.2.9 2007/03/19 17:06:26 dgp Exp $ * * TIP #268. * Heavily rewritten to handle the extend version numbers, and extended * package requirements. */ #include "tclInt.h" /* * Each invocation of the "package ifneeded" command creates a structure * of the following type, which is used to load the package into the
︙
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66	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	+ + + + + + + + + + + + + + + + + + + + +	ClientData clientData; /* Client data. */ } Package; /* * Prototypes for procedures defined in this file: */ #ifndef TCL_TIP268 static int CheckVersion _ANSI_ARGS_((Tcl_Interp *interp, CONST char *string)); static int ComparePkgVersions _ANSI_ARGS_((CONST char *v1, CONST char *v2, int *satPtr)); static Package * FindPackage _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name)); #else static int CheckVersionAndConvert(Tcl_Interp *interp, CONST char *string, char** internal, int* stable); static int CompareVersions(CONST char *v1i, CONST char *v2i, int *isMajorPtr); static int CheckRequirement(Tcl_Interp *interp, CONST char *string); static int CheckAllRequirements(Tcl_Interp* interp, int reqc, Tcl_Obj *CONST reqv[]); static int RequirementSatisfied(CONST char *havei, CONST char *req); static int AllRequirementsSatisfied(CONST char *havei, int reqc, Tcl_Obj *CONST reqv[]); static void AddRequirementsToResult(Tcl_Interp* interp, int reqc, Tcl_Obj *CONST reqv[]); static void AddRequirementsToDString(Tcl_DString* dstring, int reqc, Tcl_Obj *CONST reqv[]); static Package * FindPackage(Tcl_Interp *interp, CONST char *name); static Tcl_Obj* ExactRequirement(CONST char* version); static void VersionCleanupProc(ClientData clientData, Tcl_Interp *interp); #endif  /* *---------------------------------------------------------------------- * * Tcl_PkgProvide / Tcl_PkgProvideEx -- * * This procedure is invoked to declare that a particular version
︙
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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133	105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179	- + - - + + - + - - - - + + + + + + + + + + + + + + + + + + + + + + + + - + - +	* the interpreter. * *---------------------------------------------------------------------- */ int Tcl_PkgProvide(interp, name, version) Tcl_Interp *interp; /* Interpreter in which package is now Tcl_Interp *interp; /* Interpreter in which package is now * available. */ CONST char *name; /* Name of package. */ CONST char *version; /* Version string for package. */ CONST char *name; /* Name of package. */ CONST char *version; /* Version string for package. */ { return Tcl_PkgProvideEx(interp, name, version, (ClientData) NULL); } int Tcl_PkgProvideEx(interp, name, version, clientData) Tcl_Interp *interp; /* Interpreter in which package is now Tcl_Interp *interp; /* Interpreter in which package is now * available. */ CONST char *name; /* Name of package. */ CONST char *version; /* Version string for package. */ ClientData clientData; /* clientdata for this package (normally * used for C callback function table) */ CONST char *name; /* Name of package. */ CONST char *version; /* Version string for package. */ ClientData clientData; /* clientdata for this package (normally * used for C callback function table) */ { Package *pkgPtr; #ifdef TCL_TIP268 char* pvi; char* vi; int res; #endif pkgPtr = FindPackage(interp, name); if (pkgPtr->version == NULL) { pkgPtr->version = ckalloc((unsigned) (strlen(version) + 1)); strcpy(pkgPtr->version, version); pkgPtr->clientData = clientData; return TCL_OK; } #ifndef TCL_TIP268 if (ComparePkgVersions(pkgPtr->version, version, (int *) NULL) == 0) { #else if (CheckVersionAndConvert (interp, pkgPtr->version, &pvi, NULL) != TCL_OK) { return TCL_ERROR; } else if (CheckVersionAndConvert (interp, version, &vi, NULL) != TCL_OK) { Tcl_Free (pvi); return TCL_ERROR; } res = CompareVersions(pvi, vi, NULL); Tcl_Free (pvi); Tcl_Free (vi); if (res == 0) { #endif if (clientData != NULL) { pkgPtr->clientData = clientData; } return TCL_OK; } Tcl_AppendResult(interp, "conflicting versions provided for package \"", name, "\": ", pkgPtr->version, ", then ", version, (char *) NULL); name, "\": ", pkgPtr->version, ", then ", version, (char *) NULL); return TCL_ERROR; }  /* *---------------------------------------------------------------------- * * Tcl_PkgRequire / Tcl_PkgRequireEx -- * Tcl_PkgRequire / Tcl_PkgRequireEx / Tcl_PkgRequireProc -- * * This procedure is called by code that depends on a particular * version of a particular package. If the package is not already * provided in the interpreter, this procedure invokes a Tcl script * to provide it. If the package is already provided, this * procedure makes sure that the caller's needs don't conflict with * the version that is present.
︙
144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194	190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261	+ + + + + + + + + + + + + + + + + - + - - - + + + - - - - + + + - + - - + + - + - + + + + + +	* * Side effects: * The script from some previous "package ifneeded" command may * be invoked to provide the package. * *---------------------------------------------------------------------- */ #ifndef TCL_TIP268 /* * Empty definition for Stubs when TIP 268 is not activated. */ int Tcl_PkgRequireProc(interp,name,reqc,reqv,clientDataPtr) Tcl_Interp *interp; /* Interpreter in which package is now * available. */ CONST char *name; /* Name of desired package. */ int reqc; /* Requirements constraining the desired version. */ Tcl_Obj *CONST reqv[]; /* 0 means to use the latest version available. */ ClientData *clientDataPtr; { return TCL_ERROR; } #endif CONST char * Tcl_PkgRequire(interp, name, version, exact) Tcl_Interp *interp; /* Interpreter in which package is now Tcl_Interp *interp; /* Interpreter in which package is now * available. */ CONST char *name; /* Name of desired package. */ CONST char *version; /* Version string for desired version; * NULL means use the latest version CONST char *name; /* Name of desired package. */ CONST char *version; /* Version string for desired version; NULL * means use the latest version available. */ * available. */ int exact; /* Non-zero means that only the particular * version given is acceptable. Zero means * use the latest compatible version. */ int exact; /* Non-zero means that only the particular * version given is acceptable. Zero means use * the latest compatible version. */ { return Tcl_PkgRequireEx(interp, name, version, exact, (ClientData *) NULL); } CONST char * Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr) Tcl_Interp *interp; /* Interpreter in which package is now Tcl_Interp *interp; /* Interpreter in which package is now * available. */ CONST char *name; /* Name of desired package. */ CONST char *version; /* Version string for desired version; CONST char *name; /* Name of desired package. */ CONST char *version; /* Version string for desired version; * NULL means use the latest version * available. */ int exact; /* Non-zero means that only the particular int exact; /* Non-zero means that only the particular * version given is acceptable. Zero means * use the latest compatible version. */ ClientData *clientDataPtr; /* Used to return the client data for this ClientData *clientDataPtr; /* Used to return the client data for this * package. If it is NULL then the client * data is not returned. This is unchanged * if this call fails for any reason. */ { #ifndef TCL_TIP268 Package *pkgPtr; PkgAvail *availPtr, *bestPtr; char *script; int code, satisfies, result, pass; Tcl_DString command; #else Tcl_Obj *ov; int res; #endif /* * If an attempt is being made to load this into a standalone executable * on a platform where backlinking is not supported then this must be * a shared version of Tcl (Otherwise the load would have failed). * Detect this situation by checking that this library has been correctly * initialised. If it has not been then return immediately as nothing will
︙
253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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	320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842	- - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + - - + + - + + + + - + - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - + + + + + + + - + + - - - + + + + + + + + + + - - + + + + - - + + + + + + - - + + + + + + + + + - + + + + + + + + + + + + + - - + + + + + + + +	* are not remedied, so be very careful about adding any other calls * here without checking how they behave when initialization is * incomplete. */ tclEmptyStringRep = &tclEmptyString; Tcl_AppendResult(interp, "Cannot load package \"", name, "\" in standalone executable: This package is not ", "compiled with stub support", NULL); "\" in standalone executable: This package is not ", "compiled with stub support", NULL); return NULL; } #ifdef TCL_TIP268 /* Translate between old and new API, and defer to the new function. */ if (version == NULL) { res = Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr); } else { if (exact) { ov = ExactRequirement (version); } else { ov = Tcl_NewStringObj (version,-1); } Tcl_IncrRefCount (ov); res = Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr); Tcl_DecrRefCount (ov); } if (res != TCL_OK) { return NULL; } /* This function returns the version string explictly, and leaves the * interpreter result empty. However "Tcl_PkgRequireProc" above returned * the version through the interpreter result. Simply resetting the result * now potentially deletes the string (obj), and the pointer to its string * rep we have, as our result, may be dangling due to this. Our solution * is to remember the object in interp associated data, with a proper * reference count, and then reset the result. Now pointers will not * dangle. It will be a leak however if nothing is done. So the next time * we come through here we delete the object remembered by this call, as * we can then be sure that there is no pointer to its string around * anymore. Beyond that we have a deletion function which cleans up the last * remembered object which was not cleaned up directly, here. */ ov = (Tcl_Obj*) Tcl_GetAssocData (interp, "tcl/Tcl_PkgRequireEx", NULL); if (ov != NULL) { Tcl_DecrRefCount (ov); } ov = Tcl_GetObjResult (interp); Tcl_IncrRefCount (ov); Tcl_SetAssocData(interp, "tcl/Tcl_PkgRequireEx", VersionCleanupProc, (ClientData) ov); Tcl_ResetResult (interp); return Tcl_GetString (ov); } int Tcl_PkgRequireProc(interp,name,reqc,reqv,clientDataPtr) Tcl_Interp *interp; /* Interpreter in which package is now * available. */ CONST char *name; /* Name of desired package. */ int reqc; /* Requirements constraining the desired version. */ Tcl_Obj *CONST reqv[]; /* 0 means to use the latest version available. */ ClientData *clientDataPtr; { Interp *iPtr = (Interp *) interp; Package *pkgPtr; PkgAvail *availPtr, *bestPtr, *bestStablePtr; char *availVersion, *bestVersion; /* Internal rep. of versions */ int availStable; char *script; int code, satisfies, pass; Tcl_DString command; char* pkgVersionI; #endif /* * It can take up to three passes to find the package: one pass to * run the "package unknown" script, one to run the "package ifneeded" * script for a specific version, and a final pass to lookup the * package loaded by the "package ifneeded" script. * It can take up to three passes to find the package: one pass to run the * "package unknown" script, one to run the "package ifneeded" script for * a specific version, and a final pass to lookup the package loaded by * the "package ifneeded" script. */ for (pass = 1; ; pass++) { pkgPtr = FindPackage(interp, name); if (pkgPtr->version != NULL) { break; } /* * The package isn't yet present. Search the list of available /* * Check whether we're already attempting to load some version * of this package (circular dependency detection). */ if (pkgPtr->clientData != NULL) { Tcl_AppendResult(interp, "circular package dependency: ", "attempt to provide ", name, " ", (char *)(pkgPtr->clientData), " requires ", name, NULL); #ifndef TCL_TIP268 if (version != NULL) { Tcl_AppendResult(interp, " ", version, NULL); } return NULL; #else AddRequirementsToResult (interp, reqc, reqv); return TCL_ERROR; #endif } /* * The package isn't yet present. Search the list of available * versions and invoke the script for the best available version. * * For TIP 268 we are actually locating the best, and the best stable * version. One of them is then chosen based on the selection mode. */ #ifndef TCL_TIP268 bestPtr = NULL; for (availPtr = pkgPtr->availPtr; availPtr != NULL; availPtr = availPtr->nextPtr) { if ((bestPtr != NULL) && (ComparePkgVersions(availPtr->version, bestPtr->version, (int *) NULL) <= 0)) { #else bestPtr = NULL; bestStablePtr = NULL; bestVersion = NULL; for (availPtr = pkgPtr->availPtr; availPtr != NULL; availPtr = availPtr->nextPtr) { if (CheckVersionAndConvert (interp, availPtr->version, &availVersion, &availStable) != TCL_OK) { /* The provided version number is has invalid syntax. This * should not happen. This should have been caught by the * 'package ifneeded' registering the package. */ #endif continue; } #ifndef TCL_TIP268 if (version != NULL) { result = ComparePkgVersions(availPtr->version, version, &satisfies); if ((result != 0) && exact) { #else if (bestPtr != NULL) { int res = CompareVersions (availVersion, bestVersion, NULL); /* Note: Use internal reps! */ if (res <= 0) { /* The version of the package sought is not as good as the * currently selected version. Ignore it. */ Tcl_Free (availVersion); availVersion = NULL; #endif continue; } #ifdef TCL_TIP268 } /* We have found a version which is better than our max. */ if (reqc > 0) { /* Check satisfaction of requirements */ satisfies = AllRequirementsSatisfied (availVersion, reqc, reqv); #endif if (!satisfies) { #ifdef TCL_TIP268 Tcl_Free (availVersion); availVersion = NULL; #endif continue; } } bestPtr = availPtr; #ifdef TCL_TIP268 if (bestVersion != NULL) Tcl_Free (bestVersion); bestVersion = availVersion; availVersion = NULL; } /* If this new best version is stable then it also has to be * better than the max stable version found so far. */ if (availStable) { bestStablePtr = availPtr; } } if (bestVersion != NULL) { Tcl_Free (bestVersion); } /* Now choose a version among the two best. For 'latest' we simply * take (actually keep) the best. For 'stable' we take the best * stable, if there is any, or the best if there is nothing stable. */ if ((iPtr->packagePrefer == PKG_PREFER_STABLE) && (bestStablePtr != NULL)) { bestPtr = bestStablePtr; #endif } if (bestPtr != NULL) { /* * We found an ifneeded script for the package. Be careful while * executing it: this could cause reentrancy, so (a) protect the * We found an ifneeded script for the package. Be careful while * executing it: this could cause reentrancy, so (a) protect the * script itself from deletion and (b) don't assume that bestPtr * will still exist when the script completes. */ CONST char *versionToProvide = bestPtr->version; script = bestPtr->script; pkgPtr->clientData = (ClientData) versionToProvide; Tcl_Preserve((ClientData) script); Tcl_Preserve((ClientData) versionToProvide); code = Tcl_GlobalEval(interp, script); code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL); Tcl_Release((ClientData) script); if (code != TCL_OK) { if (code == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (\"package ifneeded\" script)"); } return NULL; } Tcl_ResetResult(interp); pkgPtr = FindPackage(interp, name); if (code == TCL_OK) { #ifdef TCL_TIP268 Tcl_ResetResult(interp); #endif if (pkgPtr->version == NULL) { #ifndef TCL_TIP268 Tcl_ResetResult(interp); #endif code = TCL_ERROR; Tcl_AppendResult(interp, "attempt to provide package ", name, " ", versionToProvide, " failed: no version of package ", name, " provided", NULL); #ifndef TCL_TIP268 } else if (0 != ComparePkgVersions( pkgPtr->version, versionToProvide, NULL)) { /* At this point, it is clear that a prior * [package ifneeded] command lied to us. It said * that to get a particular version of a particular * package, we needed to evaluate a particular script. * However, we evaluated that script and got a different * version than we were told. This is an error, and we * ought to report it. * * However, we've been letting this type of error slide * for a long time, and as a result, a lot of packages * suffer from them. * * It's a bit too harsh to make a large number of * existing packages start failing by releasing a * new patch release, so we forgive this type of error * for the rest of the Tcl 8.4 series. * * We considered reporting a warning, but in practice * even that appears too harsh a change for a patch release. * * We limit the error reporting to only * the situation where a broken ifneeded script leads * to a failure to satisfy the requirement. */ if (version) { result = ComparePkgVersions( pkgPtr->version, version, &satisfies); if (result && (exact || !satisfies)) { Tcl_ResetResult(interp); code = TCL_ERROR; Tcl_AppendResult(interp, "attempt to provide package ", name, " ", versionToProvide, " failed: package ", name, " ", pkgPtr->version, " provided instead", NULL); #else } else { char* pvi; char* vi; int res; if (CheckVersionAndConvert (interp, pkgPtr->version, &pvi, NULL) != TCL_OK) { code = TCL_ERROR; } else if (CheckVersionAndConvert (interp, versionToProvide, &vi, NULL) != TCL_OK) { Tcl_Free (pvi); code = TCL_ERROR; } else { res = CompareVersions(pvi, vi, NULL); Tcl_Free (vi); if (res != 0) { /* At this point, it is clear that a prior * [package ifneeded] command lied to us. It said * that to get a particular version of a particular * package, we needed to evaluate a particular script. * However, we evaluated that script and got a different * version than we were told. This is an error, and we * ought to report it. * * However, we've been letting this type of error slide * for a long time, and as a result, a lot of packages * suffer from them. * * It's a bit too harsh to make a large number of * existing packages start failing by releasing a * new patch release, so we forgive this type of error * for the rest of the Tcl 8.4 series. * * We considered reporting a warning, but in practice * even that appears too harsh a change for a patch release. * * We limit the error reporting to only * the situation where a broken ifneeded script leads * to a failure to satisfy the requirement. */ if (reqc > 0) { satisfies = AllRequirementsSatisfied (pvi, reqc, reqv); if (!satisfies) { Tcl_ResetResult(interp); code = TCL_ERROR; Tcl_AppendResult(interp, "attempt to provide package ", name, " ", versionToProvide, " failed: package ", name, " ", pkgPtr->version, " provided instead", NULL); } } /* * Warning generation now disabled if (code == TCL_OK) { Tcl_Obj *msg = Tcl_NewStringObj( "attempt to provide package ", -1); Tcl_Obj *cmdPtr = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(NULL, cmdPtr, Tcl_NewStringObj("tclLog", -1)); Tcl_AppendStringsToObj(msg, name, " ", versionToProvide, " failed: package ", name, " ", pkgPtr->version, " provided instead", NULL); Tcl_ListObjAppendElement(NULL, cmdPtr, msg); Tcl_IncrRefCount(cmdPtr); Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(cmdPtr); Tcl_ResetResult(interp); } */ #endif } #ifdef TCL_TIP268 Tcl_Free (pvi); #endif } #ifndef TCL_TIP268 /* * Warning generation now disabled if (code == TCL_OK) { Tcl_Obj *msg = Tcl_NewStringObj( "attempt to provide package ", -1); Tcl_Obj *cmdPtr = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(NULL, cmdPtr, Tcl_NewStringObj("tclLog", -1)); Tcl_AppendStringsToObj(msg, name, " ", versionToProvide, " failed: package ", name, " ", pkgPtr->version, " provided instead", NULL); Tcl_ListObjAppendElement(NULL, cmdPtr, msg); Tcl_IncrRefCount(cmdPtr); Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(cmdPtr); Tcl_ResetResult(interp); } */ #endif } } else if (code != TCL_ERROR) { Tcl_Obj *codePtr = Tcl_NewIntObj(code); Tcl_ResetResult(interp); Tcl_AppendResult(interp, "attempt to provide package ", name, " ", versionToProvide, " failed: ", "bad return code: ", Tcl_GetString(codePtr), NULL); Tcl_DecrRefCount(codePtr); code = TCL_ERROR; } Tcl_Release((ClientData) versionToProvide); if (code != TCL_OK) { /* * Take a non-TCL_OK code from the script as an * indication the package wasn't loaded properly, * so the package system should not remember an * improper load. * * This is consistent with our returning NULL. * If we're not willing to tell our caller we * got a particular version, we shouldn't store * that version for telling future callers either. */ Tcl_AddErrorInfo(interp, "\n (\"package ifneeded\" script)"); if (pkgPtr->version != NULL) { ckfree(pkgPtr->version); pkgPtr->version = NULL; } pkgPtr->clientData = NULL; #ifndef TCL_TIP268 return NULL; #else return TCL_ERROR; #endif } break; } /* * Package not in the database. If there is a "package unknown" * command, invoke it (but only on the first pass; after that, * we should not get here in the first place). * The package is not in the database. If there is a "package unknown" * command, invoke it (but only on the first pass; after that, we * should not get here in the first place). */ if (pass > 1) { break; } script = ((Interp *) interp)->packageUnknown; if (script != NULL) { Tcl_DStringInit(&command); Tcl_DStringAppend(&command, script, -1); Tcl_DStringAppendElement(&command, name); #ifndef TCL_TIP268 Tcl_DStringAppend(&command, " ", 1); Tcl_DStringAppend(&command, (version != NULL) ? version : "{}", -1); if (exact) { Tcl_DStringAppend(&command, " -exact", 7); } #else AddRequirementsToDString(&command, reqc, reqv); #endif code = Tcl_GlobalEval(interp, Tcl_DStringValue(&command)); code = Tcl_EvalEx(interp, Tcl_DStringValue(&command), Tcl_DStringLength(&command), TCL_EVAL_GLOBAL); Tcl_DStringFree(&command); if (code != TCL_OK) { if (code == TCL_ERROR) { Tcl_AddErrorInfo(interp, if ((code != TCL_OK) && (code != TCL_ERROR)) { Tcl_Obj *codePtr = Tcl_NewIntObj(code); Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad return code: ", Tcl_GetString(codePtr), NULL); Tcl_DecrRefCount(codePtr); code = TCL_ERROR; } if (code == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (\"package unknown\" script)"); "\n (\"package unknown\" script)"); } #ifndef TCL_TIP268 return NULL; #else return TCL_ERROR; #endif } Tcl_ResetResult(interp); } } if (pkgPtr->version == NULL) { Tcl_AppendResult(interp, "can't find package ", name, (char *) NULL); Tcl_AppendResult(interp, "can't find package ", name, (char *) NULL); #ifndef TCL_TIP268 if (version != NULL) { Tcl_AppendResult(interp, " ", version, (char *) NULL); } return NULL; #else AddRequirementsToResult(interp, reqc, reqv); return TCL_ERROR; #endif } /* * At this point we know that the package is present. Make sure that the * provided version meets the current requirement. * At this point we know that the package is present. Make sure that the * provided version meets the current requirements. */ #ifndef TCL_TIP268 if (version == NULL) { if (clientDataPtr) { *clientDataPtr = pkgPtr->clientData; } return pkgPtr->version; #else if (reqc == 0) { satisfies = 1; } else { CheckVersionAndConvert (interp, pkgPtr->version, &pkgVersionI, NULL); satisfies = AllRequirementsSatisfied (pkgVersionI, reqc, reqv); } Tcl_Free (pkgVersionI); #endif } #ifndef TCL_TIP268 result = ComparePkgVersions(pkgPtr->version, version, &satisfies); if ((satisfies && !exact) || (result == 0)) { #else if (satisfies) { #endif if (clientDataPtr) { *clientDataPtr = pkgPtr->clientData; } #ifndef TCL_TIP268 return pkgPtr->version; #else Tcl_SetObjResult (interp, Tcl_NewStringObj (pkgPtr->version, -1)); return TCL_OK; #endif } Tcl_AppendResult(interp, "version conflict for package \"", name, "\": have ", pkgPtr->version, ", need ", version, (char *) NULL); name, "\": have ", pkgPtr->version, #ifndef TCL_TIP268 ", need ", version, (char *) NULL); return NULL; #else ", need", (char*) NULL); AddRequirementsToResult (interp, reqc, reqv); return TCL_ERROR; #endif }  /* *---------------------------------------------------------------------- * * Tcl_PkgPresent / Tcl_PkgPresentEx -- *
︙
409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474	855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938	- + - - + + - + - + - - + + - + - + + + + + + + + + + + + + + + + + + +	* None. * *---------------------------------------------------------------------- */ CONST char * Tcl_PkgPresent(interp, name, version, exact) Tcl_Interp *interp; /* Interpreter in which package is now Tcl_Interp *interp; /* Interpreter in which package is now * available. */ CONST char *name; /* Name of desired package. */ CONST char *version; /* Version string for desired version; CONST char *name; /* Name of desired package. */ CONST char *version; /* Version string for desired version; * NULL means use the latest version * available. */ int exact; /* Non-zero means that only the particular int exact; /* Non-zero means that only the particular * version given is acceptable. Zero means * use the latest compatible version. */ { return Tcl_PkgPresentEx(interp, name, version, exact, (ClientData *) NULL); } CONST char * Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr) Tcl_Interp *interp; /* Interpreter in which package is now Tcl_Interp *interp; /* Interpreter in which package is now * available. */ CONST char *name; /* Name of desired package. */ CONST char *version; /* Version string for desired version; CONST char *name; /* Name of desired package. */ CONST char *version; /* Version string for desired version; * NULL means use the latest version * available. */ int exact; /* Non-zero means that only the particular int exact; /* Non-zero means that only the particular * version given is acceptable. Zero means * use the latest compatible version. */ ClientData *clientDataPtr; /* Used to return the client data for this ClientData *clientDataPtr; /* Used to return the client data for this * package. If it is NULL then the client * data is not returned. This is unchanged * if this call fails for any reason. */ { Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hPtr; Package *pkgPtr; int satisfies, result; hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name); if (hPtr) { pkgPtr = (Package *) Tcl_GetHashValue(hPtr); if (pkgPtr->version != NULL) { #ifdef TCL_TIP268 char* pvi; char* vi; int thisIsMajor; #endif /* * At this point we know that the package is present. Make sure * that the provided version meets the current requirement. */ if (version == NULL) { if (clientDataPtr) { *clientDataPtr = pkgPtr->clientData; } return pkgPtr->version; } #ifndef TCL_TIP268 result = ComparePkgVersions(pkgPtr->version, version, &satisfies); #else if (CheckVersionAndConvert (interp, pkgPtr->version, &pvi, NULL) != TCL_OK) { return NULL; } else if (CheckVersionAndConvert (interp, version, &vi, NULL) != TCL_OK) { Tcl_Free (pvi); return NULL; } result = CompareVersions(pvi, vi, &thisIsMajor); Tcl_Free (pvi); Tcl_Free (vi); satisfies = (result == 0) || ((result == 1) && !thisIsMajor); #endif if ((satisfies && !exact) || (result == 0)) { if (clientDataPtr) { *clientDataPtr = pkgPtr->clientData; } return pkgPtr->version; }
︙
502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699	966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 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	- + - - - - + + + + - - + + + + + + - - + + + + + + + + + - + + - + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	* * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ /* ARGSUSED */ /* ARGSUSED */ int Tcl_PackageObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { static CONST char *pkgOptions[] = { "forget", "ifneeded", "names", "present", "provide", "require", "unknown", "vcompare", "versions", "vsatisfies", (char *) NULL "forget", "ifneeded", "names", #ifdef TCL_TIP268 "prefer", #endif "present", "provide", "require", "unknown", "vcompare", "versions", "vsatisfies", (char *) NULL }; enum pkgOptions { PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, PKG_PRESENT, PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE, PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, #ifdef TCL_TIP268 PKG_PREFER, #endif PKG_PRESENT, PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE, PKG_VERSIONS, PKG_VSATISFIES }; Interp *iPtr = (Interp *) interp; int optionIndex, exact, i, satisfies; PkgAvail *availPtr, *prevPtr; Package *pkgPtr; Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_HashTable *tablePtr; CONST char *version; char *argv2, *argv3, *argv4; #ifdef TCL_TIP268 char* iva = NULL; char* ivb = NULL; #endif if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], pkgOptions, "option", 0, &optionIndex) != TCL_OK) { &optionIndex) != TCL_OK) { return TCL_ERROR; } switch ((enum pkgOptions) optionIndex) { #ifndef TCL_TIP268 case PKG_FORGET: { char *keyString; for (i = 2; i < objc; i++) { keyString = Tcl_GetString(objv[i]); hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString); if (hPtr == NULL) { continue; } pkgPtr = (Package *) Tcl_GetHashValue(hPtr); Tcl_DeleteHashEntry(hPtr); if (pkgPtr->version != NULL) { ckfree(pkgPtr->version); } while (pkgPtr->availPtr != NULL) { availPtr = pkgPtr->availPtr; pkgPtr->availPtr = availPtr->nextPtr; ckfree(availPtr->version); Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC); Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC); ckfree((char *) availPtr); } ckfree((char *) pkgPtr); } break; #else case PKG_FORGET: { char *keyString; for (i = 2; i < objc; i++) { keyString = Tcl_GetString(objv[i]); hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString); if (hPtr == NULL) { continue; } } pkgPtr = (Package *) Tcl_GetHashValue(hPtr); Tcl_DeleteHashEntry(hPtr); if (pkgPtr->version != NULL) { ckfree(pkgPtr->version); } while (pkgPtr->availPtr != NULL) { availPtr = pkgPtr->availPtr; pkgPtr->availPtr = availPtr->nextPtr; Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC); Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC); ckfree((char *) availPtr); } ckfree((char *) pkgPtr); } break; } case PKG_IFNEEDED: { int length; char* argv3i; char* avi; int res; if ((objc != 4) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?"); return TCL_ERROR; } argv3 = Tcl_GetString(objv[3]); if (CheckVersionAndConvert(interp, argv3, &argv3i, NULL) != TCL_OK) { return TCL_ERROR; #endif } #ifndef TCL_TIP268 case PKG_IFNEEDED: { int length; if ((objc != 4) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?"); return TCL_ERROR; #else argv2 = Tcl_GetString(objv[2]); if (objc == 4) { hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); if (hPtr == NULL) { Tcl_Free (argv3i); return TCL_OK; #endif } #ifndef TCL_TIP268 argv3 = Tcl_GetString(objv[3]); if (CheckVersion(interp, argv3) != TCL_OK) { #else pkgPtr = (Package *) Tcl_GetHashValue(hPtr); } else { pkgPtr = FindPackage(interp, argv2); } argv3 = Tcl_GetStringFromObj(objv[3], &length); for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL; prevPtr = availPtr, availPtr = availPtr->nextPtr) { if (CheckVersionAndConvert (interp, availPtr->version, &avi, NULL) != TCL_OK) { Tcl_Free (argv3i); #endif return TCL_ERROR; } #ifndef TCL_TIP268 argv2 = Tcl_GetString(objv[2]); if (objc == 4) { hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); if (hPtr == NULL) { #else res = CompareVersions(avi, argv3i, NULL); Tcl_Free (avi); if (res == 0){ if (objc == 4) { Tcl_Free (argv3i); Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE); #endif return TCL_OK; } #ifndef TCL_TIP268 pkgPtr = (Package *) Tcl_GetHashValue(hPtr); } else { pkgPtr = FindPackage(interp, argv2); } argv3 = Tcl_GetStringFromObj(objv[3], &length); for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL; prevPtr = availPtr, availPtr = availPtr->nextPtr) { if (ComparePkgVersions(availPtr->version, argv3, (int *) NULL) == 0) { if (objc == 4) { Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE); return TCL_OK; } Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC); break; } } if (objc == 4) { return TCL_OK; #else Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC); break; #endif } #ifndef TCL_TIP268 if (availPtr == NULL) { availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail)); availPtr->version = ckalloc((unsigned) (length + 1)); strcpy(availPtr->version, argv3); if (prevPtr == NULL) { availPtr->nextPtr = pkgPtr->availPtr; pkgPtr->availPtr = availPtr; } else { availPtr->nextPtr = prevPtr->nextPtr; prevPtr->nextPtr = availPtr; } #else } } Tcl_Free (argv3i); if (objc == 4) { return TCL_OK; } if (availPtr == NULL) { availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail)); availPtr->version = ckalloc((unsigned) (length + 1)); strcpy(availPtr->version, argv3); if (prevPtr == NULL) { availPtr->nextPtr = pkgPtr->availPtr; pkgPtr->availPtr = availPtr; } else { availPtr->nextPtr = prevPtr->nextPtr; prevPtr->nextPtr = availPtr; #endif } #ifndef TCL_TIP268 argv4 = Tcl_GetStringFromObj(objv[4], &length); availPtr->script = ckalloc((unsigned) (length + 1)); strcpy(availPtr->script, argv4); break; #endif } #ifndef TCL_TIP268 case PKG_NAMES: { if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); #else argv4 = Tcl_GetStringFromObj(objv[4], &length); availPtr->script = ckalloc((unsigned) (length + 1)); strcpy(availPtr->script, argv4); break; } case PKG_NAMES: { if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } tablePtr = &iPtr->packageTable; for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { pkgPtr = (Package *) Tcl_GetHashValue(hPtr); if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) { Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr)); } } return TCL_ERROR; } tablePtr = &iPtr->packageTable; for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { pkgPtr = (Package *) Tcl_GetHashValue(hPtr); if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) { Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr)); } } break; } case PKG_PRESENT: { if (objc < 3) { presentSyntax: Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?"); return TCL_ERROR; } argv2 = Tcl_GetString(objv[2]); if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) { exact = 1; } else { exact = 0; } version = NULL; if (objc == (4 + exact)) { version = Tcl_GetString(objv[3 + exact]); if (CheckVersionAndConvert(interp, version, NULL, NULL) != TCL_OK) { #endif return TCL_ERROR; } #ifndef TCL_TIP268 tablePtr = &iPtr->packageTable; for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { #else } else if ((objc != 3) || exact) { goto presentSyntax; } if (exact) { argv3 = Tcl_GetString(objv[3]); version = Tcl_PkgPresent(interp, argv3, version, exact); } else { version = Tcl_PkgPresent(interp, argv2, version, exact); } if (version == NULL) { return TCL_ERROR; } Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) ); break; } case PKG_PROVIDE: { if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "package ?version?"); return TCL_ERROR; } argv2 = Tcl_GetString(objv[2]); if (objc == 3) { hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); if (hPtr != NULL) { #endif pkgPtr = (Package *) Tcl_GetHashValue(hPtr); #ifndef TCL_TIP268 if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) { Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr)); #else if (pkgPtr->version != NULL) { Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE); #endif } } #ifndef TCL_TIP268 break; #else return TCL_OK; #endif } #ifndef TCL_TIP268 case PKG_PRESENT: { if (objc < 3) { presentSyntax: Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?"); return TCL_ERROR; #else argv3 = Tcl_GetString(objv[3]); if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) { return TCL_ERROR; } } return Tcl_PkgProvide(interp, argv2, argv3); } case PKG_REQUIRE: { if (objc < 3) { requireSyntax: Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?requirement...?"); return TCL_ERROR; } version = NULL; argv2 = Tcl_GetString(objv[2]); if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) { Tcl_Obj* ov; int res; if (objc != 5) { goto requireSyntax; #endif } #ifndef TCL_TIP268 argv2 = Tcl_GetString(objv[2]); if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) { exact = 1; } else { exact = 0; #else version = Tcl_GetString(objv[4]); if (CheckVersionAndConvert(interp, version, NULL, NULL) != TCL_OK) { return TCL_ERROR; #endif } #ifdef TCL_TIP268 /* Create a new-style requirement for the exact version. */ ov = ExactRequirement (version); #endif version = NULL; #ifndef TCL_TIP268 if (objc == (4 + exact)) { version = Tcl_GetString(objv[3 + exact]); if (CheckVersion(interp, version) != TCL_OK) { return TCL_ERROR; } } else if ((objc != 3) || exact) { goto presentSyntax; } if (exact) { argv3 = Tcl_GetString(objv[3]); version = Tcl_PkgPresent(interp, argv3, version, exact); } else { version = Tcl_PkgPresent(interp, argv2, version, exact); } if (version == NULL) { #else argv3 = Tcl_GetString(objv[3]); Tcl_IncrRefCount (ov); res = Tcl_PkgRequireProc(interp, argv3, 1, &ov, NULL); Tcl_DecrRefCount (ov); return res; } else { if (CheckAllRequirements (interp, objc-3, objv+3) != TCL_OK) { #endif return TCL_ERROR; } #ifndef TCL_TIP268 Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) ); break; #else return Tcl_PkgRequireProc(interp, argv2, objc-3, objv+3, NULL); #endif } #ifndef TCL_TIP268 case PKG_PROVIDE: { if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "package ?version?"); #else break; } case PKG_UNKNOWN: { int length; if (objc == 2) { if (iPtr->packageUnknown != NULL) { Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE); } } else if (objc == 3) { if (iPtr->packageUnknown != NULL) { ckfree(iPtr->packageUnknown); } argv2 = Tcl_GetStringFromObj(objv[2], &length); if (argv2[0] == 0) { iPtr->packageUnknown = NULL; } else { iPtr->packageUnknown = (char *) ckalloc((unsigned) (length + 1)); strcpy(iPtr->packageUnknown, argv2); } } else { Tcl_WrongNumArgs(interp, 2, objv, "?command?"); return TCL_ERROR; } return TCL_ERROR; } break; } case PKG_PREFER: { /* See tclInt.h for the enum, just before Interp */ static CONST char *pkgPreferOptions[] = { "latest", "stable", NULL }; if (objc > 3) { Tcl_WrongNumArgs(interp, 2, objv, "?latest|stable?"); return TCL_ERROR; } else if (objc == 3) { /* Set value. */ int new; if (Tcl_GetIndexFromObj(interp, objv[2], pkgPreferOptions, "preference", 0, &new) != TCL_OK) { #endif return TCL_ERROR; } #ifndef TCL_TIP268 argv2 = Tcl_GetString(objv[2]); if (objc == 3) { hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); if (hPtr != NULL) { pkgPtr = (Package *) Tcl_GetHashValue(hPtr); if (pkgPtr->version != NULL) { Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE); } } return TCL_OK; #else if (new < iPtr->packagePrefer) { iPtr->packagePrefer = new; #endif } #ifndef TCL_TIP268 argv3 = Tcl_GetString(objv[3]); if (CheckVersion(interp, argv3) != TCL_OK) { return TCL_ERROR; } return Tcl_PkgProvide(interp, argv2, argv3); #endif } #ifndef TCL_TIP268 case PKG_REQUIRE: { if (objc < 3) { requireSyntax: Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?"); return TCL_ERROR; } argv2 = Tcl_GetString(objv[2]);
︙
718 719 720 721 722 723 724 725 726 727 728 729 730 731 732	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	+ + + + - + + + + + + + +	version = Tcl_PkgRequire(interp, argv2, version, exact); } if (version == NULL) { return TCL_ERROR; } Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) ); break; #else /* Always return current value. */ Tcl_SetObjResult(interp, Tcl_NewStringObj (pkgPreferOptions [iPtr->packagePrefer], -1)); break; } } case PKG_VCOMPARE: { if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "version1 version2"); return TCL_ERROR; #endif } #ifndef TCL_TIP268 case PKG_UNKNOWN: { int length; if (objc == 2) { if (iPtr->packageUnknown != NULL) { Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE); } } else if (objc == 3) {
︙
742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805	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	+ + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + +	strcpy(iPtr->packageUnknown, argv2); } } else { Tcl_WrongNumArgs(interp, 2, objv, "?command?"); return TCL_ERROR; } break; #else argv3 = Tcl_GetString(objv[3]); argv2 = Tcl_GetString(objv[2]); if ((CheckVersionAndConvert (interp, argv2, &iva, NULL) != TCL_OK) || (CheckVersionAndConvert (interp, argv3, &ivb, NULL) != TCL_OK)) { if (iva != NULL) { Tcl_Free (iva); } /* ivb cannot be set in this branch */ return TCL_ERROR; #endif } #ifndef TCL_TIP268 case PKG_VCOMPARE: { if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "version1 version2"); return TCL_ERROR; } argv3 = Tcl_GetString(objv[3]); argv2 = Tcl_GetString(objv[2]); if ((CheckVersion(interp, argv2) != TCL_OK) || (CheckVersion(interp, argv3) != TCL_OK)) { return TCL_ERROR; } Tcl_SetIntObj(Tcl_GetObjResult(interp), ComparePkgVersions(argv2, argv3, (int *) NULL)); break; #else } /* Comparison is done on the internal representation */ Tcl_SetObjResult(interp,Tcl_NewIntObj(CompareVersions(iva, ivb, NULL))); Tcl_Free (iva); Tcl_Free (ivb); break; } case PKG_VERSIONS: { if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "package"); return TCL_ERROR; #endif } #ifndef TCL_TIP268 case PKG_VERSIONS: { if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "package"); return TCL_ERROR; #else argv2 = Tcl_GetString(objv[2]); hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); if (hPtr != NULL) { pkgPtr = (Package *) Tcl_GetHashValue(hPtr); for (availPtr = pkgPtr->availPtr; availPtr != NULL; availPtr = availPtr->nextPtr) { Tcl_AppendElement(interp, availPtr->version); #endif } #ifndef TCL_TIP268 argv2 = Tcl_GetString(objv[2]); hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); if (hPtr != NULL) { pkgPtr = (Package *) Tcl_GetHashValue(hPtr); for (availPtr = pkgPtr->availPtr; availPtr != NULL; availPtr = availPtr->nextPtr) { Tcl_AppendElement(interp, availPtr->version); } } break; #endif } #ifndef TCL_TIP268 case PKG_VSATISFIES: { if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "version1 version2"); return TCL_ERROR; } argv3 = Tcl_GetString(objv[3]); argv2 = Tcl_GetString(objv[2]); if ((CheckVersion(interp, argv2) != TCL_OK) || (CheckVersion(interp, argv3) != TCL_OK)) { return TCL_ERROR; } ComparePkgVersions(argv2, argv3, &satisfies); Tcl_SetIntObj(Tcl_GetObjResult(interp), satisfies); break; #else break; } } case PKG_VSATISFIES: { char* argv2i = NULL; if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "version requirement requirement..."); return TCL_ERROR; #endif } #ifndef TCL_TIP268 default: { panic("Tcl_PackageObjCmd: bad option index to pkgOptions"); #else } argv2 = Tcl_GetString(objv[2]); if ((CheckVersionAndConvert(interp, argv2, &argv2i, NULL) != TCL_OK)) { return TCL_ERROR; } else if (CheckAllRequirements (interp, objc-3, objv+3) != TCL_OK) { Tcl_Free (argv2i); return TCL_ERROR; #endif } #ifdef TCL_TIP268 satisfies = AllRequirementsSatisfied (argv2i, objc-3, objv+3); Tcl_Free (argv2i); Tcl_SetIntObj(Tcl_GetObjResult(interp), satisfies); break; } default: { panic("Tcl_PackageObjCmd: bad option index to pkgOptions"); } #endif } return TCL_OK; }  /* *---------------------------------------------------------------------- *
︙
817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832	1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661	- - + +	* A new Package record may be created. * *---------------------------------------------------------------------- */ static Package * FindPackage(interp, name) Tcl_Interp *interp; /* Interpreter to use for package lookup. */ CONST char *name; /* Name of package to fine. */ Tcl_Interp *interp; /* Interpreter to use for package lookup. */ CONST char *name; /* Name of package to fine. */ { Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hPtr; int new; Package *pkgPtr; hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &new);
︙
858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026	1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 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 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 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 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 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 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404	- + - + - + - + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + - + - + + + + + + + + + + + + + - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	* Memory is freed. * *---------------------------------------------------------------------- */ void TclFreePackageInfo(iPtr) Interp *iPtr; /* Interpereter that is being deleted. */ Interp *iPtr; /* Interpreter that is being deleted. */ { Package *pkgPtr; Tcl_HashSearch search; Tcl_HashEntry *hPtr; PkgAvail *availPtr; for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { pkgPtr = (Package *) Tcl_GetHashValue(hPtr); if (pkgPtr->version != NULL) { ckfree(pkgPtr->version); } while (pkgPtr->availPtr != NULL) { availPtr = pkgPtr->availPtr; pkgPtr->availPtr = availPtr->nextPtr; ckfree(availPtr->version); Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC); Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC); ckfree((char *) availPtr); } ckfree((char *) pkgPtr); } Tcl_DeleteHashTable(&iPtr->packageTable); if (iPtr->packageUnknown != NULL) { ckfree(iPtr->packageUnknown); } }  /* *---------------------------------------------------------------------- * * CheckVersion -- * CheckVersion / CheckVersionAndConvert -- * * This procedure checks to see whether a version number has * valid syntax. * * Results: * If string is a properly formed version number the TCL_OK * is returned. Otherwise TCL_ERROR is returned and an error * message is left in the interp's result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int #ifndef TCL_TIP268 CheckVersion(interp, string) Tcl_Interp *interp; /* Used for error reporting. */ CONST char *string; /* Supposedly a version number, which is * groups of decimal digits separated * by dots. */ #else CheckVersionAndConvert(interp, string, internal, stable) Tcl_Interp *interp; /* Used for error reporting. */ CONST char *string; /* Supposedly a version number, which is * groups of decimal digits separated by * dots. */ char** internal; /* Internal normalized representation */ int* stable; /* Flag: Version is (un)stable. */ #endif { CONST char *p = string; char prevChar; #ifdef TCL_TIP268 int hasunstable = 0; /* 4* assuming that each char is a separator (a,b become ' -x '). * 4+ to have spce for an additional -2 at the end */ char* ibuf = ckalloc (4+4*strlen(string)); char* ip = ibuf; /* Basic rules * (1) First character has to be a digit. * (2) All other characters have to be a digit or '.' * (3) Two '.'s may not follow each other. * TIP 268, Modified rules * (1) s.a. * (2) All other characters have to be a digit, 'a', 'b', or '.' * (3) s.a. * (4) Only one of 'a' or 'b' may occur. * (5) Neither 'a', nor 'b' may occur before or after a '.' */ #endif if (!isdigit(UCHAR(*p))) { /* INTL: digit */ goto error; } #ifdef TCL_TIP268 *ip++ = *p; #endif for (prevChar = *p, p++; *p != 0; p++) { #ifndef TCL_TIP268 if (!isdigit(UCHAR(*p)) && ((*p != '.') || (prevChar == '.'))) { /* INTL: digit */ #else if ( (!isdigit(UCHAR(*p))) && (((*p != '.') && (*p != 'a') && (*p != 'b')) || ((hasunstable && ((*p == 'a') || (*p == 'b'))) || (((prevChar == 'a') || (prevChar == 'b') || (prevChar == '.')) && (*p == '.')) || (((*p == 'a') || (*p == 'b') || (*p == '.')) && (prevChar == '.')))) ) { /* INTL: digit */ #endif goto error; } #ifdef TCL_TIP268 if ((*p == 'a') || (*p == 'b')) { hasunstable = 1 ; } /* Translation to the internal rep. Regular version chars are copied * as is. The separators are translated to numerics. The new separator * for all parts is space. */ if (*p == '.') { *ip++ = ' '; *ip++ = '0'; *ip++ = ' '; } else if (*p == 'a') { *ip++ = ' '; *ip++ = '-'; *ip++ = '2'; *ip++ = ' '; } else if (*p == 'b') { *ip++ = ' '; *ip++ = '-'; *ip++ = '1'; *ip++ = ' '; } else { *ip++ = *p; } #endif prevChar = *p; } #ifndef TCL_TIP268 if (prevChar != '.') { #else if ((prevChar != '.') && (prevChar != 'a') && (prevChar != 'b')) { *ip = '\0'; if (internal != NULL) { *internal = ibuf; } else { Tcl_Free (ibuf); } if (stable != NULL) { *stable = !hasunstable; } #endif return TCL_OK; } error: error: #ifdef TCL_TIP268 ckfree (ibuf); #endif Tcl_AppendResult(interp, "expected version number but got \"", string, "\"", (char *) NULL); return TCL_ERROR; }  /* *---------------------------------------------------------------------- * * ComparePkgVersions -- * ComparePkgVersions / CompareVersions -- * * This procedure compares two version numbers. * This procedure compares two version numbers. (268: in internal rep). * * Results: * The return value is -1 if v1 is less than v2, 0 if the two * version numbers are the same, and 1 if v1 is greater than v2. * If *satPtr is non-NULL, the word it points to is filled in * with 1 if v2 >= v1 and both numbers have the same major number * or 0 otherwise. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int #ifndef TCL_TIP268 ComparePkgVersions(v1, v2, satPtr) CONST char *v1; CONST char *v2; /* Versions strings, of form 2.1.3 (any * number of version numbers). */ int *satPtr; /* If non-null, the word pointed to is * filled in with a 0/1 value. 1 means * v1 "satisfies" v2: v1 is greater than * or equal to v2 and both version numbers * have the same major number. */ #else CompareVersions(v1, v2, isMajorPtr) CONST char *v1; /* Versions strings, of form 2.1.3 (any number */ CONST char *v2; /* of version numbers). */ int *isMajorPtr; /* If non-null, the word pointed to is filled * in with a 0/1 value. 1 means that the difference * occured in the first element. */ #endif { int thisIsMajor, n1, n2; #ifdef TCL_TIP268 int res, flip; #endif /* * Each iteration of the following loop processes one number from * each string, terminated by a ".". If those numbers don't match * then the comparison is over; otherwise, we loop back for the * next number. * Each iteration of the following loop processes one number from each * string, terminated by a " " (space). If those numbers don't match then the * comparison is over; otherwise, we loop back for the next number. * * TIP 268. * This is identical the function 'ComparePkgVersion', but using the new * space separator as used by the internal rep of version numbers. The * special separators 'a' and 'b' have already been dealt with in * 'CheckVersionAndConvert', they were translated into numbers as * well. This keeps the comparison sane. Otherwise we would have to * compare numerics, the separators, and also deal with the special case * of end-of-string compared to separators. The semi-list rep we get here * is much easier to handle, as it is still regular. */ thisIsMajor = 1; while (1) { /* * Parse one decimal number from the front of each string. */ n1 = n2 = 0; #ifndef TCL_TIP268 while ((*v1 != 0) && (*v1 != '.')) { #else flip = 0; while ((*v1 != 0) && (*v1 != ' ')) { if (*v1 == '-') {flip = 1 ; v1++ ; continue;} #endif n1 = 10*n1 + (*v1 - '0'); v1++; } #ifndef TCL_TIP268 while ((*v2 != 0) && (*v2 != '.')) { #else if (flip) n1 = -n1; flip = 0; while ((*v2 != 0) && (*v2 != ' ')) { if (*v2 == '-') {flip = 1; v2++ ; continue;} #endif n2 = 10*n2 + (*v2 - '0'); v2++; } #ifdef TCL_TIP268 if (flip) n2 = -n2; #endif /* * Compare and go on to the next version number if the * current numbers match. * Compare and go on to the next version number if the current numbers * match. */ if (n1 != n2) { break; } if (*v1 != 0) { v1++; } else if (*v2 == 0) { break; } if (*v2 != 0) { v2++; } thisIsMajor = 0; } #ifndef TCL_TIP268 if (satPtr != NULL) { *satPtr = (n1 == n2) || ((n1 > n2) && !thisIsMajor); } #endif if (n1 > n2) { #ifndef TCL_TIP268 return 1; #else res = 1; #endif } else if (n1 == n2) { #ifndef TCL_TIP268 return 0; #else res = 0; #endif } else { #ifndef TCL_TIP268 return -1; #else res = -1; } } if (isMajorPtr != NULL) { *isMajorPtr = thisIsMajor; } return res; }  /* *---------------------------------------------------------------------- * * CheckAllRequirements -- * * This function checks to see whether all requirements in a set * have valid syntax. * * Results: * TCL_OK is returned if all requirements are valid. * Otherwise TCL_ERROR is returned and an error message * is left in the interp's result. * * Side effects: * May modify the interpreter result. * *---------------------------------------------------------------------- */ static int CheckAllRequirements(interp, reqc, reqv) Tcl_Interp* interp; int reqc; /* Requirements to check. */ Tcl_Obj *CONST reqv[]; { int i; for (i = 0; i < reqc; i++) { if ((CheckRequirement(interp, Tcl_GetString(reqv[i])) != TCL_OK)) { return TCL_ERROR; } } return TCL_OK; }  /* *---------------------------------------------------------------------- * * CheckRequirement -- * * This function checks to see whether a requirement has valid syntax. * * Results: * If string is a properly formed requirement then TCL_OK is returned. * Otherwise TCL_ERROR is returned and an error message is left in the * interp's result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int CheckRequirement(interp, string) Tcl_Interp *interp; /* Used for error reporting. */ CONST char *string; /* Supposedly a requirement. */ { /* Syntax of requirement = version * = version-version * = version- */ char* dash = NULL; char* buf; dash = strchr (string, '-'); if (dash == NULL) { /* no dash found, has to be a simple version */ return CheckVersionAndConvert (interp, string, NULL, NULL); } if (strchr (dash+1, '-') != NULL) { /* More dashes found after the first. This is wrong. */ Tcl_AppendResult(interp, "expected versionMin-versionMax but got \"", string, "\"", NULL); return TCL_ERROR; #endif } #ifdef TCL_TIP268 /* Exactly one dash is present. Copy the string, split at the location of * dash and check that both parts are versions. Note that the max part can * be empty. */ buf = strdup (string); dash = buf + (dash - string); *dash = '\0'; /* buf now <=> min part */ dash ++; /* dash now <=> max part */ if ((CheckVersionAndConvert(interp, buf, NULL, NULL) != TCL_OK) || ((*dash != '\0') && (CheckVersionAndConvert(interp, dash, NULL, NULL) != TCL_OK))) { free (buf); return TCL_ERROR; } free (buf); return TCL_OK; #endif } #ifdef TCL_TIP268  /* *---------------------------------------------------------------------- * * AddRequirementsToResult -- * * This function accumulates requirements in the interpreter result. * * Results: * None. * * Side effects: * The interpreter result is extended. * *---------------------------------------------------------------------- */ static void AddRequirementsToResult(interp, reqc, reqv) Tcl_Interp* interp; int reqc; /* Requirements constraining the desired version. */ Tcl_Obj *CONST reqv[]; /* 0 means to use the latest version available. */ { if (reqc > 0) { int i; for (i = 0; i < reqc; i++) { Tcl_AppendResult(interp, " ", TclGetString(reqv[i]), NULL); } } }  /* *---------------------------------------------------------------------- * * AddRequirementsToDString -- * * This function accumulates requirements in a DString. * * Results: * None. * * Side effects: * The DString argument is extended. * *---------------------------------------------------------------------- */ static void AddRequirementsToDString(dstring, reqc, reqv) Tcl_DString* dstring; int reqc; /* Requirements constraining the desired version. */ Tcl_Obj *CONST reqv[]; /* 0 means to use the latest version available. */ { if (reqc > 0) { int i; for (i = 0; i < reqc; i++) { Tcl_DStringAppend(dstring, " ", 1); Tcl_DStringAppend(dstring, TclGetString(reqv[i]), -1); } } else { Tcl_DStringAppend(dstring, " 0-", -1); } }  /* *---------------------------------------------------------------------- * * AllRequirementSatisfied -- * * This function checks to see whether a version satisfies at * least one of a set of requirements. * * Results: * If the requirements are satisfied 1 is returned. * Otherwise 0 is returned. The function assumes * that all pieces have valid syntax. And is allowed * to make that assumption. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int AllRequirementsSatisfied(availVersionI, reqc, reqv) CONST char* availVersionI; /* Candidate version to check against the requirements */ int reqc; /* Requirements constraining the desired version. */ Tcl_Obj *CONST reqv[]; /* 0 means to use the latest version available. */ { int i, satisfies; for (satisfies = i = 0; i < reqc; i++) { satisfies = RequirementSatisfied(availVersionI, Tcl_GetString(reqv[i])); if (satisfies) break; } return satisfies; }  /* *---------------------------------------------------------------------- * * RequirementSatisfied -- * * This function checks to see whether a version satisfies a requirement. * * Results: * If the requirement is satisfied 1 is returned. * Otherwise 0 is returned. The function assumes * that all pieces have valid syntax. And is allowed * to make that assumption. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int RequirementSatisfied(havei, req) CONST char *havei; /* Version string, of candidate package we have */ CONST char *req; /* Requirement string the candidate has to satisfy */ { /* The have candidate is already in internal rep. */ int satisfied, res; char* dash = NULL; char* buf, *min, *max; dash = strchr (req, '-'); if (dash == NULL) { /* No dash found, is a simple version, fallback to regular check. * The 'CheckVersionAndConvert' cannot fail. We pad the requirement with * 'a0', i.e '-2' before doing the comparison to properly accept * unstables as well. */ char* reqi = NULL; int thisIsMajor; CheckVersionAndConvert (NULL, req, &reqi, NULL); strcat (reqi, " -2"); res = CompareVersions(havei, reqi, &thisIsMajor); satisfied = (res == 0) || ((res == 1) && !thisIsMajor); Tcl_Free (reqi); return satisfied; } /* Exactly one dash is present (Assumption of valid syntax). Copy the req, * split at the location of dash and check that both parts are * versions. Note that the max part can be empty. */ buf = strdup (req); dash = buf + (dash - req); *dash = '\0'; /* buf now <=> min part */ dash ++; /* dash now <=> max part */ if (*dash == '\0') { /* We have a min, but no max. For the comparison we generate the * internal rep, padded with 'a0' i.e. '-2'. */ /* No max part, unbound */ CheckVersionAndConvert (NULL, buf, &min, NULL); strcat (min, " -2"); satisfied = (CompareVersions(havei, min, NULL) >= 0); Tcl_Free (min); free (buf); return satisfied; } /* We have both min and max, and generate their internal reps. * When identical we compare as is, otherwise we pad with 'a0' * to ove the range a bit. */ CheckVersionAndConvert (NULL, buf, &min, NULL); CheckVersionAndConvert (NULL, dash, &max, NULL); if (CompareVersions(min, max, NULL) == 0) { satisfied = (CompareVersions(min, havei, NULL) == 0); } else { strcat (min, " -2"); strcat (max, " -2"); satisfied = ((CompareVersions(min, havei, NULL) <= 0) && (CompareVersions(havei, max, NULL) < 0)); } Tcl_Free (min); Tcl_Free (max); free (buf); return satisfied; }  /* *---------------------------------------------------------------------- * * ExactRequirement -- * * This function is the core for the translation of -exact requests. * It translates the request of the version into a range of versions. * The translation was chosen for backwards compatibility. * * Results: * A Tcl_Obj containing the version range as string. * * Side effects: * None. * *---------------------------------------------------------------------- */ static Tcl_Obj* ExactRequirement(version) CONST char* version; { /* A -exact request for a version X.y is translated into the range * X.y-X.(y+1). For example -exact 8.4 means the range "8.4-8.5". * * This translation was chosen to prevent packages which currently use a * 'package require -exact tclversion' from being affected by the core now * registering itself as 8.4.x (patchlevel) instead of 8.4 * (version). Examples are tbcload, compiler, and ITcl. * * Translating -exact 8.4 to the range "8.4-8.4" instead would require us * and everyone else to rebuild these packages to require -exact 8.4.14, * or whatever the exact current patchlevel is. A backward compatibility * issue with effects similar to the bugfix made in 8.5 now requiring * ifneeded and provided versions to match. Instead we have chosen to * interpret exactness to not be exactly equal, but to be exact only * within the specified level, and allowing variation in the deeper * level. More examples: * * -exact 8 => "8-9" * -exact 8.4 => "8.4-8.5" * -exact 8.4.14 => "8.4.14-8.4.15" * -exact 8.0a2 => "8.0a2-8.0a3" */ char* iv; int lc, i; CONST char** lv; char buf [30]; Tcl_Obj* o = Tcl_NewStringObj (version,-1); Tcl_AppendStringsToObj (o, "-", NULL); /* Assuming valid syntax here */ CheckVersionAndConvert (NULL, version, &iv, NULL); /* Split the list into components */ Tcl_SplitList (NULL, iv, &lc, &lv); /* Iterate over the components and make them parts of the result. Except * for the last, which is handled separately, to allow the * incrementation. */ for (i=0; i < (lc-1); i++) { /* Regular component */ Tcl_AppendStringsToObj (o, lv[i], NULL); /* Separator component */ i ++; if (0 == strcmp ("-1", lv[i])) { Tcl_AppendStringsToObj (o, "b", NULL); } else if (0 == strcmp ("-2", lv[i])) { Tcl_AppendStringsToObj (o, "a", NULL); } else { Tcl_AppendStringsToObj (o, ".", NULL); } } /* Regular component, last */ sprintf (buf, "%d", atoi (lv [lc-1]) + 1); Tcl_AppendStringsToObj (o, buf, NULL); ckfree ((char*) lv); return o; }  /* *---------------------------------------------------------------------- * * VersionCleanupProc -- * * This function is called to delete the last remember package version * string for an interpreter when the interpreter is deleted. It gets * invoked via the Tcl AssocData mechanism. * * Results: * None. * * Side effects: * Storage for the version object for interp get deleted. * *---------------------------------------------------------------------- */ static void VersionCleanupProc ( ClientData clientData, /* Pointer to remembered version string object * for interp. */ Tcl_Interp *interp) /* Interpreter that is being deleted. */ { Tcl_Obj* ov = (Tcl_Obj*) clientData; if (ov != NULL) { Tcl_DecrRefCount (ov); } }  /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ #endif

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- +	/* * tclPlatDecls.h -- * * Declarations of platform specific Tcl APIs. * * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. * * RCS: @(#) $Id: tclPlatDecls.h,v 1.18 2002/09/27 00:50:10 hobbs Exp $ * RCS: @(#) $Id: tclPlatDecls.h,v 1.18.2.5 2004/06/10 17:17:45 andreas_kupries Exp $ */ #ifndef _TCLPLATDECLS #define _TCLPLATDECLS /* * Pull in the typedef of TCHAR for windows.
︙
78 79 80 81 82 83 84 85 86 87 88 89 90 91	78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97	+ + + + + +	#endif /* MAC_TCL */ #ifdef MAC_OSX_TCL /* 0 */ EXTERN int Tcl_MacOSXOpenBundleResources _ANSI_ARGS_(( Tcl_Interp * interp, CONST char * bundleName, int hasResourceFile, int maxPathLen, char * libraryPath)); /* 1 */ EXTERN int Tcl_MacOSXOpenVersionedBundleResources _ANSI_ARGS_(( Tcl_Interp * interp, CONST char * bundleName, CONST char * bundleVersion, int hasResourceFile, int maxPathLen, char * libraryPath)); #endif /* MAC_OSX_TCL */ typedef struct TclPlatStubs { int magic; struct TclPlatStubHooks *hooks; #ifdef __WIN32__
︙
101 102 103 104 105 106 107 108 109 110 111 112 113 114	107 108 109 110 111 112 113 114 115 116 117 118 119 120 121	+	void (*tcl_SetOSTypeObj) _ANSI_ARGS_((Tcl_Obj * objPtr, OSType osType)); /* 5 */ Tcl_Obj * (*tcl_NewOSTypeObj) _ANSI_ARGS_((OSType osType)); /* 6 */ int (*strncasecmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2, size_t n)); /* 7 */ int (*strcasecmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2)); /* 8 */ #endif /* MAC_TCL */ #ifdef MAC_OSX_TCL int (*tcl_MacOSXOpenBundleResources) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * bundleName, int hasResourceFile, int maxPathLen, char * libraryPath)); /* 0 */ int (*tcl_MacOSXOpenVersionedBundleResources) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * bundleName, CONST char * bundleVersion, int hasResourceFile, int maxPathLen, char * libraryPath)); /* 1 */ #endif /* MAC_OSX_TCL */ } TclPlatStubs; #ifdef __cplusplus extern "C" { #endif extern TclPlatStubs *tclPlatStubsPtr;
︙
171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186	178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197	+ + + +	#endif #endif /* MAC_TCL */ #ifdef MAC_OSX_TCL #ifndef Tcl_MacOSXOpenBundleResources #define Tcl_MacOSXOpenBundleResources \ (tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */ #endif #ifndef Tcl_MacOSXOpenVersionedBundleResources #define Tcl_MacOSXOpenVersionedBundleResources \ (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ #endif #endif /* MAC_OSX_TCL */ #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ /* !END!: Do not edit above this line. */ #endif /* _TCLPLATDECLS */

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

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

- + - - - + + + + + + - + +

/* * tclPort.h -- * * This header file handles porting issues that occur because * of differences between systems. It reads in platform specific * portability files. * * Copyright (c) 1994-1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclPort.h,v 1.6 2002/02/15 14:28:49 dkf Exp $ * RCS: @(#) $Id: tclPort.h,v 1.6.2.1 2003/04/16 23:31:46 dgp Exp $ */ #ifndef _TCLPORT #define _TCLPORT #include "tcl.h" #if defined(__WIN32__) # include "../win/tclWinPort.h" #else # if defined(MAC_TCL) # include "tclMacPort.h" # else # include "../unix/tclUnixPort.h" # endif #endif #if !defined(TCL_WIDE_INT_IS_LONG) && !defined(LLONG_MIN) # ifdef LLONG_BIT # define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<(LLONG_BIT-1))) #if !defined(LLONG_MIN) # ifdef TCL_WIDE_INT_IS_LONG # define LLONG_MIN LONG_MIN # else # ifdef LLONG_BIT # define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<(LLONG_BIT-1))) # else /* Assume we're on a system with a 64-bit 'long long' type */ # define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<63)) # define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<63)) # endif # endif /* Assume that if LLONG_MIN is undefined, then so is LLONG_MAX */ # define LLONG_MAX (~LLONG_MIN) #endif #endif /* _TCLPORT */

︙
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	- +	* * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclPreserve.c,v 1.3 1999/04/16 00:46:52 stanton Exp $ * RCS: @(#) $Id: tclPreserve.c,v 1.3.34.2 2005/06/24 18:21:41 kennykb Exp $ */ #include "tclInt.h" /* * The following data structure is used to keep track of all the * Tcl_Preserve calls that are still in effect. It grows as needed
︙
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	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	- - - - - - - + - - + + -	* not changed by anyone else. */ #endif int refCount; /* Number of TclHandlePreserve() calls in * effect on this handle. */ } HandleStruct; /* * Static routines in this file: */ static void PreserveExitProc _ANSI_ARGS_((ClientData clientData));  /* *---------------------------------------------------------------------- * * PreserveExitProc -- * TclFinalizePreserve -- * * Called during exit processing to clean up the reference array. * * Results: * None. * * Side effects: * Frees the storage of the reference array. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static void PreserveExitProc(clientData) void TclFinalizePreserve() ClientData clientData; /* NULL -Unused. */ { Tcl_MutexLock(&preserveMutex); if (spaceAvl != 0) { ckfree((char *) refArray); refArray = (Reference *) NULL; inUse = 0; spaceAvl = 0;
︙
147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162	140 141 142 143 144 145 146 147 148 149 150 151 152 153	- -	/* * Make a reference array if it doesn't already exist, or make it * bigger if it is full. */ if (inUse == spaceAvl) { if (spaceAvl == 0) { Tcl_CreateExitHandler((Tcl_ExitProc *) PreserveExitProc, (ClientData) NULL); refArray = (Reference *) ckalloc((unsigned) (INITIAL_SIZE*sizeof(Reference))); spaceAvl = INITIAL_SIZE; } else { Reference *new; new = (Reference *) ckalloc((unsigned)
︙
229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244	220 221 222 223 224 225 226 227 228 229 230 231 232 233 234	- + -	freeProc = refPtr->freeProc; mustFree = refPtr->mustFree; inUse--; if (i < inUse) { refArray[i] = refArray[inUse]; } if (mustFree) { if ((freeProc == TCL_DYNAMIC) || if (freeProc == TCL_DYNAMIC) { (freeProc == (Tcl_FreeProc *) free)) { ckfree((char *) clientData); } else { Tcl_MutexUnlock(&preserveMutex); (*freeProc)((char *) clientData); return; } }
︙
302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317	292 293 294 295 296 297 298 299 300 301 302 303 304 305 306	- + -	} Tcl_MutexUnlock(&preserveMutex); /* * No reference for this block. Free it now. */ if ((freeProc == TCL_DYNAMIC) if (freeProc == TCL_DYNAMIC) { || (freeProc == (Tcl_FreeProc *) free)) { ckfree((char *) clientData); } else { (*freeProc)((char *)clientData); } }  /*
︙

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	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	- + + + + +	/* * tclProc.c -- * * This file contains routines that implement Tcl procedures, * including the "proc" and "uplevel" commands. * * Copyright (c) 1987-1993 The Regents of the University of California. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclProc.c,v 1.44 2002/12/11 21:29:52 dgp Exp $ * RCS: @(#) $Id: tclProc.c,v 1.44.2.6 2006/11/28 22:20:02 andreas_kupries Exp $ */ #include "tclInt.h" #include "tclCompile.h" /* * Prototypes for static functions in this file */ static void ProcBodyDup _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *dupPtr)); static void ProcBodyFree _ANSI_ARGS_((Tcl_Obj *objPtr)); static int ProcBodySetFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static void ProcBodyUpdateString _ANSI_ARGS_((Tcl_Obj *objPtr)); static int ProcCompileProc _ANSI_ARGS_((Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description, CONST char *procName, Proc **procPtrPtr)); static int ProcessProcResultCode _ANSI_ARGS_((Tcl_Interp *interp, char *procName, int nameLen, int returnCode)); static int TclCompileNoOp _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); /* * The ProcBodyObjType type
︙
144 145 146 147 148 149 150 151 152 153 154 155 156 157	148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	* later when the procedure is called to determine what namespace the * procedure will run in. This will be different than the current * namespace if the proc was renamed into a different namespace. */ procPtr->cmdPtr = (Command *) cmd; #ifdef TCL_TIP280 /* TIP #280 Remember the line the procedure body is starting on. In a * Byte code context we ask the engine to provide us with the necessary * information. This is for the initialization of the byte code compiler * when the body is used for the first time. */ if (iPtr->cmdFramePtr) { CmdFrame context = *iPtr->cmdFramePtr; if (context.type == TCL_LOCATION_BC) { TclGetSrcInfoForPc (&context); /* May get path in context */ } else if (context.type == TCL_LOCATION_SOURCE) { /* context now holds another reference */ Tcl_IncrRefCount (context.data.eval.path); } /* type == TCL_LOCATION_PREBC implies that 'line' is NULL here! We * cannot assume that 'line' is valid here, we have to check. If the * outer context is an eval (bc, prebc, eval) we do not save any * information. Counting relative to the beginning of the proc body is * more sensible than counting relative to the outer eval block. */ if ((context.type == TCL_LOCATION_SOURCE) && context.line && (context.nline >= 4) && (context.line [3] >= 0)) { int new; CmdFrame* cfPtr = (CmdFrame*) ckalloc (sizeof (CmdFrame)); cfPtr->level = -1; cfPtr->type = context.type; cfPtr->line = (int*) ckalloc (sizeof (int)); cfPtr->line [0] = context.line [3]; cfPtr->nline = 1; cfPtr->framePtr = NULL; cfPtr->nextPtr = NULL; if (context.type == TCL_LOCATION_SOURCE) { cfPtr->data.eval.path = context.data.eval.path; /* Transfer of reference. The reference going away (release of * the context) is replaced by the reference in the * constructed cmdframe */ } else { cfPtr->type = TCL_LOCATION_EVAL; cfPtr->data.eval.path = NULL; } cfPtr->cmd.str.cmd = NULL; cfPtr->cmd.str.len = 0; Tcl_SetHashValue (Tcl_CreateHashEntry (iPtr->linePBodyPtr, (char*) procPtr, &new), cfPtr); } } #endif /* * Optimize for noop procs: if the body is not precompiled (like a TclPro * procbody), and the argument list is just "args" and the body is empty, * define a compileProc to compile a noop. * * Notes:
︙
898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920	961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982	- + -	register Tcl_Interp *interp; /* Interpreter in which procedure was * invoked. */ int objc; /* Count of number of arguments to this * procedure. */ Tcl_Obj *CONST objv[]; /* Argument value objects. */ { Interp *iPtr = (Interp *) interp; register Proc *procPtr = (Proc *) clientData; Proc *procPtr = (Proc *) clientData; Namespace *nsPtr = procPtr->cmdPtr->nsPtr; CallFrame frame; register CallFrame *framePtr = &frame; register Var *varPtr; register CompiledLocal *localPtr; char *procName; int nameLen, localCt, numArgs, argCt, i, result; Tcl_Obj *objResult = Tcl_GetObjResult(interp); /* * This procedure generates an array "compiledLocals" that holds the * storage for local variables. It starts out with stack-allocated space * but uses dynamically-allocated storage if needed. */
︙
932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947	994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009	- - + +	* If necessary, compile the procedure's body. The compiler will * allocate frame slots for the procedure's non-argument local * variables. Note that compiling the body might increase * procPtr->numCompiledLocals if new local variables are found * while compiling. */ result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr, "body of proc", procName); result = ProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr, "body of proc", procName, &procPtr); if (result != TCL_OK) { return result; } /* * Create the "compiledLocals" array. Make sure it is large enough to
︙
1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053	1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134	+ + + + - - + + + + + + + + + + + + + + + + +	} else { goto incorrectArgs; } varPtr++; localPtr = localPtr->nextPtr; } if (argCt > 0) { Tcl_Obj *objResult; int len, flags; incorrectArgs: /* * Build up equivalent to Tcl_WrongNumArgs message for proc */ Tcl_ResetResult(interp); Tcl_AppendStringsToObj(objResult, "wrong # args: should be \"", procName, (char *) NULL); objResult = Tcl_GetObjResult(interp); Tcl_AppendToObj(objResult, "wrong # args: should be \"", -1); /* * Quote the proc name if it contains spaces (Bug 942757). */ len = Tcl_ScanCountedElement(procName, nameLen, &flags); if (len != nameLen) { char *procName1 = ckalloc((unsigned) len); len = Tcl_ConvertCountedElement(procName, nameLen, procName1, flags); Tcl_AppendToObj(objResult, procName1, len); ckfree(procName1); } else { Tcl_AppendToObj(objResult, procName, len); } localPtr = procPtr->firstLocalPtr; for (i = 1; i <= numArgs; i++) { if (localPtr->defValuePtr != NULL) { Tcl_AppendStringsToObj(objResult, " ?", localPtr->name, "?", (char *) NULL); } else { Tcl_AppendStringsToObj(objResult,
︙
1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089	1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178	+ + + + + + + +	fprintf(stdout, "\n"); fflush(stdout); } #endif /*TCL_COMPILE_DEBUG*/ iPtr->returnCode = TCL_OK; procPtr->refCount++; #ifndef TCL_TIP280 result = TclCompEvalObj(interp, procPtr->bodyPtr); #else /* TIP #280: No need to set the invoking context here. The body has * already been compiled, so the part of CompEvalObj using it is bypassed. */ result = TclCompEvalObj(interp, procPtr->bodyPtr, NULL, 0); #endif procPtr->refCount--; if (procPtr->refCount <= 0) { TclProcCleanupProc(procPtr); } if (result != TCL_OK) { result = ProcessProcResultCode(interp, procName, nameLen, result);
︙
1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149	1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258	+ + + + + + + + + + + + + + + + + + + - + +	Proc *procPtr; /* Data associated with procedure. */ Tcl_Obj *bodyPtr; /* Body of proc. (Usually procPtr->bodyPtr, * but could be any code fragment compiled * in the context of this procedure.) */ Namespace *nsPtr; /* Namespace containing procedure. */ CONST char *description; /* string describing this body of code. */ CONST char *procName; /* Name of this procedure. */ { return ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName, NULL); } static int ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName, procPtrPtr) Tcl_Interp *interp; /* Interpreter containing procedure. */ Proc *procPtr; /* Data associated with procedure. */ Tcl_Obj *bodyPtr; /* Body of proc. (Usually procPtr->bodyPtr, * but could be any code fragment compiled * in the context of this procedure.) */ Namespace *nsPtr; /* Namespace containing procedure. */ CONST char *description; /* string describing this body of code. */ CONST char *procName; /* Name of this procedure. */ Proc **procPtrPtr; /* points to storage where a replacement * (Proc *) value may be written, when * appropriate */ { Interp *iPtr = (Interp*)interp; int result; int i, result; Tcl_CallFrame frame; Proc *saveProcPtr; ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr; CompiledLocal *localPtr; /* * If necessary, compile the procedure's body. The compiler will * allocate frame slots for the procedure's non-argument local * variables. If the ByteCode already exists, make sure it hasn't been * invalidated by someone redefining a core command (this might make the * compiled code wrong). Also, if the code was compiled in/for a
︙
1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247	1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438	- + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -	* know which proc it's compiling so that it can access its * list of compiled locals. * * TRICKY NOTE: Be careful to push a call frame with the * proper namespace context, so that the byte codes are * compiled in the appropriate class context. */ saveProcPtr = iPtr->compiledProcPtr; if (procPtrPtr != NULL && procPtr->refCount > 1) { Tcl_Command token; Tcl_CmdInfo info; Proc *new = (Proc *) ckalloc(sizeof(Proc)); new->iPtr = procPtr->iPtr; new->refCount = 1; new->cmdPtr = procPtr->cmdPtr; token = (Tcl_Command) new->cmdPtr; new->bodyPtr = Tcl_DuplicateObj(bodyPtr); bodyPtr = new->bodyPtr; Tcl_IncrRefCount(bodyPtr); new->numArgs = procPtr->numArgs; new->numCompiledLocals = new->numArgs; new->firstLocalPtr = NULL; new->lastLocalPtr = NULL; localPtr = procPtr->firstLocalPtr; for (i = 0; i < new->numArgs; i++, localPtr = localPtr->nextPtr) { CompiledLocal *copy = (CompiledLocal *) ckalloc((unsigned) (sizeof(CompiledLocal) -sizeof(localPtr->name) + localPtr->nameLength + 1)); if (new->firstLocalPtr == NULL) { new->firstLocalPtr = new->lastLocalPtr = copy; } else { new->lastLocalPtr->nextPtr = copy; new->lastLocalPtr = copy; } copy->nextPtr = NULL; copy->nameLength = localPtr->nameLength; copy->frameIndex = localPtr->frameIndex; copy->flags = localPtr->flags; copy->defValuePtr = localPtr->defValuePtr; if (copy->defValuePtr) { Tcl_IncrRefCount(copy->defValuePtr); } copy->resolveInfo = localPtr->resolveInfo; strcpy(copy->name, localPtr->name); } /* Reset the ClientData */ Tcl_GetCommandInfoFromToken(token, &info); if (info.objClientData == (ClientData) procPtr) { info.objClientData = (ClientData) new; } if (info.clientData == (ClientData) procPtr) { info.clientData = (ClientData) new; } if (info.deleteData == (ClientData) procPtr) { info.deleteData = (ClientData) new; } Tcl_SetCommandInfoFromToken(token, &info); procPtr->refCount--; *procPtrPtr = procPtr = new; } iPtr->compiledProcPtr = procPtr; result = Tcl_PushCallFrame(interp, &frame, (Tcl_Namespace*)nsPtr, /* isProcCallFrame */ 0); if (result == TCL_OK) { #ifdef TCL_TIP280 /* TIP #280. We get the invoking context from the cmdFrame * which was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr). */ Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->linePBodyPtr, (char *) procPtr); /* Constructed saved frame has body as word 0. See Tcl_ProcObjCmd. */ iPtr->invokeWord = 0; iPtr->invokeCmdFramePtr = (hePtr ? (CmdFrame*) Tcl_GetHashValue (hePtr) : NULL); #endif result = tclByteCodeType.setFromAnyProc(interp, bodyPtr); #ifdef TCL_TIP280 iPtr->invokeCmdFramePtr = NULL; #endif Tcl_PopCallFrame(interp); } iPtr->compiledProcPtr = saveProcPtr; if (result != TCL_OK) { if (result == TCL_ERROR) { char buf[100 + TCL_INTEGER_SPACE]; numChars = strlen(procName); ellipsis = ""; if (numChars > 50) { numChars = 50; ellipsis = "..."; } while ( (procName[numChars] & 0xC0) == 0x80 ) { /* * Back up truncation point so that we don't truncate * in the middle of a multi-byte character (in UTF-8) */ numChars--; ellipsis = "..."; } sprintf(buf, "\n (compiling %s \"%.*s%s\", line %d)", description, numChars, procName, ellipsis, interp->errorLine); Tcl_AddObjErrorInfo(interp, buf, -1); } return result; } } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) { register CompiledLocal *localPtr; /* * The resolver epoch has changed, but we only need to invalidate * the resolver cache. */ for (localPtr = procPtr->firstLocalPtr; localPtr != NULL;
︙
1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321	1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520	+ + + + + + + +	Tcl_AppendToObj(Tcl_GetObjResult(interp), ((returnCode == TCL_BREAK) ? "invoked \"break\" outside of a loop" : "invoked \"continue\" outside of a loop"), -1); } if (nameLen > 60) { nameLen = 60; ellipsis = "..."; } while ( (procName[nameLen] & 0xC0) == 0x80 ) { /* * Back up truncation point so that we don't truncate in the * middle of a multi-byte character (in UTF-8) */ nameLen--; ellipsis = "..."; } sprintf(msg, "\n (procedure \"%.*s%s\" line %d)", nameLen, procName, ellipsis, iPtr->errorLine); Tcl_AddObjErrorInfo(interp, msg, -1); return TCL_ERROR; }
︙
1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386	1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590	+ + + + +	TclProcCleanupProc(procPtr) register Proc *procPtr; /* Procedure to be deleted. */ { register CompiledLocal *localPtr; Tcl_Obj *bodyPtr = procPtr->bodyPtr; Tcl_Obj *defPtr; Tcl_ResolvedVarInfo *resVarInfo; #ifdef TCL_TIP280 Tcl_HashEntry* hePtr = NULL; CmdFrame* cfPtr = NULL; Interp* iPtr = procPtr->iPtr; #endif if (bodyPtr != NULL) { Tcl_DecrRefCount(bodyPtr); } for (localPtr = procPtr->firstLocalPtr; localPtr != NULL; ) { CompiledLocal *nextPtr = localPtr->nextPtr;
︙
1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410	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	+ + + + + + + + + + + + + + + + + + + + + +	defPtr = localPtr->defValuePtr; Tcl_DecrRefCount(defPtr); } ckfree((char *) localPtr); localPtr = nextPtr; } ckfree((char *) procPtr); #ifdef TCL_TIP280 /* TIP #280. Release the location data associated with this Proc * structure, if any. The interpreter may not exist (For example for * procbody structurues created by tbcload. */ if (!iPtr) return; hePtr = Tcl_FindHashEntry (iPtr->linePBodyPtr, (char *) procPtr); if (!hePtr) return; cfPtr = (CmdFrame*) Tcl_GetHashValue (hePtr); if (cfPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount (cfPtr->data.eval.path); cfPtr->data.eval.path = NULL; } ckfree ((char*) cfPtr->line); cfPtr->line = NULL; ckfree ((char*) cfPtr); Tcl_DeleteHashEntry (hePtr); #endif }  /* *---------------------------------------------------------------------- * * TclUpdateReturnInfo -- *
︙
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	1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683	+ + + - - + + + + - - + +	int TclUpdateReturnInfo(iPtr) Interp *iPtr; /* Interpreter for which TCL_RETURN * exception is being processed. */ { int code; char *errorCode; Tcl_Obj *objPtr; code = iPtr->returnCode; iPtr->returnCode = TCL_OK; if (code == TCL_ERROR) { errorCode = ((iPtr->errorCode != NULL) ? iPtr->errorCode : "NONE"); objPtr = Tcl_NewStringObj(errorCode, -1); Tcl_IncrRefCount(objPtr); Tcl_ObjSetVar2((Tcl_Interp *) iPtr, iPtr->execEnvPtr->errorCode, NULL, Tcl_NewStringObj(errorCode, -1), TCL_GLOBAL_ONLY); NULL, objPtr, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(objPtr); iPtr->flags |= ERROR_CODE_SET; if (iPtr->errorInfo != NULL) { objPtr = Tcl_NewStringObj(iPtr->errorInfo, -1); Tcl_IncrRefCount(objPtr); Tcl_ObjSetVar2((Tcl_Interp *) iPtr, iPtr->execEnvPtr->errorInfo, NULL, Tcl_NewStringObj(iPtr->errorInfo, -1), TCL_GLOBAL_ONLY); NULL, objPtr, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(objPtr); iPtr->flags |= ERR_IN_PROGRESS; } } return code; }  /*
︙
1697 1698 1699 1700 1701 1702 1703 1704 1705 1706	1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943	- - + + + + + + + +	TclEmitOpcode(INST_POP, envPtr); } } envPtr->currStackDepth = savedStackDepth; TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr); return TCL_OK; }  /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclRegexp.c -- * * This file contains the public interfaces to the Tcl regular * expression mechanism. * * Copyright (c) 1998 by 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. * * RCS: @(#) $Id: tclRegexp.c,v 1.14 2002/01/17 03:03:12 dgp Exp $ * RCS: @(#) $Id: tclRegexp.c,v 1.14.4.2 2006/04/07 01:14:28 hobbs Exp $ */ #include "tclInt.h" #include "tclPort.h" #include "tclRegexp.h" /*
︙
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115	101 102 103 104 105 106 107 108 109 110 111 112 113 114 115	- +	Tcl_Obj *objPtr)); /* * The regular expression Tcl object type. This serves as a cache * of the compiled form of the regular expression. */ Tcl_ObjType tclRegexpType = { static Tcl_ObjType tclRegexpType = { "regexp", /* name */ FreeRegexpInternalRep, /* freeIntRepProc */ DupRegexpInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ SetRegexpFromAny /* setFromAnyProc */ };
︙
1020 1021 1022 1023 1024 1025 1026 1027 1028	1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034	+ + + + + +	for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) { regexpPtr = tsdPtr->regexps[i]; if (--(regexpPtr->refCount) <= 0) { FreeRegexp(regexpPtr); } ckfree(tsdPtr->patterns[i]); tsdPtr->patterns[i] = NULL; } /* * We may find ourselves reinitialized if another finalization routine * invokes regexps. */ tsdPtr->initialized = 0; }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	- +	/* * tclResult.c -- * * This file contains code to manage the interpreter result. * * Copyright (c) 1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclResult.c,v 1.5 2002/01/25 20:40:55 dgp Exp $ * RCS: @(#) $Id: tclResult.c,v 1.5.2.2 2004/09/30 22:45:15 dgp Exp $ */ #include "tclInt.h" /* * Function prototypes for local procedures in this file: */
︙
194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209	194 195 196 197 198 199 200 201 202 203 204 205 206 207 208	- + -	Tcl_SavedResult *statePtr; /* State returned by Tcl_SaveResult. */ { TclDecrRefCount(statePtr->objResultPtr); if (statePtr->result == statePtr->appendResult) { ckfree(statePtr->appendResult); } else if (statePtr->freeProc) { if ((statePtr->freeProc == TCL_DYNAMIC) if (statePtr->freeProc == TCL_DYNAMIC) { || (statePtr->freeProc == (Tcl_FreeProc *) free)) { ckfree(statePtr->result); } else { (*statePtr->freeProc)(statePtr->result); } } }
︙
261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276	260 261 262 263 264 265 266 267 268 269 270 271 272 273 274	- + -	/* * If the old result was dynamically-allocated, free it up. Do it * here, rather than at the beginning, in case the new result value * was part of the old result value. */ if (oldFreeProc != 0) { if ((oldFreeProc == TCL_DYNAMIC) if (oldFreeProc == TCL_DYNAMIC) { || (oldFreeProc == (Tcl_FreeProc *) free)) { ckfree(oldResult); } else { (*oldFreeProc)(oldResult); } } /*
︙
355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370	353 354 355 356 357 358 359 360 361 362 363 364 365 366 367	- + -	TclDecrRefCount(oldObjResult); /* * Reset the string result since we just set the result object. */ if (iPtr->freeProc != NULL) { if ((iPtr->freeProc == TCL_DYNAMIC) if (iPtr->freeProc == TCL_DYNAMIC) { || (iPtr->freeProc == (Tcl_FreeProc *) free)) { ckfree(iPtr->result); } else { (*iPtr->freeProc)(iPtr->result); } iPtr->freeProc = 0; } iPtr->result = iPtr->resultSpace;
︙
409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424	406 407 408 409 410 411 412 413 414 415 416 417 418 419 420	- + -	ResetObjResult(iPtr); objResultPtr = iPtr->objResultPtr; length = strlen(iPtr->result); TclInitStringRep(objResultPtr, iPtr->result, length); if (iPtr->freeProc != NULL) { if ((iPtr->freeProc == TCL_DYNAMIC) if (iPtr->freeProc == TCL_DYNAMIC) { || (iPtr->freeProc == (Tcl_FreeProc *) free)) { ckfree(iPtr->result); } else { (*iPtr->freeProc)(iPtr->result); } iPtr->freeProc = 0; } iPtr->result = iPtr->resultSpace;
︙
747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762	743 744 745 746 747 748 749 750 751 752 753 754 755 756 757	- + -	void Tcl_FreeResult(interp) register Tcl_Interp *interp; /* Interpreter for which to free result. */ { register Interp *iPtr = (Interp *) interp; if (iPtr->freeProc != NULL) { if ((iPtr->freeProc == TCL_DYNAMIC) if (iPtr->freeProc == TCL_DYNAMIC) { || (iPtr->freeProc == (Tcl_FreeProc *) free)) { ckfree(iPtr->result); } else { (*iPtr->freeProc)(iPtr->result); } iPtr->freeProc = 0; }
︙
787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802	782 783 784 785 786 787 788 789 790 791 792 793 794 795 796	- + -	Tcl_ResetResult(interp) register Tcl_Interp *interp; /* Interpreter for which to clear result. */ { register Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); if (iPtr->freeProc != NULL) { if ((iPtr->freeProc == TCL_DYNAMIC) if (iPtr->freeProc == TCL_DYNAMIC) { || (iPtr->freeProc == (Tcl_FreeProc *) free)) { ckfree(iPtr->result); } else { (*iPtr->freeProc)(iPtr->result); } iPtr->freeProc = 0; } iPtr->result = iPtr->resultSpace;
︙
1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052	1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049	+ - - + + + + + - + - - - + +	} iPtr->flags &= ~(ERR_ALREADY_LOGGED); Tcl_ResetResult(targetInterp); objPtr = Tcl_GetVar2Ex(sourceInterp, "errorInfo", NULL, TCL_GLOBAL_ONLY); if (objPtr) { Tcl_SetVar2Ex(targetInterp, "errorInfo", NULL, objPtr, TCL_GLOBAL_ONLY); Tcl_SetVar2Ex(targetInterp, "errorInfo", NULL, objPtr, TCL_GLOBAL_ONLY); ((Interp *) targetInterp)->flags |= ERR_IN_PROGRESS; } objPtr = Tcl_GetVar2Ex(sourceInterp, "errorCode", NULL, TCL_GLOBAL_ONLY); if (objPtr) { Tcl_SetVar2Ex(targetInterp, "errorCode", NULL, objPtr, Tcl_SetObjErrorCode(targetInterp, objPtr); TCL_GLOBAL_ONLY); ((Interp *) targetInterp)->flags |= (ERR_IN_PROGRESS | ERROR_CODE_SET); } } ((Interp *) targetInterp)->returnCode = ((Interp *) sourceInterp)->returnCode; Tcl_SetObjResult(targetInterp, Tcl_GetObjResult(sourceInterp)); Tcl_ResetResult(sourceInterp); }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	- +	/* * tclScan.c -- * * This file contains the implementation of the "scan" command. * * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclScan.c,v 1.12 2002/02/25 15:23:02 dkf Exp $ * RCS: @(#) $Id: tclScan.c,v 1.12.2.2 2005/10/23 22:01:30 msofer Exp $ */ #include "tclInt.h" /* * For strtoll() and strtoull() declarations on some platforms... */ #include "tclPort.h"
︙
367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383	367 368 369 370 371 372 373 374 375 376 377 378 379 380 381	- -	/* * Handle any size specifier. */ switch (ch) { case 'l': case 'L': #ifndef TCL_WIDE_INT_IS_LONG flags |= SCAN_LONGER; #endif case 'h': format += Tcl_UtfToUniChar(format, &ch); } if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) { goto badIndex; }
︙
700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716	698 699 700 701 702 703 704 705 706 707 708 709 710 711 712	- -	/* * Handle any size specifier. */ switch (ch) { case 'l': case 'L': #ifndef TCL_WIDE_INT_IS_LONG flags |= SCAN_LONGER; #endif /* * Fall through so we skip to the next character. */ case 'h': format += Tcl_UtfToUniChar(format, &ch); }
︙
1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055	1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050	- - - - - + + + + + -	} } else { #endif /* !TCL_WIDE_INT_IS_LONG */ value = (long) (*fn)(buf, NULL, base); if ((flags & SCAN_UNSIGNED) && (value < 0)) { sprintf(buf, "%lu", value); /* INTL: ISO digit */ objPtr = Tcl_NewStringObj(buf, -1); } else { if ((unsigned long) value > UINT_MAX) { objPtr = Tcl_NewLongObj(value); } else { objPtr = Tcl_NewIntObj(value); } else if ((flags & SCAN_LONGER) || (unsigned long) value > UINT_MAX) { objPtr = Tcl_NewLongObj(value); } else { objPtr = Tcl_NewIntObj(value); } } #ifndef TCL_WIDE_INT_IS_LONG } #endif Tcl_IncrRefCount(objPtr); objs[objIndex++] = objPtr; }
︙
1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191	1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188	+ + - - + + + -	if (numVars) { /* * In this case, variables were specified (classic scan) */ for (i = 0; i < totalVars; i++) { if (objs[i] != NULL) { Tcl_Obj *tmpPtr; result++; if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], 0) == NULL) { tmpPtr = Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], 0); Tcl_DecrRefCount(objs[i]); if (tmpPtr == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "couldn't set variable \"", Tcl_GetString(objv[i+3]), "\"", (char *) NULL); code = TCL_ERROR; } Tcl_DecrRefCount(objs[i]); } } } else { /* * Here no vars were specified, we want a list returned (inline scan) */ objPtr = Tcl_NewObj();
︙

︙
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43	29 30 31 32 33 34 35 36 37 38 39 40 41 42 43	- +	* * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 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. * * RCS: @(#) $Id: tclStringObj.c,v 1.32 2003/02/19 16:43:28 das Exp $ */ * RCS: @(#) $Id: tclStringObj.c,v 1.32.2.2 2006/09/24 21:15:11 msofer Exp $ */ #include "tclInt.h" /* * Prototypes for procedures defined later in this file: */
︙
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116	101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118	- - + + + +	Tcl_UniChar unicode[2]; /* The array of Unicode chars. The actual * size of this field depends on the * 'uallocated' field above. */ } String; #define STRING_UALLOC(numChars) \ (numChars * sizeof(Tcl_UniChar)) #define STRING_SIZE(ualloc) \ ((unsigned) (sizeof(String) - sizeof(Tcl_UniChar) + ualloc)) #define STRING_SIZE(ualloc) \ ((unsigned) ((ualloc) \ ? sizeof(String) - sizeof(Tcl_UniChar) + (ualloc) \ : sizeof(String))) #define GET_STRING(objPtr) \ ((String *) (objPtr)->internalRep.otherValuePtr) #define SET_STRING(objPtr, stringPtr) \ (objPtr)->internalRep.otherValuePtr = (VOID *) (stringPtr) /* * TCL STRING GROWTH ALGORITHM
︙
638 639 640 641 642 643 644 645 646 647 648 649 650 651 652	640 641 642 643 644 645 646 647 648 649 650 651 652 653 654	- +	* We need to fetch the pointer again because we may have just * reallocated the structure. */ stringPtr = GET_STRING(objPtr); } if (stringPtr->numChars == objPtr->length) { if (objPtr->bytes && stringPtr->numChars == objPtr->length) { char *str = Tcl_GetString(objPtr); /* * All of the characters in the Utf string are 1 byte chars, * so we don't store the unicode char. Create a new string * object containing the specified range of chars. */
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	- +	/* * tclStubInit.c -- * * This file contains the initializers for the Tcl stub vectors. * * 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. * * RCS: @(#) $Id: tclStubInit.c,v 1.79 2003/02/18 02:25:45 hobbs Exp $ * RCS: @(#) $Id: tclStubInit.c,v 1.79.2.10 2006/09/22 01:26:23 andreas_kupries Exp $ */ #include "tclInt.h" #include "tclPort.h" /* * Remove macros that will interfere with the definitions below.
︙
31 32 33 34 35 36 37 38 39 40 41 42 43 44	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	+ + + + + + + + + + + + + + + + + + + + + + +	#undef Tcl_NewStringObj #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory #if TCL_PRESERVE_BINARY_COMPATABILITY # undef Tcl_FindHashEntry # undef Tcl_CreateHashEntry #endif /* * Keep a record of the original Notifier procedures, created in the * same compilation unit as the stub tables so we can later do reliable, * portable comparisons to see whether a Tcl_SetNotifier() call swapped * new routines into the stub table. */ Tcl_NotifierProcs tclOriginalNotifier = { Tcl_SetTimer, Tcl_WaitForEvent, #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ Tcl_CreateFileHandler, Tcl_DeleteFileHandler, #else NULL, NULL, #endif NULL, NULL, NULL, NULL }; /* * WARNING: The contents of this file is automatically generated by the * tools/genStubs.tcl script. Any modifications to the function declarations * below should be made in the generic/tcl.decls script. */
︙
241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273	264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322	+ + + + + + + + + + + + + + + + + + + + + + + + + + - - + +	TclSetStartupScriptPath, /* 167 */ TclGetStartupScriptPath, /* 168 */ TclpUtfNcmp2, /* 169 */ TclCheckInterpTraces, /* 170 */ TclCheckExecutionTraces, /* 171 */ TclInThreadExit, /* 172 */ TclUniCharMatch, /* 173 */ NULL, /* 174 */ NULL, /* 175 */ NULL, /* 176 */ NULL, /* 177 */ NULL, /* 178 */ NULL, /* 179 */ NULL, /* 180 */ NULL, /* 181 */ TclpLocaltime, /* 182 */ TclpGmtime, /* 183 */ NULL, /* 184 */ NULL, /* 185 */ NULL, /* 186 */ NULL, /* 187 */ NULL, /* 188 */ NULL, /* 189 */ NULL, /* 190 */ NULL, /* 191 */ NULL, /* 192 */ NULL, /* 193 */ NULL, /* 194 */ NULL, /* 195 */ NULL, /* 196 */ NULL, /* 197 */ NULL, /* 198 */ TclMatchIsTrivial, /* 199 */ }; TclIntPlatStubs tclIntPlatStubs = { TCL_STUB_MAGIC, NULL, #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ TclGetAndDetachPids, /* 0 */ TclpCloseFile, /* 1 */ TclpCreateCommandChannel, /* 2 */ TclpCreatePipe, /* 3 */ TclpCreateProcess, /* 4 */ NULL, /* 5 */ TclpMakeFile, /* 6 */ TclpOpenFile, /* 7 */ TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ TclpReaddir, /* 10 */ TclpLocaltime, /* 11 */ TclpGmtime, /* 12 */ TclpLocaltime_unix, /* 11 */ TclpGmtime_unix, /* 12 */ TclpInetNtoa, /* 13 */ #endif /* UNIX */ #ifdef __WIN32__ TclWinConvertError, /* 0 */ TclWinConvertWSAError, /* 1 */ TclWinGetServByName, /* 2 */ TclWinGetSockOpt, /* 3 */
︙
292 293 294 295 296 297 298 299 300 301 302 303 304 305	341 342 343 344 345 346 347 348 349 350 351 352 353 354 355	+	TclpCreateTempFile, /* 22 */ TclpGetTZName, /* 23 */ TclWinNoBackslash, /* 24 */ TclWinGetPlatform, /* 25 */ TclWinSetInterfaces, /* 26 */ TclWinFlushDirtyChannels, /* 27 */ TclWinResetInterfaces, /* 28 */ TclWinCPUID, /* 29 */ #endif /* __WIN32__ */ #ifdef MAC_TCL TclpSysAlloc, /* 0 */ TclpSysFree, /* 1 */ TclpSysRealloc, /* 2 */ TclpExit, /* 3 */ FSpGetDefaultDir, /* 4 */
︙
344 345 346 347 348 349 350 351 352 353 354 355 356 357	394 395 396 397 398 399 400 401 402 403 404 405 406 407 408	+	Tcl_SetOSTypeObj, /* 5 */ Tcl_NewOSTypeObj, /* 6 */ strncasecmp, /* 7 */ strcasecmp, /* 8 */ #endif /* MAC_TCL */ #ifdef MAC_OSX_TCL Tcl_MacOSXOpenBundleResources, /* 0 */ Tcl_MacOSXOpenVersionedBundleResources, /* 1 */ #endif /* MAC_OSX_TCL */ }; static TclStubHooks tclStubHooks = { &tclPlatStubs, &tclIntStubs, &tclIntPlatStubs
︙
898 899 900 901 902 903 904 905 906 907	949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	Tcl_GetWideIntFromObj, /* 487 */ Tcl_NewWideIntObj, /* 488 */ Tcl_SetWideIntObj, /* 489 */ Tcl_AllocStatBuf, /* 490 */ Tcl_Seek, /* 491 */ Tcl_Tell, /* 492 */ Tcl_ChannelWideSeekProc, /* 493 */ NULL, /* 494 */ NULL, /* 495 */ NULL, /* 496 */ NULL, /* 497 */ NULL, /* 498 */ NULL, /* 499 */ NULL, /* 500 */ NULL, /* 501 */ NULL, /* 502 */ NULL, /* 503 */ NULL, /* 504 */ NULL, /* 505 */ NULL, /* 506 */ NULL, /* 507 */ NULL, /* 508 */ NULL, /* 509 */ NULL, /* 510 */ NULL, /* 511 */ NULL, /* 512 */ NULL, /* 513 */ NULL, /* 514 */ NULL, /* 515 */ NULL, /* 516 */ NULL, /* 517 */ NULL, /* 518 */ NULL, /* 519 */ NULL, /* 520 */ NULL, /* 521 */ NULL, /* 522 */ NULL, /* 523 */ NULL, /* 524 */ NULL, /* 525 */ NULL, /* 526 */ NULL, /* 527 */ NULL, /* 528 */ NULL, /* 529 */ NULL, /* 530 */ NULL, /* 531 */ NULL, /* 532 */ NULL, /* 533 */ NULL, /* 534 */ NULL, /* 535 */ NULL, /* 536 */ NULL, /* 537 */ NULL, /* 538 */ NULL, /* 539 */ NULL, /* 540 */ NULL, /* 541 */ NULL, /* 542 */ NULL, /* 543 */ NULL, /* 544 */ NULL, /* 545 */ NULL, /* 546 */ NULL, /* 547 */ NULL, /* 548 */ NULL, /* 549 */ NULL, /* 550 */ NULL, /* 551 */ NULL, /* 552 */ NULL, /* 553 */ Tcl_ChannelThreadActionProc, /* 554 */ NULL, /* 555 */ NULL, /* 556 */ NULL, /* 557 */ NULL, /* 558 */ NULL, /* 559 */ NULL, /* 560 */ NULL, /* 561 */ NULL, /* 562 */ NULL, /* 563 */ NULL, /* 564 */ NULL, /* 565 */ NULL, /* 566 */ NULL, /* 567 */ NULL, /* 568 */ NULL, /* 569 */ NULL, /* 570 */ NULL, /* 571 */ NULL, /* 572 */ Tcl_PkgRequireProc, /* 573 */ }; /* !END!: Do not edit above this line. */

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclStubLib.c -- * * Stub object that will be statically linked into extensions that wish * to access Tcl. * * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 1998 Paul Duffin. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclStubLib.c,v 1.6 2002/12/04 07:07:59 hobbs Exp $ * RCS: @(#) $Id: tclStubLib.c,v 1.6.2.1 2005/11/20 18:23:03 jenglish Exp $ */ /* * We need to ensure that we use the stub macros so that this file contains * no references to any of the stub functions. This will make it possible * to build an extension that references Tcl_InitStubs but doesn't end up * including the rest of the stub functions.
︙
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45	29 30 31 32 33 34 35 36 37 38 39 40 41 42	- - -	#include "tclPort.h" /* * Ensure that Tcl_InitStubs is built as an exported symbol. The other stub * functions should be built as non-exported symbols. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT TclStubs *tclStubsPtr = NULL; TclPlatStubs *tclPlatStubsPtr = NULL; TclIntStubs *tclIntStubsPtr = NULL; TclIntPlatStubs *tclIntPlatStubsPtr = NULL; static TclStubs * HasStubSupport _ANSI_ARGS_((Tcl_Interp *interp));
︙
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 116 117 118 119 120 121	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 116 117	- + - + - - +	CONST char * Tcl_InitStubs (interp, version, exact) Tcl_Interp *interp; CONST char *version; int exact; { CONST char *actualVersion = NULL; TclStubs *tmp; ClientData pkgData = NULL; /* * We can't optimize this check by caching tclStubsPtr because * that prevents apps from being able to load/unload Tcl dynamically * multiple times. [Bug 615304] */ tclStubsPtr = HasStubSupport(interp); if (!tclStubsPtr) { return NULL; } actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact, actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact, &pkgData); (ClientData *) &tmp); if (actualVersion == NULL) { tclStubsPtr = NULL; return NULL; } tclStubsPtr = (TclStubs*)pkgData; if (tclStubsPtr->hooks) { tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs; tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs; } else { tclPlatStubsPtr = NULL; tclIntStubsPtr = NULL; tclIntPlatStubsPtr = NULL; } return actualVersion; }

︙
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	- +	* Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Ajuba Solutions. * Copyright (c) 2003 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclTest.c,v 1.62 2003/02/18 10:13:25 vincentdarley Exp $ * RCS: @(#) $Id: tclTest.c,v 1.62.2.13 2006/09/22 01:26:23 andreas_kupries Exp $ */ #define TCL_TEST #include "tclInt.h" #include "tclPort.h" /*
︙
204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219	204 205 206 207 208 209 210 211 212 213 214 215 216 217	- -	Tcl_Interp *interp, int argc, CONST char **argv)); static int TestcmdinfoCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static int TestcmdtokenCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static int TestcmdtraceCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static int TestchmodCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static int TestcreatecommandCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static int TestdcallCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static int TestdelCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static int TestdelassocdataCmd _ANSI_ARGS_((ClientData dummy,
︙
310 311 312 313 314 315 316 317 318 319 320 321 322 323	308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323	+ +	static int TestsaveresultCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static void TestsaveresultFree _ANSI_ARGS_((char *blockPtr)); static int TestsetassocdataCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static int TestsetCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static int TestseterrorcodeCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static int TestsetobjerrorcodeCmd _ANSI_ARGS_(( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int TestopenfilechannelprocCmd _ANSI_ARGS_(( ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv));
︙
416 417 418 419 420 421 422 423 424 425 426 427 428 429	416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432	+ + +	static Tcl_Channel SimpleOpenFileChannel _ANSI_ARGS_ (( Tcl_Interp *interp, Tcl_Obj *fileName, int mode, int permissions)); static Tcl_Obj* SimpleListVolumes _ANSI_ARGS_ ((void)); static int SimplePathInFilesystem _ANSI_ARGS_ (( Tcl_Obj *pathPtr, ClientData *clientDataPtr)); static Tcl_Obj* SimpleCopy _ANSI_ARGS_ ((Tcl_Obj *pathPtr)); static int TestNumUtfCharsCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static Tcl_Filesystem testReportingFilesystem = { "reporting", sizeof(Tcl_Filesystem), TCL_FILESYSTEM_VERSION_1, &TestReportInFilesystem, /* path in */ &TestReportDupInternalRep,
︙
541 542 543 544 545 546 547 548 549 550 551 552 553 554 555	544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563	+ + + + +	Tcl_Obj **objv; int objc, index; static CONST char *specialOptions[] = { "-appinitprocerror", "-appinitprocdeleteinterp", "-appinitprocclosestderr", "-appinitprocsetrcfile", (char *) NULL }; #ifndef TCL_TIP268 if (Tcl_PkgProvide(interp, "Tcltest", TCL_VERSION) == TCL_ERROR) { #else /* TIP #268: Full patchlevel instead of just major.minor */ if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) { #endif return TCL_ERROR; } /* * Create additional commands and math functions for testing Tcl. */
︙
571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586	579 580 581 582 583 584 585 586 587 588 589 590 591 592	- -	Tcl_CreateCommand(interp, "testaccessproc", TestaccessprocCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testchannel", TestChannelCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
︙
647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662	653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673	+ + + + +	(ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testseterr", TestsetCmd, (ClientData) TCL_LEAVE_ERR_MSG, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "testsetobjerrorcode", TestsetobjerrorcodeCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "testnumutfchars", TestNumUtfCharsCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testtranslatefilename", TesttranslatefilenameCmd, (ClientData) 0,
︙
1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132	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	+ + + + + + + + + + + +	* further check of the robustness of the trace proc calling code in * TclExecuteByteCode. */ cmdTrace = Tcl_CreateTrace(interp, 50000, (Tcl_CmdTraceProc *) CmdTraceDeleteProc, (ClientData) NULL); Tcl_Eval(interp, argv[2]); } else if (strcmp(argv[1], "leveltest") == 0) { Interp *iPtr = (Interp *) interp; Tcl_DStringInit(&buffer); cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4, (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer); result = Tcl_Eval(interp, argv[2]); if (result == TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL); } Tcl_DeleteTrace(interp, cmdTrace); Tcl_DStringFree(&buffer); } else if ( strcmp(argv[1], "resulttest" ) == 0 ) { /* Create an object-based trace, then eval a script. This is used * to test return codes other than TCL_OK from the trace engine. */ static int deleteCalled; deleteCalled = 0; cmdTrace = Tcl_CreateObjTrace( interp, 50000,
︙
1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977	1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001	+ - +	static CONST char* positions[] = { /* Possible queue positions */ "head", "tail", "mark", NULL }; int posIndex; /* Index of the chosen position */ static CONST Tcl_QueuePosition posNum[] = { static CONST int posNum[] = { /* Interpretation of the chosen position */ /* Interpretation of the chosen position */ TCL_QUEUE_HEAD, TCL_QUEUE_TAIL, TCL_QUEUE_MARK }; TestEvent* ev; /* Event to be queued */ if ( objc < 2 ) {
︙
2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841	2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860	- - - - -	resultPtr->intValue = ((i0 > i1)? i0 : i1); } else if (args[1].type == TCL_DOUBLE) { double d0 = i0; double d1 = args[1].doubleValue; resultPtr->type = TCL_DOUBLE; resultPtr->doubleValue = ((d0 > d1)? d0 : d1); #ifndef TCL_WIDE_INT_IS_LONG } else if (args[1].type == TCL_WIDE_INT) { Tcl_WideInt w0 = Tcl_LongAsWide(i0); Tcl_WideInt w1 = args[1].wideValue; resultPtr->type = TCL_WIDE_INT; resultPtr->wideValue = ((w0 > w1)? w0 : w1); #endif } else { Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); result = TCL_ERROR; } } else if (args[0].type == TCL_DOUBLE) { double d0 = args[0].doubleValue; if (args[1].type == TCL_INT) { double d1 = args[1].intValue; resultPtr->type = TCL_DOUBLE; resultPtr->doubleValue = ((d0 > d1)? d0 : d1); } else if (args[1].type == TCL_DOUBLE) { double d1 = args[1].doubleValue; resultPtr->type = TCL_DOUBLE; resultPtr->doubleValue = ((d0 > d1)? d0 : d1); #ifndef TCL_WIDE_INT_IS_LONG } else if (args[1].type == TCL_WIDE_INT) { double d1 = Tcl_WideAsDouble(args[1].wideValue); resultPtr->type = TCL_DOUBLE; resultPtr->doubleValue = ((d0 > d1)? d0 : d1); #endif } else { Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); result = TCL_ERROR; } #ifndef TCL_WIDE_INT_IS_LONG } else if (args[0].type == TCL_WIDE_INT) { Tcl_WideInt w0 = args[0].wideValue; if (args[1].type == TCL_INT) { Tcl_WideInt w1 = Tcl_LongAsWide(args[1].intValue); resultPtr->type = TCL_WIDE_INT;
︙
2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865	2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883	-	resultPtr->type = TCL_WIDE_INT; resultPtr->wideValue = ((w0 > w1)? w0 : w1); } else { Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); result = TCL_ERROR; } #endif } else { Tcl_SetResult(interp, "T3: wrong type for arg 1", TCL_STATIC); result = TCL_ERROR; } return result; }
︙
3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354	3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386	- + - - + + + + + + + + + + + + + + + +	*/ Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); if (objc > 2 && (cflags&REG_EXPECT) && indices) { char *varName; CONST char *value; int start, end; char info[TCL_INTEGER_SPACE * 2]; char resinfo[TCL_INTEGER_SPACE * 2]; varName = Tcl_GetString(objv[2]); TclRegExpRangeUniChar(regExpr, -1, &start, &end); sprintf(info, "%d %d", start, end-1); value = Tcl_SetVar(interp, varName, info, 0); sprintf(resinfo, "%d %d", start, end-1); value = Tcl_SetVar(interp, varName, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", varName, "\"", (char *) NULL); return TCL_ERROR; } } else if (cflags & TCL_REG_CANMATCH) { char *varName; CONST char *value; char resinfo[TCL_INTEGER_SPACE * 2]; Tcl_RegExpGetInfo(regExpr, &info); varName = Tcl_GetString(objv[2]); sprintf(resinfo, "%ld", info.extendStart); value = Tcl_SetVar(interp, varName, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", varName, "\"", (char *) NULL); return TCL_ERROR; } } return TCL_OK;
︙
3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418	3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451	+ - - + +	} else if (ii > info.nsubs) { newPtr = Tcl_NewObj(); } else { newPtr = Tcl_GetRange(objPtr, info.matches[ii].start, info.matches[ii].end - 1); } } Tcl_IncrRefCount(newPtr); valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, 0); if (valuePtr == NULL) { Tcl_DecrRefCount(newPtr); Tcl_DecrRefCount(newPtr); if (valuePtr == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", Tcl_GetString(varPtr), "\"", (char *) NULL); return TCL_ERROR; } } /*
︙
3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471	3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508	+ + + +	case 'a': { cflags |= REG_ADVF; break; } case 'b': { cflags &= ~REG_ADVANCED; break; } case 'c': { cflags |= TCL_REG_CANMATCH; break; } case 'e': { cflags &= ~REG_ADVANCED; cflags |= REG_EXTENDED; break; } case 'q': {
︙
3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794	3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866	- + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	flags); } }  /* *---------------------------------------------------------------------- * * TestsetobjerrorcodeCmd -- * TestseterrorcodeCmd -- * * This procedure implements the "testsetobjerrorcodeCmd". * This procedure implements the "testseterrorcodeCmd". * This tests up to five elements passed to the * Tcl_SetObjErrorCode command. * Tcl_SetErrorCode command. * * Results: * A standard Tcl result. Always returns TCL_ERROR so that * the error code can be tested. * * Side effects: * None. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static int TestseterrorcodeCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ CONST char **argv; /* Argument strings. */ { if (argc > 6) { Tcl_SetResult(interp, "too many args", TCL_STATIC); return TCL_ERROR; } Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], argv[5], NULL); return TCL_ERROR; }  /* *---------------------------------------------------------------------- * * TestsetobjerrorcodeCmd -- * * This procedure implements the "testsetobjerrorcodeCmd". * This tests the Tcl_SetObjErrorCode function. * * Results: * A standard Tcl result. Always returns TCL_ERROR so that * the error code can be tested. * * Side effects: * None.
︙
3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996	3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -	argString = Tcl_Merge(argc-1, argv+1); panic(argString); ckfree((char *)argString); return TCL_OK; }  /* *--------------------------------------------------------------------------- * * TestchmodCmd -- * * Implements the "testchmod" cmd. Used when testing "file" * command. The only attribute used by the Mac and Windows platforms * is the user write flag; if this is not set, the file is * made read-only. Otehrwise, the file is made read-write. * * Results: * A standard Tcl result. * * Side effects: * Changes permissions of specified files. * *--------------------------------------------------------------------------- */ static int TestchmodCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ CONST char **argv; /* Argument strings. */ { int i, mode; char *rest; if (argc < 2) { usage: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " mode file ?file ...?", (char *) NULL); return TCL_ERROR; } mode = (int) strtol(argv[1], &rest, 8); if ((rest == argv[1]) || (*rest != '\0')) { goto usage; } for (i = 2; i < argc; i++) { Tcl_DString buffer; CONST char *translated; translated = Tcl_TranslateFileName(interp, argv[i], &buffer); if (translated == NULL) { return TCL_ERROR; } if (chmod(translated, (unsigned) mode) != 0) { Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } Tcl_DStringFree(&buffer); } return TCL_OK; } static int TestfileCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ Tcl_Obj *CONST argv[]; /* The argument objects. */ {
︙
4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024	4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037	- +	} if (argc - i > 2) { return TCL_ERROR; } for (j = i; j < argc; j++) { if (Tcl_FSGetTranslatedPath(interp, argv[j]) == NULL) { if (Tcl_FSGetNormalizedPath(interp, argv[j]) == NULL) { return TCL_ERROR; } } subcmd = Tcl_GetString(argv[1]); if (strcmp(subcmd, "mv") == 0) {
︙
4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655	4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679	+ + + + + + + + + + +	Tcl_IncrRefCount(pathPtr); ret = TclpObjStat(pathPtr, &realBuf); Tcl_DecrRefCount(pathPtr); if (ret != -1) { # define OUT_OF_RANGE(x) \ (((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \ ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX)) #if defined(__GNUC__) && __GNUC__ >= 2 /* * Workaround gcc warning of "comparison is always false due to limited range of * data type" in this macro by checking max type size, and when necessary ANDing * with the complement of ULONG_MAX instead of the comparison: */ # define OUT_OF_URANGE(x) \ ((((Tcl_WideUInt)(~ (__typeof__(x)) 0)) > (Tcl_WideUInt)ULONG_MAX) && \ (((Tcl_WideUInt)(x)) & ~(Tcl_WideUInt)ULONG_MAX)) #else # define OUT_OF_URANGE(x) \ (((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX) #endif /* * Perform the result-buffer overflow check manually. * * Note that ino_t/ino64_t is unsigned... */
︙
6087 6088 6089 6090 6091 6092 6093 6094 6095 6096 6097 6098 6099 6100 6101 6102 6103 6104 6105 6106 6107 6108 6109 6110	6111 6112 6113 6114 6115 6116 6117 6118 6119 6120 6121 6122 6123 6124 6125 6126 6127 6128 6129 6130 6131 6132 6133 6134 6135 6136 6137 6138 6139	- + + + + + - - - - + + + + +	return TclpOpenFileChannel(interp, TestReportGetNativePath(fileName), mode, permissions); } static int TestReportMatchInDirectory(interp, resultPtr, dirPtr, pattern, types) Tcl_Interp *interp; /* Interpreter to receive results. */ Tcl_Obj *resultPtr; /* Directory separators to pass to TclDoGlob. */ Tcl_Obj *resultPtr; /* Object to lappend results. */ Tcl_Obj *dirPtr; /* Contains path to directory to search. */ CONST char *pattern; /* Pattern to match against. */ Tcl_GlobTypeData *types; /* Object containing list of acceptable types. * May be NULL. */ { if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) { TestReport("matchmounts",dirPtr, NULL); return TCL_OK; } else { TestReport("matchindirectory",dirPtr, NULL); return Tcl_FSMatchInDirectory(interp, resultPtr, TestReportGetNativePath(dirPtr), pattern, types); TestReport("matchindirectory",dirPtr, NULL); return Tcl_FSMatchInDirectory(interp, resultPtr, TestReportGetNativePath(dirPtr), pattern, types); } } static int TestReportChdir(dirName) Tcl_Obj *dirName; { TestReport("chdir",dirName,NULL); return Tcl_FSChdir(TestReportGetNativePath(dirName));
︙
6425 6426 6427 6428 6429 6430 6431 6432	6454 6455 6456 6457 6458 6459 6460 6461 6462 6463 6464 6465 6466 6467 6468 6469 6470 6471 6472 6473 6474 6475 6476 6477 6478 6479 6480 6481	- + + + + + + + + + + + + + + + + + + + + +	/* Add one new volume */ Tcl_Obj *retVal; retVal = Tcl_NewStringObj("simplefs:/",-1); Tcl_IncrRefCount(retVal); return retVal; }  /* * Used to check correct string-length determining in Tcl_NumUtfChars */ static int TestNumUtfCharsCmd(clientData, interp, objc, objv) ClientData clientData; Tcl_Interp *interp; int objc; Tcl_Obj *CONST objv[]; { if (objc > 1) { int len = -1; if (objc > 2) { (void) Tcl_GetStringFromObj(objv[1], &len); } len = Tcl_NumUtfChars(Tcl_GetString(objv[1]), len); Tcl_SetObjResult(interp, Tcl_NewIntObj(len)); } return TCL_OK; }

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	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	- + - - - + + +	/* * tclThread.c -- * * This file implements Platform independent thread operations. * Most of the real work is done in the platform dependent files. * * Copyright (c) 1998 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclThread.c,v 1.6 2002/12/10 00:34:15 hobbs Exp $ * RCS: @(#) $Id: tclThread.c,v 1.6.2.1 2004/05/06 01:02:59 davygrvy Exp $ */ #include "tclInt.h" /* * There are three classes of synchronization objects: * mutexes, thread data keys, and condition variables. * The following are used to record the memory used for these * objects so they can be finalized. * * These statics are guarded by the mutex in the caller of * TclRememberThreadData, e.g., TclpThreadDataKeyInit */ typedef struct { int num; /* Number of objects remembered */ int max; /* Max size of the array */ char **list; /* List of pointers */ } SyncObjRecord; static SyncObjRecord keyRecord; static SyncObjRecord mutexRecord; static SyncObjRecord condRecord; static SyncObjRecord keyRecord = {0, 0, NULL}; static SyncObjRecord mutexRecord = {0, 0, NULL}; static SyncObjRecord condRecord = {0, 0, NULL}; /* * Prototypes of functions used only in this file */ static void RememberSyncObject _ANSI_ARGS_((char *objPtr, SyncObjRecord *recPtr));
︙

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	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	- - + + - + +	/* * tclThreadAlloc.c -- * * This is a very fast storage allocator for used with threads (designed * avoid lock contention). The basic strategy is to allocate memory in * fixed size blocks from block caches. * * The Initial Developer of the Original Code is America Online, Inc. * Portions created by AOL are Copyright (C) 1999 America Online, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclThreadAlloc.c,v 1.4 2002/08/26 13:05:56 msofer Exp $ */ * RCS: @(#) $Id: tclThreadAlloc.c,v 1.4.2.7 2005/12/20 22:16:34 dkf Exp $ */ #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) #include "tclInt.h" #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG) #ifdef WIN32 #include "tclWinInt.h" #else extern Tcl_Mutex *TclpNewAllocMutex(void); extern void *TclpGetAllocCache(void); extern void TclpSetAllocCache(void *);
︙
85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104	86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105	- - - - - - + + + + + +	/* * The following structure defines a bucket of blocks with * various accounting and statistics information. */ typedef struct Bucket { Block *firstPtr; int nfree; int nget; int nput; int nwait; int nlock; int nrequest; long nfree; long nget; long nput; long nwait; long nlock; long nrequest; } Bucket; /* * The following structure defines a cache of buckets and objs. */ typedef struct Cache {
︙
272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290	273 274 275 276 277 278 279 280 281 282 283 284 285 286 287	- - - -	nextPtrPtr = &firstCachePtr; while (*nextPtrPtr != cachePtr) { nextPtrPtr = &(*nextPtrPtr)->nextPtr; } *nextPtrPtr = cachePtr->nextPtr; cachePtr->nextPtr = NULL; Tcl_MutexUnlock(listLockPtr); #ifdef WIN32 TlsFree((DWORD) cachePtr); #else free(cachePtr); #endif }  /* *---------------------------------------------------------------------- * * TclpAlloc --
︙
636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651	633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648	- - + +	if (cachePtr == sharedPtr) { Tcl_DStringAppendElement(dsPtr, "shared"); } else { sprintf(buf, "thread%d", (int) cachePtr->owner); Tcl_DStringAppendElement(dsPtr, buf); } for (n = 0; n < NBUCKETS; ++n) { sprintf(buf, "%d %d %d %d %d %d %d", (int) binfo[n].blocksize, sprintf(buf, "%lu %ld %ld %ld %ld %ld %ld", (unsigned long) binfo[n].blocksize, cachePtr->buckets[n].nfree, cachePtr->buckets[n].nget, cachePtr->buckets[n].nput, cachePtr->buckets[n].nrequest, cachePtr->buckets[n].nlock, cachePtr->buckets[n].nwait); Tcl_DStringAppendElement(dsPtr, buf);
︙
947 948 949 950 951 952 953 954 955	944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	((char *) blockPtr + binfo[bucket].blocksize); blockPtr = blockPtr->b_next; } blockPtr->b_next = NULL; } return 1; } /* *---------------------------------------------------------------------- * * TclFinalizeThreadAlloc -- * * This procedure is used to destroy all private resources used in * this file. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclFinalizeThreadAlloc() { int i; for (i = 0; i < NBUCKETS; ++i) { TclpFreeAllocMutex(binfo[i].lockPtr); binfo[i].lockPtr = NULL; } TclpFreeAllocMutex(objLockPtr); objLockPtr = NULL; TclpFreeAllocMutex(listLockPtr); listLockPtr = NULL; TclpFreeAllocCache(NULL); }  #else /* ! defined(TCL_THREADS) && ! defined(USE_THREAD_ALLOC) */ /* *---------------------------------------------------------------------- * * TclFinalizeThreadAlloc -- * * This procedure is used to destroy all private resources used in * this file. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclFinalizeThreadAlloc() { Tcl_Panic("TclFinalizeThreadAlloc called when threaded memory allocator not in use."); } #endif /* TCL_THREADS */

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	/* * tclThreadTest.c -- * * This file implements the testthread command. Eventually this * should be tclThreadCmd.c * Some of this code is based on work done by Richard Hipp on behalf of * Conservation Through Innovation, Limited, with their permission. * * Copyright (c) 1998 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclThreadTest.c,v 1.16 2002/01/26 01:10:08 dgp Exp $ * RCS: @(#) $Id: tclThreadTest.c,v 1.16.2.2 2006/09/22 14:48:52 dkf Exp $ */ #include "tclInt.h" #ifdef TCL_THREADS /* * Each thread has an single instance of the following structure. There
︙
417 418 419 420 421 422 423 424 425 426 427 428 429 430 431	417 418 419 420 421 422 423 424 425 426 427 428 429 430 431	- +	joinable = joinable ? TCL_THREAD_JOINABLE : TCL_THREAD_NOFLAGS; Tcl_MutexLock(&threadMutex); if (Tcl_CreateThread(&id, NewTestThread, (ClientData) &ctrl, TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) { Tcl_MutexUnlock(&threadMutex); Tcl_AppendResult(interp,"can't create a new thread",0); Tcl_AppendResult(interp,"can't create a new thread",NULL); ckfree((void*)ctrl.script); return TCL_ERROR; } /* * Wait for the thread to start because it is using something on our stack! */
︙
864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884	864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884	- +	Tcl_Preserve((ClientData) interp); Tcl_ResetResult(interp); Tcl_CreateThreadExitHandler(ThreadFreeProc, (ClientData) threadEventPtr->script); code = Tcl_GlobalEval(interp, threadEventPtr->script); Tcl_DeleteThreadExitHandler(ThreadFreeProc, (ClientData) threadEventPtr->script); result = Tcl_GetStringResult(interp); if (code != TCL_OK) { errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY); errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); } else { errorCode = errorInfo = NULL; } result = Tcl_GetStringResult(interp); } ckfree(threadEventPtr->script); if (resultPtr) { Tcl_MutexLock(&threadMutex); resultPtr->code = code; resultPtr->result = ckalloc(strlen(result) + 1); strcpy(resultPtr->result, result);
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	/* * tclTimer.c -- * * This file provides timer event management facilities for Tcl, * including the "after" command. * * Copyright (c) 1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclTimer.c,v 1.6 2002/03/01 06:22:31 hobbs Exp $ * RCS: @(#) $Id: tclTimer.c,v 1.6.2.4 2005/11/09 21:46:20 kennykb Exp $ */ #include "tclInt.h" #include "tclPort.h" /* * For each timer callback that's pending there is one record of the following
︙
299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315	299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318	- + + + + - +	void Tcl_DeleteTimerHandler(token) Tcl_TimerToken token; /* Result previously returned by * Tcl_DeleteTimerHandler. */ { register TimerHandler *timerHandlerPtr, *prevPtr; ThreadSpecificData *tsdPtr; ThreadSpecificData *tsdPtr = InitTimer(); if (token == NULL) { return; } tsdPtr = InitTimer(); for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; timerHandlerPtr != NULL; prevPtr = timerHandlerPtr, timerHandlerPtr = timerHandlerPtr->nextPtr) { if (timerHandlerPtr->token != token) { continue; } if (prevPtr == NULL) {
︙
728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800	731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792	- + - - - + - - + - - + - - - - - - - - + - +	* *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_AfterObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Points to the "tclAfter" assocData for ClientData clientData; /* Unused */ * this interpreter, or NULL if the assocData * hasn't been created yet.*/ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { int ms; AfterInfo *afterPtr; AfterAssocData *assocPtr = (AfterAssocData *) clientData; AfterAssocData *assocPtr; Tcl_CmdInfo cmdInfo; int length; char *argString; int index; char buf[16 + TCL_INTEGER_SPACE]; static CONST char *afterSubCmds[] = { "cancel", "idle", "info", (char *) NULL }; enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO}; ThreadSpecificData *tsdPtr = InitTimer(); if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; } /* * Create the "after" information associated for this interpreter, * if it doesn't already exist. Associate it with the command too, * if it doesn't already exist. * so that it will be passed in as the ClientData argument in the * future. */ assocPtr = Tcl_GetAssocData( interp, "tclAfter", NULL ); if (assocPtr == NULL) { assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData)); assocPtr->interp = interp; assocPtr->firstAfterPtr = NULL; Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, (ClientData) assocPtr); cmdInfo.proc = NULL; cmdInfo.clientData = (ClientData) NULL; cmdInfo.objProc = Tcl_AfterObjCmd; cmdInfo.objClientData = (ClientData) assocPtr; cmdInfo.deleteProc = NULL; cmdInfo.deleteData = (ClientData) assocPtr; Tcl_SetCommandInfo(interp, Tcl_GetStringFromObj(objv[0], &length), &cmdInfo); } /* * First lets see if the command was passed a number as the first argument. */ if (objv[1]->typePtr == &tclIntType) { ms = (int) objv[1]->internalRep.longValue; goto processInteger; } argString = Tcl_GetStringFromObj(objv[1], &length); if (argString[0] == '+' || argString[0] == '-' if (isdigit(UCHAR(argString[0]))) { /* INTL: digit */ || isdigit(UCHAR(argString[0]))) { /* INTL: digit */ if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) { return TCL_ERROR; } processInteger: if (ms < 0) { ms = 0; }
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	- +	/* * tclUtf.c -- * * Routines for manipulating UTF-8 strings. * * Copyright (c) 1997-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclUtf.c,v 1.30 2003/02/18 02:25:45 hobbs Exp $ * RCS: @(#) $Id: tclUtf.c,v 1.30.2.3 2005/09/07 14:35:56 dgp Exp $ */ #include "tclInt.h" /* * Include the static character classification tables and macros. */
︙
165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217	165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219	+ - - - - - - + + + + + + - - - - - + + + + + - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + +	* be large enough to hold the UTF-8 character * (at most TCL_UTF_MAX bytes). */ { if ((ch > 0) && (ch < UNICODE_SELF)) { str[0] = (char) ch; return 1; } if (ch >= 0) { if (ch <= 0x7FF) { str[1] = (char) ((ch | 0x80) & 0xBF); str[0] = (char) ((ch >> 6) | 0xC0); return 2; } if (ch <= 0xFFFF) { if (ch <= 0x7FF) { str[1] = (char) ((ch | 0x80) & 0xBF); str[0] = (char) ((ch >> 6) | 0xC0); return 2; } if (ch <= 0xFFFF) { three: str[2] = (char) ((ch | 0x80) & 0xBF); str[1] = (char) (((ch >> 6) | 0x80) & 0xBF); str[0] = (char) ((ch >> 12) | 0xE0); return 3; } str[2] = (char) ((ch | 0x80) & 0xBF); str[1] = (char) (((ch >> 6) | 0x80) & 0xBF); str[0] = (char) ((ch >> 12) | 0xE0); return 3; } #if TCL_UTF_MAX > 3 if (ch <= 0x1FFFFF) { str[3] = (char) ((ch | 0x80) & 0xBF); str[2] = (char) (((ch >> 6) | 0x80) & 0xBF); str[1] = (char) (((ch >> 12) | 0x80) & 0xBF); str[0] = (char) ((ch >> 18) | 0xF0); return 4; } if (ch <= 0x3FFFFFF) { str[4] = (char) ((ch | 0x80) & 0xBF); str[3] = (char) (((ch >> 6) | 0x80) & 0xBF); str[2] = (char) (((ch >> 12) | 0x80) & 0xBF); str[1] = (char) (((ch >> 18) | 0x80) & 0xBF); str[0] = (char) ((ch >> 24) | 0xF8); return 5; } if (ch <= 0x7FFFFFFF) { str[5] = (char) ((ch | 0x80) & 0xBF); str[4] = (char) (((ch >> 6) | 0x80) & 0xBF); str[3] = (char) (((ch >> 12) | 0x80) & 0xBF); str[2] = (char) (((ch >> 18) | 0x80) & 0xBF); str[1] = (char) (((ch >> 24) | 0x80) & 0xBF); str[0] = (char) ((ch >> 30) | 0xFC); return 6; } if (ch <= 0x1FFFFF) { str[3] = (char) ((ch | 0x80) & 0xBF); str[2] = (char) (((ch >> 6) | 0x80) & 0xBF); str[1] = (char) (((ch >> 12) | 0x80) & 0xBF); str[0] = (char) ((ch >> 18) | 0xF0); return 4; } if (ch <= 0x3FFFFFF) { str[4] = (char) ((ch | 0x80) & 0xBF); str[3] = (char) (((ch >> 6) | 0x80) & 0xBF); str[2] = (char) (((ch >> 12) | 0x80) & 0xBF); str[1] = (char) (((ch >> 18) | 0x80) & 0xBF); str[0] = (char) ((ch >> 24) | 0xF8); return 5; } if (ch <= 0x7FFFFFFF) { str[5] = (char) ((ch | 0x80) & 0xBF); str[4] = (char) (((ch >> 6) | 0x80) & 0xBF); str[3] = (char) (((ch >> 12) | 0x80) & 0xBF); str[2] = (char) (((ch >> 18) | 0x80) & 0xBF); str[1] = (char) (((ch >> 24) | 0x80) & 0xBF); str[0] = (char) ((ch >> 30) | 0xFC); return 6; } #endif } ch = 0xFFFD; goto three; }  /* *---------------------------------------------------------------------------
︙
497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515	499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514	- + - - -	* * Since this is a time-sensitive function, we also do the check for * the single-byte char case specially. */ i = 0; if (len < 0) { while (1) { while (*str != '\0') { str += TclUtfToUniChar(str, chPtr); if (ch == '\0') { break; } i++; } } else { register int n; while (len > 0) { if (UCHAR(*str) < 0xC0) {
︙
1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306	1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308	- - - + + + + + +	int Tcl_UniCharNcasecmp(cs, ct, n) CONST Tcl_UniChar *cs; /* Unicode string to compare to ct. */ CONST Tcl_UniChar *ct; /* Unicode string cs is compared to. */ unsigned long n; /* Number of unichars to compare. */ { for ( ; n != 0; n--, cs++, ct++) { if ((*cs != *ct) && (Tcl_UniCharToLower(*cs) != Tcl_UniCharToLower(*ct))) { return (*cs - *ct); if (*cs != *ct) { Tcl_UniChar lcs = Tcl_UniCharToLower(*cs); Tcl_UniChar lct = Tcl_UniCharToLower(*ct); if (lcs != lct) { return (lcs - lct); } } } return 0; }  /* *----------------------------------------------------------------------
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	/* * tclUtil.c -- * * This file contains utility procedures that are used by many Tcl * commands. * * Copyright (c) 1987-1993 The Regents of the University of California. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclUtil.c,v 1.36 2002/11/19 02:34:50 hobbs Exp $ * RCS: @(#) $Id: tclUtil.c,v 1.36.2.8 2007/05/10 18:23:58 dgp Exp $ */ #include "tclInt.h" #include "tclPort.h" /* * The following variable holds the full path name of the binary
︙
432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454	432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465	- + + + + + + - - + + + + + - + + + + + - + -	/* * Figure out how much space to allocate. There must be enough * space for both the array of pointers and also for a copy of * the list. To estimate the number of pointers needed, count * the number of space characters in the list. */ for (size = 1, l = list; *l != 0; l++) { for (size = 2, l = list; *l != 0; l++) { if (isspace(UCHAR(*l))) { /* INTL: ISO space. */ size++; /* Consecutive space can only count as a single list delimiter */ while (1) { char next = *(l + 1); if (next == '\0') { break; } } } ++l; if (isspace(UCHAR(next))) { continue; } size++; /* Leave space for final NULL pointer. */ break; } } } length = l - list; argv = (CONST char **) ckalloc((unsigned) ((size * sizeof(char *)) + (l - list) + 1)); ((size * sizeof(char *)) + length + 1)); length = strlen(list); for (i = 0, p = ((char *) argv) + size*sizeof(char *); *list != 0; i++) { CONST char *prevList = list; result = TclFindElement(interp, list, length, &element, &list, &elSize, &brace); length -= (list - prevList);
︙
1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404	1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 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	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	} } }  /* *---------------------------------------------------------------------- * * TclMatchIsTrivial -- * * Test whether a particular glob pattern is a trivial pattern. * (i.e. where matching is the same as equality testing). * * Results: * A boolean indicating whether the pattern is free of all of the * glob special chars. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclMatchIsTrivial(pattern) CONST char *pattern; { CONST char *p = pattern; while (1) { switch (*p++) { case '\0': return 1; case '*': case '?': case '[': case '\\': return 0; } } }  /* *---------------------------------------------------------------------- * * Tcl_DStringInit -- * * Initializes a dynamic string, discarding any previous contents * of the string (Tcl_DStringFree should have been called already * if the dynamic string was previously in use). * * Results:
︙
1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755	1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802	- + -	if (*(iPtr->result) == 0) { Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), TCL_VOLATILE); } dsPtr->length = strlen(iPtr->result); if (iPtr->freeProc != NULL) { if ((iPtr->freeProc == TCL_DYNAMIC) if (iPtr->freeProc == TCL_DYNAMIC) { || (iPtr->freeProc == (Tcl_FreeProc *) free)) { dsPtr->string = iPtr->result; dsPtr->spaceAvl = dsPtr->length+1; } else { dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length+1)); strcpy(dsPtr->string, iPtr->result); (*iPtr->freeProc)(iPtr->result); }
︙
1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933	1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980	- +	int prec; /* * If the variable is unset, then recreate the trace. */ if (flags & TCL_TRACE_UNSETS) { if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { if ((flags & TCL_TRACE_DESTROYED) && !Tcl_InterpDeleted(interp)) { Tcl_TraceVar2(interp, name1, name2, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES |TCL_TRACE_UNSETS, TclPrecTraceProc, clientData); } return (char *) NULL; }
︙
1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 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	2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116	- - + + + + - - - - + + + + + + - + + + + + + + + + + + + + + + - - - - + + + + + + + + - - + - + - - + + + + + - - - + - - - - + + + + + + + + + - - - - -	int TclNeedSpace(start, end) CONST char *start; /* First character in string. */ CONST char *end; /* End of string (place where space will * be added, if appropriate). */ { Tcl_UniChar ch; /* * A space is needed unless either * (a) we're at the start of the string, or */ if (end == start) { return 0; } * (b) the trailing characters of the string consist of one or more * open curly braces preceded by a space or extending back to * the beginning of the string. * (c) the trailing characters of the string consist of a space /* * (b) we're at the start of a nested list-element, quoted with an * open curly brace; we can be nested arbitrarily deep, so long * as the first curly brace starts an element, so backtrack over * open curly braces that are trailing characters of the string; and * preceded by a character other than backslash. */ end = Tcl_UtfPrev(end, start); while (*end == '{') { if (end == start) { return 0; } end = Tcl_UtfPrev(end, start); } /* * (c) the trailing character of the string is already a list-element * separator (according to TclFindElement); that is, one of these * characters: * \u0009 \t TAB * \u000A \n NEWLINE if (end == start) { return 0; } * \u000B \v VERTICAL TAB * \u000C \f FORM FEED * \u000D \r CARRIAGE RETURN * \u0020 SPACE * with the condition that the penultimate character is not a * backslash. */ end = Tcl_UtfPrev(end, start); if (*end != '{') { if (*end > 0x20) { Tcl_UtfToUniChar(end, &ch); /* * Performance tweak. All ASCII spaces are <= 0x20. So get * Direct char comparison on next line is safe as it is with * a character in the ASCII subset, and so single-byte in UTF8. * a quick answer for most characters before comparing against * all spaces in the switch below. * * NOTE: Remove this if other Unicode spaces ever get accepted * as list-element separators. */ if (Tcl_UniCharIsSpace(ch) && ((end == start) || (end[-1] != '\\'))) { return 0; } return 1; } switch (*end) { do { if (end == start) { return 0; } case ' ': case '\t': case '\n': case '\r': case '\v': case '\f': if ((end == start) || (end[-1] != '\\')) { return 0; } end = Tcl_UtfPrev(end, start); } while (*end == '{'); Tcl_UtfToUniChar(end, &ch); if (Tcl_UniCharIsSpace(ch)) { return 0; } return 1; }  /* *---------------------------------------------------------------------- *
︙
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 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300	2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315	- - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +	Tcl_Obj *objPtr; /* Points to an object containing either * "end" or an integer. */ int endValue; /* The value to be stored at "indexPtr" if * "objPtr" holds "end". */ int *indexPtr; /* Location filled in with an integer * representing an index. */ { char *bytes; int offset; #ifndef TCL_WIDE_INT_IS_LONG Tcl_WideInt wideOffset; #endif if (Tcl_GetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) { /* * If the object is already an integer, use it. */ if (objPtr->typePtr == &tclIntType) { *indexPtr = (int)objPtr->internalRep.longValue; return TCL_OK; } /* * If the object is already a wide-int, and it is not out of range * for an integer, use it. [Bug #526717] */ #ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { Tcl_WideInt wideOffset = objPtr->internalRep.wideValue; if (wideOffset >= Tcl_LongAsWide(INT_MIN) && wideOffset <= Tcl_LongAsWide(INT_MAX)) { *indexPtr = (int) Tcl_WideAsLong(wideOffset); return TCL_OK; } } #endif /* TCL_WIDE_INT_IS_LONG */ if (SetEndOffsetFromAny(NULL, objPtr) == TCL_OK) { /* * If the object is already an offset from the end of the * list, or can be converted to one, use it. */ *indexPtr = endValue + objPtr->internalRep.longValue; #ifdef TCL_WIDE_INT_IS_LONG } else if (Tcl_GetIntFromObj(NULL, objPtr, &offset) == TCL_OK) { /* * If the object can be converted to an integer, use that. */ *indexPtr = offset; #else /* !TCL_WIDE_INT_IS_LONG */ } else if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideOffset) == TCL_OK) { /* * If the object can be converted to a wide integer, use * that. [Bug #526717] */ offset = (int) Tcl_WideAsLong(wideOffset); if (Tcl_LongAsWide(offset) == wideOffset) { /* * But it is representable as a narrow integer, so we * prefer that (so preserving old behaviour in the * majority of cases.) */ objPtr->typePtr = &tclIntType; objPtr->internalRep.longValue = offset; } *indexPtr = offset; #endif /* TCL_WIDE_INT_IS_LONG */ } else { /* * Report a parse error. */ if (interp != NULL) { bytes = Tcl_GetString(objPtr); char *bytes = Tcl_GetString(objPtr); /* * The result might not be empty; this resets it which * should be both a cheap operation, and of little problem * because this is an error-generation path anyway. */ Tcl_ResetResult(interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
︙

︙
11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29	11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30	- + +	* Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclVar.c,v 1.69 2002/11/12 02:23:03 hobbs Exp $ * RCS: @(#) $Id: tclVar.c,v 1.69.2.14 2007/05/10 18:23:58 dgp Exp $ */ #include "tclInt.h" #include "tclPort.h" /* * The strings below are used to indicate what went wrong when a * variable access is denied. */ static CONST char *noSuchVar = "no such variable";
︙
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	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	- + - + + +	static void DeleteArray _ANSI_ARGS_((Interp *iPtr, CONST char *arrayName, Var *varPtr, int flags)); static void DisposeTraceResult _ANSI_ARGS_((int flags, char *result)); static int ObjMakeUpvar _ANSI_ARGS_((Tcl_Interp *interp, CallFrame *framePtr, Tcl_Obj *otherP1Ptr, CONST char *otherP2, CONST int otherFlags, CONST char *myName, CONST int myFlags, int index)); CONST char *myName, int myFlags, int index)); static Var * NewVar _ANSI_ARGS_((void)); static ArraySearch * ParseSearchId _ANSI_ARGS_((Tcl_Interp *interp, CONST Var *varPtr, CONST char *varName, Tcl_Obj *handleObj)); static void VarErrMsg _ANSI_ARGS_((Tcl_Interp *interp, CONST char *part1, CONST char *part2, CONST char *operation, CONST char *reason)); static int SetArraySearchObj _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static void UnsetVarStruct _ANSI_ARGS_((Var *varPtr, Var *arrayPtr, Interp *iPtr, CONST char *part1, CONST char *part2, int flags)); /* * Functions defined in this file that may be exported in the future * for use by the bytecode compiler and engine or to the public interface. */ Var * TclLookupSimpleVar _ANSI_ARGS_((Tcl_Interp *interp,
︙
104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128	107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131	- + - + - +	* twoPtrValue.ptr1 = pointer to the array name Tcl_Obj, * or NULL if it is a scalar variable * twoPtrValue.ptr2 = pointer to the element name string * (owned by this Tcl_Obj), or NULL if * it is a scalar variable */ Tcl_ObjType tclLocalVarNameType = { static Tcl_ObjType tclLocalVarNameType = { "localVarName", FreeLocalVarName, DupLocalVarName, UpdateLocalVarName, NULL }; Tcl_ObjType tclNsVarNameType = { static Tcl_ObjType tclNsVarNameType = { "namespaceVarName", FreeNsVarName, DupNsVarName, NULL, NULL }; Tcl_ObjType tclParsedVarNameType = { static Tcl_ObjType tclParsedVarNameType = { "parsedVarName", FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, NULL }; /* * Type of Tcl_Objs used to speed up array searches. *
︙
546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567	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 577 578 579 580 581 582	+ + + + + + + + + + + +	Proc *procPtr = ((Interp *) interp)->varFramePtr->procPtr; part1Ptr->typePtr = &tclLocalVarNameType; procPtr->refCount++; part1Ptr->internalRep.twoPtrValue.ptr1 = (VOID *) procPtr; part1Ptr->internalRep.twoPtrValue.ptr2 = (VOID *) index; #if 0 /* * TEMPORARYLY DISABLED tclNsVarNameType * * This optimisation will hopefully be turned back on soon. * Miguel Sofer, 2004-05-22 */ } else if (index > -3) { /* * A cacheable namespace or global variable. */ Namespace *nsPtr; nsPtr = ((index == -1)? iPtr->globalNsPtr : varFramePtr->nsPtr); varPtr->refCount++; part1Ptr->typePtr = &tclNsVarNameType; part1Ptr->internalRep.twoPtrValue.ptr1 = (VOID *) nsPtr; part1Ptr->internalRep.twoPtrValue.ptr2 = (VOID *) varPtr; #endif } else { /* * At least mark part1Ptr as already parsed. */ part1Ptr->typePtr = &tclParsedVarNameType; part1Ptr->internalRep.twoPtrValue.ptr1 = NULL; part1Ptr->internalRep.twoPtrValue.ptr2 = NULL;
︙
591 592 593 594 595 596 597 598 599 600 601 602 603 604	606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629	+ + + + + + + + + +	*arrayPtrPtr = varPtr; varPtr = TclLookupArrayElement(interp, part1, part2, flags, msg, createPart1, createPart2, varPtr); } return varPtr; }  /* * This flag bit should not interfere with TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * or TCL_LEAVE_ERR_MSG; it signals that the variable lookup is performed for * upvar (or similar) purposes, with slightly different rules: * - Bug #696893 - variable is either proc-local or in the current * namespace; never follow the second (global) resolution path * - Bug #631741 - do not use special namespace or interp resolvers */ #define LOOKUP_FOR_UPVAR 0x40000 /* *---------------------------------------------------------------------- * * TclLookupSimpleVar -- * * This procedure is used by to locate a simple variable (i.e., not * an array element) given its name.
︙
638 639 640 641 642 643 644 645 646 647 648 649 650 651 652	663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678	- + +	Var * TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr) Tcl_Interp *interp; /* Interpreter to use for lookup. */ CONST char *varName; /* This is a simple variable name that could * representa scalar or an array. */ int flags; /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * and TCL_LEAVE_ERR_MSG bits matter. */ * LOOKUP_FOR_UPVAR and TCL_LEAVE_ERR_MSG bits * matter. */ CONST int create; /* If 1, create hash table entry for varname, * if it doesn't already exist. If 0, return * error if it doesn't exist. */ CONST char **errMsgPtr; int *indexPtr; { Interp *iPtr = (Interp *) interp;
︙
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 691	690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719	+ + + + + + - - - - - + - - + +	ResolverScheme *resPtr; Tcl_HashEntry *hPtr; int new, i, result; varPtr = NULL; varNsPtr = NULL; /* set non-NULL if a nonlocal variable */ *indexPtr = -3; if ((flags & TCL_GLOBAL_ONLY) || iPtr->varFramePtr == NULL) { cxtNsPtr = iPtr->globalNsPtr; } else { cxtNsPtr = iPtr->varFramePtr->nsPtr; } /* * If this namespace has a variable resolver, then give it first * crack at the variable resolution. It may return a Tcl_Var * value, it may signal to continue onward, or it may signal * an error. */ if ((flags & TCL_GLOBAL_ONLY) || iPtr->varFramePtr == NULL) { cxtNsPtr = iPtr->globalNsPtr; } else { cxtNsPtr = iPtr->varFramePtr->nsPtr; } if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) { if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) && !(flags & LOOKUP_FOR_UPVAR)) { resPtr = iPtr->resolverPtr; if (cxtNsPtr->varResProc) { result = (*cxtNsPtr->varResProc)(interp, varName, (Tcl_Namespace *) cxtNsPtr, flags, &var); } else { result = TCL_CONTINUE;
︙
732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749	760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782	- - - - + + + + + + + + +	int lookGlobal; lookGlobal = (flags & TCL_GLOBAL_ONLY) || (cxtNsPtr == iPtr->globalNsPtr) || ((*varName == ':') && (*(varName+1) == ':')); if (lookGlobal) { *indexPtr = -1; flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY; } else if (flags & TCL_NAMESPACE_ONLY) { *indexPtr = -2; } flags = (flags | TCL_GLOBAL_ONLY) & ~(TCL_NAMESPACE_ONLY|LOOKUP_FOR_UPVAR); } else { if (flags & LOOKUP_FOR_UPVAR) { flags = (flags | TCL_NAMESPACE_ONLY) & ~LOOKUP_FOR_UPVAR; } if (flags & TCL_NAMESPACE_ONLY) { *indexPtr = -2; } } /* * Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable, * or otherwise generate our own error! */ var = Tcl_FindNamespaceVar(interp, varName, (Tcl_Namespace *) cxtNsPtr, flags & ~TCL_LEAVE_ERR_MSG);
︙
1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084	1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113	- - + + - - - - - +	CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, * and TCL_LEAVE_ERR_MSG bits. */ { Var *varPtr, *arrayPtr; /* * We need a special flag check to see if we want to create part 1, /* Filter to pass through only the flags this interface supports. */ flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG); * because commands like lappend require read traces to trigger for * previously non-existent values. */ varPtr = TclLookupVar(interp, part1, part2, flags, "read", /*createPart1*/ (flags & TCL_TRACE_READS), /*createPart2*/ 1, &arrayPtr); /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return NULL; } return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags); }
︙
1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141	1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166	- - + + - - - - - +	{ Var *varPtr, *arrayPtr; char *part1, *part2; part1 = Tcl_GetString(part1Ptr); part2 = ((part2Ptr == NULL) ? NULL : Tcl_GetString(part2Ptr)); /* * We need a special flag check to see if we want to create part 1, /* Filter to pass through only the flags this interface supports. */ flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG); * because commands like lappend require read traces to trigger for * previously non-existent values. */ varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read", /*createPart1*/ (flags & TCL_TRACE_READS), /*createPart2*/ 1, &arrayPtr); /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return NULL; } return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags); }
︙
1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436	1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464	+ + +	int flags; /* Various flags that tell how to set value: * any of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE, * TCL_LIST_ELEMENT or TCL_LEAVE_ERR_MSG. */ { Var *varPtr, *arrayPtr; /* Filter to pass through only the flags this interface supports. */ flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG |TCL_APPEND_VALUE|TCL_LIST_ELEMENT); varPtr = TclLookupVar(interp, part1, part2, flags, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return NULL; } return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
︙
1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492	1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523	+ + +	{ Var *varPtr, *arrayPtr; char *part1, *part2; part1 = TclGetString(part1Ptr); part2 = ((part2Ptr == NULL) ? NULL : Tcl_GetString(part2Ptr)); /* Filter to pass through only the flags this interface supports. */ flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG |TCL_APPEND_VALUE|TCL_LIST_ELEMENT); varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return NULL; } return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
︙
1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541	1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572	- +	register Var *varPtr; Var *arrayPtr; CONST char *part1; /* Name of an array (if part2 is non-NULL) * or the name of a variable. */ CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ Tcl_Obj *newValuePtr; /* New value for variable. */ CONST int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, CONST int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, * and TCL_LEAVE_ERR_MSG bits. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *oldValuePtr; Tcl_Obj *resultPtr = NULL; int result;
︙
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	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	- + + + + + - +	VarErrMsg(interp, part1, part2, "set", isArray); } return NULL; } /* * Invoke any read traces that have been set for the variable if it * is requested; this is only done in the core when lappending. * is requested; this is only done in the core by the INST_LAPPEND_* * instructions. */ if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) { if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) { return NULL; } } /* * Set the variable's new value. If appending, append the new value to * the variable, either as a list element or as a string. Also, if * appending, then if the variable's old value is unshared we can modify * it directly, otherwise we must create a new copy to modify: this is * "copy on write". */ if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) { TclSetVarUndefined(varPtr); } oldValuePtr = varPtr->value.objPtr; if (flags & TCL_APPEND_VALUE) { if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) { if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) { Tcl_DecrRefCount(oldValuePtr); /* discard old value */ varPtr->value.objPtr = NULL; oldValuePtr = NULL; } if (flags & TCL_LIST_ELEMENT) { /* append list element */ if (oldValuePtr == NULL) {
︙
1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840	1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867	- - - - - - - - - - + +	*/ createdNewObj = 0; if (Tcl_IsShared(varValuePtr)) { varValuePtr = Tcl_DuplicateObj(varValuePtr); createdNewObj = 1; } #ifdef TCL_WIDE_INT_IS_LONG if (Tcl_GetLongFromObj(interp, varValuePtr, &i) != TCL_OK) { if (createdNewObj) { Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */ } return NULL; } Tcl_SetLongObj(varValuePtr, (i + incrAmount)); #else if (varValuePtr->typePtr == &tclWideIntType) { Tcl_WideInt wide = varValuePtr->internalRep.wideValue; Tcl_WideInt wide; TclGetWide(wide,varValuePtr); Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount)); } else if (varValuePtr->typePtr == &tclIntType) { i = varValuePtr->internalRep.longValue; Tcl_SetIntObj(varValuePtr, i + incrAmount); } else { /* * Not an integer or wide internal-rep...
︙
1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863	1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889	-	if (wide <= Tcl_LongAsWide(LONG_MAX) && wide >= Tcl_LongAsWide(LONG_MIN)) { Tcl_SetLongObj(varValuePtr, Tcl_WideAsLong(wide) + incrAmount); } else { Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount)); } } #endif /* * Store the variable's new value and run any write traces. */ return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, varValuePtr, flags);
︙
1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942	1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970	+ +	* TCL_LEAVE_ERR_MSG. */ { int result; Tcl_Obj *part1Ptr; part1Ptr = Tcl_NewStringObj(part1, -1); Tcl_IncrRefCount(part1Ptr); /* Filter to pass through only the flags this interface supports. */ flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG); result = TclObjUnsetVar2(interp, part1Ptr, part2, flags); TclDecrRefCount(part1Ptr); return result; }
︙
1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001	1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 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 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121	- - + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	* to be looked up. */ Tcl_Obj *part1Ptr; /* Name of variable or array. */ CONST char *part2; /* Name of element within array or NULL. */ int flags; /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_LEAVE_ERR_MSG. */ { Var dummyVar; Var *varPtr, *dummyVarPtr; Var *varPtr; Interp *iPtr = (Interp *) interp; Var *arrayPtr; ActiveVarTrace *activePtr; Tcl_Obj *objPtr; int result; char *part1; part1 = TclGetString(part1Ptr); varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "unset", /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); if (varPtr == NULL) { return TCL_ERROR; } result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK); /* * Keep the variable alive until we're done with it. We used to * increase/decrease the refCount for each operation, making it * hard to find [Bug 735335] - caused by unsetting the variable * whose value was the variable's name. */ varPtr->refCount++; UnsetVarStruct(varPtr, arrayPtr, iPtr, part1, part2, flags); /* * It's an error to unset an undefined variable. */ if (result != TCL_OK) { if (flags & TCL_LEAVE_ERR_MSG) { VarErrMsg(interp, part1, part2, "unset", ((arrayPtr == NULL) ? noSuchVar : noSuchElement)); } } /* * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType * keeping a reference. This removes some additional exteriorisations of * [Bug 736729], but may be a good thing independently of the bug. */ if (part1Ptr->typePtr == &tclNsVarNameType) { part1Ptr->typePtr->freeIntRepProc(part1Ptr); part1Ptr->typePtr = NULL; } /* * Finally, if the variable is truly not in use then free up its Var * structure and remove it from its hash table, if any. The ref count of * its value object, if any, was decremented above. */ varPtr->refCount--; CleanupVar(varPtr, arrayPtr); return result; }  /* *---------------------------------------------------------------------- * * UnsetVarStruct -- * * Unset and delete a variable. This does the internal work for * TclObjUnsetVar2 and TclDeleteNamespaceVars, which call here for each * variable to be unset and deleted. * * Results: * None. * * Side effects: * If the arguments indicate a local or global variable in iPtr, it is * unset and deleted. * *---------------------------------------------------------------------- */ static void UnsetVarStruct(varPtr, arrayPtr, iPtr, part1, part2, flags) Var *varPtr; Var *arrayPtr; Interp *iPtr; CONST char *part1; CONST char *part2; int flags; { Var dummyVar; Var *dummyVarPtr; ActiveVarTrace *activePtr; if ((arrayPtr != NULL) && (arrayPtr->searchPtr != NULL)) { DeleteSearches(arrayPtr); } /* * For global/upvar variables referenced in procedures, decrement * the reference count on the variable referred to, and free * the referenced variable if it's no longer needed. */ if (TclIsVarLink(varPtr)) { Var *linkPtr = varPtr->value.linkPtr; linkPtr->refCount--; if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr) && (linkPtr->tracePtr == NULL) && (linkPtr->flags & VAR_IN_HASHTABLE)) { if (linkPtr->hPtr != NULL) { Tcl_DeleteHashEntry(linkPtr->hPtr); } ckfree((char *) linkPtr); } } /* * The code below is tricky, because of the possibility that * a trace procedure might try to access a variable being * deleted. To handle this situation gracefully, do things * in three steps: * 1. Copy the contents of the variable to a dummy variable
︙
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 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116	2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199	- - - - - - - - - - - - - - - - - + + - - - - + - - - - - - - - - - - - - - - - - - -	* will use dummyVar so it won't increment varPtr's refCount itself. * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to * call unset traces even if other traces are pending. */ if ((dummyVar.tracePtr != NULL) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) { varPtr->refCount++; dummyVar.flags &= ~VAR_TRACE_ACTIVE; CallVarTraces(iPtr, arrayPtr, &dummyVar, part1, part2, (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS, /* leaveErrMsg */ 0); while (dummyVar.tracePtr != NULL) { VarTrace *tracePtr = dummyVar.tracePtr; dummyVar.tracePtr = tracePtr->nextPtr; Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); } for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->varPtr == varPtr) { activePtr->nextTracePtr = NULL; } } varPtr->refCount--; } /* * If the variable is an array, delete all of its elements. This must be * done after calling the traces on the array, above (that's the way * traces are defined). If it is a scalar, "discard" its object * (decrement the ref count of its object, if any). */ dummyVarPtr = &dummyVar; if (TclIsVarArray(dummyVarPtr) && !TclIsVarUndefined(dummyVarPtr)) { /* * Deleting the elements of the array may cause traces to be fired * on those elements. Before deleting them, bump the reference count * of the array, so that if those trace procs make a global or upvar * link to the array, the array is not deleted when the call stack * gets popped (we will delete the array ourselves later in this * function). * * Bumping the count can lead to the odd situation that elements of the * array are being deleted when the array still exists, but since the * array is about to be removed anyway, that shouldn't really matter. */ varPtr->refCount++; DeleteArray(iPtr, part1, dummyVarPtr, (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) DeleteArray(iPtr, part1, dummyVarPtr, (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS); | TCL_TRACE_UNSETS); /* Decr ref count */ varPtr->refCount--; } if (TclIsVarScalar(dummyVarPtr) && (dummyVarPtr->value.objPtr != NULL)) { objPtr = dummyVarPtr->value.objPtr; Tcl_Obj *objPtr = dummyVarPtr->value.objPtr; TclDecrRefCount(objPtr); dummyVarPtr->value.objPtr = NULL; } /* * If the variable was a namespace variable, decrement its reference count. */ if (varPtr->flags & VAR_NAMESPACE_VAR) { varPtr->flags &= ~VAR_NAMESPACE_VAR; varPtr->refCount--; } /* * It's an error to unset an undefined variable. */ if (result != TCL_OK) { if (flags & TCL_LEAVE_ERR_MSG) { VarErrMsg(interp, part1, part2, "unset", ((arrayPtr == NULL) ? noSuchVar : noSuchElement)); } } /* * Finally, if the variable is truly not in use then free up its Var * structure and remove it from its hash table, if any. The ref count of * its value object, if any, was decremented above. */ CleanupVar(varPtr, arrayPtr); return result; }  /* *---------------------------------------------------------------------- * * Tcl_TraceVar -- *
︙
2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 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 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725	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 2806 2807 2808	- + + + - + + - + + + + + + - - + - - - - - - - - + + -	Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { Tcl_Obj *varValuePtr, *newValuePtr; register List *listRepPtr; register Tcl_Obj **elemPtrs; int numElems, numRequired, createdNewObj, createVar, i, j; int numElems, numRequired, createdNewObj, i, j; Var *varPtr, *arrayPtr; char *part1; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?"); return TCL_ERROR; } if (objc == 2) { newValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL, 0); if (newValuePtr == NULL) { /* * The variable doesn't exist yet. Just create it with an empty * initial value. */ varValuePtr = Tcl_NewObj(); Tcl_IncrRefCount(varValuePtr); newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, varValuePtr, TCL_LEAVE_ERR_MSG); Tcl_DecrRefCount(varValuePtr); if (newValuePtr == NULL) { Tcl_DecrRefCount(varValuePtr); /* free unneeded object */ return TCL_ERROR; } } else { int result; } result = Tcl_ListObjLength(interp, newValuePtr, &numElems); if (result != TCL_OK) { return result; } } } else { /* * We have arguments to append. We used to call Tcl_SetVar2 to * append each argument one at a time to ensure that traces were run * for each append step. We now append the arguments all at once * because it's faster. Note that a read trace and a write trace for * the variable will now each only be called once. Also, if the * variable's old value is unshared we modify it directly, otherwise * we create a new copy to modify: this is "copy on write". */ * createdNewObj = 0; createVar = 1; /* * Use the TCL_TRACE_READS flag to ensure that if we have an * array with no elements set yet, but with a read trace on it, * we will create the variable and get read traces triggered. * Note that you have to protect the variable pointers around * the TclPtrGetVar call to insure that they remain valid * even if the variable was undefined and unused. */ varPtr = TclObjLookupVar(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return TCL_ERROR; } varPtr->refCount++; if (arrayPtr != NULL) { arrayPtr->refCount++; } part1 = TclGetString(objv[1]); varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, NULL, (TCL_TRACE_READS | TCL_LEAVE_ERR_MSG)); TCL_LEAVE_ERR_MSG); varPtr->refCount--; if (arrayPtr != NULL) { arrayPtr->refCount--; } createdNewObj = 0; if (varValuePtr == NULL) { /* * We couldn't read the old value: either the var doesn't yet * exist or it's an array element. If it's new, we will try to * create it with Tcl_ObjSetVar2 below. */ createVar = (TclIsVarUndefined(varPtr)); varValuePtr = Tcl_NewObj(); createdNewObj = 1; } else if (Tcl_IsShared(varValuePtr)) { varValuePtr = Tcl_DuplicateObj(varValuePtr); createdNewObj = 1; }
︙
2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797	2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879	+ + - - -	/* * Now store the list object back into the variable. If there is an * error setting the new value, decrement its ref count if it * was new and we didn't create the variable. */ Tcl_IncrRefCount(varValuePtr); newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL, varValuePtr, TCL_LEAVE_ERR_MSG); Tcl_DecrRefCount(varValuePtr); if (newValuePtr == NULL) { if (createdNewObj && !createVar) { Tcl_DecrRefCount(varValuePtr); /* free unneeded obj */ } return TCL_ERROR; } } /* * Set the interpreter's object result to refer to the variable's value * object.
︙
3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400	3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490	+ + + + + + + +	part2, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr); if ((elemVarPtr == NULL) || (TclPtrSetVar(interp, elemVarPtr, varPtr, varName, part2, elemPtrs[i+1], TCL_LEAVE_ERR_MSG) == NULL)) { result = TCL_ERROR; break; } /* * The TclPtrSetVar call might have shimmered * arrayElemObj to another type, so re-fetch * the pointers for safety. */ Tcl_ListObjGetElements(NULL, arrayElemObj, &elemLen, &elemPtrs); } return result; } } /* * The list is empty make sure we have an array, or create
︙
3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468	3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558	- +	* NULL means use global :: context. */ Tcl_Obj *otherP1Ptr; CONST char *otherP2; /* Two-part name of variable in framePtr. */ CONST int otherFlags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of "other" variable. */ CONST char *myName; /* Name of variable which will refer to * otherP1/otherP2. Must be a scalar. */ CONST int myFlags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: int myFlags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of myName. */ int index; /* If the variable to be linked is an indexed * scalar, this is its index. Otherwise, -1. */ { Interp *iPtr = (Interp *) interp; Var *otherPtr, *varPtr, *arrayPtr; CallFrame *varFramePtr;
︙
3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500	3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590	- +	} if (otherPtr == NULL) { return TCL_ERROR; } if (index >= 0) { if (!varFramePtr->isProcCallFrame) { panic("ObjMakeUpVar called with an index outside from a proc.\n"); panic("ObjMakeUpvar called with an index outside from a proc.\n"); } varPtr = &(varFramePtr->compiledLocals[index]); } else { /* * Check that we are not trying to create a namespace var linked to * a local variable in a procedure. If we allowed this, the local * variable in the shorter-lived procedure frame could go away
︙
3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527	3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622	- + + + + + + - - + +	Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"", myName, "\": upvar won't create namespace variable that ", "refers to procedure variable", (char *) NULL); return TCL_ERROR; } /* * Lookup and eventually create the new variable. * Lookup and eventually create the new variable. Set the flag bit * LOOKUP_FOR_UPVAR to indicate the special resolution rules for * upvar purposes: * - Bug #696893 - variable is either proc-local or in the current * namespace; never follow the second (global) resolution path * - Bug #631741 - do not use special namespace or interp resolvers */ varPtr = TclLookupSimpleVar(interp, myName, myFlags, /*create*/ 1, &errMsg, &index); varPtr = TclLookupSimpleVar(interp, myName, (myFlags | LOOKUP_FOR_UPVAR), /* create */ 1, &errMsg, &index); if (varPtr == NULL) { VarErrMsg(interp, myName, NULL, "create", errMsg); return TCL_ERROR; } } if (varPtr == otherPtr) {
︙
4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095	4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191	- + - + +	Var *varPtr; /* Variable whose traces are to be * invoked. */ CONST char *part1; CONST char *part2; /* Variable's two-part name. */ int flags; /* Flags passed to trace procedures: * indicates what's happening to variable, * plus other stuff like TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY, and * or TCL_NAMESPACE_ONLY. */ * TCL_INTERP_DESTROYED. */ CONST int leaveErrMsg; /* If true, and one of the traces indicates an * error, then leave an error message and stack * trace information in *iPTr. */ { register VarTrace *tracePtr; ActiveVarTrace active; char *result; CONST char *openParen, *p; Tcl_DString nameCopy; int copiedName; int code = TCL_OK; int disposeFlags = 0; int saveErrFlags = iPtr->flags & (ERR_IN_PROGRESS | ERR_ALREADY_LOGGED | ERROR_CODE_SET); /* * If there are already similar trace procedures active for the * variable, don't call them again. */ if (varPtr->flags & VAR_TRACE_ACTIVE) {
︙
4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161	4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260	+ + +	for (tracePtr = arrayPtr->tracePtr; tracePtr != NULL; tracePtr = active.nextTracePtr) { active.nextTracePtr = tracePtr->nextPtr; if (!(tracePtr->flags & flags)) { continue; } Tcl_Preserve((ClientData) tracePtr); if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) { flags |= TCL_INTERP_DESTROYED; } result = (*tracePtr->traceProc)(tracePtr->clientData, (Tcl_Interp *) iPtr, part1, part2, flags); if (result != NULL) { if (flags & TCL_TRACE_UNSETS) { /* Ignore errors in unset traces */ DisposeTraceResult(tracePtr->flags, result); } else {
︙
4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194	4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296	+ + +	for (tracePtr = varPtr->tracePtr; tracePtr != NULL; tracePtr = active.nextTracePtr) { active.nextTracePtr = tracePtr->nextPtr; if (!(tracePtr->flags & flags)) { continue; } Tcl_Preserve((ClientData) tracePtr); if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) { flags |= TCL_INTERP_DESTROYED; } result = (*tracePtr->traceProc)(tracePtr->clientData, (Tcl_Interp *) iPtr, part1, part2, flags); if (result != NULL) { if (flags & TCL_TRACE_UNSETS) { /* Ignore errors in unset traces */ DisposeTraceResult(tracePtr->flags, result); } else {
︙
4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217	4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322	+ + +	/* * Restore the variable's flags, remove the record of our active * traces, and then return. */ done: if (code == TCL_OK) { iPtr->flags |= saveErrFlags; } if (code == TCL_ERROR) { if (leaveErrMsg) { CONST char *type = ""; switch (flags&(TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_ARRAY)) { case TCL_TRACE_READS: { type = "read"; break;
︙
4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475	4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	ckfree((char *) searchPtr); } }  /* *---------------------------------------------------------------------- * * TclDeleteNamespaceVars -- * * This procedure is called to recycle all the storage space * associated with a namespace's table of variables. * * Results: * None. * * Side effects: * Variables are deleted and trace procedures are invoked, if * any are declared. * *---------------------------------------------------------------------- */ void TclDeleteNamespaceVars(nsPtr) Namespace *nsPtr; { Tcl_HashTable *tablePtr = &nsPtr->varTable; Tcl_Interp *interp = nsPtr->interp; Interp *iPtr = (Interp *)interp; Tcl_HashSearch search; Tcl_HashEntry *hPtr; int flags = 0; Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); /* * Determine what flags to pass to the trace callback procedures. */ if (nsPtr == iPtr->globalNsPtr) { flags = TCL_GLOBAL_ONLY; } else if (nsPtr == currNsPtr) { flags = TCL_NAMESPACE_ONLY; } for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL; hPtr = Tcl_FirstHashEntry(tablePtr, &search)) { register Var *varPtr = (Var *) Tcl_GetHashValue(hPtr); Tcl_Obj *objPtr = Tcl_NewObj(); varPtr->refCount++; /* Make sure we get to remove from hash */ Tcl_IncrRefCount(objPtr); Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr); UnsetVarStruct(varPtr, NULL, iPtr, Tcl_GetString(objPtr), NULL, flags); Tcl_DecrRefCount(objPtr); /* free no longer needed obj */ varPtr->refCount--; /* Remove the variable from the table and force it undefined * in case an unset trace brought it back from the dead */ Tcl_DeleteHashEntry(hPtr); varPtr->hPtr = NULL; TclSetVarUndefined(varPtr); TclSetVarScalar(varPtr); while (varPtr->tracePtr != NULL) { VarTrace *tracePtr = varPtr->tracePtr; varPtr->tracePtr = tracePtr->nextPtr; Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); } CleanupVar(varPtr, NULL); } Tcl_DeleteHashTable(tablePtr); }  /* *---------------------------------------------------------------------- * * TclDeleteVars -- * * This procedure is called to recycle all the storage space * associated with a table of variables. For this procedure * to work correctly, it must not be possible for any of the * variables in the table to be accessed from Tcl commands * (e.g. from trace procedures).
︙
4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522	4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692	- - -	flags = TCL_TRACE_UNSETS; if (tablePtr == &iPtr->globalNsPtr->varTable) { flags |= TCL_GLOBAL_ONLY; } else if (tablePtr == &currNsPtr->varTable) { flags |= TCL_NAMESPACE_ONLY; } if (Tcl_InterpDeleted(interp)) { flags |= TCL_INTERP_DESTROYED; } for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { varPtr = (Var *) Tcl_GetHashValue(hPtr); /* * For global/upvar variables referenced in procedures, decrement
︙
4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757	4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926	-	DeleteArray(iPtr, arrayName, varPtr, flags) Interp *iPtr; /* Interpreter containing array. */ CONST char *arrayName; /* Name of array (used for trace * callbacks). */ Var *varPtr; /* Pointer to variable structure. */ int flags; /* Flags to pass to CallVarTraces: * TCL_TRACE_UNSETS and sometimes * TCL_INTERP_DESTROYED, * TCL_NAMESPACE_ONLY, or * TCL_GLOBAL_ONLY. */ { Tcl_HashSearch search; register Tcl_HashEntry *hPtr; register Var *elPtr; ActiveVarTrace *activePtr;
︙

1 2 3 4 5 6 7 8 9 10 11 12 13	1 2 3 4 5 6 7 8 9 10 11 12 13	- +	# auto.tcl -- # # utility procs formerly in init.tcl dealing with auto execution # of commands and can be auto loaded themselves. # # RCS: @(#) $Id: auto.tcl,v 1.12 2002/10/28 16:34:25 dgp Exp $ # RCS: @(#) $Id: auto.tcl,v 1.12.2.10 2005/07/23 03:31:41 dgp Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. #
︙
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45	29 30 31 32 33 34 35 36 37 38 39 40 41 42 43	- + - -	&& ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup tcl_findLibrary pkg_compareExtension tclPkgUnknown tcl::MacOSXPkgUnknown tcl::MacPkgUnknown} $p] < 0)} { rename $p {} } } catch {unset auto_execs} unset -nocomplain auto_execs auto_index auto_oldpath catch {unset auto_index} catch {unset auto_oldpath} } # tcl_findLibrary -- # # This is a utility for extensions that searches for a library directory # using a canonical searching algorithm. A side effect is to source # the initialization script and set a global library variable.
︙
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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135	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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171	- - + + - - + + + - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - - - - - - - - - + + + + + + + + - - - - - - - + + + + + + + + + + + + + + + + + + + + + + - - + -	upvar #0 $varName the_library global env errorInfo set dirs {} set errors {} # The C application may have hardwired a path, which we honor set variableSet [info exists the_library] if {[info exists the_library] && $the_library ne ""} { if {$variableSet && [string compare $the_library {}]} { lappend dirs $the_library } else { # Do the canonical search # 1. From an environment variable, if it exists # 1. From an environment variable, if it exists. # Placing this first gives the end-user ultimate control # to work-around any bugs, or to customize. if {[info exists env($enVarName)]} { lappend dirs $env($enVarName) } # 2. Relative to the Tcl library lappend dirs [file join [file dirname [info library]] \ $basename$version] # 2. In the package script directory registered within # the configuration of the package itself. # # Only do this for Tcl 8.5+, when Tcl_RegsiterConfig() is available. #if {[catch { # ::${basename}::pkgconfig get scriptdir,runtime #} value] == 0} { # lappend dirs $value #} # 3. Relative to auto_path directories. This checks relative to the # Tcl library as well as allowing loading of libraries added to the # auto_path that is not relative to the core library or binary paths. foreach d $::auto_path { lappend dirs [file join $d $basename$version] if {$::tcl_platform(platform) eq "unix" && $::tcl_platform(os) eq "Darwin"} { # 4. On MacOSX, check the Resources/Scripts subdir too lappend dirs [file join $d $basename$version Resources Scripts] } } # 3. Various locations relative to the executable # ../lib/foo1.0 (From bin directory in install hierarchy) # ../../lib/foo1.0 (From bin/arch directory in install hierarchy) # ../library (From unix directory in build hierarchy) set parentDir [file dirname [file dirname [info nameofexecutable]]] set grandParentDir [file dirname $parentDir] lappend dirs [file join $parentDir lib $basename$version] lappend dirs [file join $grandParentDir lib $basename$version] lappend dirs [file join $parentDir library] # Remaining locations are out of date (when relevant, they ought # to be covered by the $::auto_path seach above). # # ../../library (From unix/arch directory in build hierarchy) # ../../foo1.0.1/library # (From unix directory in parallel build hierarchy) # ../../../foo1.0.1/library # (From unix/arch directory in parallel build hierarchy) # set parentDir [file dirname [file dirname [info nameofexecutable]]] set grandParentDir [file dirname $parentDir] lappend dirs [file join $parentDir lib $basename$version] lappend dirs [file join $grandParentDir lib $basename$version] lappend dirs [file join $parentDir library] lappend dirs [file join $grandParentDir library] lappend dirs [file join $grandParentDir $basename$patch library] lappend dirs [file join [file dirname $grandParentDir] \ $basename$patch library] # For the sake of extra compatibility safety, we keep adding these # paths during the 8.4.* release series. if {1} { lappend dirs [file join $grandParentDir library] lappend dirs [file join $grandParentDir $basename$patch library] lappend dirs [file join [file dirname $grandParentDir] \ $basename$patch library] } # 4. On MacOSX, check the directories in the tcl_pkgPath if {[string equal $::tcl_platform(platform) "unix"] && \ [string equal $::tcl_platform(os) "Darwin"]} { foreach d $::tcl_pkgPath { lappend dirs [file join $d $basename$version] lappend dirs [file join $d $basename$version Resources Scripts] } } # uniquify $dirs in order array set seen {} foreach i $dirs { # For Tcl 8.4.9, we've disabled the use of [file normalize] here. # This means that two different path names that are the same path # in normalized form, will both remain on the search path. There # should be no harm in that, just a bit more file system access # than is strictly necessary. # # [file normalize] has been disabled because of reports it has # caused difficulties with the freewrap utility. To keep # compatibility with freewrap's needs, we'll keep this disabled # throughout the 8.4.x (x >= 9) releases. See Bug 1072136. if {1 || [interp issafe]} { set norm $i } else { set norm [file normalize $i] } if {[info exists seen($norm)]} { continue } set seen($norm) "" lappend uniqdirs $i } set dirs $uniqdirs foreach i $dirs { set the_library $i set file [file join $i $initScript] # source everything when in a safe interpreter because # we have a source command, but no file exists command if {[interp issafe] || [file exists $file]} { if {![catch {uplevel #0 [list source $file]} msg]} { return } else { append errors "$file: $msg\n$errorInfo\n" } } } if {!$variableSet} { unset the_library unset -nocomplain the_library } set msg "Can't find a usable $initScript in the following directories: \n" append msg " $dirs\n\n" append msg "$errors\n\n" append msg "This probably means that $basename wasn't installed properly.\n" error $msg }
︙
174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193	210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229	- + - +	append index "# Tcl autoload index file, version 2.0\n" append index "# This file is generated by the \"auto_mkindex\" command\n" append index "# and sourced to set up indexing information for one or\n" append index "# more commands. Typically each line is a command that\n" append index "# sets an element in the auto_index array, where the\n" append index "# element name is the name of a command and the value is\n" append index "# a script that loads the command.\n\n" if {$args == ""} { if {[llength $args] == 0} { set args *.tcl } auto_mkindex_parser::init foreach file [eval glob $args] { foreach file [eval [linsert $args 0 glob --]] { if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} { append index $msg } else { set code $errorCode set info $errorInfo cd $oldDir error $msg $info $code
︙
212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229	248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265	- + - +	append index "# Tcl autoload index file, version 2.0\n" append index "# This file is generated by the \"auto_mkindex\" command\n" append index "# and sourced to set up indexing information for one or\n" append index "# more commands. Typically each line is a command that\n" append index "# sets an element in the auto_index array, where the\n" append index "# element name is the name of a command and the value is\n" append index "# a script that loads the command.\n\n" if {[string equal $args ""]} { if {[llength $args] == 0} { set args *.tcl } foreach file [eval glob $args] { foreach file [eval [linsert $args 0 glob --]] { set f "" set error [catch { set f [open $file] while {[gets $f line] >= 0} { if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} { set procName [lindex [auto_qualify $procName "::"] 0] append index "set [list auto_index($procName)]"
︙
333 334 335 336 337 338 339 340 341 342 343 344 345 346 347	369 370 371 372 373 374 375 376 377 378 379 380 381 382 383	- +	# interpreter: references like "$x" will fail since code is not # really being executed and variables do not really exist. # To avoid this, we replace all $ with \0 (literally, the null char) # later, when getting proc names we will have to reverse this replacement, # in case there were any $ in the proc name. This will cause a problem # if somebody actually tries to have a \0 in their proc name. Too bad # for them. regsub -all {\$} $contents "\0" contents set contents [string map "$ \u0000" $contents] set index "" set contextStack "" set imports "" $parser eval $contents
︙
411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439	447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473	- - + + - - - + - +	# body Implementation of command to handle indexing. proc auto_mkindex_parser::commandInit {name arglist body} { variable parser set ns [namespace qualifiers $name] set tail [namespace tail $name] if {[string equal $ns ""]} { set fakeName "[namespace current]::_%@fake_$tail" if {$ns eq ""} { set fakeName [namespace current]::_%@fake_$tail } else { set fakeName "_%@fake_$name" regsub -all {::} $fakeName "_" fakeName set fakeName "[namespace current]::$fakeName" set fakeName [namespace current]::[string map {:: _} _%@fake_$name] } proc $fakeName $arglist $body # YUK! Tcl won't let us alias fully qualified command names, # so we can't handle names like "::itcl::class". Instead, # we have to build procs with the fully qualified names, and # have the procs point to the aliases. if {[regexp {::} $name]} { if {[string match *::* $name]} { set exportCmd [list _%@namespace export [namespace tail $name]] $parser eval [list _%@namespace eval $ns $exportCmd] # The following proc definition does not work if you # want to tolerate space or something else diabolical # in the procedure name, (i.e., space in $alias) # The following does not work:
︙
475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498	509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531	- + - - +	set name "${ns}::$name" if {[string match ::* $name]} { break } } } if {[string equal [namespace qualifiers $name] ""]} { if {[namespace qualifiers $name] eq ""} { set name [namespace tail $name] } elseif {![string match ::* $name]} { set name "::$name" } # Earlier, mkindex replaced all $'s with \0. Now, we have to reverse # that replacement. regsub -all "\0" $name "\$" name return $name return [string map "\u0000 $" $name] } # Register all of the procedures for the auto_mkindex parser that # will build the "tclIndex" file. # AUTO MKINDEX: proc name arglist body # Adds an entry to the auto index list for the given procedure name.
︙
516 517 518 519 520 521 522 523 524 525 526 527 528 529 530	549 550 551 552 553 554 555 556 557 558 559 560 561 562 563	- +	# variable. Second, because the package index file may defer loading the # library until we invoke a command, we need to explicitly invoke auto_load # to force it to be loaded. This should be a noop if the package has # already been loaded auto_mkindex_parser::hook { if {![catch {package require tbcload}]} { if {[llength [info commands tbcload::bcproc]] == 0} { if {[namespace which -command tbcload::bcproc] eq ""} { auto_load tbcload::bcproc } load {} tbcload $auto_mkindex_parser::parser # AUTO MKINDEX: tbcload::bcproc name arglist body # Adds an entry to the auto index list for the given pre-compiled # procedure name.
︙
567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583	600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616	- +	$parser eval [list _%@namespace eval $name] $args set contextStack [lrange $contextStack 1 end] } import { variable parser variable imports foreach pattern $args { if {[string compare $pattern "-force"]} { if {$pattern ne "-force"} { lappend imports $pattern } } catch {$parser eval "_%@namespace import $args"} } } } return

1 2 3 4 5 6

1 2 3 4 5 6 7

+ - - + + - +

if {![package vsatisfies [package provide Tcl] 8]} {return} if {[string compare $::tcl_platform(platform) windows]} {return} if {[info exists tcl_platform(debug)]} { package ifneeded dde 1.2.1 [list load [file join $dir tcldde12g.dll] dde] if {[info exists ::tcl_platform(debug)]} { package ifneeded dde 1.2.4 [list load [file join $dir tcldde12g.dll] dde] } else { package ifneeded dde 1.2.1 [list load [file join $dir tcldde12.dll] dde] package ifneeded dde 1.2.4 [list load [file join $dir tcldde12.dll] dde] }

	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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	# Encoding file: gb2312, double-byte D 233F 0 81 21 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000030003001300230FB02C902C700A8300330052015FF5E2225202620182019 201C201D3014301530083009300A300B300C300D300E300F3016301730103011 00B100D700F72236222722282211220F222A222922082237221A22A522252220 23122299222B222E2261224C2248223D221D2260226E226F22642265221E2235 22342642264000B0203220332103FF0400A4FFE0FFE1203000A7211626062605 25CB25CF25CE25C725C625A125A025B325B2203B219221902191219330130000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 22 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000024882489248A248B248C248D248E248F2490249124922493249424952496 249724982499249A249B247424752476247724782479247A247B247C247D247E 247F248024812482248324842485248624872460246124622463246424652466 2467246824690000000032203221322232233224322532263227322832290000 00002160216121622163216421652166216721682169216A216B000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 23 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000FF01FF02FF03FFE5FF05FF06FF07FF08FF09FF0AFF0BFF0CFF0DFF0EFF0F FF10FF11FF12FF13FF14FF15FF16FF17FF18FF19FF1AFF1BFF1CFF1DFF1EFF1F FF20FF21FF22FF23FF24FF25FF26FF27FF28FF29FF2AFF2BFF2CFF2DFF2EFF2F FF30FF31FF32FF33FF34FF35FF36FF37FF38FF39FF3AFF3BFF3CFF3DFF3EFF3F FF40FF41FF42FF43FF44FF45FF46FF47FF48FF49FF4AFF4BFF4CFF4DFF4EFF4F FF50FF51FF52FF53FF54FF55FF56FF57FF58FF59FF5AFF5BFF5CFF5DFFE30000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 24 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000304130423043304430453046304730483049304A304B304C304D304E304F 3050305130523053305430553056305730583059305A305B305C305D305E305F 3060306130623063306430653066306730683069306A306B306C306D306E306F 3070307130723073307430753076307730783079307A307B307C307D307E307F 3080308130823083308430853086308730883089308A308B308C308D308E308F 3090309130923093000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 25 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000030A130A230A330A430A530A630A730A830A930AA30AB30AC30AD30AE30AF 30B030B130B230B330B430B530B630B730B830B930BA30BB30BC30BD30BE30BF 30C030C130C230C330C430C530C630C730C830C930CA30CB30CC30CD30CE30CF 30D030D130D230D330D430D530D630D730D830D930DA30DB30DC30DD30DE30DF 30E030E130E230E330E430E530E630E730E830E930EA30EB30EC30ED30EE30EF 30F030F130F230F330F430F530F6000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 26 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000039103920393039403950396039703980399039A039B039C039D039E039F 03A003A103A303A403A503A603A703A803A90000000000000000000000000000 000003B103B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF 03C003C103C303C403C503C603C703C803C90000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 27 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000004100411041204130414041504010416041704180419041A041B041C041D 041E041F0420042104220423042404250426042704280429042A042B042C042D 042E042F00000000000000000000000000000000000000000000000000000000 000004300431043204330434043504510436043704380439043A043B043C043D 043E043F0440044104420443044404450446044704480449044A044B044C044D 044E044F00000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 28 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000010100E101CE00E0011300E9011B00E8012B00ED01D000EC014D00F301D2 00F2016B00FA01D400F901D601D801DA01DC00FC00EA00000000000000000000 0000000000000000000031053106310731083109310A310B310C310D310E310F 3110311131123113311431153116311731183119311A311B311C311D311E311F 3120312131223123312431253126312731283129000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 29 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000002500250125022503250425052506250725082509250A250B 250C250D250E250F2510251125122513251425152516251725182519251A251B 251C251D251E251F2520252125222523252425252526252725282529252A252B 252C252D252E252F2530253125322533253425352536253725382539253A253B 253C253D253E253F2540254125422543254425452546254725482549254A254B 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 30 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000554A963F57C3632854CE550954C07691764C853C77EE827E788D72319698 978D6C285B894FFA630966975CB880FA684880AE660276CE51F9655671AC7FF1 888450B2596561CA6FB382AD634C625253ED54277B06516B75A45DF462D48DCB 9776628A8019575D97387F627238767D67CF767E64464F708D2562DC7A176591 73ED642C6273822C9881677F7248626E62CC4F3474E3534A529E7ECA90A65E2E 6886699C81807ED168D278C5868C9551508D8C2482DE80DE5305891252650000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 31 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000858496F94FDD582199715B9D62B162A566B48C799C8D7206676F789160B2 535153178F8880CC8D1D94A1500D72C8590760EB711988AB595482EF672C7B28 5D297EF7752D6CF58E668FF8903C9F3B6BD491197B145F7C78A784D6853D6BD5 6BD96BD65E015E8775F995ED655D5F0A5FC58F9F58C181C2907F965B97AD8FB9 7F168D2C62414FBF53D8535E8FA88FA98FAB904D68075F6A819888689CD6618B 522B762A5F6C658C6FD26EE85BBE6448517551B067C44E1979C9997C70B30000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 32 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000075C55E7673BB83E064AD62E894B56CE2535A52C3640F94C27B944F2F5E1B 82368116818A6E246CCA9A736355535C54FA886557E04E0D5E036B657C3F90E8 601664E6731C88C16750624D8D22776C8E2991C75F6983DC8521991053C28695 6B8B60ED60E8707F82CD82314ED36CA785CF64CD7CD969FD66F9834953957B56 4FA7518C6D4B5C428E6D63D253C9832C833667E578B4643D5BDF5C945DEE8BE7 62C667F48C7A640063BA8749998B8C177F2094F24EA7961098A4660C73160000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 33 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000573A5C1D5E38957F507F80A05382655E7545553150218D856284949E671D 56326F6E5DE2543570928F66626F64A463A35F7B6F8890F481E38FB05C186668 5FF16C8996488D81886C649179F057CE6A59621054484E587A0B60E96F848BDA 627F901E9A8B79E4540375F4630153196C608FDF5F1B9A70803B9F7F4F885C3A 8D647FC565A570BD514551B2866B5D075BA062BD916C75748E0C7A2061017B79 4EC77EF877854E1181ED521D51FA6A7153A88E87950496CF6EC19664695A0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 34 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000784050A877D7641089E6590463E35DDD7A7F693D4F20823955984E3275AE 7A975E625E8A95EF521B5439708A6376952457826625693F918755076DF37EAF 882262337EF075B5832878C196CC8F9E614874F78BCD6B64523A8D506B21806A 847156F153064ECE4E1B51D17C97918B7C074FC38E7F7BE17A9C64675D1450AC 810676017CB96DEC7FE067515B585BF878CB64AE641363AA632B9519642D8FBE 7B5476296253592754466B7950A362345E266B864EE38D37888B5F85902E0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 35 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006020803D62C54E39535590F863B880C665E66C2E4F4660EE6DE18BDE5F39 86CB5F536321515A83616863520063638E4850125C9B79775BFC52307A3B60BC 905376D75FB75F9776848E6C706F767B7B4977AA51F3909358244F4E6EF48FEA 654C7B1B72C46DA47FDF5AE162B55E95573084827B2C5E1D5F1F90127F1498A0 63826EC7789870B95178975B57AB75354F4375385E9760E659606DC06BBF7889 53FC96D551CB52016389540A94938C038DCC7239789F87768FED8C0D53E00000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 36 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004E0176EF53EE948998769F0E952D5B9A8BA24E224E1C51AC846361C252A8 680B4F97606B51BB6D1E515C6296659796618C46901775D890FD77636BD2728A 72EC8BFB583577798D4C675C9540809A5EA66E2159927AEF77ED953B6BB565AD 7F0E58065151961F5BF958A954288E726566987F56E4949D76FE9041638754C6 591A593A579B8EB267358DFA8235524160F0581586FE5CE89E454FC4989D8BB9 5A2560765384627C904F9102997F6069800C513F80335C1499756D314E8C0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 37 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008D3053D17F5A7B4F4F104E4F96006CD573D085E95E06756A7FFB6A0A77FE 94927E4151E170E653CD8FD483038D2972AF996D6CDB574A82B365B980AA623F 963259A84EFF8BBF7EBA653E83F2975E556198DE80A5532A8BFD542080BA5E9F 6CB88D3982AC915A54296C1B52067EB7575F711A6C7E7C89594B4EFD5FFF6124 7CAA4E305C0167AB87025CF0950B98CE75AF70FD902251AF7F1D8BBD594951E4 4F5B5426592B657780A45B75627662C28F905E456C1F7B264F0F4FD8670D0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 38 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006D6E6DAA798F88B15F17752B629A8F854FEF91DC65A7812F81515E9C8150 8D74526F89868D4B590D50854ED8961C723681798D1F5BCC8BA3964459877F1A 54905676560E8BE565396982949976D66E895E727518674667D17AFF809D8D76 611F79C665628D635188521A94A27F38809B7EB25C976E2F67607BD9768B9AD8 818F7F947CD5641E95507A3F544A54E56B4C640162089E3D80F3759952729769 845B683C86E49601969494EC4E2A54047ED968398DDF801566F45E9A7FB90000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 39 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000057C2803F68975DE5653B529F606D9F9A4F9B8EAC516C5BAB5F135DE96C5E 62F18D21517194A952FE6C9F82DF72D757A267848D2D591F8F9C83C754957B8D 4F306CBD5B6459D19F1353E486CA9AA88C3780A16545987E56FA96C7522E74DC 52505BE1630289024E5662D0602A68FA51735B9851A089C27BA199867F5060EF 704C8D2F51495E7F901B747089C4572D78455F529F9F95FA8F689B3C8BE17678 684267DC8DEA8D35523D8F8A6EDA68CD950590ED56FD679C88F98FC754C80000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009AB85B696D776C264EA55BB39A87916361A890AF97E9542B6DB55BD251FD 558A7F557FF064BC634D65F161BE608D710A6C576C49592F676D822A58D5568E 8C6A6BEB90DD597D801753F76D695475559D837783CF683879BE548C4F555408 76D28C8996026CB36DB88D6B89109E648D3A563F9ED175D55F8872E0606854FC 4EA86A2A886160528F7054C470D886799E3F6D2A5B8F5F187EA255894FAF7334 543C539A5019540E547C4E4E5FFD745A58F6846B80E1877472D07CCA6E560000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3B 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005F27864E552C62A44E926CAA623782B154D7534E733E6ED1753B52125316 8BDD69D05F8A60006DEE574F6B2273AF68538FD87F13636260A3552475EA8C62 71156DA35BA65E7B8352614C9EC478FA87577C27768751F060F6714C66435E4C 604D8C0E707063258F895FBD606286D456DE6BC160946167534960E066668D3F 79FD4F1A70E96C478BB38BF27ED88364660F5A5A9B426D516DF78C416D3B4F19 706B83B7621660D1970D8D27797851FB573E57FA673A75787A3D79EF7B950000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3C 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000808C99658FF96FC08BA59E2159EC7EE97F095409678168D88F917C4D96C6 53CA602575BE6C7253735AC97EA7632451E0810A5DF184DF628051805B634F0E 796D524260B86D4E5BC45BC28BA18BB065E25FCC964559937EE77EAA560967B7 59394F735BB652A0835A988A8D3E753294BE50477A3C4EF767B69A7E5AC16B7C 76D1575A5C167B3A95F4714E517C80A9827059787F04832768C067EC78B17877 62E363617B804FED526A51CF835069DB92748DF58D3189C1952E7BAD4EF60000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3D 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000506582305251996F6E106E856DA75EFA50F559DC5C066D466C5F7586848B 686859568BB253209171964D854969127901712680F64EA490CA6D479A845A07 56BC640594F077EB4FA5811A72E189D2997A7F347EDE527F655991758F7F8F83 53EB7A9663ED63A5768679F888579636622A52AB8282685467706377776B7AED 6D017ED389E359D0621285C982A5754C501F4ECB75A58BEB5C4A5DFE7B4B65A4 91D14ECA6D25895F7D2795264EC58C288FDB9773664B79818FD170EC6D780000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3E 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005C3D52B283465162830E775B66769CB84EAC60CA7CBE7CB37ECF4E958B66 666F988897595883656C955C5F8475C997567ADF7ADE51C070AF7A9863EA7A76 7EA0739697ED4E4570784E5D915253A9655165E781FC8205548E5C31759A97A0 62D872D975BD5C459A7983CA5C40548077E94E3E6CAE805A62D2636E5DE85177 8DDD8E1E952F4FF153E560E770AC526763509E435A1F5026773753777EE26485 652B628963985014723589C951B38BC07EDD574783CC94A7519B541B5CFB0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3F 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004FCA7AE36D5A90E19A8F55805496536154AF5F0063E9697751EF6168520A 582A52D8574E780D770B5EB761777CE0625B62974EA27095800362F770E49760 577782DB67EF68F578D5989779D158F354B353EF6E34514B523B5BA28BFE80AF 554357A660735751542D7A7A60505B5463A762A053E362635BC767AF54ED7A9F 82E691775E9388E4593857AE630E8DE880EF57577B774FA95FEB5BBD6B3E5321 7B5072C2684677FF773665F751B54E8F76D45CBF7AA58475594E9B4150800000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 40 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000998861276E8357646606634656F062EC62695ED39614578362C955878721 814A8FA3556683B167658D5684DD5A6A680F62E67BEE961151706F9C8C3063FD 89C861D27F0670C26EE57405699472FC5ECA90CE67176D6A635E52B372628001 4F6C59E5916A70D96D9D52D24E5096F7956D857E78CA7D2F5121579264C2808B 7C7B6CEA68F1695E51B7539868A872819ECE7BF172F879BB6F137406674E91CC 9CA4793C83898354540F68174E3D538952B1783E5386522950884F8B4FD00000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 41 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000075E27ACB7C926CA596B6529B748354E94FE9805483B28FDE95705EC9601C 6D9F5E18655B813894FE604B70BC7EC37CAE51C968817CB1826F4E248F8691CF 667E4EAE8C0564A9804A50DA759771CE5BE58FBD6F664E86648295635ED66599 521788C270C852A3730E7433679778F797164E3490BB9CDE6DCB51DB8D41541D 62CE73B283F196F69F8494C34F367F9A51CC707596755CAD988653E64EE46E9C 740969B4786B998F7559521876246D4167F3516D9F99804B54997B3C7ABF0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 42 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009686578462E29647697C5A0464027BD36F0F964B82A6536298855E907089 63B35364864F9C819E93788C97328DEF8D429E7F6F5E79845F559646622E9A74 541594DD4FA365C55C655C617F1586516C2F5F8B73876EE47EFF5CE6631B5B6A 6EE653754E7163A0756562A18F6E4F264ED16CA67EB68BBA841D87BA7F57903B 95237BA99AA188F8843D6D1B9A867EDC59889EBB739B780186829A6C9A82561B 541757CB4E709EA653568FC881097792999286EE6EE1851366FC61626F2B0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 43 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008C298292832B76F26C135FD983BD732B8305951A6BDB77DB94C6536F8302 51925E3D8C8C8D384E4873AB679A68859176970971646CA177095A9295416BCF 7F8E66275BD059B95A9A95E895F74EEC840C84996AAC76DF9530731B68A65B5F 772F919A97617CDC8FF78C1C5F257C7379D889C56CCC871C5BC65E4268C97720 7EF55195514D52C95A297F05976282D763CF778485D079D26E3A5E9959998511 706D6C1162BF76BF654F60AF95FD660E879F9E2394ED540D547D8C2C64780000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 44 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000647986116A21819C78E864699B5462B9672B83AB58A89ED86CAB6F205BDE 964C8C0B725F67D062C772614EA959C66BCD589366AE5E5552DF6155672876EE 776672677A4662FF54EA545094A090A35A1C7EB36C164E435976801059485357 753796BE56CA63208111607C95F96DD65462998151855AE980FD59AE9713502A 6CE55C3C62DF4F60533F817B90066EBA852B62C85E7478BE64B5637B5FF55A18 917F9E1F5C3F634F80425B7D556E954A954D6D8560A867E072DE51DD5B810000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 45 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000062E76CDE725B626D94AE7EBD81136D53519C5F04597452AA601259736696 8650759F632A61E67CEF8BFA54E66B279E256BB485D5545550766CA4556A8DB4 722C5E156015743662CD6392724C5F986E436D3E65006F5876D878D076FC7554 522453DB4E535E9E65C1802A80D6629B5486522870AE888D8DD16CE1547880DA 57F988F48D54966A914D4F696C9B55B776C6783062A870F96F8E5F6D84EC68DA 787C7BF781A8670B9E4F636778B0576F78129739627962AB528874356BD70000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 46 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005564813E75B276AE533975DE50FB5C418B6C7BC7504F72479A9798D86F02 74E27968648777A562FC98918D2B54C180584E52576A82F9840D5E7351ED74F6 8BC45C4F57616CFC98875A4678349B448FEB7C955256625194FA4EC683868461 83E984B257D467345703666E6D668C3166DD7011671F6B3A6816621A59BB4E03 51C46F0667D26C8F517668CB59476B6775665D0E81109F5065D7794879419A91 8D775C824E5E4F01542F5951780C56686C148FC45F036C7D6CE38BAB63900000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 47 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000060706D3D72756266948E94C553438FC17B7E4EDF8C264E7E9ED494B194B3 524D6F5C90636D458C3458115D4C6B206B4967AA545B81547F8C589985375F3A 62A26A47953965726084686577A74E544FA85DE7979864AC7FD85CED4FCF7A8D 520783044E14602F7A8394A64FB54EB279E6743452E482B964D279BD5BDD6C81 97528F7B6C22503E537F6E0564CE66746C3060C598778BF75E86743C7A7779CB 4E1890B174036C4256DA914B6CC58D8B533A86C666F28EAF5C489A716E200000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 48 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000053D65A369F8B8DA353BB570898A76743919B6CC9516875CA62F372AC5238 529D7F3A7094763853749E4A69B7786E96C088D97FA4713671C3518967D374E4 58E4651856B78BA9997662707ED560F970ED58EC4EC14EBA5FCD97E74EFB8BA4 5203598A7EAB62544ECD65E5620E833884C98363878D71946EB65BB97ED25197 63C967D480898339881551125B7A59828FB14E736C5D516589258F6F962E854A 745E951095F06DA682E55F3164926D128428816E9CC3585E8D5B4E0953C10000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 49 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004F1E6563685155D34E2764149A9A626B5AC2745F82726DA968EE50E7838E 7802674052396C997EB150BB5565715E7B5B665273CA82EB67495C715220717D 886B95EA965564C58D6181B355846C5562477F2E58924F2455468D4F664C4E0A 5C1A88F368A2634E7A0D70E7828D52FA97F65C1154E890B57ECD59628D4A86C7 820C820D8D6664445C0461516D89793E8BBE78377533547B4F388EAB6DF15A20 7EC5795E6C885BA15A76751A80BE614E6E1758F0751F7525727253477EF30000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000770176DB526980DC57235E08593172EE65BD6E7F8BD75C388671534177F3 62FE65F64EC098DF86805B9E8BC653F277E24F7F5C4E9A7659CB5F0F793A58EB 4E1667FF4E8B62ED8A93901D52BF662F55DC566C90024ED54F8D91CA99706C0F 5E0260435BA489C68BD56536624B99965B885BFF6388552E53D77626517D852C 67A268B36B8A62928F9353D482126DD1758F4E668D4E5B70719F85AF669166D9 7F7287009ECD9F205C5E672F8FF06811675F620D7AD658855EB665706F310000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4B 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000060555237800D6454887075295E05681362F4971C53CC723D8C016C347761 7A0E542E77AC987A821C8BF47855671470C165AF64955636601D79C153F84E1D 6B7B80865BFA55E356DB4F3A4F3C99725DF3677E80386002988290015B8B8BBC 8BF5641C825864DE55FD82CF91654FD77D20901F7C9F50F358516EAF5BBF8BC9 80839178849C7B97867D968B968F7EE59AD3788E5C817A57904296A7795F5B59 635F7B0B84D168AD55067F2974107D2295016240584C4ED65B83597958540000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4C 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000736D631E8E4B8E0F80CE82D462AC53F06CF0915E592A60016C70574D644A 8D2A762B6EE9575B6A8075F06F6D8C2D8C0857666BEF889278B363A253F970AD 6C645858642A580268E0819B55107CD650188EBA6DCC8D9F70EB638F6D9B6ED4 7EE68404684390036DD896768BA85957727985E4817E75BC8A8A68AF52548E22 951163D098988E44557C4F5366FF568F60D56D9552435C4959296DFB586B7530 751C606C82148146631167618FE2773A8DF38D3494C15E165385542C70C30000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4D 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006C405EF7505C4EAD5EAD633A8247901A6850916E77B3540C94DC5F647AE5 687663457B527EDF75DB507762955934900F51F879C37A8156FE5F9290146D82 5C60571F541051546E4D56E263A89893817F8715892A9000541E5C6F81C062D6 625881319E3596409A6E9A7C692D59A562D3553E631654C786D96D3C5A0374E6 889C6B6A59168C4C5F2F6E7E73A9987D4E3870F75B8C7897633D665A769660CB 5B9B5A494E0781556C6A738B4EA167897F515F8065FA671B5FD859845A010000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4E 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005DCD5FAE537197E68FDD684556F4552F60DF4E3A6F4D7EF482C7840E59D4 4F1F4F2A5C3E7EAC672A851A5473754F80C355829B4F4F4D6E2D8C135C096170 536B761F6E29868A658795FB7EB9543B7A337D0A95EE55E17FC174EE631D8717 6DA17A9D621165A1536763E16C835DEB545C94A84E4C6C618BEC5C4B65E0829C 68A7543E54346BCB6B664E9463425348821E4F0D4FAE575E620A96FE66647269 52FF52A1609F8BEF661471996790897F785277FD6670563B54389521727A0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4F 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007A00606F5E0C6089819D591560DC718470EF6EAA6C5072806A8488AD5E2D 4E605AB3559C94E36D177CFB9699620F7EC6778E867E5323971E8F9666875CE1 4FA072ED4E0B53A6590F54136380952851484ED99C9C7EA454B88D2488548237 95F26D8E5F265ACC663E966973B0732E53BF817A99857FA15BAA967796507EBF 76F853A2957699997BB189446E584E617FD479658BE660F354CD4EAB98795DF7 6A6150CF54118C618427785D9704524A54EE56A395006D885BB56DC666530000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 50 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005C0F5B5D6821809655787B11654869544E9B6B47874E978B534F631F643A 90AA659C80C18C10519968B0537887F961C86CC46CFB8C225C5185AA82AF950C 6B238F9B65B05FFB5FC34FE18845661F8165732960FA51745211578B5F6290A2 884C91925E78674F602759D3514451F680F853086C7996C4718A4F114FEE7F9E 673D55C5950879C088967EE3589F620C9700865A5618987B5F908BB884C49157 53D965ED5E8F755C60647D6E5A7F7EEA7EED8F6955A75BA360AC65CB73840000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 51 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009009766377297EDA9774859B5B667A7496EA884052CB718F5FAA65EC8BE2 5BFB9A6F5DE16B896C5B8BAD8BAF900A8FC5538B62BC9E269E2D54404E2B82BD 7259869C5D1688596DAF96C554D14E9A8BB6710954BD960970DF6DF976D04E25 781487125CA95EF68A00989C960E708E6CBF594463A9773C884D6F1482735830 71D5538C781A96C155015F6671305BB48C1A9A8C6B83592E9E2F79E76768626C 4F6F75A17F8A6D0B96336C274EF075D2517B68376F3E90808170599674760000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 52 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000064475C2790657A918C2359DA54AC8200836F898180006930564E80367237 91CE51B64E5F987563964E1A53F666F3814B591C6DB24E0058F9533B63D694F1 4F9D4F0A886398905937905779FB4EEA80F075916C825B9C59E85F5D69058681 501A5DF24E5977E34EE5827A6291661390915C794EBF5F7981C69038808475AB 4EA688D4610F6BC55FC64E4976CA6EA28BE38BAE8C0A8BD15F027FFC7FCC7ECE 8335836B56E06BB797F3963459FB541F94F66DEB5BC5996E5C395F1596900000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 53 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000537082F16A315A749E705E947F2883B984248425836787478FCE8D6276C8 5F719896786C662054DF62E54F6381C375C85EB896CD8E0A86F9548F6CF36D8C 6C38607F52C775285E7D4F1860A05FE75C24753190AE94C072B96CB96E389149 670953CB53F34F5191C98BF153C85E7C8FC26DE44E8E76C26986865E611A8206 4F594FDE903E9C7C61096E1D6E1496854E885A3196E84E0E5C7F79B95B878BED 7FBD738957DF828B90C15401904755BB5CEA5FA161086B3272F180B28A890000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 54 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006D745BD388D598848C6B9A6D9E336E0A51A4514357A38881539F63F48F95 56ED54585706733F6E907F188FDC82D1613F6028966266F07EA68D8A8DC394A5 5CB37CA4670860A6960580184E9190E75300966851418FD08574915D665597F5 5B55531D78386742683D54C9707E5BB08F7D518D572854B1651266828D5E8D43 810F846C906D7CDF51FF85FB67A365E96FA186A48E81566A90207682707671E5 8D2362E952196CFD8D3C600E589E618E66FE8D60624E55B36E23672D8F670000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 55 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000094E195F87728680569A8548B4E4D70B88BC86458658B5B857A84503A5BE8 77BB6BE18A797C986CBE76CF65A98F975D2D5C5586386808536062187AD96E5B 7EFD6A1F7AE05F706F335F20638C6DA867564E085E108D264ED780C07634969C 62DB662D627E6CBC8D7571677F695146808753EC906E629854F286F08F998005 951785178FD96D5973CD659F771F7504782781FB8D1E94884FA6679575B98BCA 9707632F9547963584B8632377415F8172F04E896014657462EF6B63653F0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 56 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005E2775C790D18BC1829D679D652F5431871877E580A281026C414E4B7EC7 804C76F4690D6B966267503C4F84574063076B628DBE53EA65E87EB85FD7631A 63B781F381F47F6E5E1C5CD95236667A79E97A1A8D28709975D46EDE6CBB7A92 4E2D76C55FE0949F88777EC879CD80BF91CD4EF24F17821F54685DDE6D328BCC 7CA58F7480985E1A549276B15B99663C9AA473E0682A86DB6731732A8BF88BDB 90107AF970DB716E62C477A956314E3B845767F152A986C08D2E94F87B510000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 57 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004F4F6CE8795D9A7B6293722A62FD4E1378168F6C64B08D5A7BC668695E84 88C55986649E58EE72B6690E95258FFD8D5857607F008C0651C6634962D95353 684C74228301914C55447740707C6D4A517954A88D4459FF6ECB6DC45B5C7D2B 4ED47C7D6ED35B5081EA6E0D5B579B0368D58E2A5B977EFC603B7EB590B98D70 594F63CD79DF8DB3535265CF79568BC5963B7EC494BB7E825634918967007F6A 5C0A907566285DE64F5067DE505A4F5C57505EA7000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 58 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004E8D4E0C51404E105EFF53454E154E984E1E9B325B6C56694E2879BA4E3F 53154E47592D723B536E6C1056DF80E499976BD3777E9F174E364E9F9F104E5C 4E694E9382885B5B556C560F4EC4538D539D53A353A553AE97658D5D531A53F5 5326532E533E8D5C5366536352025208520E522D5233523F5240524C525E5261 525C84AF527D528252815290529351827F544EBB4EC34EC94EC24EE84EE14EEB 4EDE4F1B4EF34F224F644EF54F254F274F094F2B4F5E4F6765384F5A4F5D0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 59 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004F5F4F574F324F3D4F764F744F914F894F834F8F4F7E4F7B4FAA4F7C4FAC 4F944FE64FE84FEA4FC54FDA4FE34FDC4FD14FDF4FF85029504C4FF3502C500F 502E502D4FFE501C500C50255028507E504350555048504E506C507B50A550A7 50A950BA50D6510650ED50EC50E650EE5107510B4EDD6C3D4F584F654FCE9FA0 6C467C74516E5DFD9EC999985181591452F9530D8A07531051EB591951554EA0 51564EB3886E88A44EB5811488D279805B3488037FB851AB51B151BD51BC0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000051C7519651A251A58BA08BA68BA78BAA8BB48BB58BB78BC28BC38BCB8BCF 8BCE8BD28BD38BD48BD68BD88BD98BDC8BDF8BE08BE48BE88BE98BEE8BF08BF3 8BF68BF98BFC8BFF8C008C028C048C078C0C8C0F8C118C128C148C158C168C19 8C1B8C188C1D8C1F8C208C218C258C278C2A8C2B8C2E8C2F8C328C338C358C36 5369537A961D962296219631962A963D963C964296499654965F9667966C9672 96749688968D969796B09097909B909D909990AC90A190B490B390B690BA0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5B 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000090B890B090CF90C590BE90D090C490C790D390E690E290DC90D790DB90EB 90EF90FE91049122911E91239131912F913991439146520D594252A252AC52AD 52BE54FF52D052D652F053DF71EE77CD5EF451F551FC9B2F53B65F01755A5DEF 574C57A957A1587E58BC58C558D15729572C572A57335739572E572F575C573B 574257695785576B5786577C577B5768576D5776577357AD57A4578C57B257CF 57A757B4579357A057D557D857DA57D957D257B857F457EF57F857E457DD0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5C 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000580B580D57FD57ED5800581E5819584458205865586C58815889589A5880 99A89F1961FF8279827D827F828F828A82A88284828E82918297829982AB82B8 82BE82B082C882CA82E3829882B782AE82CB82CC82C182A982B482A182AA829F 82C482CE82A482E1830982F782E4830F830782DC82F482D282D8830C82FB82D3 8311831A83068314831582E082D5831C8351835B835C83088392833C83348331 839B835E832F834F83478343835F834083178360832D833A8333836683650000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5D 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008368831B8369836C836A836D836E83B0837883B383B483A083AA8393839C 8385837C83B683A9837D83B8837B8398839E83A883BA83BC83C1840183E583D8 58078418840B83DD83FD83D6841C84388411840683D483DF840F840383F883F9 83EA83C583C0842683F083E1845C8451845A8459847384878488847A84898478 843C844684698476848C848E8431846D84C184CD84D084E684BD84D384CA84BF 84BA84E084A184B984B4849784E584E3850C750D853884F08539851F853A0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5E 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008556853B84FF84FC8559854885688564855E857A77A285438572857B85A4 85A88587858F857985AE859C858585B985B785B085D385C185DC85FF86278605 86298616863C5EFE5F08593C594180375955595A5958530F5C225C255C2C5C34 624C626A629F62BB62CA62DA62D762EE632262F66339634B634363AD63F66371 637A638E63B4636D63AC638A636963AE63BC63F263F863E063FF63C463DE63CE 645263C663BE64456441640B641B6420640C64266421645E6484646D64960000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5F 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000647A64B764B8649964BA64C064D064D764E464E265096525652E5F0B5FD2 75195F11535F53F153FD53E953E853FB541254165406544B5452545354545456 54435421545754595423543254825494547754715464549A549B548454765466 549D54D054AD54C254B454D254A754A654D354D4547254A354D554BB54BF54CC 54D954DA54DC54A954AA54A454DD54CF54DE551B54E7552054FD551454F35522 5523550F55115527552A5567558F55B55549556D55415555553F5550553C0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 60 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005537555655755576557755335530555C558B55D2558355B155B955885581 559F557E55D65591557B55DF55BD55BE5594559955EA55F755C9561F55D155EB 55EC55D455E655DD55C455EF55E555F255F355CC55CD55E855F555E48F94561E 5608560C56015624562355FE56005627562D565856395657562C564D56625659 565C564C5654568656645671566B567B567C5685569356AF56D456D756DD56E1 56F556EB56F956FF5704570A5709571C5E0F5E195E145E115E315E3B5E3C0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 61 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005E375E445E545E5B5E5E5E615C8C5C7A5C8D5C905C965C885C985C995C91 5C9A5C9C5CB55CA25CBD5CAC5CAB5CB15CA35CC15CB75CC45CD25CE45CCB5CE5 5D025D035D275D265D2E5D245D1E5D065D1B5D585D3E5D345D3D5D6C5D5B5D6F 5D5D5D6B5D4B5D4A5D695D745D825D995D9D8C735DB75DC55F735F775F825F87 5F895F8C5F955F995F9C5FA85FAD5FB55FBC88625F6172AD72B072B472B772B8 72C372C172CE72CD72D272E872EF72E972F272F472F7730172F3730372FA0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 62 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000072FB731773137321730A731E731D7315732273397325732C733873317350 734D73577360736C736F737E821B592598E7592459029963996799689969996A 996B996C99749977997D998099849987998A998D999099919993999499955E80 5E915E8B5E965EA55EA05EB95EB55EBE5EB38D535ED25ED15EDB5EE85EEA81BA 5FC45FC95FD65FCF60035FEE60045FE15FE45FFE600560065FEA5FED5FF86019 60356026601B600F600D6029602B600A603F602160786079607B607A60420000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 63 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000606A607D6096609A60AD609D60836092608C609B60EC60BB60B160DD60D8 60C660DA60B4612061266115612360F46100610E612B614A617561AC619461A7 61B761D461F55FDD96B395E995EB95F195F395F595F695FC95FE960396049606 9608960A960B960C960D960F96129615961696179619961A4E2C723F62156C35 6C546C5C6C4A6CA36C856C906C946C8C6C686C696C746C766C866CA96CD06CD4 6CAD6CF76CF86CF16CD76CB26CE06CD66CFA6CEB6CEE6CB16CD36CEF6CFE0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 64 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006D396D276D0C6D436D486D076D046D196D0E6D2B6D4D6D2E6D356D1A6D4F 6D526D546D336D916D6F6D9E6DA06D5E6D936D946D5C6D606D7C6D636E1A6DC7 6DC56DDE6E0E6DBF6DE06E116DE66DDD6DD96E166DAB6E0C6DAE6E2B6E6E6E4E 6E6B6EB26E5F6E866E536E546E326E256E446EDF6EB16E986EE06F2D6EE26EA5 6EA76EBD6EBB6EB76ED76EB46ECF6E8F6EC26E9F6F626F466F476F246F156EF9 6F2F6F366F4B6F746F2A6F096F296F896F8D6F8C6F786F726F7C6F7A6FD10000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 65 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006FC96FA76FB96FB66FC26FE16FEE6FDE6FE06FEF701A7023701B70397035 704F705E5B805B845B955B935BA55BB8752F9A9E64345BE45BEE89305BF08E47 8B078FB68FD38FD58FE58FEE8FE48FE98FE68FF38FE890059004900B90269011 900D9016902190359036902D902F9044905190529050906890589062905B66B9 9074907D908290889083908B5F505F575F565F585C3B54AB5C505C595B715C63 5C667FBC5F2A5F295F2D82745F3C9B3B5C6E59815983598D59A959AA59A30000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 66 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000599759CA59AB599E59A459D259B259AF59D759BE5A055A0659DD5A0859E3 59D859F95A0C5A095A325A345A115A235A135A405A675A4A5A555A3C5A625A75 80EC5AAA5A9B5A775A7A5ABE5AEB5AB25AD25AD45AB85AE05AE35AF15AD65AE6 5AD85ADC5B095B175B165B325B375B405C155C1C5B5A5B655B735B515B535B62 9A759A779A789A7A9A7F9A7D9A809A819A859A889A8A9A909A929A939A969A98 9A9B9A9C9A9D9A9F9AA09AA29AA39AA59AA77E9F7EA17EA37EA57EA87EA90000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 67 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007EAD7EB07EBE7EC07EC17EC27EC97ECB7ECC7ED07ED47ED77EDB7EE07EE1 7EE87EEB7EEE7EEF7EF17EF27F0D7EF67EFA7EFB7EFE7F017F027F037F077F08 7F0B7F0C7F0F7F117F127F177F197F1C7F1B7F1F7F217F227F237F247F257F26 7F277F2A7F2B7F2C7F2D7F2F7F307F317F327F337F355E7A757F5DDB753E9095 738E739173AE73A2739F73CF73C273D173B773B373C073C973C873E573D9987C 740A73E973E773DE73BA73F2740F742A745B7426742574287430742E742C0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 68 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000741B741A7441745C7457745574597477746D747E749C748E748074817487 748B749E74A874A9749074A774D274BA97EA97EB97EC674C6753675E67486769 67A56787676A6773679867A7677567A8679E67AD678B6777677C67F0680967D8 680A67E967B0680C67D967B567DA67B367DD680067C367B867E2680E67C167FD 6832683368606861684E6862684468646883681D68556866684168676840683E 684A6849682968B5688F687468776893686B68C2696E68FC691F692068F90000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 69 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000692468F0690B6901695768E369106971693969606942695D6984696B6980 69986978693469CC6987698869CE6989696669636979699B69A769BB69AB69AD 69D469B169C169CA69DF699569E0698D69FF6A2F69ED6A176A186A6569F26A44 6A3E6AA06A506A5B6A356A8E6A796A3D6A286A586A7C6A916A906AA96A976AAB 733773526B816B826B876B846B926B936B8D6B9A6B9B6BA16BAA8F6B8F6D8F71 8F728F738F758F768F788F778F798F7A8F7C8F7E8F818F828F848F878F8B0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008F8D8F8E8F8F8F988F9A8ECE620B6217621B621F6222622162256224622C 81E774EF74F474FF750F75117513653465EE65EF65F0660A6619677266036615 6600708566F7661D66346631663666358006665F66546641664F665666616657 66776684668C66A7669D66BE66DB66DC66E666E98D328D338D368D3B8D3D8D40 8D458D468D488D498D478D4D8D558D5989C789CA89CB89CC89CE89CF89D089D1 726E729F725D7266726F727E727F7284728B728D728F72926308633263B00000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6B 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000643F64D880046BEA6BF36BFD6BF56BF96C056C076C066C0D6C156C186C19 6C1A6C216C296C246C2A6C3265356555656B724D72527256723086625216809F 809C809380BC670A80BD80B180AB80AD80B480B780E780E880E980EA80DB80C2 80C480D980CD80D7671080DD80EB80F180F480ED810D810E80F280FC67158112 8C5A8136811E812C811881328148814C815381748159815A817181608169817C 817D816D8167584D5AB58188818281916ED581A381AA81CC672681CA81BB0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6C 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000081C181A66B246B376B396B436B466B5998D198D298D398D598D998DA6BB3 5F406BC289F365909F51659365BC65C665C465C365CC65CE65D265D67080709C 7096709D70BB70C070B770AB70B170E870CA711071137116712F71317173715C 716871457172714A7178717A719871B371B571A871A071E071D471E771F9721D 7228706C7118716671B9623E623D624362486249793B794079467949795B795C 7953795A796279577960796F7967797A7985798A799A79A779B35FD15FD00000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6D 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000603C605D605A606760416059606360AB6106610D615D61A9619D61CB61D1 62068080807F6C936CF66DFC77F677F87800780978177818781165AB782D781C 781D7839783A783B781F783C7825782C78237829784E786D7856785778267850 7847784C786A789B7893789A7887789C78A178A378B278B978A578D478D978C9 78EC78F2790578F479137924791E79349F9B9EF99EFB9EFC76F17704770D76F9 77077708771A77227719772D7726773577387750775177477743775A77680000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6E 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000077627765777F778D777D7780778C7791779F77A077B077B577BD753A7540 754E754B7548755B7572757975837F587F617F5F8A487F687F747F717F797F81 7F7E76CD76E58832948594869487948B948A948C948D948F9490949494979495 949A949B949C94A394A494AB94AA94AD94AC94AF94B094B294B494B694B794B8 94B994BA94BC94BD94BF94C494C894C994CA94CB94CC94CD94CE94D094D194D2 94D594D694D794D994D894DB94DE94DF94E094E294E494E594E794E894EA0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6F 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000094E994EB94EE94EF94F394F494F594F794F994FC94FD94FF950395029506 95079509950A950D950E950F951295139514951595169518951B951D951E951F 9522952A952B9529952C953195329534953695379538953C953E953F95429535 9544954595469549954C954E954F9552955395549556955795589559955B955E 955F955D95619562956495659566956795689569956A956B956C956F95719572 9573953A77E777EC96C979D579ED79E379EB7A065D477A037A027A1E7A140000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 70 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007A397A377A519ECF99A57A707688768E7693769976A474DE74E0752C9E20 9E229E289E299E2A9E2B9E2C9E329E319E369E389E379E399E3A9E3E9E419E42 9E449E469E479E489E499E4B9E4C9E4E9E519E559E579E5A9E5B9E5C9E5E9E63 9E669E679E689E699E6A9E6B9E6C9E719E6D9E7375927594759675A0759D75AC 75A375B375B475B875C475B175B075C375C275D675CD75E375E875E675E475EB 75E7760375F175FC75FF761076007605760C7617760A76257618761576190000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 71 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000761B763C762276207640762D7630763F76357643763E7633764D765E7654 765C7656766B766F7FCA7AE67A787A797A807A867A887A957AA67AA07AAC7AA8 7AAD7AB3886488698872887D887F888288A288C688B788BC88C988E288CE88E3 88E588F1891A88FC88E888FE88F0892189198913891B890A8934892B89368941 8966897B758B80E576B276B477DC801280148016801C80208022802580268027 802980288031800B803580438046804D80528069807189839878988098830000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 72 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009889988C988D988F9894989A989B989E989F98A198A298A598A6864D8654 866C866E867F867A867C867B86A8868D868B86AC869D86A786A386AA869386A9 86B686C486B586CE86B086BA86B186AF86C986CF86B486E986F186F286ED86F3 86D0871386DE86F486DF86D886D18703870786F88708870A870D87098723873B 871E8725872E871A873E87488734873187298737873F87828722877D877E877B 87608770874C876E878B87538763877C876487598765879387AF87A887D20000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 73 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000087C68788878587AD8797878387AB87E587AC87B587B387CB87D387BD87D1 87C087CA87DB87EA87E087EE8816881387FE880A881B88218839883C7F367F42 7F447F4582107AFA7AFD7B087B037B047B157B0A7B2B7B0F7B477B387B2A7B19 7B2E7B317B207B257B247B337B3E7B1E7B587B5A7B457B757B4C7B5D7B607B6E 7B7B7B627B727B717B907BA67BA77BB87BAC7B9D7BA87B857BAA7B9C7BA27BAB 7BB47BD17BC17BCC7BDD7BDA7BE57BE67BEA7C0C7BFE7BFC7C0F7C167C0B0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 74 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007C1F7C2A7C267C387C417C4081FE82018202820481EC8844822182228223 822D822F8228822B8238823B82338234823E82448249824B824F825A825F8268 887E8885888888D888DF895E7F9D7F9F7FA77FAF7FB07FB27C7C65497C917C9D 7C9C7C9E7CA27CB27CBC7CBD7CC17CC77CCC7CCD7CC87CC57CD77CE8826E66A8 7FBF7FCE7FD57FE57FE17FE67FE97FEE7FF37CF87D777DA67DAE7E477E9B9EB8 9EB48D738D848D948D918DB18D678D6D8C478C49914A9150914E914F91640000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 75 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009162916191709169916F917D917E917291749179918C91859190918D9191 91A291A391AA91AD91AE91AF91B591B491BA8C559E7E8DB88DEB8E058E598E69 8DB58DBF8DBC8DBA8DC48DD68DD78DDA8DDE8DCE8DCF8DDB8DC68DEC8DF78DF8 8DE38DF98DFB8DE48E098DFD8E148E1D8E1F8E2C8E2E8E238E2F8E3A8E408E39 8E358E3D8E318E498E418E428E518E528E4A8E708E768E7C8E6F8E748E858E8F 8E948E908E9C8E9E8C788C828C8A8C858C988C94659B89D689DE89DA89DC0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 76 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000089E589EB89EF8A3E8B26975396E996F396EF970697019708970F970E972A 972D9730973E9F809F839F859F869F879F889F899F8A9F8C9EFE9F0B9F0D96B9 96BC96BD96CE96D277BF96E0928E92AE92C8933E936A93CA938F943E946B9C7F 9C829C859C869C879C887A239C8B9C8E9C909C919C929C949C959C9A9C9B9C9E 9C9F9CA09CA19CA29CA39CA59CA69CA79CA89CA99CAB9CAD9CAE9CB09CB19CB2 9CB39CB49CB59CB69CB79CBA9CBB9CBC9CBD9CC49CC59CC69CC79CCA9CCB0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 77 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009CCC9CCD9CCE9CCF9CD09CD39CD49CD59CD79CD89CD99CDC9CDD9CDF9CE2 977C978597919792979497AF97AB97A397B297B49AB19AB09AB79E589AB69ABA 9ABC9AC19AC09AC59AC29ACB9ACC9AD19B459B439B479B499B489B4D9B5198E8 990D992E995599549ADF9AE19AE69AEF9AEB9AFB9AED9AF99B089B0F9B139B1F 9B239EBD9EBE7E3B9E829E879E889E8B9E9293D69E9D9E9F9EDB9EDC9EDD9EE0 9EDF9EE29EE99EE79EE59EEA9EEF9F229F2C9F2F9F399F379F3D9F3E9F440000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000

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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380

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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397

- + - - + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - + - + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

# Encoding file: gb2312, double-byte # Encoding file: euc-cn, multi-byte D 233F 0 81 M 003F 0 82 21 00 0000000100020003000400050006000700080009000A000B000C000D000E000F 0010001100120013001400150016001700180019001A001B001C001D001E001F 0020002100220023002400250026002700280029002A002B002C002D002E002F 0030003100320033003400350036003700380039003A003B003C003D003E003F 0040004100420043004400450046004700480049004A004B004C004D004E004F 0050005100520053005400550056005700580059005A005B005C005D005E005F 0060006100620063006400650066006700680069006A006B006C006D006E006F 0070007100720073007400750076007700780079007A007B007C007D007E007F 0080008100820083008400850086008700880089008A008B008C008D008E008F 0090009100920093009400950096009700980099009A009B009C009D009E009F 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 A1 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000030003001300230FB02C902C700A8300330052015FF5E2225202620182019 201C201D3014301530083009300A300B300C300D300E300F3016301730103011 00B100D700F72236222722282211220F222A222922082237221A22A522252220 23122299222B222E2261224C2248223D221D2260226E226F22642265221E2235 22342642264000B0203220332103FF0400A4FFE0FFE1203000A7211626062605 25CB25CF25CE25C725C625A125A025B325B2203B219221902191219330130000 A2 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 22 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000024882489248A248B248C248D248E248F2490249124922493249424952496 249724982499249A249B247424752476247724782479247A247B247C247D247E 247F248024812482248324842485248624872460246124622463246424652466 2467246824690000000032203221322232233224322532263227322832290000 00002160216121622163216421652166216721682169216A216B000000000000 A3 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 23 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000FF01FF02FF03FFE5FF05FF06FF07FF08FF09FF0AFF0BFF0CFF0DFF0EFF0F FF10FF11FF12FF13FF14FF15FF16FF17FF18FF19FF1AFF1BFF1CFF1DFF1EFF1F FF20FF21FF22FF23FF24FF25FF26FF27FF28FF29FF2AFF2BFF2CFF2DFF2EFF2F FF30FF31FF32FF33FF34FF35FF36FF37FF38FF39FF3AFF3BFF3CFF3DFF3EFF3F FF40FF41FF42FF43FF44FF45FF46FF47FF48FF49FF4AFF4BFF4CFF4DFF4EFF4F FF50FF51FF52FF53FF54FF55FF56FF57FF58FF59FF5AFF5BFF5CFF5DFFE30000 A4 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 24 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000304130423043304430453046304730483049304A304B304C304D304E304F 3050305130523053305430553056305730583059305A305B305C305D305E305F 3060306130623063306430653066306730683069306A306B306C306D306E306F 3070307130723073307430753076307730783079307A307B307C307D307E307F 3080308130823083308430853086308730883089308A308B308C308D308E308F 3090309130923093000000000000000000000000000000000000000000000000 A5 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 25 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000030A130A230A330A430A530A630A730A830A930AA30AB30AC30AD30AE30AF 30B030B130B230B330B430B530B630B730B830B930BA30BB30BC30BD30BE30BF 30C030C130C230C330C430C530C630C730C830C930CA30CB30CC30CD30CE30CF 30D030D130D230D330D430D530D630D730D830D930DA30DB30DC30DD30DE30DF 30E030E130E230E330E430E530E630E730E830E930EA30EB30EC30ED30EE30EF 30F030F130F230F330F430F530F6000000000000000000000000000000000000 A6 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 26 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000039103920393039403950396039703980399039A039B039C039D039E039F 03A003A103A303A403A503A603A703A803A90000000000000000000000000000 000003B103B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF 03C003C103C303C403C503C603C703C803C90000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 A7 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000004100411041204130414041504010416041704180419041A041B041C041D 041E041F0420042104220423042404250426042704280429042A042B042C042D 042E042F00000000000000000000000000000000000000000000000000000000 000004300431043204330434043504510436043704380439043A043B043C043D 043E043F0440044104420443044404450446044704480449044A044B044C044D 044E044F00000000000000000000000000000000000000000000000000000000 A8 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000010100E101CE00E0011300E9011B00E8012B00ED01D000EC014D00F301D2 00F2016B00FA01D400F901D601D801DA01DC00FC00EA00000000000000000000 0000000000000000000031053106310731083109310A310B310C310D310E310F 3110311131123113311431153116311731183119311A311B311C311D311E311F 3120312131223123312431253126312731283129000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 A9 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000002500250125022503250425052506250725082509250A250B 250C250D250E250F2510251125122513251425152516251725182519251A251B 251C251D251E251F2520252125222523252425252526252725282529252A252B 252C252D252E252F2530253125322533253425352536253725382539253A253B 253C253D253E253F2540254125422543254425452546254725482549254A254B 0000000000000000000000000000000000000000000000000000000000000000 B0 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000554A963F57C3632854CE550954C07691764C853C77EE827E788D72319698 978D6C285B894FFA630966975CB880FA684880AE660276CE51F9655671AC7FF1 888450B2596561CA6FB382AD634C625253ED54277B06516B75A45DF462D48DCB 9776628A8019575D97387F627238767D67CF767E64464F708D2562DC7A176591 73ED642C6273822C9881677F7248626E62CC4F3474E3534A529E7ECA90A65E2E 6886699C81807ED168D278C5868C9551508D8C2482DE80DE5305891252650000 B1 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000858496F94FDD582199715B9D62B162A566B48C799C8D7206676F789160B2 535153178F8880CC8D1D94A1500D72C8590760EB711988AB595482EF672C7B28 5D297EF7752D6CF58E668FF8903C9F3B6BD491197B145F7C78A784D6853D6BD5 6BD96BD65E015E8775F995ED655D5F0A5FC58F9F58C181C2907F965B97AD8FB9 7F168D2C62414FBF53D8535E8FA88FA98FAB904D68075F6A819888689CD6618B 522B762A5F6C658C6FD26EE85BBE6448517551B067C44E1979C9997C70B30000 B2 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000075C55E7673BB83E064AD62E894B56CE2535A52C3640F94C27B944F2F5E1B 82368116818A6E246CCA9A736355535C54FA886557E04E0D5E036B657C3F90E8 601664E6731C88C16750624D8D22776C8E2991C75F6983DC8521991053C28695 6B8B60ED60E8707F82CD82314ED36CA785CF64CD7CD969FD66F9834953957B56 4FA7518C6D4B5C428E6D63D253C9832C833667E578B4643D5BDF5C945DEE8BE7 62C667F48C7A640063BA8749998B8C177F2094F24EA7961098A4660C73160000 B3 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000573A5C1D5E38957F507F80A05382655E7545553150218D856284949E671D 56326F6E5DE2543570928F66626F64A463A35F7B6F8890F481E38FB05C186668 5FF16C8996488D81886C649179F057CE6A59621054484E587A0B60E96F848BDA 627F901E9A8B79E4540375F4630153196C608FDF5F1B9A70803B9F7F4F885C3A 8D647FC565A570BD514551B2866B5D075BA062BD916C75748E0C7A2061017B79 4EC77EF877854E1181ED521D51FA6A7153A88E87950496CF6EC19664695A0000 B4 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000784050A877D7641089E6590463E35DDD7A7F693D4F20823955984E3275AE 7A975E625E8A95EF521B5439708A6376952457826625693F918755076DF37EAF 882262337EF075B5832878C196CC8F9E614874F78BCD6B64523A8D506B21806A 847156F153064ECE4E1B51D17C97918B7C074FC38E7F7BE17A9C64675D1450AC 810676017CB96DEC7FE067515B585BF878CB64AE641363AA632B9519642D8FBE 7B5476296253592754466B7950A362345E266B864EE38D37888B5F85902E0000 B5 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006020803D62C54E39535590F863B880C665E66C2E4F4660EE6DE18BDE5F39 86CB5F536321515A83616863520063638E4850125C9B79775BFC52307A3B60BC 905376D75FB75F9776848E6C706F767B7B4977AA51F3909358244F4E6EF48FEA 654C7B1B72C46DA47FDF5AE162B55E95573084827B2C5E1D5F1F90127F1498A0 63826EC7789870B95178975B57AB75354F4375385E9760E659606DC06BBF7889 53FC96D551CB52016389540A94938C038DCC7239789F87768FED8C0D53E00000 B6 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004E0176EF53EE948998769F0E952D5B9A8BA24E224E1C51AC846361C252A8 680B4F97606B51BB6D1E515C6296659796618C46901775D890FD77636BD2728A 72EC8BFB583577798D4C675C9540809A5EA66E2159927AEF77ED953B6BB565AD 7F0E58065151961F5BF958A954288E726566987F56E4949D76FE9041638754C6 591A593A579B8EB267358DFA8235524160F0581586FE5CE89E454FC4989D8BB9 5A2560765384627C904F9102997F6069800C513F80335C1499756D314E8C0000 B7 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008D3053D17F5A7B4F4F104E4F96006CD573D085E95E06756A7FFB6A0A77FE 94927E4151E170E653CD8FD483038D2972AF996D6CDB574A82B365B980AA623F 963259A84EFF8BBF7EBA653E83F2975E556198DE80A5532A8BFD542080BA5E9F 6CB88D3982AC915A54296C1B52067EB7575F711A6C7E7C89594B4EFD5FFF6124 7CAA4E305C0167AB87025CF0950B98CE75AF70FD902251AF7F1D8BBD594951E4 4F5B5426592B657780A45B75627662C28F905E456C1F7B264F0F4FD8670D0000 B8 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006D6E6DAA798F88B15F17752B629A8F854FEF91DC65A7812F81515E9C8150 8D74526F89868D4B590D50854ED8961C723681798D1F5BCC8BA3964459877F1A 54905676560E8BE565396982949976D66E895E727518674667D17AFF809D8D76 611F79C665628D635188521A94A27F38809B7EB25C976E2F67607BD9768B9AD8 818F7F947CD5641E95507A3F544A54E56B4C640162089E3D80F3759952729769 845B683C86E49601969494EC4E2A54047ED968398DDF801566F45E9A7FB90000 B9 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000057C2803F68975DE5653B529F606D9F9A4F9B8EAC516C5BAB5F135DE96C5E 62F18D21517194A952FE6C9F82DF72D757A267848D2D591F8F9C83C754957B8D 4F306CBD5B6459D19F1353E486CA9AA88C3780A16545987E56FA96C7522E74DC 52505BE1630289024E5662D0602A68FA51735B9851A089C27BA199867F5060EF 704C8D2F51495E7F901B747089C4572D78455F529F9F95FA8F689B3C8BE17678 684267DC8DEA8D35523D8F8A6EDA68CD950590ED56FD679C88F98FC754C80000 BA 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009AB85B696D776C264EA55BB39A87916361A890AF97E9542B6DB55BD251FD 558A7F557FF064BC634D65F161BE608D710A6C576C49592F676D822A58D5568E 8C6A6BEB90DD597D801753F76D695475559D837783CF683879BE548C4F555408 76D28C8996026CB36DB88D6B89109E648D3A563F9ED175D55F8872E0606854FC 4EA86A2A886160528F7054C470D886799E3F6D2A5B8F5F187EA255894FAF7334 543C539A5019540E547C4E4E5FFD745A58F6846B80E1877472D07CCA6E560000 BB 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005F27864E552C62A44E926CAA623782B154D7534E733E6ED1753B52125316 8BDD69D05F8A60006DEE574F6B2273AF68538FD87F13636260A3552475EA8C62 71156DA35BA65E7B8352614C9EC478FA87577C27768751F060F6714C66435E4C 604D8C0E707063258F895FBD606286D456DE6BC160946167534960E066668D3F 79FD4F1A70E96C478BB38BF27ED88364660F5A5A9B426D516DF78C416D3B4F19 706B83B7621660D1970D8D27797851FB573E57FA673A75787A3D79EF7B950000 BC 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000808C99658FF96FC08BA59E2159EC7EE97F095409678168D88F917C4D96C6 53CA602575BE6C7253735AC97EA7632451E0810A5DF184DF628051805B634F0E 796D524260B86D4E5BC45BC28BA18BB065E25FCC964559937EE77EAA560967B7 59394F735BB652A0835A988A8D3E753294BE50477A3C4EF767B69A7E5AC16B7C 76D1575A5C167B3A95F4714E517C80A9827059787F04832768C067EC78B17877 62E363617B804FED526A51CF835069DB92748DF58D3189C1952E7BAD4EF60000 BD 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000506582305251996F6E106E856DA75EFA50F559DC5C066D466C5F7586848B 686859568BB253209171964D854969127901712680F64EA490CA6D479A845A07 56BC640594F077EB4FA5811A72E189D2997A7F347EDE527F655991758F7F8F83 53EB7A9663ED63A5768679F888579636622A52AB8282685467706377776B7AED 6D017ED389E359D0621285C982A5754C501F4ECB75A58BEB5C4A5DFE7B4B65A4 91D14ECA6D25895F7D2795264EC58C288FDB9773664B79818FD170EC6D780000 BE 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005C3D52B283465162830E775B66769CB84EAC60CA7CBE7CB37ECF4E958B66 666F988897595883656C955C5F8475C997567ADF7ADE51C070AF7A9863EA7A76 7EA0739697ED4E4570784E5D915253A9655165E781FC8205548E5C31759A97A0 62D872D975BD5C459A7983CA5C40548077E94E3E6CAE805A62D2636E5DE85177 8DDD8E1E952F4FF153E560E770AC526763509E435A1F5026773753777EE26485 652B628963985014723589C951B38BC07EDD574783CC94A7519B541B5CFB0000 BF 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004FCA7AE36D5A90E19A8F55805496536154AF5F0063E9697751EF6168520A 582A52D8574E780D770B5EB761777CE0625B62974EA27095800362F770E49760 577782DB67EF68F578D5989779D158F354B353EF6E34514B523B5BA28BFE80AF 554357A660735751542D7A7A60505B5463A762A053E362635BC767AF54ED7A9F 82E691775E9388E4593857AE630E8DE880EF57577B774FA95FEB5BBD6B3E5321 7B5072C2684677FF773665F751B54E8F76D45CBF7AA58475594E9B4150800000 C0 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000998861276E8357646606634656F062EC62695ED39614578362C955878721 814A8FA3556683B167658D5684DD5A6A680F62E67BEE961151706F9C8C3063FD 89C861D27F0670C26EE57405699472FC5ECA90CE67176D6A635E52B372628001 4F6C59E5916A70D96D9D52D24E5096F7956D857E78CA7D2F5121579264C2808B 7C7B6CEA68F1695E51B7539868A872819ECE7BF172F879BB6F137406674E91CC 9CA4793C83898354540F68174E3D538952B1783E5386522950884F8B4FD00000 C1 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000075E27ACB7C926CA596B6529B748354E94FE9805483B28FDE95705EC9601C 6D9F5E18655B813894FE604B70BC7EC37CAE51C968817CB1826F4E248F8691CF 667E4EAE8C0564A9804A50DA759771CE5BE58FBD6F664E86648295635ED66599 521788C270C852A3730E7433679778F797164E3490BB9CDE6DCB51DB8D41541D 62CE73B283F196F69F8494C34F367F9A51CC707596755CAD988653E64EE46E9C 740969B4786B998F7559521876246D4167F3516D9F99804B54997B3C7ABF0000 C2 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009686578462E29647697C5A0464027BD36F0F964B82A6536298855E907089 63B35364864F9C819E93788C97328DEF8D429E7F6F5E79845F559646622E9A74 541594DD4FA365C55C655C617F1586516C2F5F8B73876EE47EFF5CE6631B5B6A 6EE653754E7163A0756562A18F6E4F264ED16CA67EB68BBA841D87BA7F57903B 95237BA99AA188F8843D6D1B9A867EDC59889EBB739B780186829A6C9A82561B 541757CB4E709EA653568FC881097792999286EE6EE1851366FC61626F2B0000 C3 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008C298292832B76F26C135FD983BD732B8305951A6BDB77DB94C6536F8302 51925E3D8C8C8D384E4873AB679A68859176970971646CA177095A9295416BCF 7F8E66275BD059B95A9A95E895F74EEC840C84996AAC76DF9530731B68A65B5F 772F919A97617CDC8FF78C1C5F257C7379D889C56CCC871C5BC65E4268C97720 7EF55195514D52C95A297F05976282D763CF778485D079D26E3A5E9959998511 706D6C1162BF76BF654F60AF95FD660E879F9E2394ED540D547D8C2C64780000 C4 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000647986116A21819C78E864699B5462B9672B83AB58A89ED86CAB6F205BDE 964C8C0B725F67D062C772614EA959C66BCD589366AE5E5552DF6155672876EE 776672677A4662FF54EA545094A090A35A1C7EB36C164E435976801059485357 753796BE56CA63208111607C95F96DD65462998151855AE980FD59AE9713502A 6CE55C3C62DF4F60533F817B90066EBA852B62C85E7478BE64B5637B5FF55A18 917F9E1F5C3F634F80425B7D556E954A954D6D8560A867E072DE51DD5B810000 C5 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000062E76CDE725B626D94AE7EBD81136D53519C5F04597452AA601259736696 8650759F632A61E67CEF8BFA54E66B279E256BB485D5545550766CA4556A8DB4 722C5E156015743662CD6392724C5F986E436D3E65006F5876D878D076FC7554 522453DB4E535E9E65C1802A80D6629B5486522870AE888D8DD16CE1547880DA 57F988F48D54966A914D4F696C9B55B776C6783062A870F96F8E5F6D84EC68DA 787C7BF781A8670B9E4F636778B0576F78129739627962AB528874356BD70000 C6 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005564813E75B276AE533975DE50FB5C418B6C7BC7504F72479A9798D86F02 74E27968648777A562FC98918D2B54C180584E52576A82F9840D5E7351ED74F6 8BC45C4F57616CFC98875A4678349B448FEB7C955256625194FA4EC683868461 83E984B257D467345703666E6D668C3166DD7011671F6B3A6816621A59BB4E03 51C46F0667D26C8F517668CB59476B6775665D0E81109F5065D7794879419A91 8D775C824E5E4F01542F5951780C56686C148FC45F036C7D6CE38BAB63900000 C7 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000060706D3D72756266948E94C553438FC17B7E4EDF8C264E7E9ED494B194B3 524D6F5C90636D458C3458115D4C6B206B4967AA545B81547F8C589985375F3A 62A26A47953965726084686577A74E544FA85DE7979864AC7FD85CED4FCF7A8D 520783044E14602F7A8394A64FB54EB279E6743452E482B964D279BD5BDD6C81 97528F7B6C22503E537F6E0564CE66746C3060C598778BF75E86743C7A7779CB 4E1890B174036C4256DA914B6CC58D8B533A86C666F28EAF5C489A716E200000 C8 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000053D65A369F8B8DA353BB570898A76743919B6CC9516875CA62F372AC5238 529D7F3A7094763853749E4A69B7786E96C088D97FA4713671C3518967D374E4 58E4651856B78BA9997662707ED560F970ED58EC4EC14EBA5FCD97E74EFB8BA4 5203598A7EAB62544ECD65E5620E833884C98363878D71946EB65BB97ED25197 63C967D480898339881551125B7A59828FB14E736C5D516589258F6F962E854A 745E951095F06DA682E55F3164926D128428816E9CC3585E8D5B4E0953C10000 C9 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004F1E6563685155D34E2764149A9A626B5AC2745F82726DA968EE50E7838E 7802674052396C997EB150BB5565715E7B5B665273CA82EB67495C715220717D 886B95EA965564C58D6181B355846C5562477F2E58924F2455468D4F664C4E0A 5C1A88F368A2634E7A0D70E7828D52FA97F65C1154E890B57ECD59628D4A86C7 820C820D8D6664445C0461516D89793E8BBE78377533547B4F388EAB6DF15A20 7EC5795E6C885BA15A76751A80BE614E6E1758F0751F7525727253477EF30000 CA 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000770176DB526980DC57235E08593172EE65BD6E7F8BD75C388671534177F3 62FE65F64EC098DF86805B9E8BC653F277E24F7F5C4E9A7659CB5F0F793A58EB 4E1667FF4E8B62ED8A93901D52BF662F55DC566C90024ED54F8D91CA99706C0F 5E0260435BA489C68BD56536624B99965B885BFF6388552E53D77626517D852C 67A268B36B8A62928F9353D482126DD1758F4E668D4E5B70719F85AF669166D9 7F7287009ECD9F205C5E672F8FF06811675F620D7AD658855EB665706F310000 CB 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000060555237800D6454887075295E05681362F4971C53CC723D8C016C347761 7A0E542E77AC987A821C8BF47855671470C165AF64955636601D79C153F84E1D 6B7B80865BFA55E356DB4F3A4F3C99725DF3677E80386002988290015B8B8BBC 8BF5641C825864DE55FD82CF91654FD77D20901F7C9F50F358516EAF5BBF8BC9 80839178849C7B97867D968B968F7EE59AD3788E5C817A57904296A7795F5B59 635F7B0B84D168AD55067F2974107D2295016240584C4ED65B83597958540000 CC 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000736D631E8E4B8E0F80CE82D462AC53F06CF0915E592A60016C70574D644A 8D2A762B6EE9575B6A8075F06F6D8C2D8C0857666BEF889278B363A253F970AD 6C645858642A580268E0819B55107CD650188EBA6DCC8D9F70EB638F6D9B6ED4 7EE68404684390036DD896768BA85957727985E4817E75BC8A8A68AF52548E22 951163D098988E44557C4F5366FF568F60D56D9552435C4959296DFB586B7530 751C606C82148146631167618FE2773A8DF38D3494C15E165385542C70C30000 CD 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006C405EF7505C4EAD5EAD633A8247901A6850916E77B3540C94DC5F647AE5 687663457B527EDF75DB507762955934900F51F879C37A8156FE5F9290146D82 5C60571F541051546E4D56E263A89893817F8715892A9000541E5C6F81C062D6 625881319E3596409A6E9A7C692D59A562D3553E631654C786D96D3C5A0374E6 889C6B6A59168C4C5F2F6E7E73A9987D4E3870F75B8C7897633D665A769660CB 5B9B5A494E0781556C6A738B4EA167897F515F8065FA671B5FD859845A010000 CE 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005DCD5FAE537197E68FDD684556F4552F60DF4E3A6F4D7EF482C7840E59D4 4F1F4F2A5C3E7EAC672A851A5473754F80C355829B4F4F4D6E2D8C135C096170 536B761F6E29868A658795FB7EB9543B7A337D0A95EE55E17FC174EE631D8717 6DA17A9D621165A1536763E16C835DEB545C94A84E4C6C618BEC5C4B65E0829C 68A7543E54346BCB6B664E9463425348821E4F0D4FAE575E620A96FE66647269 52FF52A1609F8BEF661471996790897F785277FD6670563B54389521727A0000 CF 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007A00606F5E0C6089819D591560DC718470EF6EAA6C5072806A8488AD5E2D 4E605AB3559C94E36D177CFB9699620F7EC6778E867E5323971E8F9666875CE1 4FA072ED4E0B53A6590F54136380952851484ED99C9C7EA454B88D2488548237 95F26D8E5F265ACC663E966973B0732E53BF817A99857FA15BAA967796507EBF 76F853A2957699997BB189446E584E617FD479658BE660F354CD4EAB98795DF7 6A6150CF54118C618427785D9704524A54EE56A395006D885BB56DC666530000 D0 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005C0F5B5D6821809655787B11654869544E9B6B47874E978B534F631F643A 90AA659C80C18C10519968B0537887F961C86CC46CFB8C225C5185AA82AF950C 6B238F9B65B05FFB5FC34FE18845661F8165732960FA51745211578B5F6290A2 884C91925E78674F602759D3514451F680F853086C7996C4718A4F114FEE7F9E 673D55C5950879C088967EE3589F620C9700865A5618987B5F908BB884C49157 53D965ED5E8F755C60647D6E5A7F7EEA7EED8F6955A75BA360AC65CB73840000 D1 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009009766377297EDA9774859B5B667A7496EA884052CB718F5FAA65EC8BE2 5BFB9A6F5DE16B896C5B8BAD8BAF900A8FC5538B62BC9E269E2D54404E2B82BD 7259869C5D1688596DAF96C554D14E9A8BB6710954BD960970DF6DF976D04E25 781487125CA95EF68A00989C960E708E6CBF594463A9773C884D6F1482735830 71D5538C781A96C155015F6671305BB48C1A9A8C6B83592E9E2F79E76768626C 4F6F75A17F8A6D0B96336C274EF075D2517B68376F3E90808170599674760000 D2 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000064475C2790657A918C2359DA54AC8200836F898180006930564E80367237 91CE51B64E5F987563964E1A53F666F3814B591C6DB24E0058F9533B63D694F1 4F9D4F0A886398905937905779FB4EEA80F075916C825B9C59E85F5D69058681 501A5DF24E5977E34EE5827A6291661390915C794EBF5F7981C69038808475AB 4EA688D4610F6BC55FC64E4976CA6EA28BE38BAE8C0A8BD15F027FFC7FCC7ECE 8335836B56E06BB797F3963459FB541F94F66DEB5BC5996E5C395F1596900000 D3 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000537082F16A315A749E705E947F2883B984248425836787478FCE8D6276C8 5F719896786C662054DF62E54F6381C375C85EB896CD8E0A86F9548F6CF36D8C 6C38607F52C775285E7D4F1860A05FE75C24753190AE94C072B96CB96E389149 670953CB53F34F5191C98BF153C85E7C8FC26DE44E8E76C26986865E611A8206 4F594FDE903E9C7C61096E1D6E1496854E885A3196E84E0E5C7F79B95B878BED 7FBD738957DF828B90C15401904755BB5CEA5FA161086B3272F180B28A890000 D4 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006D745BD388D598848C6B9A6D9E336E0A51A4514357A38881539F63F48F95 56ED54585706733F6E907F188FDC82D1613F6028966266F07EA68D8A8DC394A5 5CB37CA4670860A6960580184E9190E75300966851418FD08574915D665597F5 5B55531D78386742683D54C9707E5BB08F7D518D572854B1651266828D5E8D43 810F846C906D7CDF51FF85FB67A365E96FA186A48E81566A90207682707671E5 8D2362E952196CFD8D3C600E589E618E66FE8D60624E55B36E23672D8F670000 D5 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000094E195F87728680569A8548B4E4D70B88BC86458658B5B857A84503A5BE8 77BB6BE18A797C986CBE76CF65A98F975D2D5C5586386808536062187AD96E5B 7EFD6A1F7AE05F706F335F20638C6DA867564E085E108D264ED780C07634969C 62DB662D627E6CBC8D7571677F695146808753EC906E629854F286F08F998005 951785178FD96D5973CD659F771F7504782781FB8D1E94884FA6679575B98BCA 9707632F9547963584B8632377415F8172F04E896014657462EF6B63653F0000 D6 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005E2775C790D18BC1829D679D652F5431871877E580A281026C414E4B7EC7 804C76F4690D6B966267503C4F84574063076B628DBE53EA65E87EB85FD7631A 63B781F381F47F6E5E1C5CD95236667A79E97A1A8D28709975D46EDE6CBB7A92 4E2D76C55FE0949F88777EC879CD80BF91CD4EF24F17821F54685DDE6D328BCC 7CA58F7480985E1A549276B15B99663C9AA473E0682A86DB6731732A8BF88BDB 90107AF970DB716E62C477A956314E3B845767F152A986C08D2E94F87B510000 D7 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004F4F6CE8795D9A7B6293722A62FD4E1378168F6C64B08D5A7BC668695E84 88C55986649E58EE72B6690E95258FFD8D5857607F008C0651C6634962D95353 684C74228301914C55447740707C6D4A517954A88D4459FF6ECB6DC45B5C7D2B 4ED47C7D6ED35B5081EA6E0D5B579B0368D58E2A5B977EFC603B7EB590B98D70 594F63CD79DF8DB3535265CF79568BC5963B7EC494BB7E825634918967007F6A 5C0A907566285DE64F5067DE505A4F5C57505EA7000000000000000000000000 D8 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004E8D4E0C51404E105EFF53454E154E984E1E9B325B6C56694E2879BA4E3F 53154E47592D723B536E6C1056DF80E499976BD3777E9F174E364E9F9F104E5C 4E694E9382885B5B556C560F4EC4538D539D53A353A553AE97658D5D531A53F5 5326532E533E8D5C5366536352025208520E522D5233523F5240524C525E5261 525C84AF527D528252815290529351827F544EBB4EC34EC94EC24EE84EE14EEB 4EDE4F1B4EF34F224F644EF54F254F274F094F2B4F5E4F6765384F5A4F5D0000 D9 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004F5F4F574F324F3D4F764F744F914F894F834F8F4F7E4F7B4FAA4F7C4FAC 4F944FE64FE84FEA4FC54FDA4FE34FDC4FD14FDF4FF85029504C4FF3502C500F 502E502D4FFE501C500C50255028507E504350555048504E506C507B50A550A7 50A950BA50D6510650ED50EC50E650EE5107510B4EDD6C3D4F584F654FCE9FA0 6C467C74516E5DFD9EC999985181591452F9530D8A07531051EB591951554EA0 51564EB3886E88A44EB5811488D279805B3488037FB851AB51B151BD51BC0000 DA 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000051C7519651A251A58BA08BA68BA78BAA8BB48BB58BB78BC28BC38BCB8BCF 8BCE8BD28BD38BD48BD68BD88BD98BDC8BDF8BE08BE48BE88BE98BEE8BF08BF3 8BF68BF98BFC8BFF8C008C028C048C078C0C8C0F8C118C128C148C158C168C19 8C1B8C188C1D8C1F8C208C218C258C278C2A8C2B8C2E8C2F8C328C338C358C36 5369537A961D962296219631962A963D963C964296499654965F9667966C9672 96749688968D969796B09097909B909D909990AC90A190B490B390B690BA0000 DB 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000090B890B090CF90C590BE90D090C490C790D390E690E290DC90D790DB90EB 90EF90FE91049122911E91239131912F913991439146520D594252A252AC52AD 52BE54FF52D052D652F053DF71EE77CD5EF451F551FC9B2F53B65F01755A5DEF 574C57A957A1587E58BC58C558D15729572C572A57335739572E572F575C573B 574257695785576B5786577C577B5768576D5776577357AD57A4578C57B257CF 57A757B4579357A057D557D857DA57D957D257B857F457EF57F857E457DD0000 DC 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000580B580D57FD57ED5800581E5819584458205865586C58815889589A5880 99A89F1961FF8279827D827F828F828A82A88284828E82918297829982AB82B8 82BE82B082C882CA82E3829882B782AE82CB82CC82C182A982B482A182AA829F 82C482CE82A482E1830982F782E4830F830782DC82F482D282D8830C82FB82D3 8311831A83068314831582E082D5831C8351835B835C83088392833C83348331 839B835E832F834F83478343835F834083178360832D833A8333836683650000 DD 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008368831B8369836C836A836D836E83B0837883B383B483A083AA8393839C 8385837C83B683A9837D83B8837B8398839E83A883BA83BC83C1840183E583D8 58078418840B83DD83FD83D6841C84388411840683D483DF840F840383F883F9 83EA83C583C0842683F083E1845C8451845A8459847384878488847A84898478 843C844684698476848C848E8431846D84C184CD84D084E684BD84D384CA84BF 84BA84E084A184B984B4849784E584E3850C750D853884F08539851F853A0000 DE 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008556853B84FF84FC8559854885688564855E857A77A285438572857B85A4 85A88587858F857985AE859C858585B985B785B085D385C185DC85FF86278605 86298616863C5EFE5F08593C594180375955595A5958530F5C225C255C2C5C34 624C626A629F62BB62CA62DA62D762EE632262F66339634B634363AD63F66371 637A638E63B4636D63AC638A636963AE63BC63F263F863E063FF63C463DE63CE 645263C663BE64456441640B641B6420640C64266421645E6484646D64960000 DF 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000647A64B764B8649964BA64C064D064D764E464E265096525652E5F0B5FD2 75195F11535F53F153FD53E953E853FB541254165406544B5452545354545456 54435421545754595423543254825494547754715464549A549B548454765466 549D54D054AD54C254B454D254A754A654D354D4547254A354D554BB54BF54CC 54D954DA54DC54A954AA54A454DD54CF54DE551B54E7552054FD551454F35522 5523550F55115527552A5567558F55B55549556D55415555553F5550553C0000 E0 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005537555655755576557755335530555C558B55D2558355B155B955885581 559F557E55D65591557B55DF55BD55BE5594559955EA55F755C9561F55D155EB 55EC55D455E655DD55C455EF55E555F255F355CC55CD55E855F555E48F94561E 5608560C56015624562355FE56005627562D565856395657562C564D56625659 565C564C5654568656645671566B567B567C5685569356AF56D456D756DD56E1 56F556EB56F956FF5704570A5709571C5E0F5E195E145E115E315E3B5E3C0000 E1 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005E375E445E545E5B5E5E5E615C8C5C7A5C8D5C905C965C885C985C995C91 5C9A5C9C5CB55CA25CBD5CAC5CAB5CB15CA35CC15CB75CC45CD25CE45CCB5CE5 5D025D035D275D265D2E5D245D1E5D065D1B5D585D3E5D345D3D5D6C5D5B5D6F 5D5D5D6B5D4B5D4A5D695D745D825D995D9D8C735DB75DC55F735F775F825F87 5F895F8C5F955F995F9C5FA85FAD5FB55FBC88625F6172AD72B072B472B772B8 72C372C172CE72CD72D272E872EF72E972F272F472F7730172F3730372FA0000 E2 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000072FB731773137321730A731E731D7315732273397325732C733873317350 734D73577360736C736F737E821B592598E7592459029963996799689969996A 996B996C99749977997D998099849987998A998D999099919993999499955E80 5E915E8B5E965EA55EA05EB95EB55EBE5EB38D535ED25ED15EDB5EE85EEA81BA 5FC45FC95FD65FCF60035FEE60045FE15FE45FFE600560065FEA5FED5FF86019 60356026601B600F600D6029602B600A603F602160786079607B607A60420000 E3 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000606A607D6096609A60AD609D60836092608C609B60EC60BB60B160DD60D8 60C660DA60B4612061266115612360F46100610E612B614A617561AC619461A7 61B761D461F55FDD96B395E995EB95F195F395F595F695FC95FE960396049606 9608960A960B960C960D960F96129615961696179619961A4E2C723F62156C35 6C546C5C6C4A6CA36C856C906C946C8C6C686C696C746C766C866CA96CD06CD4 6CAD6CF76CF86CF16CD76CB26CE06CD66CFA6CEB6CEE6CB16CD36CEF6CFE0000 E4 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006D396D276D0C6D436D486D076D046D196D0E6D2B6D4D6D2E6D356D1A6D4F 6D526D546D336D916D6F6D9E6DA06D5E6D936D946D5C6D606D7C6D636E1A6DC7 6DC56DDE6E0E6DBF6DE06E116DE66DDD6DD96E166DAB6E0C6DAE6E2B6E6E6E4E 6E6B6EB26E5F6E866E536E546E326E256E446EDF6EB16E986EE06F2D6EE26EA5 6EA76EBD6EBB6EB76ED76EB46ECF6E8F6EC26E9F6F626F466F476F246F156EF9 6F2F6F366F4B6F746F2A6F096F296F896F8D6F8C6F786F726F7C6F7A6FD10000 E5 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006FC96FA76FB96FB66FC26FE16FEE6FDE6FE06FEF701A7023701B70397035 704F705E5B805B845B955B935BA55BB8752F9A9E64345BE45BEE89305BF08E47 8B078FB68FD38FD58FE58FEE8FE48FE98FE68FF38FE890059004900B90269011 900D9016902190359036902D902F9044905190529050906890589062905B66B9 9074907D908290889083908B5F505F575F565F585C3B54AB5C505C595B715C63 5C667FBC5F2A5F295F2D82745F3C9B3B5C6E59815983598D59A959AA59A30000 E6 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000599759CA59AB599E59A459D259B259AF59D759BE5A055A0659DD5A0859E3 59D859F95A0C5A095A325A345A115A235A135A405A675A4A5A555A3C5A625A75 80EC5AAA5A9B5A775A7A5ABE5AEB5AB25AD25AD45AB85AE05AE35AF15AD65AE6 5AD85ADC5B095B175B165B325B375B405C155C1C5B5A5B655B735B515B535B62 9A759A779A789A7A9A7F9A7D9A809A819A859A889A8A9A909A929A939A969A98 9A9B9A9C9A9D9A9F9AA09AA29AA39AA59AA77E9F7EA17EA37EA57EA87EA90000 E7 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007EAD7EB07EBE7EC07EC17EC27EC97ECB7ECC7ED07ED47ED77EDB7EE07EE1 7EE87EEB7EEE7EEF7EF17EF27F0D7EF67EFA7EFB7EFE7F017F027F037F077F08 7F0B7F0C7F0F7F117F127F177F197F1C7F1B7F1F7F217F227F237F247F257F26 7F277F2A7F2B7F2C7F2D7F2F7F307F317F327F337F355E7A757F5DDB753E9095 738E739173AE73A2739F73CF73C273D173B773B373C073C973C873E573D9987C 740A73E973E773DE73BA73F2740F742A745B7426742574287430742E742C0000 E8 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000741B741A7441745C7457745574597477746D747E749C748E748074817487 748B749E74A874A9749074A774D274BA97EA97EB97EC674C6753675E67486769 67A56787676A6773679867A7677567A8679E67AD678B6777677C67F0680967D8 680A67E967B0680C67D967B567DA67B367DD680067C367B867E2680E67C167FD 6832683368606861684E6862684468646883681D68556866684168676840683E 684A6849682968B5688F687468776893686B68C2696E68FC691F692068F90000 E9 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000692468F0690B6901695768E369106971693969606942695D6984696B6980 69986978693469CC6987698869CE6989696669636979699B69A769BB69AB69AD 69D469B169C169CA69DF699569E0698D69FF6A2F69ED6A176A186A6569F26A44 6A3E6AA06A506A5B6A356A8E6A796A3D6A286A586A7C6A916A906AA96A976AAB 733773526B816B826B876B846B926B936B8D6B9A6B9B6BA16BAA8F6B8F6D8F71 8F728F738F758F768F788F778F798F7A8F7C8F7E8F818F828F848F878F8B0000 EA 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008F8D8F8E8F8F8F988F9A8ECE620B6217621B621F6222622162256224622C 81E774EF74F474FF750F75117513653465EE65EF65F0660A6619677266036615 6600708566F7661D66346631663666358006665F66546641664F665666616657 66776684668C66A7669D66BE66DB66DC66E666E98D328D338D368D3B8D3D8D40 8D458D468D488D498D478D4D8D558D5989C789CA89CB89CC89CE89CF89D089D1 726E729F725D7266726F727E727F7284728B728D728F72926308633263B00000 EB 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000643F64D880046BEA6BF36BFD6BF56BF96C056C076C066C0D6C156C186C19 6C1A6C216C296C246C2A6C3265356555656B724D72527256723086625216809F 809C809380BC670A80BD80B180AB80AD80B480B780E780E880E980EA80DB80C2 80C480D980CD80D7671080DD80EB80F180F480ED810D810E80F280FC67158112 8C5A8136811E812C811881328148814C815381748159815A817181608169817C 817D816D8167584D5AB58188818281916ED581A381AA81CC672681CA81BB0000 EC 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000081C181A66B246B376B396B436B466B5998D198D298D398D598D998DA6BB3 5F406BC289F365909F51659365BC65C665C465C365CC65CE65D265D67080709C 7096709D70BB70C070B770AB70B170E870CA711071137116712F71317173715C 716871457172714A7178717A719871B371B571A871A071E071D471E771F9721D 7228706C7118716671B9623E623D624362486249793B794079467949795B795C 7953795A796279577960796F7967797A7985798A799A79A779B35FD15FD00000 ED 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000603C605D605A606760416059606360AB6106610D615D61A9619D61CB61D1 62068080807F6C936CF66DFC77F677F87800780978177818781165AB782D781C 781D7839783A783B781F783C7825782C78237829784E786D7856785778267850 7847784C786A789B7893789A7887789C78A178A378B278B978A578D478D978C9 78EC78F2790578F479137924791E79349F9B9EF99EFB9EFC76F17704770D76F9 77077708771A77227719772D7726773577387750775177477743775A77680000 EE 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000077627765777F778D777D7780778C7791779F77A077B077B577BD753A7540 754E754B7548755B7572757975837F587F617F5F8A487F687F747F717F797F81 7F7E76CD76E58832948594869487948B948A948C948D948F9490949494979495 949A949B949C94A394A494AB94AA94AD94AC94AF94B094B294B494B694B794B8 94B994BA94BC94BD94BF94C494C894C994CA94CB94CC94CD94CE94D094D194D2 94D594D694D794D994D894DB94DE94DF94E094E294E494E594E794E894EA0000 EF 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000094E994EB94EE94EF94F394F494F594F794F994FC94FD94FF950395029506 95079509950A950D950E950F951295139514951595169518951B951D951E951F 9522952A952B9529952C953195329534953695379538953C953E953F95429535 9544954595469549954C954E954F9552955395549556955795589559955B955E 955F955D95619562956495659566956795689569956A956B956C956F95719572 9573953A77E777EC96C979D579ED79E379EB7A065D477A037A027A1E7A140000 F0 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007A397A377A519ECF99A57A707688768E7693769976A474DE74E0752C9E20 9E229E289E299E2A9E2B9E2C9E329E319E369E389E379E399E3A9E3E9E419E42 9E449E469E479E489E499E4B9E4C9E4E9E519E559E579E5A9E5B9E5C9E5E9E63 9E669E679E689E699E6A9E6B9E6C9E719E6D9E7375927594759675A0759D75AC 75A375B375B475B875C475B175B075C375C275D675CD75E375E875E675E475EB 75E7760375F175FC75FF761076007605760C7617760A76257618761576190000 F1 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000761B763C762276207640762D7630763F76357643763E7633764D765E7654 765C7656766B766F7FCA7AE67A787A797A807A867A887A957AA67AA07AAC7AA8 7AAD7AB3886488698872887D887F888288A288C688B788BC88C988E288CE88E3 88E588F1891A88FC88E888FE88F0892189198913891B890A8934892B89368941 8966897B758B80E576B276B477DC801280148016801C80208022802580268027 802980288031800B803580438046804D80528069807189839878988098830000 F2 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009889988C988D988F9894989A989B989E989F98A198A298A598A6864D8654 866C866E867F867A867C867B86A8868D868B86AC869D86A786A386AA869386A9 86B686C486B586CE86B086BA86B186AF86C986CF86B486E986F186F286ED86F3 86D0871386DE86F486DF86D886D18703870786F88708870A870D87098723873B 871E8725872E871A873E87488734873187298737873F87828722877D877E877B 87608770874C876E878B87538763877C876487598765879387AF87A887D20000 F3 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000087C68788878587AD8797878387AB87E587AC87B587B387CB87D387BD87D1 87C087CA87DB87EA87E087EE8816881387FE880A881B88218839883C7F367F42 7F447F4582107AFA7AFD7B087B037B047B157B0A7B2B7B0F7B477B387B2A7B19 7B2E7B317B207B257B247B337B3E7B1E7B587B5A7B457B757B4C7B5D7B607B6E 7B7B7B627B727B717B907BA67BA77BB87BAC7B9D7BA87B857BAA7B9C7BA27BAB 7BB47BD17BC17BCC7BDD7BDA7BE57BE67BEA7C0C7BFE7BFC7C0F7C167C0B0000 F4 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007C1F7C2A7C267C387C417C4081FE82018202820481EC8844822182228223 822D822F8228822B8238823B82338234823E82448249824B824F825A825F8268 887E8885888888D888DF895E7F9D7F9F7FA77FAF7FB07FB27C7C65497C917C9D 7C9C7C9E7CA27CB27CBC7CBD7CC17CC77CCC7CCD7CC87CC57CD77CE8826E66A8 7FBF7FCE7FD57FE57FE17FE67FE97FEE7FF37CF87D777DA67DAE7E477E9B9EB8 9EB48D738D848D948D918DB18D678D6D8C478C49914A9150914E914F91640000 F5 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009162916191709169916F917D917E917291749179918C91859190918D9191 91A291A391AA91AD91AE91AF91B591B491BA8C559E7E8DB88DEB8E058E598E69 8DB58DBF8DBC8DBA8DC48DD68DD78DDA8DDE8DCE8DCF8DDB8DC68DEC8DF78DF8 8DE38DF98DFB8DE48E098DFD8E148E1D8E1F8E2C8E2E8E238E2F8E3A8E408E39 8E358E3D8E318E498E418E428E518E528E4A8E708E768E7C8E6F8E748E858E8F 8E948E908E9C8E9E8C788C828C8A8C858C988C94659B89D689DE89DA89DC0000 F6 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000089E589EB89EF8A3E8B26975396E996F396EF970697019708970F970E972A 972D9730973E9F809F839F859F869F879F889F899F8A9F8C9EFE9F0B9F0D96B9 96BC96BD96CE96D277BF96E0928E92AE92C8933E936A93CA938F943E946B9C7F 9C829C859C869C879C887A239C8B9C8E9C909C919C929C949C959C9A9C9B9C9E 9C9F9CA09CA19CA29CA39CA59CA69CA79CA89CA99CAB9CAD9CAE9CB09CB19CB2 9CB39CB49CB59CB69CB79CBA9CBB9CBC9CBD9CC49CC59CC69CC79CCA9CCB0000 F7 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 27 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000004100411041204130414041504010416041704180419041A041B041C041D 041E041F0420042104220423042404250426042704280429042A042B042C042D 042E042F00000000000000000000000000000000000000000000000000000000 000004300431043204330434043504510436043704380439043A043B043C043D 043E043F0440044104420443044404450446044704480449044A044B044C044D 044E044F00000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 28 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000010100E101CE00E0011300E9011B00E8012B00ED01D000EC014D00F301D2 00F2016B00FA01D400F901D601D801DA01DC00FC00EA00000000000000000000 0000000000000000000031053106310731083109310A310B310C310D310E310F 3110311131123113311431153116311731183119311A311B311C311D311E311F 3120312131223123312431253126312731283129000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 29 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000002500250125022503250425052506250725082509250A250B 250C250D250E250F2510251125122513251425152516251725182519251A251B 251C251D251E251F2520252125222523252425252526252725282529252A252B 252C252D252E252F2530253125322533253425352536253725382539253A253B 253C253D253E253F2540254125422543254425452546254725482549254A254B 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 30 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000554A963F57C3632854CE550954C07691764C853C77EE827E788D72319698 978D6C285B894FFA630966975CB880FA684880AE660276CE51F9655671AC7FF1 888450B2596561CA6FB382AD634C625253ED54277B06516B75A45DF462D48DCB 9776628A8019575D97387F627238767D67CF767E64464F708D2562DC7A176591 73ED642C6273822C9881677F7248626E62CC4F3474E3534A529E7ECA90A65E2E 6886699C81807ED168D278C5868C9551508D8C2482DE80DE5305891252650000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 31 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000858496F94FDD582199715B9D62B162A566B48C799C8D7206676F789160B2 535153178F8880CC8D1D94A1500D72C8590760EB711988AB595482EF672C7B28 5D297EF7752D6CF58E668FF8903C9F3B6BD491197B145F7C78A784D6853D6BD5 6BD96BD65E015E8775F995ED655D5F0A5FC58F9F58C181C2907F965B97AD8FB9 7F168D2C62414FBF53D8535E8FA88FA98FAB904D68075F6A819888689CD6618B 522B762A5F6C658C6FD26EE85BBE6448517551B067C44E1979C9997C70B30000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 32 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000075C55E7673BB83E064AD62E894B56CE2535A52C3640F94C27B944F2F5E1B 82368116818A6E246CCA9A736355535C54FA886557E04E0D5E036B657C3F90E8 601664E6731C88C16750624D8D22776C8E2991C75F6983DC8521991053C28695 6B8B60ED60E8707F82CD82314ED36CA785CF64CD7CD969FD66F9834953957B56 4FA7518C6D4B5C428E6D63D253C9832C833667E578B4643D5BDF5C945DEE8BE7 62C667F48C7A640063BA8749998B8C177F2094F24EA7961098A4660C73160000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 33 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000573A5C1D5E38957F507F80A05382655E7545553150218D856284949E671D 56326F6E5DE2543570928F66626F64A463A35F7B6F8890F481E38FB05C186668 5FF16C8996488D81886C649179F057CE6A59621054484E587A0B60E96F848BDA 627F901E9A8B79E4540375F4630153196C608FDF5F1B9A70803B9F7F4F885C3A 8D647FC565A570BD514551B2866B5D075BA062BD916C75748E0C7A2061017B79 4EC77EF877854E1181ED521D51FA6A7153A88E87950496CF6EC19664695A0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 34 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000784050A877D7641089E6590463E35DDD7A7F693D4F20823955984E3275AE 7A975E625E8A95EF521B5439708A6376952457826625693F918755076DF37EAF 882262337EF075B5832878C196CC8F9E614874F78BCD6B64523A8D506B21806A 847156F153064ECE4E1B51D17C97918B7C074FC38E7F7BE17A9C64675D1450AC 810676017CB96DEC7FE067515B585BF878CB64AE641363AA632B9519642D8FBE 7B5476296253592754466B7950A362345E266B864EE38D37888B5F85902E0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 35 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006020803D62C54E39535590F863B880C665E66C2E4F4660EE6DE18BDE5F39 86CB5F536321515A83616863520063638E4850125C9B79775BFC52307A3B60BC 905376D75FB75F9776848E6C706F767B7B4977AA51F3909358244F4E6EF48FEA 654C7B1B72C46DA47FDF5AE162B55E95573084827B2C5E1D5F1F90127F1498A0 63826EC7789870B95178975B57AB75354F4375385E9760E659606DC06BBF7889 53FC96D551CB52016389540A94938C038DCC7239789F87768FED8C0D53E00000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 36 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004E0176EF53EE948998769F0E952D5B9A8BA24E224E1C51AC846361C252A8 680B4F97606B51BB6D1E515C6296659796618C46901775D890FD77636BD2728A 72EC8BFB583577798D4C675C9540809A5EA66E2159927AEF77ED953B6BB565AD 7F0E58065151961F5BF958A954288E726566987F56E4949D76FE9041638754C6 591A593A579B8EB267358DFA8235524160F0581586FE5CE89E454FC4989D8BB9 5A2560765384627C904F9102997F6069800C513F80335C1499756D314E8C0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 37 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008D3053D17F5A7B4F4F104E4F96006CD573D085E95E06756A7FFB6A0A77FE 94927E4151E170E653CD8FD483038D2972AF996D6CDB574A82B365B980AA623F 963259A84EFF8BBF7EBA653E83F2975E556198DE80A5532A8BFD542080BA5E9F 6CB88D3982AC915A54296C1B52067EB7575F711A6C7E7C89594B4EFD5FFF6124 7CAA4E305C0167AB87025CF0950B98CE75AF70FD902251AF7F1D8BBD594951E4 4F5B5426592B657780A45B75627662C28F905E456C1F7B264F0F4FD8670D0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 38 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006D6E6DAA798F88B15F17752B629A8F854FEF91DC65A7812F81515E9C8150 8D74526F89868D4B590D50854ED8961C723681798D1F5BCC8BA3964459877F1A 54905676560E8BE565396982949976D66E895E727518674667D17AFF809D8D76 611F79C665628D635188521A94A27F38809B7EB25C976E2F67607BD9768B9AD8 818F7F947CD5641E95507A3F544A54E56B4C640162089E3D80F3759952729769 845B683C86E49601969494EC4E2A54047ED968398DDF801566F45E9A7FB90000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 39 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000057C2803F68975DE5653B529F606D9F9A4F9B8EAC516C5BAB5F135DE96C5E 62F18D21517194A952FE6C9F82DF72D757A267848D2D591F8F9C83C754957B8D 4F306CBD5B6459D19F1353E486CA9AA88C3780A16545987E56FA96C7522E74DC 52505BE1630289024E5662D0602A68FA51735B9851A089C27BA199867F5060EF 704C8D2F51495E7F901B747089C4572D78455F529F9F95FA8F689B3C8BE17678 684267DC8DEA8D35523D8F8A6EDA68CD950590ED56FD679C88F98FC754C80000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009AB85B696D776C264EA55BB39A87916361A890AF97E9542B6DB55BD251FD 558A7F557FF064BC634D65F161BE608D710A6C576C49592F676D822A58D5568E 8C6A6BEB90DD597D801753F76D695475559D837783CF683879BE548C4F555408 76D28C8996026CB36DB88D6B89109E648D3A563F9ED175D55F8872E0606854FC 4EA86A2A886160528F7054C470D886799E3F6D2A5B8F5F187EA255894FAF7334 543C539A5019540E547C4E4E5FFD745A58F6846B80E1877472D07CCA6E560000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3B 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005F27864E552C62A44E926CAA623782B154D7534E733E6ED1753B52125316 8BDD69D05F8A60006DEE574F6B2273AF68538FD87F13636260A3552475EA8C62 71156DA35BA65E7B8352614C9EC478FA87577C27768751F060F6714C66435E4C 604D8C0E707063258F895FBD606286D456DE6BC160946167534960E066668D3F 79FD4F1A70E96C478BB38BF27ED88364660F5A5A9B426D516DF78C416D3B4F19 706B83B7621660D1970D8D27797851FB573E57FA673A75787A3D79EF7B950000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3C 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000808C99658FF96FC08BA59E2159EC7EE97F095409678168D88F917C4D96C6 53CA602575BE6C7253735AC97EA7632451E0810A5DF184DF628051805B634F0E 796D524260B86D4E5BC45BC28BA18BB065E25FCC964559937EE77EAA560967B7 59394F735BB652A0835A988A8D3E753294BE50477A3C4EF767B69A7E5AC16B7C 76D1575A5C167B3A95F4714E517C80A9827059787F04832768C067EC78B17877 62E363617B804FED526A51CF835069DB92748DF58D3189C1952E7BAD4EF60000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3D 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000506582305251996F6E106E856DA75EFA50F559DC5C066D466C5F7586848B 686859568BB253209171964D854969127901712680F64EA490CA6D479A845A07 56BC640594F077EB4FA5811A72E189D2997A7F347EDE527F655991758F7F8F83 53EB7A9663ED63A5768679F888579636622A52AB8282685467706377776B7AED 6D017ED389E359D0621285C982A5754C501F4ECB75A58BEB5C4A5DFE7B4B65A4 91D14ECA6D25895F7D2795264EC58C288FDB9773664B79818FD170EC6D780000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3E 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005C3D52B283465162830E775B66769CB84EAC60CA7CBE7CB37ECF4E958B66 666F988897595883656C955C5F8475C997567ADF7ADE51C070AF7A9863EA7A76 7EA0739697ED4E4570784E5D915253A9655165E781FC8205548E5C31759A97A0 62D872D975BD5C459A7983CA5C40548077E94E3E6CAE805A62D2636E5DE85177 8DDD8E1E952F4FF153E560E770AC526763509E435A1F5026773753777EE26485 652B628963985014723589C951B38BC07EDD574783CC94A7519B541B5CFB0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 3F 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004FCA7AE36D5A90E19A8F55805496536154AF5F0063E9697751EF6168520A 582A52D8574E780D770B5EB761777CE0625B62974EA27095800362F770E49760 577782DB67EF68F578D5989779D158F354B353EF6E34514B523B5BA28BFE80AF 554357A660735751542D7A7A60505B5463A762A053E362635BC767AF54ED7A9F 82E691775E9388E4593857AE630E8DE880EF57577B774FA95FEB5BBD6B3E5321 7B5072C2684677FF773665F751B54E8F76D45CBF7AA58475594E9B4150800000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 40 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000998861276E8357646606634656F062EC62695ED39614578362C955878721 814A8FA3556683B167658D5684DD5A6A680F62E67BEE961151706F9C8C3063FD 89C861D27F0670C26EE57405699472FC5ECA90CE67176D6A635E52B372628001 4F6C59E5916A70D96D9D52D24E5096F7956D857E78CA7D2F5121579264C2808B 7C7B6CEA68F1695E51B7539868A872819ECE7BF172F879BB6F137406674E91CC 9CA4793C83898354540F68174E3D538952B1783E5386522950884F8B4FD00000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 41 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000075E27ACB7C926CA596B6529B748354E94FE9805483B28FDE95705EC9601C 6D9F5E18655B813894FE604B70BC7EC37CAE51C968817CB1826F4E248F8691CF 667E4EAE8C0564A9804A50DA759771CE5BE58FBD6F664E86648295635ED66599 521788C270C852A3730E7433679778F797164E3490BB9CDE6DCB51DB8D41541D 62CE73B283F196F69F8494C34F367F9A51CC707596755CAD988653E64EE46E9C 740969B4786B998F7559521876246D4167F3516D9F99804B54997B3C7ABF0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 42 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009686578462E29647697C5A0464027BD36F0F964B82A6536298855E907089 63B35364864F9C819E93788C97328DEF8D429E7F6F5E79845F559646622E9A74 541594DD4FA365C55C655C617F1586516C2F5F8B73876EE47EFF5CE6631B5B6A 6EE653754E7163A0756562A18F6E4F264ED16CA67EB68BBA841D87BA7F57903B 95237BA99AA188F8843D6D1B9A867EDC59889EBB739B780186829A6C9A82561B 541757CB4E709EA653568FC881097792999286EE6EE1851366FC61626F2B0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 43 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008C298292832B76F26C135FD983BD732B8305951A6BDB77DB94C6536F8302 51925E3D8C8C8D384E4873AB679A68859176970971646CA177095A9295416BCF 7F8E66275BD059B95A9A95E895F74EEC840C84996AAC76DF9530731B68A65B5F 772F919A97617CDC8FF78C1C5F257C7379D889C56CCC871C5BC65E4268C97720 7EF55195514D52C95A297F05976282D763CF778485D079D26E3A5E9959998511 706D6C1162BF76BF654F60AF95FD660E879F9E2394ED540D547D8C2C64780000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 44 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000647986116A21819C78E864699B5462B9672B83AB58A89ED86CAB6F205BDE 964C8C0B725F67D062C772614EA959C66BCD589366AE5E5552DF6155672876EE 776672677A4662FF54EA545094A090A35A1C7EB36C164E435976801059485357 753796BE56CA63208111607C95F96DD65462998151855AE980FD59AE9713502A 6CE55C3C62DF4F60533F817B90066EBA852B62C85E7478BE64B5637B5FF55A18 917F9E1F5C3F634F80425B7D556E954A954D6D8560A867E072DE51DD5B810000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 45 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000062E76CDE725B626D94AE7EBD81136D53519C5F04597452AA601259736696 8650759F632A61E67CEF8BFA54E66B279E256BB485D5545550766CA4556A8DB4 722C5E156015743662CD6392724C5F986E436D3E65006F5876D878D076FC7554 522453DB4E535E9E65C1802A80D6629B5486522870AE888D8DD16CE1547880DA 57F988F48D54966A914D4F696C9B55B776C6783062A870F96F8E5F6D84EC68DA 787C7BF781A8670B9E4F636778B0576F78129739627962AB528874356BD70000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 46 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005564813E75B276AE533975DE50FB5C418B6C7BC7504F72479A9798D86F02 74E27968648777A562FC98918D2B54C180584E52576A82F9840D5E7351ED74F6 8BC45C4F57616CFC98875A4678349B448FEB7C955256625194FA4EC683868461 83E984B257D467345703666E6D668C3166DD7011671F6B3A6816621A59BB4E03 51C46F0667D26C8F517668CB59476B6775665D0E81109F5065D7794879419A91 8D775C824E5E4F01542F5951780C56686C148FC45F036C7D6CE38BAB63900000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 47 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000060706D3D72756266948E94C553438FC17B7E4EDF8C264E7E9ED494B194B3 524D6F5C90636D458C3458115D4C6B206B4967AA545B81547F8C589985375F3A 62A26A47953965726084686577A74E544FA85DE7979864AC7FD85CED4FCF7A8D 520783044E14602F7A8394A64FB54EB279E6743452E482B964D279BD5BDD6C81 97528F7B6C22503E537F6E0564CE66746C3060C598778BF75E86743C7A7779CB 4E1890B174036C4256DA914B6CC58D8B533A86C666F28EAF5C489A716E200000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 48 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000053D65A369F8B8DA353BB570898A76743919B6CC9516875CA62F372AC5238 529D7F3A7094763853749E4A69B7786E96C088D97FA4713671C3518967D374E4 58E4651856B78BA9997662707ED560F970ED58EC4EC14EBA5FCD97E74EFB8BA4 5203598A7EAB62544ECD65E5620E833884C98363878D71946EB65BB97ED25197 63C967D480898339881551125B7A59828FB14E736C5D516589258F6F962E854A 745E951095F06DA682E55F3164926D128428816E9CC3585E8D5B4E0953C10000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 49 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004F1E6563685155D34E2764149A9A626B5AC2745F82726DA968EE50E7838E 7802674052396C997EB150BB5565715E7B5B665273CA82EB67495C715220717D 886B95EA965564C58D6181B355846C5562477F2E58924F2455468D4F664C4E0A 5C1A88F368A2634E7A0D70E7828D52FA97F65C1154E890B57ECD59628D4A86C7 820C820D8D6664445C0461516D89793E8BBE78377533547B4F388EAB6DF15A20 7EC5795E6C885BA15A76751A80BE614E6E1758F0751F7525727253477EF30000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000770176DB526980DC57235E08593172EE65BD6E7F8BD75C388671534177F3 62FE65F64EC098DF86805B9E8BC653F277E24F7F5C4E9A7659CB5F0F793A58EB 4E1667FF4E8B62ED8A93901D52BF662F55DC566C90024ED54F8D91CA99706C0F 5E0260435BA489C68BD56536624B99965B885BFF6388552E53D77626517D852C 67A268B36B8A62928F9353D482126DD1758F4E668D4E5B70719F85AF669166D9 7F7287009ECD9F205C5E672F8FF06811675F620D7AD658855EB665706F310000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4B 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000060555237800D6454887075295E05681362F4971C53CC723D8C016C347761 7A0E542E77AC987A821C8BF47855671470C165AF64955636601D79C153F84E1D 6B7B80865BFA55E356DB4F3A4F3C99725DF3677E80386002988290015B8B8BBC 8BF5641C825864DE55FD82CF91654FD77D20901F7C9F50F358516EAF5BBF8BC9 80839178849C7B97867D968B968F7EE59AD3788E5C817A57904296A7795F5B59 635F7B0B84D168AD55067F2974107D2295016240584C4ED65B83597958540000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4C 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000736D631E8E4B8E0F80CE82D462AC53F06CF0915E592A60016C70574D644A 8D2A762B6EE9575B6A8075F06F6D8C2D8C0857666BEF889278B363A253F970AD 6C645858642A580268E0819B55107CD650188EBA6DCC8D9F70EB638F6D9B6ED4 7EE68404684390036DD896768BA85957727985E4817E75BC8A8A68AF52548E22 951163D098988E44557C4F5366FF568F60D56D9552435C4959296DFB586B7530 751C606C82148146631167618FE2773A8DF38D3494C15E165385542C70C30000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4D 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006C405EF7505C4EAD5EAD633A8247901A6850916E77B3540C94DC5F647AE5 687663457B527EDF75DB507762955934900F51F879C37A8156FE5F9290146D82 5C60571F541051546E4D56E263A89893817F8715892A9000541E5C6F81C062D6 625881319E3596409A6E9A7C692D59A562D3553E631654C786D96D3C5A0374E6 889C6B6A59168C4C5F2F6E7E73A9987D4E3870F75B8C7897633D665A769660CB 5B9B5A494E0781556C6A738B4EA167897F515F8065FA671B5FD859845A010000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4E 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005DCD5FAE537197E68FDD684556F4552F60DF4E3A6F4D7EF482C7840E59D4 4F1F4F2A5C3E7EAC672A851A5473754F80C355829B4F4F4D6E2D8C135C096170 536B761F6E29868A658795FB7EB9543B7A337D0A95EE55E17FC174EE631D8717 6DA17A9D621165A1536763E16C835DEB545C94A84E4C6C618BEC5C4B65E0829C 68A7543E54346BCB6B664E9463425348821E4F0D4FAE575E620A96FE66647269 52FF52A1609F8BEF661471996790897F785277FD6670563B54389521727A0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 4F 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007A00606F5E0C6089819D591560DC718470EF6EAA6C5072806A8488AD5E2D 4E605AB3559C94E36D177CFB9699620F7EC6778E867E5323971E8F9666875CE1 4FA072ED4E0B53A6590F54136380952851484ED99C9C7EA454B88D2488548237 95F26D8E5F265ACC663E966973B0732E53BF817A99857FA15BAA967796507EBF 76F853A2957699997BB189446E584E617FD479658BE660F354CD4EAB98795DF7 6A6150CF54118C618427785D9704524A54EE56A395006D885BB56DC666530000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 50 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005C0F5B5D6821809655787B11654869544E9B6B47874E978B534F631F643A 90AA659C80C18C10519968B0537887F961C86CC46CFB8C225C5185AA82AF950C 6B238F9B65B05FFB5FC34FE18845661F8165732960FA51745211578B5F6290A2 884C91925E78674F602759D3514451F680F853086C7996C4718A4F114FEE7F9E 673D55C5950879C088967EE3589F620C9700865A5618987B5F908BB884C49157 53D965ED5E8F755C60647D6E5A7F7EEA7EED8F6955A75BA360AC65CB73840000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 51 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009009766377297EDA9774859B5B667A7496EA884052CB718F5FAA65EC8BE2 5BFB9A6F5DE16B896C5B8BAD8BAF900A8FC5538B62BC9E269E2D54404E2B82BD 7259869C5D1688596DAF96C554D14E9A8BB6710954BD960970DF6DF976D04E25 781487125CA95EF68A00989C960E708E6CBF594463A9773C884D6F1482735830 71D5538C781A96C155015F6671305BB48C1A9A8C6B83592E9E2F79E76768626C 4F6F75A17F8A6D0B96336C274EF075D2517B68376F3E90808170599674760000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 52 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000064475C2790657A918C2359DA54AC8200836F898180006930564E80367237 91CE51B64E5F987563964E1A53F666F3814B591C6DB24E0058F9533B63D694F1 4F9D4F0A886398905937905779FB4EEA80F075916C825B9C59E85F5D69058681 501A5DF24E5977E34EE5827A6291661390915C794EBF5F7981C69038808475AB 4EA688D4610F6BC55FC64E4976CA6EA28BE38BAE8C0A8BD15F027FFC7FCC7ECE 8335836B56E06BB797F3963459FB541F94F66DEB5BC5996E5C395F1596900000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 53 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000537082F16A315A749E705E947F2883B984248425836787478FCE8D6276C8 5F719896786C662054DF62E54F6381C375C85EB896CD8E0A86F9548F6CF36D8C 6C38607F52C775285E7D4F1860A05FE75C24753190AE94C072B96CB96E389149 670953CB53F34F5191C98BF153C85E7C8FC26DE44E8E76C26986865E611A8206 4F594FDE903E9C7C61096E1D6E1496854E885A3196E84E0E5C7F79B95B878BED 7FBD738957DF828B90C15401904755BB5CEA5FA161086B3272F180B28A890000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 54 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006D745BD388D598848C6B9A6D9E336E0A51A4514357A38881539F63F48F95 56ED54585706733F6E907F188FDC82D1613F6028966266F07EA68D8A8DC394A5 5CB37CA4670860A6960580184E9190E75300966851418FD08574915D665597F5 5B55531D78386742683D54C9707E5BB08F7D518D572854B1651266828D5E8D43 810F846C906D7CDF51FF85FB67A365E96FA186A48E81566A90207682707671E5 8D2362E952196CFD8D3C600E589E618E66FE8D60624E55B36E23672D8F670000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 55 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000094E195F87728680569A8548B4E4D70B88BC86458658B5B857A84503A5BE8 77BB6BE18A797C986CBE76CF65A98F975D2D5C5586386808536062187AD96E5B 7EFD6A1F7AE05F706F335F20638C6DA867564E085E108D264ED780C07634969C 62DB662D627E6CBC8D7571677F695146808753EC906E629854F286F08F998005 951785178FD96D5973CD659F771F7504782781FB8D1E94884FA6679575B98BCA 9707632F9547963584B8632377415F8172F04E896014657462EF6B63653F0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 56 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005E2775C790D18BC1829D679D652F5431871877E580A281026C414E4B7EC7 804C76F4690D6B966267503C4F84574063076B628DBE53EA65E87EB85FD7631A 63B781F381F47F6E5E1C5CD95236667A79E97A1A8D28709975D46EDE6CBB7A92 4E2D76C55FE0949F88777EC879CD80BF91CD4EF24F17821F54685DDE6D328BCC 7CA58F7480985E1A549276B15B99663C9AA473E0682A86DB6731732A8BF88BDB 90107AF970DB716E62C477A956314E3B845767F152A986C08D2E94F87B510000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 57 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004F4F6CE8795D9A7B6293722A62FD4E1378168F6C64B08D5A7BC668695E84 88C55986649E58EE72B6690E95258FFD8D5857607F008C0651C6634962D95353 684C74228301914C55447740707C6D4A517954A88D4459FF6ECB6DC45B5C7D2B 4ED47C7D6ED35B5081EA6E0D5B579B0368D58E2A5B977EFC603B7EB590B98D70 594F63CD79DF8DB3535265CF79568BC5963B7EC494BB7E825634918967007F6A 5C0A907566285DE64F5067DE505A4F5C57505EA7000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 58 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004E8D4E0C51404E105EFF53454E154E984E1E9B325B6C56694E2879BA4E3F 53154E47592D723B536E6C1056DF80E499976BD3777E9F174E364E9F9F104E5C 4E694E9382885B5B556C560F4EC4538D539D53A353A553AE97658D5D531A53F5 5326532E533E8D5C5366536352025208520E522D5233523F5240524C525E5261 525C84AF527D528252815290529351827F544EBB4EC34EC94EC24EE84EE14EEB 4EDE4F1B4EF34F224F644EF54F254F274F094F2B4F5E4F6765384F5A4F5D0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 59 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00004F5F4F574F324F3D4F764F744F914F894F834F8F4F7E4F7B4FAA4F7C4FAC 4F944FE64FE84FEA4FC54FDA4FE34FDC4FD14FDF4FF85029504C4FF3502C500F 502E502D4FFE501C500C50255028507E504350555048504E506C507B50A550A7 50A950BA50D6510650ED50EC50E650EE5107510B4EDD6C3D4F584F654FCE9FA0 6C467C74516E5DFD9EC999985181591452F9530D8A07531051EB591951554EA0 51564EB3886E88A44EB5811488D279805B3488037FB851AB51B151BD51BC0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000051C7519651A251A58BA08BA68BA78BAA8BB48BB58BB78BC28BC38BCB8BCF 8BCE8BD28BD38BD48BD68BD88BD98BDC8BDF8BE08BE48BE88BE98BEE8BF08BF3 8BF68BF98BFC8BFF8C008C028C048C078C0C8C0F8C118C128C148C158C168C19 8C1B8C188C1D8C1F8C208C218C258C278C2A8C2B8C2E8C2F8C328C338C358C36 5369537A961D962296219631962A963D963C964296499654965F9667966C9672 96749688968D969796B09097909B909D909990AC90A190B490B390B690BA0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5B 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000090B890B090CF90C590BE90D090C490C790D390E690E290DC90D790DB90EB 90EF90FE91049122911E91239131912F913991439146520D594252A252AC52AD 52BE54FF52D052D652F053DF71EE77CD5EF451F551FC9B2F53B65F01755A5DEF 574C57A957A1587E58BC58C558D15729572C572A57335739572E572F575C573B 574257695785576B5786577C577B5768576D5776577357AD57A4578C57B257CF 57A757B4579357A057D557D857DA57D957D257B857F457EF57F857E457DD0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5C 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000580B580D57FD57ED5800581E5819584458205865586C58815889589A5880 99A89F1961FF8279827D827F828F828A82A88284828E82918297829982AB82B8 82BE82B082C882CA82E3829882B782AE82CB82CC82C182A982B482A182AA829F 82C482CE82A482E1830982F782E4830F830782DC82F482D282D8830C82FB82D3 8311831A83068314831582E082D5831C8351835B835C83088392833C83348331 839B835E832F834F83478343835F834083178360832D833A8333836683650000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5D 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008368831B8369836C836A836D836E83B0837883B383B483A083AA8393839C 8385837C83B683A9837D83B8837B8398839E83A883BA83BC83C1840183E583D8 58078418840B83DD83FD83D6841C84388411840683D483DF840F840383F883F9 83EA83C583C0842683F083E1845C8451845A8459847384878488847A84898478 843C844684698476848C848E8431846D84C184CD84D084E684BD84D384CA84BF 84BA84E084A184B984B4849784E584E3850C750D853884F08539851F853A0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5E 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008556853B84FF84FC8559854885688564855E857A77A285438572857B85A4 85A88587858F857985AE859C858585B985B785B085D385C185DC85FF86278605 86298616863C5EFE5F08593C594180375955595A5958530F5C225C255C2C5C34 624C626A629F62BB62CA62DA62D762EE632262F66339634B634363AD63F66371 637A638E63B4636D63AC638A636963AE63BC63F263F863E063FF63C463DE63CE 645263C663BE64456441640B641B6420640C64266421645E6484646D64960000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 5F 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000647A64B764B8649964BA64C064D064D764E464E265096525652E5F0B5FD2 75195F11535F53F153FD53E953E853FB541254165406544B5452545354545456 54435421545754595423543254825494547754715464549A549B548454765466 549D54D054AD54C254B454D254A754A654D354D4547254A354D554BB54BF54CC 54D954DA54DC54A954AA54A454DD54CF54DE551B54E7552054FD551454F35522 5523550F55115527552A5567558F55B55549556D55415555553F5550553C0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 60 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005537555655755576557755335530555C558B55D2558355B155B955885581 559F557E55D65591557B55DF55BD55BE5594559955EA55F755C9561F55D155EB 55EC55D455E655DD55C455EF55E555F255F355CC55CD55E855F555E48F94561E 5608560C56015624562355FE56005627562D565856395657562C564D56625659 565C564C5654568656645671566B567B567C5685569356AF56D456D756DD56E1 56F556EB56F956FF5704570A5709571C5E0F5E195E145E115E315E3B5E3C0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 61 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00005E375E445E545E5B5E5E5E615C8C5C7A5C8D5C905C965C885C985C995C91 5C9A5C9C5CB55CA25CBD5CAC5CAB5CB15CA35CC15CB75CC45CD25CE45CCB5CE5 5D025D035D275D265D2E5D245D1E5D065D1B5D585D3E5D345D3D5D6C5D5B5D6F 5D5D5D6B5D4B5D4A5D695D745D825D995D9D8C735DB75DC55F735F775F825F87 5F895F8C5F955F995F9C5FA85FAD5FB55FBC88625F6172AD72B072B472B772B8 72C372C172CE72CD72D272E872EF72E972F272F472F7730172F3730372FA0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 62 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000072FB731773137321730A731E731D7315732273397325732C733873317350 734D73577360736C736F737E821B592598E7592459029963996799689969996A 996B996C99749977997D998099849987998A998D999099919993999499955E80 5E915E8B5E965EA55EA05EB95EB55EBE5EB38D535ED25ED15EDB5EE85EEA81BA 5FC45FC95FD65FCF60035FEE60045FE15FE45FFE600560065FEA5FED5FF86019 60356026601B600F600D6029602B600A603F602160786079607B607A60420000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 63 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000606A607D6096609A60AD609D60836092608C609B60EC60BB60B160DD60D8 60C660DA60B4612061266115612360F46100610E612B614A617561AC619461A7 61B761D461F55FDD96B395E995EB95F195F395F595F695FC95FE960396049606 9608960A960B960C960D960F96129615961696179619961A4E2C723F62156C35 6C546C5C6C4A6CA36C856C906C946C8C6C686C696C746C766C866CA96CD06CD4 6CAD6CF76CF86CF16CD76CB26CE06CD66CFA6CEB6CEE6CB16CD36CEF6CFE0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 64 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006D396D276D0C6D436D486D076D046D196D0E6D2B6D4D6D2E6D356D1A6D4F 6D526D546D336D916D6F6D9E6DA06D5E6D936D946D5C6D606D7C6D636E1A6DC7 6DC56DDE6E0E6DBF6DE06E116DE66DDD6DD96E166DAB6E0C6DAE6E2B6E6E6E4E 6E6B6EB26E5F6E866E536E546E326E256E446EDF6EB16E986EE06F2D6EE26EA5 6EA76EBD6EBB6EB76ED76EB46ECF6E8F6EC26E9F6F626F466F476F246F156EF9 6F2F6F366F4B6F746F2A6F096F296F896F8D6F8C6F786F726F7C6F7A6FD10000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 65 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00006FC96FA76FB96FB66FC26FE16FEE6FDE6FE06FEF701A7023701B70397035 704F705E5B805B845B955B935BA55BB8752F9A9E64345BE45BEE89305BF08E47 8B078FB68FD38FD58FE58FEE8FE48FE98FE68FF38FE890059004900B90269011 900D9016902190359036902D902F9044905190529050906890589062905B66B9 9074907D908290889083908B5F505F575F565F585C3B54AB5C505C595B715C63 5C667FBC5F2A5F295F2D82745F3C9B3B5C6E59815983598D59A959AA59A30000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 66 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000599759CA59AB599E59A459D259B259AF59D759BE5A055A0659DD5A0859E3 59D859F95A0C5A095A325A345A115A235A135A405A675A4A5A555A3C5A625A75 80EC5AAA5A9B5A775A7A5ABE5AEB5AB25AD25AD45AB85AE05AE35AF15AD65AE6 5AD85ADC5B095B175B165B325B375B405C155C1C5B5A5B655B735B515B535B62 9A759A779A789A7A9A7F9A7D9A809A819A859A889A8A9A909A929A939A969A98 9A9B9A9C9A9D9A9F9AA09AA29AA39AA59AA77E9F7EA17EA37EA57EA87EA90000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 67 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007EAD7EB07EBE7EC07EC17EC27EC97ECB7ECC7ED07ED47ED77EDB7EE07EE1 7EE87EEB7EEE7EEF7EF17EF27F0D7EF67EFA7EFB7EFE7F017F027F037F077F08 7F0B7F0C7F0F7F117F127F177F197F1C7F1B7F1F7F217F227F237F247F257F26 7F277F2A7F2B7F2C7F2D7F2F7F307F317F327F337F355E7A757F5DDB753E9095 738E739173AE73A2739F73CF73C273D173B773B373C073C973C873E573D9987C 740A73E973E773DE73BA73F2740F742A745B7426742574287430742E742C0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 68 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000741B741A7441745C7457745574597477746D747E749C748E748074817487 748B749E74A874A9749074A774D274BA97EA97EB97EC674C6753675E67486769 67A56787676A6773679867A7677567A8679E67AD678B6777677C67F0680967D8 680A67E967B0680C67D967B567DA67B367DD680067C367B867E2680E67C167FD 6832683368606861684E6862684468646883681D68556866684168676840683E 684A6849682968B5688F687468776893686B68C2696E68FC691F692068F90000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 69 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000692468F0690B6901695768E369106971693969606942695D6984696B6980 69986978693469CC6987698869CE6989696669636979699B69A769BB69AB69AD 69D469B169C169CA69DF699569E0698D69FF6A2F69ED6A176A186A6569F26A44 6A3E6AA06A506A5B6A356A8E6A796A3D6A286A586A7C6A916A906AA96A976AAB 733773526B816B826B876B846B926B936B8D6B9A6B9B6BA16BAA8F6B8F6D8F71 8F728F738F758F768F788F778F798F7A8F7C8F7E8F818F828F848F878F8B0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00008F8D8F8E8F8F8F988F9A8ECE620B6217621B621F6222622162256224622C 81E774EF74F474FF750F75117513653465EE65EF65F0660A6619677266036615 6600708566F7661D66346631663666358006665F66546641664F665666616657 66776684668C66A7669D66BE66DB66DC66E666E98D328D338D368D3B8D3D8D40 8D458D468D488D498D478D4D8D558D5989C789CA89CB89CC89CE89CF89D089D1 726E729F725D7266726F727E727F7284728B728D728F72926308633263B00000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6B 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000643F64D880046BEA6BF36BFD6BF56BF96C056C076C066C0D6C156C186C19 6C1A6C216C296C246C2A6C3265356555656B724D72527256723086625216809F 809C809380BC670A80BD80B180AB80AD80B480B780E780E880E980EA80DB80C2 80C480D980CD80D7671080DD80EB80F180F480ED810D810E80F280FC67158112 8C5A8136811E812C811881328148814C815381748159815A817181608169817C 817D816D8167584D5AB58188818281916ED581A381AA81CC672681CA81BB0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6C 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000081C181A66B246B376B396B436B466B5998D198D298D398D598D998DA6BB3 5F406BC289F365909F51659365BC65C665C465C365CC65CE65D265D67080709C 7096709D70BB70C070B770AB70B170E870CA711071137116712F71317173715C 716871457172714A7178717A719871B371B571A871A071E071D471E771F9721D 7228706C7118716671B9623E623D624362486249793B794079467949795B795C 7953795A796279577960796F7967797A7985798A799A79A779B35FD15FD00000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6D 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000603C605D605A606760416059606360AB6106610D615D61A9619D61CB61D1 62068080807F6C936CF66DFC77F677F87800780978177818781165AB782D781C 781D7839783A783B781F783C7825782C78237829784E786D7856785778267850 7847784C786A789B7893789A7887789C78A178A378B278B978A578D478D978C9 78EC78F2790578F479137924791E79349F9B9EF99EFB9EFC76F17704770D76F9 77077708771A77227719772D7726773577387750775177477743775A77680000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6E 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000077627765777F778D777D7780778C7791779F77A077B077B577BD753A7540 754E754B7548755B7572757975837F587F617F5F8A487F687F747F717F797F81 7F7E76CD76E58832948594869487948B948A948C948D948F9490949494979495 949A949B949C94A394A494AB94AA94AD94AC94AF94B094B294B494B694B794B8 94B994BA94BC94BD94BF94C494C894C994CA94CB94CC94CD94CE94D094D194D2 94D594D694D794D994D894DB94DE94DF94E094E294E494E594E794E894EA0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 6F 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000094E994EB94EE94EF94F394F494F594F794F994FC94FD94FF950395029506 95079509950A950D950E950F951295139514951595169518951B951D951E951F 9522952A952B9529952C953195329534953695379538953C953E953F95429535 9544954595469549954C954E954F9552955395549556955795589559955B955E 955F955D95619562956495659566956795689569956A956B956C956F95719572 9573953A77E777EC96C979D579ED79E379EB7A065D477A037A027A1E7A140000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 70 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007A397A377A519ECF99A57A707688768E7693769976A474DE74E0752C9E20 9E229E289E299E2A9E2B9E2C9E329E319E369E389E379E399E3A9E3E9E419E42 9E449E469E479E489E499E4B9E4C9E4E9E519E559E579E5A9E5B9E5C9E5E9E63 9E669E679E689E699E6A9E6B9E6C9E719E6D9E7375927594759675A0759D75AC 75A375B375B475B875C475B175B075C375C275D675CD75E375E875E675E475EB 75E7760375F175FC75FF761076007605760C7617760A76257618761576190000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 71 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000761B763C762276207640762D7630763F76357643763E7633764D765E7654 765C7656766B766F7FCA7AE67A787A797A807A867A887A957AA67AA07AAC7AA8 7AAD7AB3886488698872887D887F888288A288C688B788BC88C988E288CE88E3 88E588F1891A88FC88E888FE88F0892189198913891B890A8934892B89368941 8966897B758B80E576B276B477DC801280148016801C80208022802580268027 802980288031800B803580438046804D80528069807189839878988098830000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 72 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009889988C988D988F9894989A989B989E989F98A198A298A598A6864D8654 866C866E867F867A867C867B86A8868D868B86AC869D86A786A386AA869386A9 86B686C486B586CE86B086BA86B186AF86C986CF86B486E986F186F286ED86F3 86D0871386DE86F486DF86D886D18703870786F88708870A870D87098723873B 871E8725872E871A873E87488734873187298737873F87828722877D877E877B 87608770874C876E878B87538763877C876487598765879387AF87A887D20000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 73 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000087C68788878587AD8797878387AB87E587AC87B587B387CB87D387BD87D1 87C087CA87DB87EA87E087EE8816881387FE880A881B88218839883C7F367F42 7F447F4582107AFA7AFD7B087B037B047B157B0A7B2B7B0F7B477B387B2A7B19 7B2E7B317B207B257B247B337B3E7B1E7B587B5A7B457B757B4C7B5D7B607B6E 7B7B7B627B727B717B907BA67BA77BB87BAC7B9D7BA87B857BAA7B9C7BA27BAB 7BB47BD17BC17BCC7BDD7BDA7BE57BE67BEA7C0C7BFE7BFC7C0F7C167C0B0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 74 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00007C1F7C2A7C267C387C417C4081FE82018202820481EC8844822182228223 822D822F8228822B8238823B82338234823E82448249824B824F825A825F8268 887E8885888888D888DF895E7F9D7F9F7FA77FAF7FB07FB27C7C65497C917C9D 7C9C7C9E7CA27CB27CBC7CBD7CC17CC77CCC7CCD7CC87CC57CD77CE8826E66A8 7FBF7FCE7FD57FE57FE17FE67FE97FEE7FF37CF87D777DA67DAE7E477E9B9EB8 9EB48D738D848D948D918DB18D678D6D8C478C49914A9150914E914F91640000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 75 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009162916191709169916F917D917E917291749179918C91859190918D9191 91A291A391AA91AD91AE91AF91B591B491BA8C559E7E8DB88DEB8E058E598E69 8DB58DBF8DBC8DBA8DC48DD68DD78DDA8DDE8DCE8DCF8DDB8DC68DEC8DF78DF8 8DE38DF98DFB8DE48E098DFD8E148E1D8E1F8E2C8E2E8E238E2F8E3A8E408E39 8E358E3D8E318E498E418E428E518E528E4A8E708E768E7C8E6F8E748E858E8F 8E948E908E9C8E9E8C788C828C8A8C858C988C94659B89D689DE89DA89DC0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 76 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000089E589EB89EF8A3E8B26975396E996F396EF970697019708970F970E972A 972D9730973E9F809F839F859F869F879F889F899F8A9F8C9EFE9F0B9F0D96B9 96BC96BD96CE96D277BF96E0928E92AE92C8933E936A93CA938F943E946B9C7F 9C829C859C869C879C887A239C8B9C8E9C909C919C929C949C959C9A9C9B9C9E 9C9F9CA09CA19CA29CA39CA59CA69CA79CA89CA99CAB9CAD9CAE9CB09CB19CB2 9CB39CB49CB59CB69CB79CBA9CBB9CBC9CBD9CC49CC59CC69CC79CCA9CCB0000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 77 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 00009CCC9CCD9CCE9CCF9CD09CD39CD49CD59CD79CD89CD99CDC9CDD9CDF9CE2 977C978597919792979497AF97AB97A397B297B49AB19AB09AB79E589AB69ABA 9ABC9AC19AC09AC59AC29ACB9ACC9AD19B459B439B479B499B489B4D9B5198E8 990D992E995599549ADF9AE19AE69AEF9AEB9AFB9AED9AF99B089B0F9B139B1F 9B239EBD9EBE7E3B9E829E879E889E8B9E9293D69E9D9E9F9EDB9EDC9EDD9EE0 9EDF9EE29EE99EE79EE59EEA9EEF9F229F2C9F2F9F399F379F3D9F3E9F440000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000

1 2 3 4 5 6 7 8 9 10 11 12	1 2 3 4 5 6 7 8 9 10 11 12	- +	# history.tcl -- # # Implementation of the history command. # # RCS: @(#) $Id: history.tcl,v 1.5 2001/05/17 08:18:56 hobbs Exp $ # RCS: @(#) $Id: history.tcl,v 1.5.14.1 2005/07/22 21:59:40 dgp Exp $ # # Copyright (c) 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. #
︙
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185	164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185	- + - +	# Side Effects: # Adds to the history list proc tcl::HistAdd {command {exec {}}} { variable history # Do not add empty commands to the history if {[string trim $command] == ""} { if {[string trim $command] eq ""} { return "" } set i [incr history(nextid)] set history($i) $command set j [incr history(oldest)] if {[info exists history($j)]} {unset history($j)} unset -nocomplain history($j) if {[string match e* $exec]} { return [uplevel #0 $command] } else { return {} } }
︙
194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214	194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214	- + - +	# If no limit is specified, the current limit is returned # # Side Effects: # Updates history(keep) if a limit is specified proc tcl::HistKeep {{limit {}}} { variable history if {[string length $limit] == 0} { if {$limit eq ""} { return $history(keep) } else { set oldold $history(oldest) set history(oldest) [expr {$history(nextid) - $limit}] for {} {$oldold <= $history(oldest)} {incr oldold} { if {[info exists history($oldold)]} {unset history($oldold)} unset -nocomplain history($oldold) } set history(keep) $limit } } # tcl::HistClear -- #
︙
242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267	242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266	- + - + -	# num (optional) the length of the history list to return # # Results: # A formatted history list proc tcl::HistInfo {{num {}}} { variable history if {$num == {}} { if {$num eq ""} { set num [expr {$history(keep) + 1}] } set result {} set newline "" for {set i [expr {$history(nextid) - $num + 1}]} \ {$i <= $history(nextid)} {incr i} { if {![info exists history($i)]} { continue } set cmd [string trimright $history($i) \ \n] set cmd [string map [list \n \n\t] [string trimright $history($i) \ \n]] regsub -all \n $cmd "\n\t" cmd append result $newline[format "%6d %s" $i $cmd] set newline \n } return $result } # tcl::HistRedo --
︙
277 278 279 280 281 282 283 284 285 286 287 288 289 290 291	276 277 278 279 280 281 282 283 284 285 286 287 288 289 290	- +	# Those of the command being redone. # # Side Effects: # Replaces the current history list item with the one being redone. proc tcl::HistRedo {{event -1}} { variable history if {[string length $event] == 0} { if {$event eq ""} { set event -1 } set i [HistIndex $event] if {$i == $history(nextid)} { return -code error "cannot redo the current event" } set cmd $history($i)
︙

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	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	- - + + - - + - - + + - + - - - - - - - - - + + + + + + + + + - - - - + + + + + - - + + + + + - - + + + - + + + +	# http.tcl -- # # Client-side HTTP for GET, POST, and HEAD commands. # These routines can be used in untrusted code that uses # Client-side HTTP for GET, POST, and HEAD commands. These routines can # be used in untrusted code that uses the Safesock security policy. These # the Safesock security policy. These procedures use a # callback interface to avoid using vwait, which is not # procedures use a callback interface to avoid using vwait, which is not # defined in the safe base. # # See the file "license.terms" for information on usage and # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: http.tcl,v 1.43 2002/10/03 13:34:32 dkf Exp $ # RCS: @(#) $Id: http.tcl,v 1.43.2.13 2006/10/06 05:56:48 hobbs Exp $ # Rough version history: # 1.0 Old http_get interface # 2.0 http:: namespace and http::geturl # 2.1 Added callbacks to handle arriving data, and timeouts # 2.2 Added ability to fetch into a channel # 2.3 Added SSL support, and ability to post from a channel # This version also cleans up error cases and eliminates the # "ioerror" status in favor of raising an error # 2.4 Added -binary option to http::geturl and charset element # to the state array. # 1.0 Old http_get interface. # 2.0 http:: namespace and http::geturl. # 2.1 Added callbacks to handle arriving data, and timeouts. # 2.2 Added ability to fetch into a channel. # 2.3 Added SSL support, and ability to post from a channel. This version # also cleans up error cases and eliminates the "ioerror" status in # favor of raising an error # 2.4 Added -binary option to http::geturl and charset element to the state # array. package require Tcl 8.2 # keep this in sync with pkgIndex.tcl # and with the install directories in Makefiles package provide http 2.4.2 package require Tcl 8.4 # Keep this in sync with pkgIndex.tcl and with the install directories # in Makefiles package provide http 2.5.3 namespace eval http { variable http array set http { -accept */* -proxyhost {} -proxyport {} -proxyfilter http::ProxyRequired -urlencoding utf-8 } set http(-useragent) "Tcl http client package [package provide http]" proc init {} { variable formMap variable alphanumeric a-zA-Z0-9 # Set up the map for quoting chars. RFC3986 Section 2.3 say percent # encode all except: "... percent-encoded octets in the ranges of ALPHA # (%41-%5A and %61-%7A), DIGIT (%30-%39), hyphen (%2D), period (%2E), # underscore (%5F), or tilde (%7E) should not be created by URI # producers ..." for {set i 0} {$i <= 256} {incr i} { set c [format %c $i] if {![string match \[$alphanumeric\] $c]} { set formMap($c) %[format %.2x $i] if {![string match {[-._~a-zA-Z0-9]} $c]} { set map($c) %[format %.2x $i] } } # These are handled specially set map(\n) %0d%0a array set formMap { " " + \n %0d%0a } variable formMap [array get map] } init variable urlTypes array set urlTypes { http {80 ::socket} } variable encodings [string tolower [encoding names]] # This can be changed, but iso8859-1 is the RFC standard. variable defaultCharset "iso8859-1" # Force RFC 3986 strictness in geturl url verification? Not for 8.4.x variable strict 0 namespace export geturl config reset wait formatQuery register unregister # Useful, but not exported: data size status code } # http::register -- #
︙
115 116 117 118 119 120 121 122 123 124 125 126 127 128 129	122 123 124 125 126 127 128 129 130 131 132 133 134 135 136	- +	if {[llength $args] == 0} { set result {} foreach name $options { lappend result $name $http($name) } return $result } regsub -all -- - $options {} options set options [string map {- ""} $options] set pat ^-([join $options |])$ if {[llength $args] == 1} { set flag [lindex $args 0] if {[regexp -- $pat $flag]} { return $http($flag) } else { return -code error "Unknown option $flag, must be: $usage"
︙
142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158	149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165	- + - +	# http::Finish -- # # Clean up the socket and eval close time callbacks # # Arguments: # token Connection token. # errormsg (optional) If set, forces status to error. # skipCB (optional) If set, don't call the -command callback. This # skipCB (optional) If set, don't call the -command callback. This # is useful when geturl wants to throw an exception instead # of calling the callback. That way, the same error isn't # of calling the callback. That way, the same error isn't # reported to two places. # # Side Effects: # Closes the socket proc http::Finish { token {errormsg ""} {skipCB 0}} { variable $token
︙
208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232	215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239	- + - - + + - - + +	# Establishes a connection to a remote url via http. # # Arguments: # url The http URL to goget. # args Option value pairs. Valid options include: # -blocksize, -validate, -headers, -timeout # Results: # Returns a token for this connection. # Returns a token for this connection. This token is the name of an array # This token is the name of an array that the caller should # unset to garbage collect the state. # that the caller should unset to garbage collect the state. proc http::geturl { url args } { variable http variable urlTypes variable defaultCharset variable strict # Initialize the state variable, an array. We'll return the # name of this array as the token for the transaction. # Initialize the state variable, an array. We'll return the name of this # array as the token for the transaction. if {![info exists http(uid)]} { set http(uid) 0 } set token [namespace current]::[incr http(uid)] variable $token upvar 0 $token state
︙
250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498	257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620	+ + + + + + + + - + - + - - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - + + + + + + + + + + + + + + - - + + - - + + - + - - - + + + - + - - + + - + - + - - + + - + - - + + - + - + - - + + - - + + - - - - - + + + + + - - - - - - - + + + + + + - - - + + - + - + - - + + - + - +	totalsize 0 querylength 0 queryoffset 0 type text/html body {} status "" http "" } # These flags have their types verified [Bug 811170] array set type { -binary boolean -blocksize integer -queryblocksize integer -validate boolean -timeout integer } set state(charset) $defaultCharset set options {-binary -blocksize -channel -command -handler -headers \ -progress -query -queryblocksize -querychannel -queryprogress\ -validate -timeout -type} set usage [join $options ", "] regsub -all -- - $options {} options set options [string map {- ""} $options] set pat ^-([join $options |])$ foreach {flag value} $args { if {[regexp $pat $flag]} { # Validate numbers if {[info exists state($flag)] && \ if {[info exists type($flag)] && \ [string is integer -strict $state($flag)] && \ ![string is integer -strict $value]} { ![string is $type($flag) -strict $value]} { unset $token return -code error "Bad value for $flag ($value), must be integer" return -code error "Bad value for $flag ($value), must be $type($flag)" } set state($flag) $value } else { unset $token return -code error "Unknown option $flag, can be: $usage" } } # Make sure -query and -querychannel aren't both specified set isQueryChannel [info exists state(-querychannel)] set isQuery [info exists state(-query)] if {$isQuery && $isQueryChannel} { unset $token return -code error "Can't combine -query and -querychannel options!" } # Validate URL, determine the server host and port, and check proxy case # Recognize user:pass@host URLs also, although we do not do anything with # that info yet. # URLs have basically four parts. # First, before the colon, is the protocol scheme (e.g. http) # Second, for HTTP-like protocols, is the authority # The authority is preceded by // and lasts up to (but not including) # the following / and it identifies up to four parts, of which only one, # the host, is required (if an authority is present at all). All other # parts of the authority (user name, password, port number) are optional. # Third is the resource name, which is split into two parts at a ? # The first part (from the single "/" up to "?") is the path, and the # second part (from that "?" up to "#") is the query. *HOWEVER*, we do # not need to separate them; we send the whole lot to the server. # Fourth is the fragment identifier, which is everything after the first # "#" in the URL. The fragment identifier MUST NOT be sent to the server # and indeed, we don't bother to validate it (it could be an error to # pass it in here, but it's cheap to strip). # # An example of a URL that has all the parts: # http://jschmoe:xyzzy@www.bogus.net:8000/foo/bar.tml?q=foo#changes # The "http" is the protocol, the user is "jschmoe", the password is # "xyzzy", the host is "www.bogus.net", the port is "8000", the path is # "/foo/bar.tml", the query is "q=foo", and the fragment is "changes". # # Note that the RE actually combines the user and password parts, as # recommended in RFC 3986. Indeed, that RFC states that putting passwords # in URLs is a Really Bad Idea, something with which I would agree utterly. # Also note that we do not currently support IPv6 addresses. # # From a validation perspective, we need to ensure that the parts of the # URL that are going to the server are correctly encoded. # This is only done if $::http::strict is true (default 0 for compat). if {![regexp -nocase {^(([^:]*)://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \ x prefix proto host y port srvurl]} { set URLmatcher {(?x) # this is _expanded_ syntax ^ (?: (\w+) : ) ? # <protocol scheme> (?: // (?: ( [^@/\#?]+ # <userinfo part of authority> ) @ )? ( [^/:\#?]+ ) # <host part of authority> (?: : (\d+) )? # <port part of authority> )? ( / [^\#?]* (?: \? [^\#?]* )?)? # <path> (including query) (?: \# (.*) )? # <fragment> $ } # Phase one: parse if {![regexp -- $URLmatcher $url -> proto user host port srvurl]} { unset $token return -code error "Unsupported URL: $url" } # Phase two: validate if {$host eq ""} { # Caller has to provide a host name; we do not have a "default host" # that would enable us to handle relative URLs. unset $token return -code error "Missing host part: $url" # Note that we don't check the hostname for validity here; if it's # invalid, we'll simply fail to resolve it later on. } if {$port ne "" && $port>65535} { unset $token return -code error "Invalid port number: $port" } # The user identification and resource identification parts of the URL can # have encoded characters in them; take care! if {$user ne ""} { # Check for validity according to RFC 3986, Appendix A set validityRE {(?xi) ^ (?: [-\w.~!$&'()*+,;=:] | %[0-9a-f][0-9a-f] )+ $ } if {$strict && ![regexp -- $validityRE $user]} { unset $token # Provide a better error message in this error case if {[regexp {(?i)%(?![0-9a-f][0-9a-f]).?.?} $user bad]} { return -code error \ "Illegal encoding character usage \"$bad\" in URL user" } return -code error "Illegal characters in URL user" } } if {$srvurl ne ""} { # Check for validity according to RFC 3986, Appendix A set validityRE {(?xi) ^ # Path part (already must start with / character) (?: [-\w.~!$&'()*+,;=:@/] | %[0-9a-f][0-9a-f] )* # Query part (optional, permits ? characters) (?: \? (?: [-\w.~!$&'()*+,;=:@/?] | %[0-9a-f][0-9a-f] )* )? $ } if {$strict && ![regexp -- $validityRE $srvurl]} { unset $token # Provide a better error message in this error case if {[regexp {(?i)%(?![0-9a-f][0-9a-f])..} $srvurl bad]} { return -code error \ "Illegal encoding character usage \"$bad\" in URL path" } return -code error "Illegal characters in URL path" } } else { set srvurl / } if {[string length $proto] == 0} { set proto http set url ${proto}://$url } if {![info exists urlTypes($proto)]} { unset $token return -code error "Unsupported URL type \"$proto\"" } set defport [lindex $urlTypes($proto) 0] set defcmd [lindex $urlTypes($proto) 1] if {[string length $port] == 0} { set port $defport } if {[string length $srvurl] == 0} { set srvurl / } if {[string length $proto] == 0} { set url http://$url } set state(url) $url if {![catch {$http(-proxyfilter) $host} proxy]} { set phost [lindex $proxy 0] set pport [lindex $proxy 1] } # OK, now reassemble into a full URL set url ${proto}:// if {$user ne ""} { append url $user append url @ } append url $host if {$port != $defport} { append url : $port } append url $srvurl # Don't append the fragment! set state(url) $url # If a timeout is specified we set up the after event # and arrange for an asynchronous socket connection. # If a timeout is specified we set up the after event and arrange for an # asynchronous socket connection. if {$state(-timeout) > 0} { set state(after) [after $state(-timeout) \ [list http::reset $token timeout]] set async -async } else { set async "" } # If we are using the proxy, we must pass in the full URL that # includes the server name. # If we are using the proxy, we must pass in the full URL that includes # the server name. if {[info exists phost] && [string length $phost]} { set srvurl $url set conStat [catch {eval $defcmd $async {$phost $pport}} s] } else { set conStat [catch {eval $defcmd $async {$host $port}} s] } if {$conStat} { if {$conStat} { # something went wrong while trying to establish the connection # Clean up after events and such, but DON'T call the command callback # (if available) because we're going to throw an exception from here # Something went wrong while trying to establish the connection. Clean # up after events and such, but DON'T call the command callback (if # available) because we're going to throw an exception from here # instead. Finish $token "" 1 cleanup $token return -code error $s } set state(sock) $s # Wait for the connection to complete # Wait for the connection to complete. if {$state(-timeout) > 0} { fileevent $s writable [list http::Connect $token] http::wait $token if {[string equal $state(status) "error"]} { # something went wrong while trying to establish the connection if {$state(status) eq "error"} { # Something went wrong while trying to establish the connection. # Clean up after events and such, but DON'T call the command # callback (if available) because we're going to throw an # callback (if available) because we're going to throw an # exception from here instead. set err [lindex $state(error) 0] cleanup $token return -code error $err } elseif {![string equal $state(status) "connect"]} { } elseif {$state(status) ne "connect"} { # Likely to be connection timeout return $token } set state(status) "" } # Send data in cr-lf format, but accept any line terminators fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize) # The following is disallowed in safe interpreters, but the socket # is already in non-blocking mode in that case. # The following is disallowed in safe interpreters, but the socket is # already in non-blocking mode in that case. catch {fconfigure $s -blocking off} set how GET if {$isQuery} { set state(querylength) [string length $state(-query)] if {$state(querylength) > 0} { set how POST set contDone 0 } else { # there's no query data # There's no query data. unset state(-query) set isQuery 0 } } elseif {$state(-validate)} { set how HEAD } elseif {$isQueryChannel} { set how POST # The query channel must be blocking for the async Write to # work properly. fconfigure $state(-querychannel) -blocking 1 -translation binary set contDone 0 } if {[catch { puts $s "$how $srvurl HTTP/1.0" puts $s "Accept: $http(-accept)" if {$port == $defport} { # Don't add port in this case, to handle broken servers. # [Bug #504508] # Don't add port in this case, to handle broken servers. [Bug # 504508] puts $s "Host: $host" } else { puts $s "Host: $host:$port" } puts $s "User-Agent: $http(-useragent)" foreach {key value} $state(-headers) { regsub -all \[\n\r\] $value {} value set value [string map [list \n "" \r ""] $value] set key [string trim $key] if {[string equal $key "Content-Length"]} { if {$key eq "Content-Length"} { set contDone 1 set state(querylength) $value } if {[string length $key]} { puts $s "$key: $value" } } if {$isQueryChannel && $state(querylength) == 0} { # Try to determine size of data in channel # If we cannot seek, the surrounding catch will trap us # Try to determine size of data in channel. If we cannot seek, the # surrounding catch will trap us set start [tell $state(-querychannel)] seek $state(-querychannel) 0 end set state(querylength) \ [expr {[tell $state(-querychannel)] - $start}] seek $state(-querychannel) $start } # Flush the request header and set up the fileevent that will # either push the POST data or read the response. # Flush the request header and set up the fileevent that will either # push the POST data or read the response. # # fileevent note: # # It is possible to have both the read and write fileevents active # at this point. The only scenario it seems to affect is a server # that closes the connection without reading the POST data. # (e.g., early versions TclHttpd in various error cases). # Depending on the platform, the client may or may not be able to # It is possible to have both the read and write fileevents active at # this point. The only scenario it seems to affect is a server that # closes the connection without reading the POST data. (e.g., early # versions TclHttpd in various error cases). Depending on the platform, # the client may or may not be able to get the response from the server # get the response from the server because of the error it will # get trying to write the post data. Having both fileevents active # changes the timing and the behavior, but no two platforms # (among Solaris, Linux, and NT) behave the same, and none # behave all that well in any case. Servers should always read thier # POST data if they expect the client to read their response. # because of the error it will get trying to write the post data. # Having both fileevents active changes the timing and the behavior, # but no two platforms (among Solaris, Linux, and NT) behave the same, # and none behave all that well in any case. Servers should always read # their POST data if they expect the client to read their response. if {$isQuery || $isQueryChannel} { puts $s "Content-Type: $state(-type)" if {!$contDone} { puts $s "Content-Length: $state(querylength)" } puts $s "" fconfigure $s -translation {auto binary} fileevent $s writable [list http::Write $token] } else { puts $s "" flush $s fileevent $s readable [list http::Event $token] } if {! [info exists state(-command)]} { # geturl does EVERYTHING asynchronously, so if the user # calls it synchronously, we just do a wait here. # geturl does EVERYTHING asynchronously, so if the user calls it # synchronously, we just do a wait here. wait $token if {[string equal $state(status) "error"]} { if {$state(status) eq "error"} { # Something went wrong, so throw the exception, and the # enclosing catch will do cleanup. return -code error [lindex $state(error) 0] } } } } err]} { # The socket probably was never connected, # or the connection dropped later. # The socket probably was never connected, or the connection dropped # later. # Clean up after events and such, but DON'T call the command callback # (if available) because we're going to throw an exception from here # instead. # if state(status) is error, it means someone's already called Finish # to do the above-described clean up. if {[string equal $state(status) "error"]} { if {$state(status) eq "error"} { Finish $token $err 1 } cleanup $token return -code error $err } return $token
︙
596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655	718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773	- + - - - - - + + - - - + + - +	# Side Effects # Write the socket and handle callbacks. proc http::Write {token} { variable $token upvar 0 $token state set s $state(sock) # Output a block. Tcl will buffer this if the socket blocks set done 0 if {[catch { # Catch I/O errors on dead sockets if {[info exists state(-query)]} { # Chop up large query strings so queryprogress callback # can give smooth feedback # Chop up large query strings so queryprogress callback can give # smooth feedback. puts -nonewline $s \ [string range $state(-query) $state(queryoffset) \ [expr {$state(queryoffset) + $state(-queryblocksize) - 1}]] incr state(queryoffset) $state(-queryblocksize) if {$state(queryoffset) >= $state(querylength)} { set state(queryoffset) $state(querylength) set done 1 } } else { # Copy blocks from the query channel set outStr [read $state(-querychannel) $state(-queryblocksize)] puts -nonewline $s $outStr incr state(queryoffset) [string length $outStr] if {[eof $state(-querychannel)]} { set done 1 } } } err]} { # Do not call Finish here, but instead let the read half of # the socket process whatever server reply there is to get. # Do not call Finish here, but instead let the read half of the socket # process whatever server reply there is to get. set state(posterror) $err set done 1 } if {$done} { catch {flush $s} fileevent $s writable {} fileevent $s readable [list http::Event $token] } # Callback to the client after we've completely handled everything # Callback to the client after we've completely handled everything. if {[string length $state(-queryprogress)]} { eval $state(-queryprogress) [list $token $state(querylength)\ $state(queryoffset)] } }
︙
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	786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818	- + - - + + + - - - - + + + +	upvar 0 $token state set s $state(sock) if {[eof $s]} { Eof $token return } if {[string equal $state(state) "header"]} { if {$state(state) eq "header"} { if {[catch {gets $s line} n]} { Finish $token $n } elseif {$n == 0} { variable encodings set state(state) body if {$state(-binary) || ![regexp -nocase ^text $state(type)] || \ [regexp gzip|compress $state(coding)]} { if {$state(-binary) || ![string match -nocase text* $state(type)] || [string match *gzip* $state(coding)] || [string match *compress* $state(coding)]} { # Turn off conversions for non-text data fconfigure $s -translation binary if {[info exists state(-channel)]} { fconfigure $state(-channel) -translation binary } } else { # If we are getting text, set the incoming channel's # encoding correctly. iso8859-1 is the RFC default, but # this could be any IANA charset. However, we only know # how to convert what we have encodings for. # If we are getting text, set the incoming channel's encoding # correctly. iso8859-1 is the RFC default, but this could be # any IANA charset. However, we only know how to convert what # we have encodings for. set idx [lsearch -exact $encodings \ [string tolower $state(charset)]] if {$idx >= 0} { fconfigure $s -encoding [lindex $encodings $idx] } } if {[info exists state(-channel)] && \
︙
712 713 714 715 716 717 718 719 720 721 722 723 724 725 726	831 832 833 834 835 836 837 838 839 840 841 842 843 844 845	- +	set state(totalsize) [string trim $length] } if {[regexp -nocase {^content-encoding:(.+)$} $line x coding]} { set state(coding) [string trim $coding] } if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} { lappend state(meta) $key [string trim $value] } elseif {[regexp ^HTTP $line]} { } elseif {[string match HTTP* $line]} { set state(http) $line } } } else { if {[catch { if {[info exists state(-handler)]} { set n [eval $state(-handler) {$s $token}]
︙
805 806 807 808 809 810 811 812 813 814 815 816 817 818 819	924 925 926 927 928 929 930 931 932 933 934 935 936 937 938	- +	# # Side Effects # Clean up the socket proc http::Eof {token} { variable $token upvar 0 $token state if {[string equal $state(state) "header"]} { if {$state(state) eq "header"} { # Premature eof set state(status) eof } else { set state(status) ok } set state(state) eof Finish $token
︙
839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904	958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029	- + - - - + + - + - + - - + + - - - - - - - - - + + + + + + + + + + + + + + + + - +	} return $state(status) } # http::formatQuery -- # # See documentaion for details. # See documentaion for details. Call http::formatQuery with an even # Call http::formatQuery with an even number of arguments, where # the first is a name, the second is a value, the third is another # name, and so on. # number of arguments, where the first is a name, the second is a value, # the third is another name, and so on. # # Arguments: # args A list of name-value pairs. # # Results: # TODO # TODO proc http::formatQuery {args} { set result "" set sep "" foreach i $args { append result $sep [mapReply $i] if {[string equal $sep "="]} { if {$sep eq "="} { set sep & } else { set sep = } } return $result } # http::mapReply -- # # Do x-www-urlencoded character mapping # # Arguments: # string The string the needs to be encoded # # Results: # The encoded string proc http::mapReply {string} { variable formMap variable alphanumeric variable http variable formMap # The spec says: "non-alphanumeric characters are replaced by '%HH'" # 1 leave alphanumerics characters alone # 2 Convert every other character to an array lookup # 3 Escape constructs that are "special" to the tcl parser # 4 "subst" the result, doing all the array substitutions regsub -all \[^$alphanumeric\] $string {$formMap(&)} string regsub -all {[][{})\\]\)} $string {\\&} string return [subst -nocommand $string] # The spec says: "non-alphanumeric characters are replaced by '%HH'". Use # a pre-computed map and [string map] to do the conversion (much faster # than [regsub]/[subst]). [Bug 1020491] if {$http(-urlencoding) ne ""} { set string [encoding convertto $http(-urlencoding) $string] return [string map $formMap $string] } set converted [string map $formMap $string] if {[string match "*\[\u0100-\uffff\]*" $converted]} { regexp {[\u0100-\uffff]} $converted badChar # Return this error message for maximum compatability... :^/ return -code error \ "can't read \"formMap($badChar)\": no such element in array" } return $converted } # http::ProxyRequired -- # Default proxy filter. # Default proxy filter. # # Arguments: # host The destination host # # Results: # The current proxy settings
︙

1 2 3 4 5 6 7 8 9 10 11 12

1 2 3 4 5 6 7 8 9 10 11 12

- - + +

# Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.2]} {return} package ifneeded http 2.4.2 [list tclPkgSetup $dir http 2.4.2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister}}}] if {![package vsatisfies [package provide Tcl] 8.4]} {return} package ifneeded http 2.5.3 [list tclPkgSetup $dir http 2.5.3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]

1 2 3 4 5 6 7 8 9 10 11 12 13	1 2 3 4 5 6 7 8 9 10 11 12 13	- +	# init.tcl -- # # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # # RCS: @(#) $Id: init.tcl,v 1.55 2002/11/23 01:41:35 hobbs Exp $ # RCS: @(#) $Id: init.tcl,v 1.55.2.6 2005/07/22 21:59:40 dgp Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
︙
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58	44 45 46 47 48 49 50 51 52 53 54 55 56 57 58	- +	set auto_path $env(TCLLIBPATH) } else { set auto_path "" } } namespace eval tcl { variable Dir if {[info library] != ""} { if {[info library] ne ""} { foreach Dir [list [info library] [file dirname [info library]]] { if {[lsearch -exact $::auto_path $Dir] < 0} { lappend ::auto_path $Dir } } } set Dir [file join [file dirname [file dirname \
︙
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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149	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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149	- + - + - + - + - + - - + + - + - + - +	} } } } # Windows specific end of initialization if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} { if {(![interp issafe]) && $tcl_platform(platform) eq "windows"} { namespace eval tcl { proc EnvTraceProc {lo n1 n2 op} { set x $::env($n2) set ::env($lo) $x set ::env([string toupper $lo]) $x } proc InitWinEnv {} { global env tcl_platform foreach p [array names env] { set u [string toupper $p] if {![string equal $u $p]} { if {$u ne $p} { switch -- $u { COMSPEC - PATH { if {![info exists env($u)]} { set env($u) $env($p) } trace variable env($p) w \ trace add variable env($p) write \ [namespace code [list EnvTraceProc $p]] trace variable env($u) w \ trace add variable env($u) write \ [namespace code [list EnvTraceProc $p]] } } } } if {![info exists env(COMSPEC)]} { if {[string equal $tcl_platform(os) "Windows NT"]} { if {$tcl_platform(os) eq "Windows NT"} { set env(COMSPEC) cmd.exe } else { set env(COMSPEC) command.com } } } InitWinEnv } } # Setup the unknown package handler package unknown tclPkgUnknown if {![interp issafe]} { # setup platform specific unknown package handlers if {[string equal $::tcl_platform(platform) "unix"] && \ [string equal $::tcl_platform(os) "Darwin"]} { if {$::tcl_platform(platform) eq "unix" && $::tcl_platform(os) eq "Darwin"} { package unknown [list tcl::MacOSXPkgUnknown [package unknown]] } if {[string equal $::tcl_platform(platform) "macintosh"]} { if {$::tcl_platform(platform) eq "macintosh"} { package unknown [list tcl::MacPkgUnknown [package unknown]] } } # Conditionalize for presence of exec. if {[llength [info commands exec]] == 0} { if {[namespace which -command exec] eq ""} { # Some machines, such as the Macintosh, do not have exec. Also, on all # platforms, safe interpreters do not have exec. set auto_noexec 1 } set errorCode "" set errorInfo "" # Define a log command (which can be overwitten to log errors # differently, specially when stderr is not available) if {[llength [info commands tclLog]] == 0} { if {[namespace which -command tclLog] eq ""} { proc tclLog {string} { catch {puts stderr $string} } } # unknown -- # This procedure is called when a Tcl command is invoked that doesn't
︙
185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201	185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209	+ + + + + + + + - +	} } # Save the values of errorCode and errorInfo variables, since they # may get modified if caught errors occur below. The variables will # be restored just before re-executing the missing command. # Safety check in case something unsets the variables # ::errorInfo or ::errorCode. [Bug 1063707] if {![info exists errorCode]} { set errorCode "" } if {![info exists errorInfo]} { set errorInfo "" } set savedErrorCode $errorCode set savedErrorInfo $errorInfo set name [lindex $args 0] set name $cmd if {![info exists auto_noload]} { # # Make sure we're not trying to load the same proc twice. # if {[info exists unknown_pending($name)]} { return -code error "self-referential recursion in \"unknown\" for command \"$name\""; }
︙
216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233	224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243	+ - - + + + - +	if {$code == 1} { # # Compute stack trace contribution from the [uplevel]. # Note the dependence on how Tcl_AddErrorInfo, etc. # construct the stack trace. # set cinfo $args set ellipsis "" if {[string length $cinfo] > 150} { set cinfo "[string range $cinfo 0 149]..." while {[string bytelength $cinfo] > 150} { set cinfo [string range $cinfo 0 end-1] set ellipsis "..." } append cinfo "\"\n (\"uplevel\" body line 1)" append cinfo $ellipsis "\"\n (\"uplevel\" body line 1)" append cinfo "\n invoked from within" append cinfo "\n\"uplevel 1 \$args\"" # # Try each possible form of the stack trace # and trim the extra contribution from the matching case # set expect "$msg\n while executing\n\"$cinfo"
︙
259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428	269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449	- + - + - + - + - + - + - - + + - + + + + + + + + + + + + + + + + + - + - - - - - + - - + - - + + + + + + + + + + + - + - - - - - - - + - - + - - - + - + - + - +	-errorinfo $einfo $msg } else { return -code $code $msg } } } if {([info level] == 1) && [string equal [info script] ""] \ if {([info level] == 1) && [info script] eq "" \ && [info exists tcl_interactive] && $tcl_interactive} { if {![info exists auto_noexec]} { set new [auto_execok $name] if {$new != ""} { if {$new ne ""} { set errorCode $savedErrorCode set errorInfo $savedErrorInfo set redir "" if {[string equal [info commands console] ""]} { if {[namespace which -command console] eq ""} { set redir ">&@stdout <@stdin" } return [uplevel 1 exec $redir $new [lrange $args 1 end]] } } set errorCode $savedErrorCode set errorInfo $savedErrorInfo if {[string equal $name "!!"]} { if {$name eq "!!"} { set newcmd [history event] } elseif {[regexp {^!(.+)$} $name dummy event]} { } elseif {[regexp {^!(.+)$} $name -> event]} { set newcmd [history event $event] } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} { } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name -> old new]} { set newcmd [history event -1] catch {regsub -all -- $old $newcmd $new newcmd} } if {[info exists newcmd]} { tclLog $newcmd history change $newcmd 0 return [uplevel 1 $newcmd] } set ret [catch {set cmds [info commands $name*]} msg] if {[string equal $name "::"]} { set ret [catch {set candidates [info commands $name*]} msg] if {$name eq "::"} { set name "" } if {$ret != 0} { return -code $ret -errorcode $errorCode \ "error in unknown while checking if \"$name\" is a unique command abbreviation: $msg" "error in unknown while checking if \"$name\" is\ a unique command abbreviation:\n$msg" } # Handle empty $name separately due to strangeness in [string first] if {$name eq ""} { if {[llength $candidates] != 1} { return -code error "empty command name \"\"" } return [uplevel 1 [lreplace $args 0 0 [lindex $candidates 0]]] } # Filter out bogus matches when $name contained # a glob-special char [Bug 946952] set cmds [list] foreach x $candidates { if {[string first $name $x] == 0} { lappend cmds $x } } if {[llength $cmds] == 1} { return [uplevel 1 [lreplace $args 0 0 $cmds]] return [uplevel 1 [lreplace $args 0 0 [lindex $cmds 0]]] } if {[llength $cmds]} { if {[string equal $name ""]} { return -code error "empty command name \"\"" } else { return -code error \ "ambiguous command name \"$name\": [lsort $cmds]" return -code error "ambiguous command name \"$name\": [lsort $cmds]" } } } return -code error "invalid command name \"$name\"" } # auto_load -- # Checks a collection of library directories to see if a procedure # is defined in one of them. If so, it sources the appropriate # library file to create the procedure. Returns 1 if it successfully # loaded the procedure, 0 otherwise. # # Arguments: # cmd - Name of the command to find and load. # namespace (optional) The namespace where the command is being used - must be # a canonical namespace as returned [namespace current] # for instance. If not given, namespace current is used. proc auto_load {cmd {namespace {}}} { global auto_index auto_oldpath auto_path if {[string length $namespace] == 0} { if {$namespace eq ""} { set namespace [uplevel 1 [list ::namespace current]] } set nameList [auto_qualify $cmd $namespace] # workaround non canonical auto_index entries that might be around # from older auto_mkindex versions lappend nameList $cmd foreach name $nameList { if {[info exists auto_index($name)]} { uplevel #0 $auto_index($name) return [expr {[info commands $name] != ""}] namespace eval :: $auto_index($name) # There's a couple of ways to look for a command of a given # name. One is to use # info commands $name # Unfortunately, if the name has glob-magic chars in it like * # or [], it may not match. For our purposes here, a better # route is to use # namespace which -command $name if {[namespace which -command $name] ne ""} { return 1 } } } if {![info exists auto_path]} { return 0 } if {![auto_load_index]} { return 0 } foreach name $nameList { if {[info exists auto_index($name)]} { uplevel #0 $auto_index($name) namespace eval :: $auto_index($name) # There's a couple of ways to look for a command of a given # name. One is to use # info commands $name # Unfortunately, if the name has glob-magic chars in it like * # or [], it may not match. For our purposes here, a better # route is to use # namespace which -command $name if {[namespace which -command $name] ne ""} { if { ![string equal [namespace which -command $name] ""] } { return 1 } } } return 0 } # auto_load_index -- # Loads the contents of tclIndex files on the auto_path directory # list. This is usually invoked within auto_load to load the index # of available commands. Returns 1 if the index is loaded, and 0 if # the index is already loaded and up to date. # # Arguments: # None. proc auto_load_index {} { global auto_index auto_oldpath auto_path errorInfo errorCode if {[info exists auto_oldpath] && \ if {[info exists auto_oldpath] && $auto_oldpath eq $auto_path} { [string equal $auto_oldpath $auto_path]} { return 0 } set auto_oldpath $auto_path # Check if we are a safe interpreter. In that case, we support only # newer format tclIndex files. set issafe [interp issafe] for {set i [expr {[llength $auto_path] - 1}]} {$i >= 0} {incr i -1} { set dir [lindex $auto_path $i] set f "" if {$issafe} { catch {source [file join $dir tclIndex]} } elseif {[catch {set f [open [file join $dir tclIndex]]}]} { continue } else { set error [catch { set id [gets $f] if {[string equal $id \ "# Tcl autoload index file, version 2.0"]} { if {$id eq "# Tcl autoload index file, version 2.0"} { eval [read $f] } elseif {[string equal $id "# Tcl autoload index file: each line identifies a Tcl"]} { } elseif {$id eq "# Tcl autoload index file: each line identifies a Tcl"} { while {[gets $f line] >= 0} { if {[string equal [string index $line 0] "#"] \ if {[string index $line 0] eq "#" || ([llength $line] != 2)} { continue } set name [lindex $line 0] set auto_index($name) \ "source [file join $dir [lindex $line 1]]" } } else { error "[file join $dir tclIndex] isn't a proper Tcl index file" } } msg] if {$f != ""} { if {$f ne ""} { close $f } if {$error} { error $msg $errorInfo $errorCode } } }
︙
453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488	474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509	- + - + - + - +	# Ignore namespace if the name starts with :: # Handle special case of only leading :: # Before each return case we give an example of which category it is # with the following form : # ( inputCmd, inputNameSpace) -> output if {[regexp {^::(.*)$} $cmd x tail]} { if {[string match ::* $cmd]} { if {$n > 1} { # ( ::foo::bar , * ) -> ::foo::bar return [list $cmd] } else { # ( ::global , * ) -> global return [list $tail] return [list [string range $cmd 2 end]] } } # Potentially returning 2 elements to try : # (if the current namespace is not the global one) if {$n == 0} { if {[string equal $namespace ::]} { if {$namespace eq "::"} { # ( nocolons , :: ) -> nocolons return [list $cmd] } else { # ( nocolons , ::sub ) -> ::sub::nocolons nocolons return [list ${namespace}::$cmd $cmd] } } elseif {[string equal $namespace ::]} { } elseif {$namespace eq "::"} { # ( foo::bar , :: ) -> ::foo::bar return [list ::$cmd] } else { # ( foo::bar , ::sub ) -> ::sub::foo::bar ::foo::bar return [list ${namespace}::$cmd ::$cmd] } }
︙
510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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	531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582	- - - - + + + - + - +	set ns [uplevel 1 [list ::namespace current]] set patternList [auto_qualify $pattern $ns] auto_load_index foreach pattern $patternList { foreach name [array names auto_index $pattern] { if {[string equal "" [info commands $name]] && [string equal [namespace qualifiers $pattern] \ [namespace qualifiers $name]]} { uplevel #0 $auto_index($name) if {([namespace which -command $name] eq "") && ([namespace qualifiers $pattern] eq [namespace qualifiers $name])} { namespace eval :: $auto_index($name) } } } } # auto_execok -- # # Returns string that indicates name of program to execute if # name corresponds to a shell builtin or an executable in the # Windows search path, or "" otherwise. Builds an associative # array auto_execs that caches information about previous checks, # for speed. # # Arguments: # name - Name of a command. if {[string equal windows $tcl_platform(platform)]} { if {$tcl_platform(platform) eq "windows"} { # Windows version. # # Note that info executable doesn't work under Windows, so we have to # look for files with .exe, .com, or .bat extensions. Also, the path # may be in the Path or PATH environment variables, and path # components are separated with semicolons, not colons as under Unix. # proc auto_execok name { global auto_execs env tcl_platform if {[info exists auto_execs($name)]} { return $auto_execs($name) } set auto_execs($name) "" set shellBuiltins [list cls copy date del erase dir echo mkdir \ md rename ren rmdir rd time type ver vol] if {[string equal $tcl_platform(os) "Windows NT"]} { if {$tcl_platform(os) eq "Windows NT"} { # NT includes the 'start' built-in lappend shellBuiltins "start" } if {[info exists env(PATHEXT)]} { # Add an initial ; to have the {} extension check first. set execExtensions [split ";$env(PATHEXT)" ";"] } else {
︙
585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613	605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633	- + - +	} set path "[file dirname [info nameof]];.;" if {[info exists env(WINDIR)]} { set windir $env(WINDIR) } if {[info exists windir]} { if {[string equal $tcl_platform(os) "Windows NT"]} { if {$tcl_platform(os) eq "Windows NT"} { append path "$windir/system32;" } append path "$windir/system;$windir;" } foreach var {PATH Path path} { if {[info exists env($var)]} { append path ";$env($var)" } } foreach dir [split $path {;}] { # Skip already checked directories if {[info exists checked($dir)] || [string equal {} $dir]} { continue } if {[info exists checked($dir)] || $dir eq {}} { continue } set checked($dir) {} foreach ext $execExtensions { set file [file join $dir ${name}${ext}] if {[file exists $file] && ![file isdirectory $file]} { return [set auto_execs($name) [list $file]] } }
︙
628 629 630 631 632 633 634 635 636 637 638 639 640 641 642	648 649 650 651 652 653 654 655 656 657 658 659 660 661 662	- +	if {[llength [file split $name]] != 1} { if {[file executable $name] && ![file isdirectory $name]} { set auto_execs($name) [list $name] } return $auto_execs($name) } foreach dir [split $env(PATH) :] { if {[string equal $dir ""]} { if {$dir eq ""} { set dir . } set file [file join $dir $name] if {[file executable $file] && ![file isdirectory $file]} { set auto_execs($name) [list $file] return $auto_execs($name) }
︙
659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726	679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747	- + - + - + - - + + + - + - + - +	# Arguments: # action - "renaming" or "copying" # src - source directory # dest - destination directory proc tcl::CopyDirectory {action src dest} { set nsrc [file normalize $src] set ndest [file normalize $dest] if {[string equal $action "renaming"]} { if {$action eq "renaming"} { # Can't rename volumes. We could give a more precise # error message here, but that would break the test suite. if {[lsearch -exact [file volumes] $nsrc] != -1} { return -code error "error $action \"$src\" to\ \"$dest\": trying to rename a volume or move a directory\ into itself" } } if {[file exists $dest]} { if {$nsrc == $ndest} { if {$nsrc eq $ndest} { return -code error "error $action \"$src\" to\ \"$dest\": trying to rename a volume or move a directory\ into itself" } if {[string equal $action "copying"]} { if {$action eq "copying"} { return -code error "error $action \"$src\" to\ \"$dest\": file already exists" } else { # Depending on the platform, and on the current # working directory, the directories '.', '..' # can be returned in various combinations. Anyway, # if any other file is returned, we must signal an error. set existing [glob -nocomplain -directory $dest * .*] eval [list lappend existing] \ [glob -nocomplain -directory $dest -type hidden * .*] eval [linsert \ [glob -nocomplain -directory $dest -type hidden * .*] 0 \ lappend existing] foreach s $existing { if {([file tail $s] != ".") && ([file tail $s] != "..")} { if {([file tail $s] ne ".") && ([file tail $s] ne "..")} { return -code error "error $action \"$src\" to\ \"$dest\": file already exists" } } } } else { if {[string first $nsrc $ndest] != -1} { set srclen [expr {[llength [file split $nsrc]] -1}] set ndest [lindex [file split $ndest] $srclen] if {$ndest == [file tail $nsrc]} { if {$ndest eq [file tail $nsrc]} { return -code error "error $action \"$src\" to\ \"$dest\": trying to rename a volume or move a directory\ into itself" } } file mkdir $dest } # Have to be careful to capture both visible and hidden files. # We will also be more generous to the file system and not # assume the hidden and non-hidden lists are non-overlapping. # # On Unix 'hidden' files begin with '.'. On other platforms # or filesystems hidden files may have other interpretations. set filelist [concat [glob -nocomplain -directory $src *] \ [glob -nocomplain -directory $src -types hidden *]] foreach s [lsort -unique $filelist] { if {([file tail $s] != ".") && ([file tail $s] != "..")} { if {([file tail $s] ne ".") && ([file tail $s] ne "..")} { file copy $s [file join $dest [file tail $s]] } } return }

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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167	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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169	- + - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	# msgcat.tcl -- # # This file defines various procedures which implement a # message catalog facility for Tcl programs. It should be # loaded with the command "package require msgcat". # # Copyright (c) 1998-2000 by Ajuba Solutions. # Copyright (c) 1998 by Mark Harrison. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: msgcat.tcl,v 1.17 2002/08/20 15:33:32 dgp Exp $ # RCS: @(#) $Id: msgcat.tcl,v 1.17.2.6 2006/09/10 18:23:45 dgp Exp $ package require Tcl 8.2 # When the version number changes, be sure to update the pkgIndex.tcl file, # and the installation directory in the Makefiles. package provide msgcat 1.3 package provide msgcat 1.3.4 namespace eval msgcat { namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \ mcunknown # Records the current locale as passed to mclocale variable Locale "" # Records the list of locales to search variable Loclist {} # Records the mapping between source strings and translated strings. The # array key is of the form "<locale>,<namespace>,<src>" and the value is # the translated string. array set Msgs {} # Map of language codes used in Windows registry to those of ISO-639 if { [string equal $::tcl_platform(platform) windows] } { array set WinRegToISO639 { 01 ar 0401 ar_SA 0801 ar_IQ 0c01 ar_EG 1001 ar_LY 1401 ar_DZ 1801 ar_MA 1c01 ar_TN 2001 ar_OM 2401 ar_YE 2801 ar_SY 2c01 ar_JO 3001 ar_LB 3401 ar_KW 3801 ar_AE 3c01 ar_BH 4001 ar_QA 02 bg 0402 bg_BG 03 ca 0403 ca_ES 04 zh 0404 zh_TW 0804 zh_CN 0c04 zh_HK 1004 zh_SG 1404 zh_MO 05 cs 0405 cs_CZ 06 da 0406 da_DK 07 de 0407 de_DE 0807 de_CH 0c07 de_AT 1007 de_LU 1407 de_LI 08 el 0408 el_GR 09 en 0409 en_US 0809 en_GB 0c09 en_AU 1009 en_CA 1409 en_NZ 1809 en_IE 1c09 en_ZA 2009 en_JM 2409 en_GD 2809 en_BZ 2c09 en_TT 3009 en_ZW 3409 en_PH 0a es 040a es_ES 080a es_MX 0c0a es_ES@modern 100a es_GT 140a es_CR 180a es_PA 1c0a es_DO 200a es_VE 240a es_CO 280a es_PE 2c0a es_AR 300a es_EC 340a es_CL 380a es_UY 3c0a es_PY 400a es_BO 440a es_SV 480a es_HN 4c0a es_NI 500a es_PR 0b fi 040b fi_FI 0c fr 040c fr_FR 080c fr_BE 0c0c fr_CA 100c fr_CH 140c fr_LU 180c fr_MC 0d he 040d he_IL 0e hu 040e hu_HU 0f is 040f is_IS 10 it 0410 it_IT 0810 it_CH 11 ja 0411 ja_JP 12 ko 0412 ko_KR 13 nl 0413 nl_NL 0813 nl_BE 14 no 0414 no_NO 0814 nn_NO 15 pl 0415 pl_PL 16 pt 0416 pt_BR 0816 pt_PT 17 rm 0417 rm_CH 18 ro 0418 ro_RO 19 ru 1a hr 041a hr_HR 081a sr_YU 0c1a sr_YU@cyrillic 1b sk 041b sk_SK 1c sq 041c sq_AL 1d sv 041d sv_SE 081d sv_FI 1e th 041e th_TH 1f tr 041f tr_TR 20 ur 0420 ur_PK 0820 ur_IN 21 id 0421 id_ID 22 uk 0422 uk_UA 23 be 0423 be_BY 24 sl 0424 sl_SI 25 et 0425 et_EE 26 lv 0426 lv_LV 27 lt 0427 lt_LT 28 tg 0428 tg_TJ 29 fa 0429 fa_IR 2a vi 042a vi_VN 2b hy 042b hy_AM 2c az 042c az_AZ@latin 082c az_AZ@cyrillic 2d eu 2e wen 042e wen_DE 2f mk 042f mk_MK 30 bnt 0430 bnt_TZ 31 ts 0431 ts_ZA 33 ven 0433 ven_ZA 34 xh 0434 xh_ZA 35 zu 0435 zu_ZA 36 af 0436 af_ZA 37 ka 0437 ka_GE 38 fo 0438 fo_FO 39 hi 0439 hi_IN 3a mt 043a mt_MT 3b se 043b se_NO 043c gd_UK 083c ga_IE 3d yi 043d yi_IL 3e ms 043e ms_MY 083e ms_BN 3f kk 043f kk_KZ 40 ky 0440 ky_KG 41 sw 0441 sw_KE 42 tk 0442 tk_TM 43 uz 0443 uz_UZ@latin 0843 uz_UZ@cyrillic 44 tt 0444 tt_RU 45 bn 0445 bn_IN 46 pa 0446 pa_IN 47 gu 0447 gu_IN 48 or 0448 or_IN 49 ta 4a te 044a te_IN 4b kn 044b kn_IN 4c ml 044c ml_IN 4d as 044d as_IN 4e mr 044e mr_IN 4f sa 044f sa_IN 50 mn 51 bo 0451 bo_CN 52 cy 0452 cy_GB 53 km 0453 km_KH 54 lo 0454 lo_LA 55 my 0455 my_MM 56 gl 0456 gl_ES 57 kok 0457 kok_IN 58 mni 0458 mni_IN 59 sd 5a syr 045a syr_TR 5b si 045b si_LK 5c chr 045c chr_US 5d iu 045d iu_CA 5e am 045e am_ET 5f ber 045f ber_MA 60 ks 0460 ks_PK 0860 ks_IN 61 ne 0461 ne_NP 0861 ne_IN 62 fy 0462 fy_NL 63 ps 64 tl 0464 tl_PH 65 div 0465 div_MV 66 bin 0466 bin_NG 67 ful 0467 ful_NG 68 ha 0468 ha_NG 69 nic 0469 nic_NG 6a yo 046a yo_NG 70 ibo 0470 ibo_NG 71 kau 0471 kau_NG 72 om 0472 om_ET 73 ti 0473 ti_ET 74 gn 0474 gn_PY 75 cpe 0475 cpe_US 76 la 0476 la_VA 77 so 0477 so_SO 78 sit 0478 sit_CN 79 pap 0479 pap_AN array set WinRegToISO639 { 01 ar 0401 ar_SA 0801 ar_IQ 0c01 ar_EG 1001 ar_LY 1401 ar_DZ 1801 ar_MA 1c01 ar_TN 2001 ar_OM 2401 ar_YE 2801 ar_SY 2c01 ar_JO 3001 ar_LB 3401 ar_KW 3801 ar_AE 3c01 ar_BH 4001 ar_QA 02 bg 0402 bg_BG 03 ca 0403 ca_ES 04 zh 0404 zh_TW 0804 zh_CN 0c04 zh_HK 1004 zh_SG 1404 zh_MO 05 cs 0405 cs_CZ 06 da 0406 da_DK 07 de 0407 de_DE 0807 de_CH 0c07 de_AT 1007 de_LU 1407 de_LI 08 el 0408 el_GR 09 en 0409 en_US 0809 en_GB 0c09 en_AU 1009 en_CA 1409 en_NZ 1809 en_IE 1c09 en_ZA 2009 en_JM 2409 en_GD 2809 en_BZ 2c09 en_TT 3009 en_ZW 3409 en_PH 0a es 040a es_ES 080a es_MX 0c0a es_ES@modern 100a es_GT 140a es_CR 180a es_PA 1c0a es_DO 200a es_VE 240a es_CO 280a es_PE 2c0a es_AR 300a es_EC 340a es_CL 380a es_UY 3c0a es_PY 400a es_BO 440a es_SV 480a es_HN 4c0a es_NI 500a es_PR 0b fi 040b fi_FI 0c fr 040c fr_FR 080c fr_BE 0c0c fr_CA 100c fr_CH 140c fr_LU 180c fr_MC 0d he 040d he_IL 0e hu 040e hu_HU 0f is 040f is_IS 10 it 0410 it_IT 0810 it_CH 11 ja 0411 ja_JP 12 ko 0412 ko_KR 13 nl 0413 nl_NL 0813 nl_BE 14 no 0414 no_NO 0814 nn_NO 15 pl 0415 pl_PL 16 pt 0416 pt_BR 0816 pt_PT 17 rm 0417 rm_CH 18 ro 0418 ro_RO 19 ru 1a hr 041a hr_HR 081a sr_YU 0c1a sr_YU@cyrillic 1b sk 041b sk_SK 1c sq 041c sq_AL 1d sv 041d sv_SE 081d sv_FI 1e th 041e th_TH 1f tr 041f tr_TR 20 ur 0420 ur_PK 0820 ur_IN 21 id 0421 id_ID 22 uk 0422 uk_UA 23 be 0423 be_BY 24 sl 0424 sl_SI 25 et 0425 et_EE 26 lv 0426 lv_LV 27 lt 0427 lt_LT 28 tg 0428 tg_TJ 29 fa 0429 fa_IR 2a vi 042a vi_VN 2b hy 042b hy_AM 2c az 042c az_AZ@latin 082c az_AZ@cyrillic 2d eu 2e wen 042e wen_DE 2f mk 042f mk_MK 30 bnt 0430 bnt_TZ 31 ts 0431 ts_ZA 33 ven 0433 ven_ZA 34 xh 0434 xh_ZA 35 zu 0435 zu_ZA 36 af 0436 af_ZA 37 ka 0437 ka_GE 38 fo 0438 fo_FO 39 hi 0439 hi_IN 3a mt 043a mt_MT 3b se 043b se_NO 043c gd_UK 083c ga_IE 3d yi 043d yi_IL 3e ms 043e ms_MY 083e ms_BN 3f kk 043f kk_KZ 40 ky 0440 ky_KG 41 sw 0441 sw_KE 42 tk 0442 tk_TM 43 uz 0443 uz_UZ@latin 0843 uz_UZ@cyrillic 44 tt 0444 tt_RU 45 bn 0445 bn_IN 46 pa 0446 pa_IN 47 gu 0447 gu_IN 48 or 0448 or_IN 49 ta 4a te 044a te_IN 4b kn 044b kn_IN 4c ml 044c ml_IN 4d as 044d as_IN 4e mr 044e mr_IN 4f sa 044f sa_IN 50 mn 51 bo 0451 bo_CN 52 cy 0452 cy_GB 53 km 0453 km_KH 54 lo 0454 lo_LA 55 my 0455 my_MM 56 gl 0456 gl_ES 57 kok 0457 kok_IN 58 mni 0458 mni_IN 59 sd 5a syr 045a syr_TR 5b si 045b si_LK 5c chr 045c chr_US 5d iu 045d iu_CA 5e am 045e am_ET 5f ber 045f ber_MA 60 ks 0460 ks_PK 0860 ks_IN 61 ne 0461 ne_NP 0861 ne_IN 62 fy 0462 fy_NL 63 ps 64 tl 0464 tl_PH 65 div 0465 div_MV 66 bin 0466 bin_NG 67 ful 0467 ful_NG 68 ha 0468 ha_NG 69 nic 0469 nic_NG 6a yo 046a yo_NG 70 ibo 0470 ibo_NG 71 kau 0471 kau_NG 72 om 0472 om_ET 73 ti 0473 ti_ET 74 gn 0474 gn_PY 75 cpe 0475 cpe_US 76 la 0476 la_VA 77 so 0477 so_SO 78 sit 0478 sit_CN 79 pap 0479 pap_AN } } } # msgcat::mc -- # # Find the translation for the given string based on the current # locale setting. Check the local namespace first, then look in each
︙
223 224 225 226 227 228 229 230 231 232 233 234 235 236 237	225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244	+ + + + + - +	set len [llength $args] if {$len > 1} { error {wrong # args: should be "mclocale ?newLocale?"} } if {$len == 1} { set newLocale [lindex $args 0] if {$newLocale ne [file tail $newLocale]} { return -code error "invalid newLocale value \"$newLocale\":\ could be path to unsafe code." } set Locale [string tolower [lindex $args 0]] set Locale [string tolower $newLocale] set Loclist {} set word "" foreach part [split $Locale _] { set word [string trimleft "${word}_${part}" _] set Loclist [linsert $Loclist 0 $word] } }
︙
291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306	298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313	- - + +	# the source string is used. # # Results: # Returns the new locale. proc msgcat::mcset {locale src {dest ""}} { variable Msgs if {[string equal $dest ""]} { set dest $src if {[llength [info level 0]] == 3} { ;# dest not specified set dest $src } set ns [uplevel 1 [list ::namespace current]] set Msgs([string tolower $locale],$ns,$src) $dest return $dest }
︙
393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434	400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462	- - + + + + - + + + + + + + + + + + + + + + + + + + + + - + -	# ^ # Match all the way to the beginning # ([^_.@]*) # Match "lanugage"; ends with _, ., or @ # (_([^.@]*))? # Match (optional) "territory"; starts with _ # ([.]([^@]*))? # Match (optional) "codeset"; starts with . # (@(.*))? # Match (optional) "modifier"; starts with @ # $ # Match all the way to the end # } $value -> language _ territory _ codeset _ modifier regexp {^([^_.@]*)(_([^.@]*))?([.]([^@]*))?(@(.*))?$} $value \ -> language _ territory _ codeset _ modifier if {![regexp {^([^_.@]+)(_([^.@]*))?([.]([^@]*))?(@(.*))?$} $value \ -> language _ territory _ codeset _ modifier]} { return -code error "invalid locale '$value': empty language part" } set ret $language if {[string length $territory]} { append ret _$territory } if {[string length $modifier]} { append ret _$modifier } return $ret } # Initialize the default locale proc msgcat::Init {} { # # set default locale, try to get from environment # foreach varName {LC_ALL LC_MESSAGES LANG} { if {[info exists ::env($varName)] && ![string equal "" $::env($varName)]} { mclocale [ConvertLocale $::env($varName)] if {![catch {mclocale [ConvertLocale $::env($varName)]}]} { return } } } # # On Darwin, fallback to current CFLocale identifier if available. # if {[string equal $::tcl_platform(os) Darwin] && [string equal $::tcl_platform(platform) unix] && [info exists ::tcl::mac::locale] && ![string equal $::tcl::mac::locale ""]} { if {![catch {mclocale [ConvertLocale $::tcl::mac::locale]}]} { return } } # # The rest of this routine is special processing for Windows; # all other platforms, get out now. # if { ![string equal $::tcl_platform(platform) windows] } { mclocale C return } # # On Windows, try to set locale depending on registry settings, # or fall back on locale of "C". Other platforms will return # or fall back on locale of "C". # when they fail to load the registry package. # set key {HKEY_CURRENT_USER\Control Panel\International} if {[catch {package require registry}] \ || [catch {registry get $key "locale"} locale]} { mclocale C return }
︙

1 2

1 2

- +

if {![package vsatisfies [package provide Tcl] 8.2]} {return} package ifneeded msgcat 1.3 [list source [file join $dir msgcat.tcl]] package ifneeded msgcat 1.3.4 [list source [file join $dir msgcat.tcl]]

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	- + - + - +	# optparse.tcl -- # # (private) Option parsing package # Primarily used internally by the safe:: code. # # WARNING: This code will go away in a future release # of Tcl. It is NOT supported and you should not rely # on it. If your code does rely on this package you # may directly incorporate this code into your application. # # RCS: @(#) $Id: optparse.tcl,v 1.8 2002/11/23 01:41:35 hobbs Exp $ # RCS: @(#) $Id: optparse.tcl,v 1.8.2.1 2003/09/10 20:29:59 dgp Exp $ package require Tcl 8 package require Tcl 8.2 # When this version number changes, update the pkgIndex.tcl file # and the install directory in the Makefiles. package provide opt 0.4.4 package provide opt 0.4.4.1 namespace eval ::tcl { # Exported APIs namespace export OptKeyRegister OptKeyDelete OptKeyError OptKeyParse \ OptProc OptProcArgGiven OptParse \ Lempty Lget \
︙

1 2 3 4 5 6 7 8 9 10 11 12

1 2 3 4 5 6 7 8 9 10 11 12

- - + +

# Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex -direct" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8]} {return} package ifneeded opt 0.4.4 [list source [file join $dir optparse.tcl]] if {![package vsatisfies [package provide Tcl] 8.2]} {return} package ifneeded opt 0.4.4.1 [list source [file join $dir optparse.tcl]]

1 2 3 4 5 6 7 8 9 10 11 12 13	1 2 3 4 5 6 7 8 9 10 11 12 13	- +	# package.tcl -- # # utility procs formerly in init.tcl which can be loaded on demand # for package management. # # RCS: @(#) $Id: package.tcl,v 1.23 2003/02/25 23:58:09 dgp Exp $ # RCS: @(#) $Id: package.tcl,v 1.23.2.4 2006/09/22 01:26:24 andreas_kupries Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. #
︙
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52	29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52	- - + + - +	# Defaults to [info sharedlibextension] # # Results: # Returns 1 if the extension matches, 0 otherwise proc pkg_compareExtension { fileName {ext {}} } { global tcl_platform if {![string length $ext]} {set ext [info sharedlibextension]} if {[string equal $tcl_platform(platform) "windows"]} { if {$ext eq ""} {set ext [info sharedlibextension]} if {$tcl_platform(platform) eq "windows"} { return [string equal -nocase [file extension $fileName] $ext] } else { # Some unices add trailing numbers after the .so, so # we could have something like '.so.1.2'. set root $fileName while {1} { set currExt [file extension $root] if {[string equal $currExt $ext]} { if {$currExt eq $ext} { return 1 } # The current extension does not match; if it is not a numeric # value, quit, as we are only looking to ignore version number # extensions. Otherwise we might return 1 in this case: # pkg_compareExtension foo.so.bar .so
︙
136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175	136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175	- + - + - +	if {[llength $patternList] == 0} { set patternList [list "*.tcl" "*[info sharedlibextension]"] } set oldDir [pwd] cd $dir if {[catch {eval glob $patternList} fileList]} { if {[catch {eval [linsert $patternList 0 glob --]} fileList]} { global errorCode errorInfo cd $oldDir return -code error -errorcode $errorCode -errorinfo $errorInfo $fileList } foreach file $fileList { # For each file, figure out what commands and packages it provides. # To do this, create a child interpreter, load the file into the # interpreter, and get a list of the new commands and packages # that are defined. if {[string equal $file "pkgIndex.tcl"]} { if {$file eq "pkgIndex.tcl"} { continue } # Changed back to the original directory before initializing the # slave in case TCL_LIBRARY is a relative path (e.g. in the test # suite). cd $oldDir set c [interp create] # Load into the child any packages currently loaded in the parent # interpreter that match the -load pattern. if {[string length $loadPat]} { if {$loadPat ne ""} { if {$doVerbose} { tclLog "currently loaded packages: '[info loaded]'" tclLog "trying to load all packages matching $loadPat" } if {![llength [info loaded]]} { tclLog "warning: no packages are currently loaded, nothing" tclLog "can possibly match '$loadPat'"
︙
187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216	187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216	- + - +	} err]} { if {$doVerbose} { tclLog "warning: load [lindex $pkg 0] [lindex $pkg 1]\nfailed with: $err" } } elseif {$doVerbose} { tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]" } if {[string equal [lindex $pkg 1] "Tk"]} { if {[lindex $pkg 1] eq "Tk"} { # Withdraw . if Tk was loaded, to avoid showing a window. $c eval [list wm withdraw .] } } cd $dir $c eval { # Stub out the package command so packages can # require other packages. rename package __package_orig proc package {what args} { switch -- $what { require { return ; # ignore transitive requires } default { eval __package_orig {$what} $args } default { uplevel 1 [linsert $args 0 __package_orig $what] } } } proc tclPkgUnknown args {} package unknown tclPkgUnknown # Stub out the unknown command so package can call # into each other during their initialilzation.
︙
257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282	257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285	- + + + - + +	# we need to track command defined by each package even in # the -direct case, because they are needed internally by # the "partial pkgIndex.tcl" step above. proc ::tcl::GetAllNamespaces {{root ::}} { set list $root foreach ns [namespace children $root] { eval lappend list [::tcl::GetAllNamespaces $ns] eval [linsert [::tcl::GetAllNamespaces $ns] 0 \ lappend list] } return $list } # init the list of existing namespaces, packages, commands foreach ::tcl::x [::tcl::GetAllNamespaces] { set ::tcl::namespaces($::tcl::x) 1 } foreach ::tcl::x [package names] { if {[package provide $::tcl::x] ne ""} { set ::tcl::packages($::tcl::x) 1 set ::tcl::packages($::tcl::x) 1 } } set ::tcl::origCmds [info commands] # Try to load the file if it has the shared library # extension, otherwise source it. It's important not to # try to load files that aren't shared libraries, because # on some systems (like SunOS) the loader will abort the
︙
314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376	317 318 319 320 321 322 323 324 325 326 327 328 329 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 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	- + - + - + + - + +	# Figure out what commands appeared foreach ::tcl::x [info commands] { set ::tcl::newCmds($::tcl::x) 1 } foreach ::tcl::x $::tcl::origCmds { catch {unset ::tcl::newCmds($::tcl::x)} unset -nocomplain ::tcl::newCmds($::tcl::x) } foreach ::tcl::x [array names ::tcl::newCmds] { # determine which namespace a command comes from set ::tcl::abs [namespace origin $::tcl::x] # special case so that global names have no leading # ::, this is required by the unknown command set ::tcl::abs \ [lindex [auto_qualify $::tcl::abs ::] 0] if {[string compare $::tcl::x $::tcl::abs]} { if {$::tcl::x ne $::tcl::abs} { # Name changed during qualification set ::tcl::newCmds($::tcl::abs) 1 unset ::tcl::newCmds($::tcl::x) } } } } # Look through the packages that appeared, and if there is # a version provided, then record it foreach ::tcl::x [package names] { if {[string compare [package provide $::tcl::x] ""] \ if {[package provide $::tcl::x] ne "" && ![info exists ::tcl::packages($::tcl::x)]} { lappend ::tcl::newPkgs \ [list $::tcl::x [package provide $::tcl::x]] } } } } msg] == 1} { set what [$c eval set ::tcl::debug] if {$doVerbose} { tclLog "warning: error while $what $file: $msg" } } else { set what [$c eval set ::tcl::debug] if {$doVerbose} { tclLog "successful $what of $file" } set type [$c eval set ::tcl::type] set cmds [lsort [$c eval array names ::tcl::newCmds]] set pkgs [$c eval set ::tcl::newPkgs] if {$doVerbose} { if { !$direct } { tclLog "commands provided were $cmds" tclLog "commands provided were $cmds" } tclLog "packages provided were $pkgs" } if {[llength $pkgs] > 1} { tclLog "warning: \"$file\" provides more than one package ($pkgs)" } foreach pkg $pkgs { # cmds is empty/not used in the direct case
︙
439 440 441 442 443 444 445 446 447 448 449 450 451 452 453	444 445 446 447 448 449 450 451 452 453 454 455 456 457 458	- +	global auto_index package provide $pkg $version foreach fileInfo $files { set f [lindex $fileInfo 0] set type [lindex $fileInfo 1] foreach cmd [lindex $fileInfo 2] { if {[string equal $type "load"]} { if {$type eq "load"} { set auto_index($cmd) [list load [file join $dir $f] $pkg] } else { set auto_index($cmd) [list source [file join $dir $f]] } } } }
︙
462 463 464 465 466 467 468 469 470 471 472 473 474 475 476	467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486	+ - + + + + +	# to the auto_path and scan any new directories. # # Arguments: # name - Name of desired package. Not used. # version - Version of desired package. Not used. # exact - Either "-exact" or omitted. Not used. proc tclPkgUnknown {name version {exact {}}} { proc tclPkgUnknown [expr { [info exists tcl_platform(tip,268)] ? "name args" : "name version {exact {}}" }] { global auto_path env if {![info exists auto_path]} { return } # Cache the auto_path, because it may change while we run through # the first set of pkgIndex.tcl files
︙
555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605	565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - + + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + +	# of the auto_path directories for pkgIndex files. # Only installed in interps that are not safe so we don't check # for [interp issafe] as in tclPkgUnknown. # # Arguments: # original - original [package unknown] procedure # name - Name of desired package. Not used. #ifndef TCL_TIP268 # version - Version of desired package. Not used. # exact - Either "-exact" or omitted. Not used. #else # args - List of requirements. Not used. #endif if {[info exists tcl_platform(tip,268)]} { proc tcl::MacOSXPkgUnknown {original name args} { # First do the cross-platform default search uplevel 1 $original [linsert $args 0 $name] # Now do MacOSX specific searching global auto_path if {![info exists auto_path]} { return } # Cache the auto_path, because it may change while we run through # the first set of pkgIndex.tcl files set old_path [set use_path $auto_path] while {[llength $use_path]} { set dir [lindex $use_path end] # get the pkgIndex files out of the subdirectories foreach file [glob -directory $dir -join -nocomplain \ * Resources Scripts pkgIndex.tcl] { set dir [file dirname $file] if {[file readable $file] && ![info exists procdDirs($dir)]} { if {[catch {source $file} msg]} { tclLog "error reading package index file $file: $msg" } else { set procdDirs($dir) 1 } } } set use_path [lrange $use_path 0 end-1] if {$old_path ne $auto_path} { foreach dir $auto_path { lappend use_path $dir } set old_path $auto_path } } } } else { proc tcl::MacOSXPkgUnknown {original name version {exact {}}} { proc tcl::MacOSXPkgUnknown {original name version {exact {}}} { # First do the cross-platform default search uplevel 1 $original [list $name $version $exact] # First do the cross-platform default search uplevel 1 $original [list $name $version $exact] # Now do MacOSX specific searching global auto_path # Now do MacOSX specific searching global auto_path if {![info exists auto_path]} { return } # Cache the auto_path, because it may change while we run through # the first set of pkgIndex.tcl files set old_path [set use_path $auto_path] while {[llength $use_path]} { set dir [lindex $use_path end] # get the pkgIndex files out of the subdirectories foreach file [glob -directory $dir -join -nocomplain \ * Resources Scripts pkgIndex.tcl] { set dir [file dirname $file] if {[file readable $file] && ![info exists procdDirs($dir)]} { if {[catch {source $file} msg]} { tclLog "error reading package index file $file: $msg" } else { set procdDirs($dir) 1 } } } set use_path [lrange $use_path 0 end-1] if {[string compare $old_path $auto_path]} { foreach dir $auto_path { lappend use_path $dir } set old_path $auto_path if {![info exists auto_path]} { return } # Cache the auto_path, because it may change while we run through # the first set of pkgIndex.tcl files set old_path [set use_path $auto_path] while {[llength $use_path]} { set dir [lindex $use_path end] # get the pkgIndex files out of the subdirectories foreach file [glob -directory $dir -join -nocomplain \ * Resources Scripts pkgIndex.tcl] { set dir [file dirname $file] if {[file readable $file] && ![info exists procdDirs($dir)]} { if {[catch {source $file} msg]} { tclLog "error reading package index file $file: $msg" } else { set procdDirs($dir) 1 } } } set use_path [lrange $use_path 0 end-1] if {$old_path ne $auto_path} { foreach dir $auto_path { lappend use_path $dir } set old_path $auto_path } } } } # tcl::MacPkgUnknown -- # This procedure extends the "package unknown" function for Mac. # It searches for pkgIndex TEXT resources in all files
︙
632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655	685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708	- + - +	foreach x [concat [list $dir] [glob -directory $dir -nocomplain *] ] { if {[file isdirectory $x] && ![info exists procdDirs($x)]} { set dir $x foreach x [glob -directory $dir -nocomplain *.shlb] { if {[file isfile $x]} { set res [resource open $x] foreach y [resource list TEXT $res] { if {[string equal $y "pkgIndex"]} {source -rsrc pkgIndex} if {$y eq "pkgIndex"} {source -rsrc pkgIndex} } catch {resource close $res} } } set procdDirs($dir) 1 } } set use_path [lrange $use_path 0 end-1] if {[string compare $old_path $auto_path]} { if {$old_path ne $auto_path} { foreach dir $auto_path { lappend use_path $dir } set old_path $auto_path } } }
︙

1 2 3 4 5 6 7 8

1 2 3 4 5 6 7 8 9

+ - - + + - +

if {![package vsatisfies [package provide Tcl] 8]} {return} if {[string compare $::tcl_platform(platform) windows]} {return} if {[info exists tcl_platform(debug)]} { package ifneeded registry 1.1.1 \ if {[info exists ::tcl_platform(debug)]} { package ifneeded registry 1.1.5 \ [list load [file join $dir tclreg11g.dll] registry] } else { package ifneeded registry 1.1.1 \ package ifneeded registry 1.1.5 \ [list load [file join $dir tclreg11.dll] registry] }

︙
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	- +	# See the safe.n man page for details. # # Copyright (c) 1996-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. # # RCS: @(#) $Id: safe.tcl,v 1.9 2003/02/08 22:03:20 hobbs Exp $ # RCS: @(#) $Id: safe.tcl,v 1.9.2.3 2005/07/22 21:59:41 dgp Exp $ # # The implementation is based on namespaces. These naming conventions # are followed: # Private procs starts with uppercase. # Public procs are exported and starts with lowercase #
︙
32 33 34 35 36 37 38 39 40 41 42 43 44 45	32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49	+ + + +	interpAddToAccessPath interpFindInAccessPath setLogCmd #### # # Setup the arguments parsing # #### # Make sure that our temporary variable is local to this # namespace. [Bug 981733] variable temp # Share the descriptions set temp [::tcl::OptKeyRegister { {-accessPath -list {} "access path for the slave"} {-noStatics "prevent loading of statically linked pkgs"} {-statics true "loading of statically linked pkgs"} {-nestedLoadOk "allow nested loading"}
︙
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	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	- + - +	# Helper function to resolve the dual way of specifying staticsok # (either by -noStatics or -statics 0) proc InterpStatics {} { foreach v {Args statics noStatics} { upvar $v $v } set flag [::tcl::OptProcArgGiven -noStatics]; if {$flag && ($noStatics == $statics) if {$flag && (!$noStatics == !$statics) && ([::tcl::OptProcArgGiven -statics])} { return -code error\ "conflicting values given for -statics and -noStatics" } if {$flag} { return [expr {!$noStatics}] } else { return $statics } } # Helper function to resolve the dual way of specifying nested loading # (either by -nestedLoadOk or -nested 1) proc InterpNested {} { foreach v {Args nested nestedLoadOk} { upvar $v $v } set flag [::tcl::OptProcArgGiven -nestedLoadOk]; # note that the test here is the opposite of the "InterpStatics" # one (it is not -noNested... because of the wanted default value) if {$flag && ($nestedLoadOk != $nested) if {$flag && (!$nestedLoadOk != !$nested) && ([::tcl::OptProcArgGiven -nested])} { return -code error\ "conflicting values given for -nested and -nestedLoadOk" } if {$flag} { # another difference with "InterpStatics" return $nestedLoadOk
︙
316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331	320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335	- - + +	# you probably need to call "auto_reset" in the slave in order that it # gets the right auto_index() array values. proc ::safe::InterpSetConfig {slave access_path staticsok\ nestedok deletehook} { # determine and store the access path if empty if {[string equal "" $access_path]} { set access_path [uplevel #0 set auto_path] if {$access_path eq ""} { set access_path [uplevel \#0 set auto_path] # Make sure that tcl_library is in auto_path # and at the first position (needed by setAccessPath) set where [lsearch -exact $access_path [info library]] if {$where == -1} { # not found, add it. set access_path [concat [list [info library]] $access_path] Log $slave "tcl_library was not in auto_path,\
︙
632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654	636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658	- + - + - +	} # Run some code at the namespace toplevel proc Toplevel {args} { namespace eval [namespace current] $args } # set/get values proc Set {args} { eval [list Toplevel set] $args eval [linsert $args 0 Toplevel set] } # lappend on toplevel vars proc Lappend {args} { eval [list Toplevel lappend] $args eval [linsert $args 0 Toplevel lappend] } # unset a var/token (currently just an global level eval) proc Unset {args} { eval [list Toplevel unset] $args eval [linsert $args 0 Toplevel unset] } # test existance proc Exists {varname} { Toplevel info exists $varname } # short cut for access path getting proc GetAccessPath {slave} {
︙
770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798	774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802	- + - + - +	# package name (can be empty if file is not). set package [lindex $args 0] # Determine where to load. load use a relative interp path # and {} means self, so we can directly and safely use passed arg. set target [lindex $args 1] if {[string length $target]} { if {$target ne ""} { # we will try to load into a sub sub interp # check that we want to authorize that. if {![NestedOk $slave]} { Log $slave "loading to a sub interp (nestedok)\ disabled (trying to load $package to $target)" return -code error "permission denied (nested load)" } } # Determine what kind of load is requested if {[string length $file] == 0} { if {$file eq ""} { # static package loading if {[string length $package] == 0} { if {$package eq ""} { set msg "load error: empty filename and no package name" Log $slave $msg return -code error $msg } if {![StaticsOk $slave]} { Log $slave "static packages loading disabled\ (trying to load $package to $target)"
︙
833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858	837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870	+ + + + + + + + - + - +	set access_path [GetAccessPath $slave] if {[file isdirectory $file]} { error "\"$file\": is a directory" } set parent [file dirname $file] # Normalize paths for comparison since lsearch knows nothing of # potential pathname anomalies. set norm_parent [file normalize $parent] foreach path $access_path { lappend norm_access_path [file normalize $path] } if {[lsearch -exact $access_path $parent] == -1} { if {[lsearch -exact $norm_access_path $norm_parent] == -1} { error "\"$file\": not in access_path" } } # This procedure enables access from a safe interpreter to only a subset of # the subcommands of a command: proc Subset {slave command okpat args} { set subcommand [lindex $args 0] if {[regexp $okpat $subcommand]} { return [eval [list $command $subcommand] [lrange $args 1 end]] return [eval [linsert $args 0 $command]] } set msg "not allowed to invoke subcommand $subcommand of $command" Log $slave $msg error $msg } # This procedure installs an alias in a slave that invokes "safesubset"
︙
879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897	891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909	+ - + - - +	set argc [llength $args] set okpat "^(name.*|convert.*)\$" set subcommand [lindex $args 0] if {[regexp $okpat $subcommand]} { return [eval [linsert $args 0 \ return [eval ::interp invokehidden $slave encoding $subcommand \ ::interp invokehidden $slave encoding]] [lrange $args 1 end]] } if {[string match $subcommand system]} { if {[string first $subcommand system] == 0} { if {$argc == 1} { # passed all the tests , lets source it: if {[catch {::interp invokehidden \ $slave encoding system} msg]} { Log $slave $msg return -code error "script error" }
︙

1 2 3 4 5 6 7 8 9 10 11 12

1 2 3 4 5 6 7 8 9 10 11 12

- +

# Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex -direct" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.3]} {return} package ifneeded tcltest 2.2.2 [list source [file join $dir tcltest.tcl]] package ifneeded tcltest 2.2.8 [list source [file join $dir tcltest.tcl]]

︙
12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34	12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34	- + - +	# # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 2000 by Ajuba Solutions # Contributions from Don Porter, NIST, 2002. (not subject to US copyright) # All rights reserved. # # RCS: @(#) $Id: tcltest.tcl,v 1.78 2003/02/17 19:12:06 dgp Exp $ # RCS: @(#) $Id: tcltest.tcl,v 1.78.2.13 2005/02/24 18:03:36 dgp Exp $ package require Tcl 8.3 ;# uses [glob -directory] namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. variable Version 2.2.2 variable Version 2.2.8 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] # yourself. You don't need tcltest to wrap it for you. variable version [package provide Tcl] variable patchLevel [info patchlevel]
︙
626 627 628 629 630 631 632 633 634 635 636 637 638 639 640	626 627 628 629 630 631 632 633 634 635 636 637 638 639 640	- +	proc IsVerbose {level} { variable Option return [expr {[lsearch -exact $Option(-verbose) $level] != -1}] } # Default verbosity is to show bodies of failed tests Option -verbose body { Option -verbose {body error} { Takes any combination of the values 'p', 's', 'b', 't' and 'e'. Test suite will display all passed tests if 'p' is specified, all skipped tests if 's' is specified, the bodies of failed tests if 'b' is specified, and when tests start if 't' is specified. ErrorInfo is displayed if 'e' is specified. } AcceptVerbose verbose
︙
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	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	- + - + + + + + + + - - + + +	exit 1 } if {[llength $flagArray] == 0} { RemoveAutoConfigureTraces } else { set args $flagArray while {[llength $args] && [catch {eval configure $args} msg]} { while {[llength $args]>1 && [catch {eval configure $args} msg]} { # Something went wrong parsing $args for tcltest options # Check whether the problem is "unknown option" if {[regexp {^unknown option (\S+):} $msg -> option]} { # Could be this is an option the Hook knows about set moreOptions [processCmdLineArgsAddFlagsHook] if {[lsearch -exact $moreOptions $option] == -1} { # Nope. Report the error, including additional options, # but keep going if {[llength $moreOptions]} { append msg ", " append msg [join [lrange $moreOptions 0 end -1] ", "] append msg [join [lrange $moreOptions 0 end-1] ", "] append msg "or [lindex $moreOptions end]" } Warn $msg } } else { # error is something other than "unknown option" # notify user of the error; and exit puts [errorChannel] $msg exit 1 } # To recover, find that unknown option and remove up to it. # then retry while {![string equal [lindex $args 0] $option]} { set args [lrange $args 2 end] } set args [lrange $args 2 end] } if {[llength $args] == 1} { puts [errorChannel] \ "missing value for option [lindex $args 0]" exit 1 } } # Call the hook catch { array set flag $flagArray processCmdLineArgsHook [array get flag] array set flag $flagArray processCmdLineArgsHook [array get flag] } return } # tcltest::ProcessCmdLineArgs -- # # This procedure must be run after constraint initialization is # set up (by [DefineConstraintInitializers]) because some constraints
︙
1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505	1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512	- - + +	# Spit out everything you know if we're at a debug level 2 or # greater DebugPuts 2 "Flags passed into tcltest:" if {[info exists ::env(TCLTEST_OPTIONS)]} { DebugPuts 2 \ " ::env(TCLTEST_OPTIONS): $::env(TCLTEST_OPTIONS)" } if {[info exists argv]} { DebugPuts 2 " argv: $argv" if {[info exists ::argv]} { DebugPuts 2 " argv: $::argv" } DebugPuts 2 "tcltest::debug = [debug]" DebugPuts 2 "tcltest::testsDirectory = [testsDirectory]" DebugPuts 2 "tcltest::workingDirectory = [workingDirectory]" DebugPuts 2 "tcltest::temporaryDirectory = [temporaryDirectory]" DebugPuts 2 "tcltest::outputChannel = [outputChannel]" DebugPuts 2 "tcltest::errorChannel = [errorChannel]"
︙
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	1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631	- - - - - + - - + - - + - + - - + - - -	proc tcltest::Eval {script {ignoreOutput 1}} { variable outData variable errData DebugPuts 3 "[lindex [info level 0] 0] called" if {!$ignoreOutput} { set outData {} set errData {} set callerHasPuts [llength [uplevel 1 { ::info commands [::namespace current]::puts }]] if {$callerHasPuts} { uplevel 1 [list ::rename puts [namespace current]::Replace::Puts] rename ::puts [namespace current]::Replace::Puts } else { interp alias {} [namespace current]::Replace::Puts {} ::puts namespace eval :: \ } uplevel 1 [list ::namespace import [namespace origin Replace::puts]] [list namespace import [namespace origin Replace::puts]] namespace import Replace::puts } set result [uplevel 1 $script] if {!$ignoreOutput} { namespace forget puts uplevel 1 ::namespace forget puts namespace eval :: namespace forget puts if {$callerHasPuts} { uplevel 1 [list ::rename [namespace current]::Replace::Puts puts] rename [namespace current]::Replace::Puts ::puts } else { interp alias {} [namespace current]::Replace::Puts {} } } return $result } # tcltest::CompareStrings -- # # compares the expected answer to the actual answer, depending on
︙
1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851	1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855	+ + + + + + +	# proc tcltest::test {name description args} { global tcl_platform variable testLevel variable coreModTime DebugPuts 3 "test $name $args" DebugDo 1 { variable TestNames catch { puts "test name '$name' re-used; prior use in $TestNames($name)" } set TestNames($name) [info script] } FillFilesExisted incr testLevel # Pre-define everything to null except output and errorOutput. We # determine whether or not to trap output based on whether or not # these variables (output & errorOutput) are defined.
︙
1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926	1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928	- - - + + - - +	set values [join [lrange $sorted 0 end-1] ", "] append values ", or [lindex $sorted end]" return -code error "bad -match value \"$match\":\ must be $values" } # Replace symbolic valies supplied for -returnCodes regsub -nocase normal $returnCodes 0 returnCodes regsub -nocase error $returnCodes 1 returnCodes regsub -nocase return $returnCodes 2 returnCodes foreach {strcode numcode} {ok 0 normal 0 error 1 return 2 break 3 continue 4} { set returnCodes [string map -nocase [list $strcode $numcode] $returnCodes] regsub -nocase break $returnCodes 3 returnCodes regsub -nocase continue $returnCodes 4 returnCodes } } else { # This is parsing for the old test command format; it is here # for backward compatibility. set result [lindex $args end] if {[llength $args] == 2} { set body [lindex $args 0] } elseif {[llength $args] == 3} {
︙
1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978	1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992	+ + + + + + + + + + + +	if {[file exists [file join [workingDirectory] core]]} { set coreModTime [file mtime [file join [workingDirectory] core]] } } # First, run the setup script set code [catch {uplevel 1 $setup} setupMsg] if {$code == 1} { set errorInfo(setup) $::errorInfo set errorCode(setup) $::errorCode } set setupFailure [expr {$code != 0}] # Only run the test body if the setup was successful if {!$setupFailure} { # Verbose notification of $body start if {[IsVerbose start]} { puts [outputChannel] "---- $name start" flush [outputChannel] } set command [list [namespace origin RunTest] $name $body] if {[info exists output] || [info exists errorOutput]} { set testResult [uplevel 1 [list [namespace origin Eval] $command 0]] } else { set testResult [uplevel 1 [list [namespace origin Eval] $command 1]] } foreach {actualAnswer returnCode} $testResult break if {$returnCode == 1} { set errorInfo(body) $::errorInfo set errorCode(body) $::errorCode } } # Always run the cleanup script set code [catch {uplevel 1 $cleanup} cleanupMsg] if {$code == 1} { set errorInfo(cleanup) $::errorInfo set errorCode(cleanup) $::errorCode } set cleanupFailure [expr {$code != 0}] set coreFailure 0 set coreMsg "" # check for a core file first - if one was created by the test, # then the test failed if {[preserveCore]} {
︙
1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 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	2013 2014 2015 2016 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 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062	+ + + + + + - + - + - - - - - - - +	if {[string length $msg] > 0} { append coreMsg "\nError:\ Problem renaming core file: $msg" } } } } # check if the return code matched the expected return code set codeFailure 0 if {!$setupFailure && [lsearch -exact $returnCodes $returnCode] == -1} { set codeFailure 1 } # If expected output/error strings exist, we have to compare # them. If the comparison fails, then so did the test. set outputFailure 0 variable outData if {[info exists output]} { if {[info exists output] && !$codeFailure} { if {[set outputCompare [catch { CompareStrings $outData $output $match } outputMatch]] == 0} { set outputFailure [expr {!$outputMatch}] } else { set outputFailure 1 } } set errorFailure 0 variable errData if {[info exists errorOutput]} { if {[info exists errorOutput] && !$codeFailure} { if {[set errorCompare [catch { CompareStrings $errData $errorOutput $match } errorMatch]] == 0} { set errorFailure [expr {!$errorMatch}] } else { set errorFailure 1 } } # check if the return code matched the expected return code set codeFailure 0 if {!$setupFailure && [lsearch -exact $returnCodes $returnCode] == -1} { set codeFailure 1 } # check if the answer matched the expected answer # Only check if we ran the body of the test (no setup failure) if {$setupFailure} { if {$setupFailure || $codeFailure} { set scriptFailure 0 } elseif {[set scriptCompare [catch { CompareStrings $actualAnswer $result $match } scriptMatch]] == 0} { set scriptFailure [expr {!$scriptMatch}] } else { set scriptFailure 1
︙
2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091	2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109	+ + + +	if {[string length $body]} { puts [outputChannel] "==== Contents of test case:" puts [outputChannel] $body } if {$setupFailure} { puts [outputChannel] "---- Test setup\ failed:\n$setupMsg" if {[info exists errorInfo(setup)]} { puts [outputChannel] "---- errorInfo(setup): $errorInfo(setup)" puts [outputChannel] "---- errorCode(setup): $errorCode(setup)" } } if {$scriptFailure} { if {$scriptCompare} { puts [outputChannel] "---- Error testing result: $scriptMatch" } else { puts [outputChannel] "---- Result was:\n$actualAnswer" puts [outputChannel] "---- Result should have been\
︙
2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117	2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135	- - - + + +	4 { set msg "Test generated continue exception" } default { set msg "Test generated exception" } } puts [outputChannel] "---- $msg; Return code was: $returnCode" puts [outputChannel] "---- Return code should have been\ one of: $returnCodes" if {[IsVerbose error]} { if {[info exists ::errorInfo]} { puts [outputChannel] "---- errorInfo: $::errorInfo" puts [outputChannel] "---- errorCode: $::errorCode" if {[info exists errorInfo(body)] && ([lsearch $returnCodes 1]<0)} { puts [outputChannel] "---- errorInfo: $errorInfo(body)" puts [outputChannel] "---- errorCode: $errorCode(body)" } } } if {$outputFailure} { if {$outputCompare} { puts [outputChannel] "---- Error testing output: $outputMatch" } else {
︙
2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140	2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162	+ + + +	puts [outputChannel] "---- Error output was:\n$errData" puts [outputChannel] "---- Error output should have\ been ($match matching):\n$errorOutput" } } if {$cleanupFailure} { puts [outputChannel] "---- Test cleanup failed:\n$cleanupMsg" if {[info exists errorInfo(cleanup)]} { puts [outputChannel] "---- errorInfo(cleanup): $errorInfo(cleanup)" puts [outputChannel] "---- errorCode(cleanup): $errorCode(cleanup)" } } if {$coreFailure} { puts [outputChannel] "---- Core file produced while running\ test! $coreMsg" } puts [outputChannel] "==== $name FAILED\n"
︙
2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428	2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449	-	} } else { # if we're deferring stat-reporting until all files are sourced, # then add current file to failFile list if any tests in this # file failed incr numTestFiles if {$currentFailure \ && ([lsearch -exact $failFiles $testFileName] == -1)} { lappend failFiles $testFileName } set currentFailure false # restore the environment to the state it was in before this package
︙
2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492	2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513	- + - +	} if {[file exists [file join [workingDirectory] core]]} { if {[preserveCore] > 1} { puts "rename core file (> 1)" puts [outputChannel] "produced core file! \ Moving file to: \ [file join [temporaryDirectory] core-$name]" [file join [temporaryDirectory] core-$testFileName]" catch {file rename -force \ [file join [workingDirectory] core] \ [file join [temporaryDirectory] core-$name] [file join [temporaryDirectory] core-$testFileName] } msg if {[string length $msg] > 0} { PrintError "Problem renaming file: $msg" } } else { # Print a message if there is a core file and (1) there # previously wasn't one or (2) the new one is different
︙
2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565	2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588	- + + - + +	set matchingFiles [list] foreach directory $dirList { # List files in $directory that match patterns to run. set matchFileList [list] foreach match [matchFiles] { set matchFileList [concat $matchFileList \ [glob -directory $directory -nocomplain -- $match]] [glob -directory $directory -types {b c f p s} \ -nocomplain -- $match]] } # List files in $directory that match patterns to skip. set skipFileList [list] foreach skip [skipFiles] { set skipFileList [concat $skipFileList \ [glob -directory $directory -nocomplain -- $skip]] [glob -directory $directory -types {b c f p s} \ -nocomplain -- $skip]] } # Add to result list all files in match list and not in skip list foreach file $matchFileList { if {[lsearch -exact $skipFileList $file] == -1} { lappend matchingFiles $file }
︙
2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625	2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643	- - + + - - - - - - - + + + + - - - + + -	proc tcltest::GetMatchingDirectories {rootdir} { # Determine the skip list first, to avoid [glob]-ing over subdirectories # we're going to throw away anyway. Be sure we skip the $rootdir if it # comes up to avoid infinite loops. set skipDirs [list $rootdir] foreach pattern [skipDirectories] { foreach path [glob -directory $rootdir -nocomplain -- $pattern] { if {[file isdirectory $path]} { set skipDirs [concat $skipDirs [glob -directory $rootdir -types d \ -nocomplain -- $pattern]] lappend skipDirs $path } } } # Now step through the matching directories, prune out the skipped ones # as you go. set matchDirs [list] foreach pattern [matchDirectories] { foreach path [glob -directory $rootdir -nocomplain -- $pattern] { if {[file isdirectory $path]} { if {[lsearch -exact $skipDirs $path] == -1} { set matchDirs [concat $matchDirs \ foreach path [glob -directory $rootdir -types d -nocomplain -- \ $pattern] { if {[lsearch -exact $skipDirs $path] == -1} { set matchDirs [concat $matchDirs [GetMatchingDirectories $path]] [GetMatchingDirectories $path]] if {[file exists [file join $path all.tcl]]} { lappend matchDirs $path if {[file exists [file join $path all.tcl]]} { lappend matchDirs $path } } } } } if {[llength $matchDirs] == 0} { DebugPuts 1 "No test directories remain after applying match\
︙
2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894	2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911	- + - - +	# string with extra newlines removed # # Side effects: # None. proc tcltest::normalizeMsg {msg} { regsub "\n$" [string tolower $msg] "" msg regsub -all "\n\n" $msg "\n" msg set msg [string map [list "\n\n" "\n"] $msg] regsub -all "\n\}" $msg "\}" msg return $msg return [string map [list "\n\}" "\}"] $msg] } # tcltest::makeFile -- # # Create a new file with the name <name>, and write <contents> to it. # # If this file hasn't been created via makeFile since the last time
︙
3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298	3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315	- +	proc ConfigureFromEnvironment {} { upvar #0 env(TCLTEST_OPTIONS) options if {[catch {llength $options} msg]} { Warn "invalid TCLTEST_OPTIONS \"$options\":\n invalid\ Tcl list: $msg" return } if {[llength $::env(TCLTEST_OPTIONS)] < 2} { if {[llength $::env(TCLTEST_OPTIONS)] % 2} { Warn "invalid TCLTEST_OPTIONS: \"$options\":\n should be\ -option value ?-option value ...?" return } if {[catch {eval Configure $::env(TCLTEST_OPTIONS)} msg]} { Warn "invalid TCLTEST_OPTIONS: \"$options\":\n $msg" return
︙

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	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	- + - +	# word.tcl -- # # This file defines various procedures for computing word boundaries # in strings. This file is primarily needed so Tk text and entry # widgets behave properly for different platforms. # # Copyright (c) 1996 by Sun Microsystems, Inc. # Copyright (c) 1998 by Scritpics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: word.tcl,v 1.7 2002/11/01 00:28:51 andreas_kupries Exp $ # RCS: @(#) $Id: word.tcl,v 1.7.2.1 2005/07/22 21:59:41 dgp Exp $ # The following variables are used to determine which characters are # interpreted as white space. if {[string equal $::tcl_platform(platform) "windows"]} { if {$::tcl_platform(platform) eq "windows"} { # Windows style - any but a unicode space char set tcl_wordchars "\\S" set tcl_nonwordchars "\\s" } else { # Motif style - any unicode word char (number, letter, or underscore) set tcl_wordchars "\\w" set tcl_nonwordchars "\\W"
︙
54 55 56 57 58 59 60 61 62 63 64 65 66 67 68	54 55 56 57 58 59 60 61 62 63 64 65 66 67 68	- +	# # Arguments: # str - String to search. # start - Index into string specifying starting point. proc tcl_wordBreakBefore {str start} { global tcl_nonwordchars tcl_wordchars if {[string equal $start end]} { if {$start eq "end"} { set start [string length $str] } if {[regexp -indices "^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)" [string range $str 0 $start] result]} { return [lindex $result 1] } return -1 }
︙
116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132	116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132	- +	# # Arguments: # str - String to search. # start - Index into string specifying starting point. proc tcl_startOfPreviousWord {str start} { global tcl_nonwordchars tcl_wordchars if {[string equal $start end]} { if {$start eq "end"} { set start [string length $str] } if {[regexp -indices \ "$tcl_nonwordchars*($tcl_wordchars+)$tcl_nonwordchars*\$" \ [string range $str 0 [expr {$start - 1}]] result word]} { return [lindex $word 0] } return -1 }

1 2 3 4 5 6 7 8 9 10	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	- + + + + + + + + + + + + +	Tcl 8.4 for Macintosh RCS: @(#) $Id: README,v 1.17 2002/03/04 23:26:03 hobbs Exp $ RCS: @(#) $Id: README,v 1.17.2.1 2005/12/04 00:50:03 das Exp $ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Note that Tcl on Mac OS Classic is no longer supported and likely no longer compiles, the last release known to work is 8.4.2. The 'mac' source directory and all other Mac Classic code have been removed from Tk 8.5. The Mac OS X port of Tcl can be found in the 'macosx' source directory. The information and URLs below are known to be outdated and incorrect. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1. Introduction --------------- This is the README file for the Macintosh version of the Tcl scripting language. The home page for the Mac/Tcl info is http://www.tcl.tk/software/mac/
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	/* * tclMacChan.c * * Channel drivers for Macintosh channels for the * console fds. * * Copyright (c) 1996-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. * * RCS: @(#) $Id: tclMacChan.c,v 1.21 2003/03/03 20:22:42 das Exp $ * RCS: @(#) $Id: tclMacChan.c,v 1.21.2.1 2005/01/27 22:53:34 andreas_kupries Exp $ */ #include "tclInt.h" #include "tclPort.h" #include "tclMacInt.h" #include <Aliases.h> #include <Errors.h>
︙
98 99 100 101 102 103 104 105 106 107 108 109 110 111	98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113	+ +	char *buf, int toRead, int *errorCode)); static int FileOutput _ANSI_ARGS_((ClientData instanceData, CONST char *buf, int toWrite, int *errorCode)); static int FileSeek _ANSI_ARGS_((ClientData instanceData, long offset, int mode, int *errorCode)); static void FileSetupProc _ANSI_ARGS_((ClientData clientData, int flags)); static void FileThreadActionProc _ANSI_ARGS_ (( ClientData instanceData, int action)); static Tcl_Channel OpenFileChannel _ANSI_ARGS_((CONST char *fileName, int mode, int permissions, int *errorCodePtr)); static int StdIOBlockMode _ANSI_ARGS_((ClientData instanceData, int mode)); static int StdIOClose _ANSI_ARGS_((ClientData instanceData, Tcl_Interp *interp)); static int StdIOInput _ANSI_ARGS_((ClientData instanceData,
︙
119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159	121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172	- + + + + + + + - + - + + + + + +	/* * This structure describes the channel type structure for file based IO: */ static Tcl_ChannelType consoleChannelType = { "file", /* Type name. */ (Tcl_ChannelTypeVersion)StdIOBlockMode, /* Set blocking/nonblocking mode.*/ TCL_CHANNEL_VERSION_4, /* v4 channel */ StdIOClose, /* Close proc. */ StdIOInput, /* Input proc. */ StdIOOutput, /* Output proc. */ StdIOSeek, /* Seek proc. */ NULL, /* Set option proc. */ NULL, /* Get option proc. */ CommonWatch, /* Initialize notifier. */ CommonGetHandle /* Get OS handles out of channel. */ NULL, /* close2proc. */ StdIOBlockMode, /* Set blocking/nonblocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc. */ NULL, /* thread actions */ }; /* * This variable describes the channel type structure for file based IO. */ static Tcl_ChannelType fileChannelType = { "file", /* Type name. */ (Tcl_ChannelTypeVersion)FileBlockMode, /* Set blocking or TCL_CHANNEL_VERSION_4, /* v4 channel */ * non-blocking mode.*/ FileClose, /* Close proc. */ FileInput, /* Input proc. */ FileOutput, /* Output proc. */ FileSeek, /* Seek proc. */ NULL, /* Set option proc. */ NULL, /* Get option proc. */ CommonWatch, /* Initialize notifier. */ CommonGetHandle /* Get OS handles out of channel. */ NULL, /* close2proc. */ FileBlockMode, /* Set blocking/nonblocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc. */ FileThreadActionProc, /* thread actions */ }; /* * Hack to allow Mac Tk to override the TclGetStdChannels function. */
︙
1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300	1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275	- + - + - - - + + - - - + + - - - - + + + + + + + + - - - - - - - - - - - - - + + + + + + + + - - - - - + + + + + - - - - + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -	Tcl_SetMaxBlockTime(&blockTime); } }  /* *---------------------------------------------------------------------- * * TclpCutFileChannel -- * FileThreadActionProc -- * * Remove any thread local refs to this channel. See * Insert or remove any thread local refs to this channel. * Tcl_CutChannel for more info. * * Results: * None. * * Side effects: * Changes thread local list of valid channels. * *---------------------------------------------------------------------- */ void TclpCutFileChannel(chan) static void FileThreadActionProc (instanceData, action) Tcl_Channel chan; /* The channel being removed. Must * not be referenced in any * interpreter. */ ClientData instanceData; int action; { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Channel *chanPtr = (Channel *) chan; FileState *infoPtr; FileState **nextPtrPtr; int removed = 0; FileState *infoPtr = (FileState *) instanceData; if (action == TCL_CHANNEL_THREAD_INSERT) { infoPtr->nextPtr = tsdPtr->firstFilePtr; tsdPtr->firstFilePtr = infoPtr; } else { FileState **nextPtrPtr; int removed = 0; if (chanPtr->typePtr != &fileChannelType) return; infoPtr = (FileState *) chanPtr->instanceData; for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL; nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { if ((*nextPtrPtr) == infoPtr) { (*nextPtrPtr) = infoPtr->nextPtr; removed = 1; break; } } for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL; nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { if ((*nextPtrPtr) == infoPtr) { (*nextPtrPtr) = infoPtr->nextPtr; removed = 1; break; } } /* * This could happen if the channel was created in one thread * and then moved to another without updating the thread * local data in each thread. */ /* * This could happen if the channel was created in one thread * and then moved to another without updating the thread * local data in each thread. */ if (!removed) panic("file info ptr not on thread channel list"); } if (!removed) { panic("file info ptr not on thread channel list"); } }  /* *---------------------------------------------------------------------- * * TclpSpliceFileChannel -- * * Insert thread local ref for this channel. * Tcl_SpliceChannel for more info. * * Results: * None. * * Side effects: * Changes thread local list of valid channels. * *---------------------------------------------------------------------- */ void TclpSpliceFileChannel(chan) Tcl_Channel chan; /* The channel being removed. Must * not be referenced in any * interpreter. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Channel *chanPtr = (Channel *) chan; FileState *infoPtr; if (chanPtr->typePtr != &fileChannelType) return; infoPtr = (FileState *) chanPtr->instanceData; infoPtr->nextPtr = tsdPtr->firstFilePtr; tsdPtr->firstFilePtr = infoPtr; }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclMacFile.c -- * * This file implements the channel drivers for Macintosh * files. It also comtains Macintosh version of other Tcl * functions that deal with the file system. * * Copyright (c) 1995-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclMacFile.c,v 1.27 2003/03/03 20:22:43 das Exp $ * RCS: @(#) $Id: tclMacFile.c,v 1.27.2.1 2003/10/03 17:45:37 vincentdarley Exp $ */ /* * Note: This code eventually needs to support async I/O. In doing this * we will need to keep track of all current async I/O. If exit to shell * is called - we shouldn't exit until all asyc I/O completes. */
︙
174 175 176 177 178 179 180 181 182 183 184 185 186 187	174 175 176 177 178 179 180 181 182 183 184 185 186 187 188	+	/* Match a single file directly */ Tcl_StatBuf buf; CInfoPBRec paramBlock; FSSpec fileSpec; if (TclpObjLstat(fileNamePtr, &buf) != 0) { /* File doesn't exist */ Tcl_DecrRefCount(fileNamePtr); return TCL_OK; } if (FspLLocationFromFsPath(fileNamePtr, &fileSpec) == noErr) { paramBlock.hFileInfo.ioCompletion = NULL; paramBlock.hFileInfo.ioNamePtr = fileSpec.name; paramBlock.hFileInfo.ioVRefNum = fileSpec.vRefNum;
︙
198 199 200 201 202 203 204 205 206 207 208 209 210 211	199 200 201 202 203 204 205 206 207 208 209 210 211 212 213	+	if ((fnameLen > 1) && (strchr(fname+1, ':') == NULL)) { Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(fname+1, fnameLen-1)); } else { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); } } Tcl_DecrRefCount(fileNamePtr); return TCL_OK; } else { char *fname; int fnameLen, result = TCL_OK; int baseLength; CInfoPBRec pb; OSErr err;
︙
254 255 256 257 258 259 260 261 262 263 264 265 266 267	256 257 258 259 260 261 262 263 264 265 266 267 268 269 270	+	Tcl_DStringFree(&fileString); if (err == noErr) { err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory); } if ((err != noErr) || !isDirectory) { Tcl_DStringFree(&dsOrig); Tcl_DecrRefCount(fileNamePtr); return TCL_OK; } } /* Make sure we have a trailing directory delimiter */ if (Tcl_DStringValue(&dsOrig)[baseLength-1] != ':') { Tcl_DStringAppend(&dsOrig, ":", 1);
︙
322 323 324 325 326 327 328 329 330 331 332 333 334 335	325 326 327 328 329 330 331 332 333 334 335 336 337 338 339	+	Tcl_DecrRefCount(tempName); } Tcl_DStringFree(&fileString); itemIndex++; } Tcl_DStringFree(&dsOrig); Tcl_DecrRefCount(fileNamePtr); return result; } } static int NativeMatchType( Tcl_Obj *tempName, /* Path to check */
︙
1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220	1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225	+	return NULL; } if (TclpReadlink(Tcl_GetString(transPtr), &ds) != NULL) { link = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); Tcl_IncrRefCount(link); Tcl_DStringFree(&ds); } Tcl_DecrRefCount(transPtr); } return link; } #endif
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	- +	/* * tclMacInit.c -- * * Contains the Mac-specific interpreter initialization functions. * * Copyright (c) 1995-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclMacInit.c,v 1.9 2002/02/08 02:52:54 dgp Exp $ * RCS: @(#) $Id: tclMacInit.c,v 1.9.2.2 2005/10/23 22:01:31 msofer Exp $ */ #include <AppleEvents.h> #include <AEDataModel.h> #include <AEObjects.h> #include <AEPackObject.h> #include <AERegistry.h>
︙
335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357	335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358	+ - + - +	* encoding. TclpSetInitialEncodings() will translate the library * path from the native encoding to UTF-8 as soon as it determines * what the native encoding actually is. * * Called at process initialization time. * * Results: * Return 1, indicating that the UTF may be dirty and require "cleanup" * None. * after encodings are initialized. * * Side effects: * None. * *--------------------------------------------------------------------------- */ void int TclpInitLibraryPath(argv0) CONST char *argv0; /* Name of executable from argv[0] to main(). * Not used because we can determine the name * by querying the module handle. */ { Tcl_Obj *objPtr, *pathPtr; CONST char *str;
︙
407 408 409 410 411 412 413 414 415 416 417 418 419 420	408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423	+ +	objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&path)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); Tcl_DStringFree(&libPath); Tcl_DStringFree(&path); } TclSetLibraryPath(pathPtr); return 1; /* 1 indicates that pathPtr may be dirty utf (needs cleaning) */ }  /* *--------------------------------------------------------------------------- * * TclpSetInitialEncodings -- *
︙
705 706 707 708 709 710 711 712 713 714 715 716 717 718 719	708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724	+ +	* look in the tcl_library directory. Ditto for the history command. */ pathPtr = TclGetLibraryPath(); if (pathPtr == NULL) { pathPtr = Tcl_NewObj(); } Tcl_IncrRefCount(pathPtr); Tcl_SetVar2Ex(interp, "auto_path", NULL, pathPtr, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(pathPtr); return Tcl_Eval(interp, initCmd); }  /* *---------------------------------------------------------------------- * * Tcl_SourceRCFile --
︙

︙
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	- +	* event proc will have to arbitrate which events go to which threads. * * Copyright (c) 1995-1996 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclMacNotify.c,v 1.8 2001/11/23 01:27:53 das Exp $ * RCS: @(#) $Id: tclMacNotify.c,v 1.8.4.1 2003/03/21 03:24:08 dgp Exp $ */ #include "tclInt.h" #include "tclPort.h" #include "tclMac.h" #include "tclMacInt.h" #include <signal.h>
︙
44 45 46 47 48 49 50 51 52 53 54 55 56 57	44 45 46 47 48 49 50 51 52 53 54 55 56 57 58	+	/* * Need this for replacing Tcl_SetTimer and Tcl_WaitForEvent defined * in THIS file with ones defined in the stub table. */ extern TclStubs tclStubs; extern Tcl_NotifierProcs tclOriginalNotifier; /* * The follwing static indicates whether this module has been initialized. */ static int initialized = 0;
︙
335 336 337 338 339 340 341 342 343 344 345 346 347 348 349	336 337 338 339 340 341 342 343 344 345 346 347 348 349 350	- +	Tcl_Time *timePtr) /* New value for interval timer. */ { /* * Allow the notifier to be hooked. This may not make sense * on the Mac, but mirrors the UNIX hook. */ if (tclStubs.tcl_SetTimer != Tcl_SetTimer) { if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) { tclStubs.tcl_SetTimer(timePtr); return; } if (!timePtr) { notifier.timerActive = 0; } else {
︙
416 417 418 419 420 421 422 423 424 425 426 427 428 429 430	417 418 419 420 421 422 423 424 425 426 427 428 429 430 431	- +	Rect mouseRect; /* * Allow the notifier to be hooked. This may not make * sense on the Mac, but mirrors the UNIX hook. */ if (tclStubs.tcl_WaitForEvent != Tcl_WaitForEvent) { if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) { return tclStubs.tcl_WaitForEvent(timePtr); } /* * Compute the next timeout value. */
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	/* * tclMacResource.c -- * * This file contains several commands that manipulate or use * Macintosh resources. Included are extensions to the "source" * command, the mac specific "beep" and "resource" commands, and * administration for open resource file references. * * Copyright (c) 1996-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. * * RCS: @(#) $Id: tclMacResource.c,v 1.14 2002/06/05 11:59:49 das Exp $ * RCS: @(#) $Id: tclMacResource.c,v 1.14.2.1 2003/10/01 14:34:16 das Exp $ */ #include <Errors.h> #include <FSpCompat.h> #include <Processes.h> #include <Resources.h> #include <Sound.h>
︙
1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496	1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496	- +	} else { resource = GetNamedResource(resourceType, rezName); } Tcl_DStringFree(&ds); } if (*resource == NULL) { if (resource != NULL && *resource == NULL) { *releaseIt = 1; LoadResource(resource); } else { *releaseIt = 0; } SetResLoad(true);
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	- +	/* * tclMacSock.c * * Channel drivers for Macintosh sockets. * * Copyright (c) 1996-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. * * RCS: @(#) $Id: tclMacSock.c,v 1.14 2002/04/08 09:03:17 das Exp $ * RCS: @(#) $Id: tclMacSock.c,v 1.14.2.1 2006/03/10 14:27:41 vasiljevic Exp $ */ #include "tclInt.h" #include "tclPort.h" #include "tclMacInt.h" #include <AddressXlation.h> #include <Aliases.h>
︙
155 156 157 158 159 160 161 162 163 164 165 166 167 168 169	155 156 157 158 159 160 161 162 163 164 165 166 167 168	-	static TcpState * NewSocketInfo _ANSI_ARGS_((StreamPtr stream)); static OSErr ResolveAddress _ANSI_ARGS_((ip_addr tcpAddress, Tcl_DString *dsPtr)); static void SocketCheckProc _ANSI_ARGS_((ClientData clientData, int flags)); static int SocketEventProc _ANSI_ARGS_((Tcl_Event *evPtr, int flags)); static void SocketExitHandler _ANSI_ARGS_((ClientData clientData)); static void SocketFreeProc _ANSI_ARGS_((ClientData clientData)); static int SocketReady _ANSI_ARGS_((TcpState *statePtr)); static void SocketSetupProc _ANSI_ARGS_((ClientData clientData, int flags)); static void TcpAccept _ANSI_ARGS_((TcpState *statePtr)); static int TcpBlockMode _ANSI_ARGS_((ClientData instanceData, int mode)); static int TcpClose _ANSI_ARGS_((ClientData instanceData,
︙
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 402 403 404 405 406 407	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 402 403 404 405	+ - - + - + - - + - - - - - + + + + + + + - -	/* * Do per-thread initialization. */ tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->socketList = NULL; Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL); Tcl_CreateThreadExitHandler(SocketExitHandler, (ClientData) NULL); } }  /* *---------------------------------------------------------------------- * * SocketExitHandler -- * TclpFinalizeSockets -- * * Callback invoked during exit clean up to deinitialize the * Invoked during exit clean up to deinitialize the socket module. * socket module. * * Results: * None. * * Side effects: * None. * Removed event source. * *---------------------------------------------------------------------- */ static void SocketExitHandler( ClientData clientData) /* Not used. */ { if (hasSockets) { void TclpFinalizeSockets() { ThreadSpecificData *tsdPtr; tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (tsdPtr != NULL) { Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL); /* CleanUpExitProc(); TclMacDeleteExitToShellPatch(CleanUpExitProc); */ } }  /* *---------------------------------------------------------------------- * * TclpHasSockets --
︙

︙
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188	164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188	- - - - - + + + + + - +	* The result area is set to the exit code of the thread we * waited upon. * *---------------------------------------------------------------------- */ int Tcl_JoinThread(id, result) Tcl_ThreadId id; /* Id of the thread to wait upon */ int* result; /* Reference to the storage the result * of the thread we wait upon will be * written into. */ Tcl_JoinThread(threadId, result) Tcl_ThreadId threadId; /* Id of the thread to wait upon */ int* result; /* Reference to the storage the result * of the thread we wait upon will be * written into. */ { if (!TclMacHaveThreads()) { return TCL_ERROR; } return TclJoinThread (id, result); return TclJoinThread (threadId, result); }  /* *---------------------------------------------------------------------- * * TclpThreadExit -- *
︙

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

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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207

- + - - + + + + + + + + - + - + + + + + - + - + + + + + - + + + + + + + + - - + + + + + + - + + + + + + - + + + + + + + + + + + - - + + + + + + + + - + + + + + + + - + + - + + + - + + - + + - + + + + - + - + - + + + + + + + + + + + + - - + + + + + - - + - - + + + - + - - - + + + + + + + - - + + + + + + + + + + + + - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + - + + + + + + + + + + - - - - + + + + + + + - + - + - - + + - + +

################################################################################ ######################################################################################################## # # Simple makefile for building on Mac OS X with the # Project Builder command line tool 'pbxbuild' # Makefile wrapper to build tcl on Mac OS X in a way compatible with the tk/macosx Xcode buildsystem # uses the standard unix build system in tcl/unix (which can be used directly instead of this # if you are not using the tk/macosx projects). # # Copyright (c) 2002-2007 Daniel A. Steffen <das@users.sourceforge.net> # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: Makefile,v 1.5 2003/02/19 16:43:29 das Exp $ # RCS: @(#) $Id: Makefile,v 1.5.2.17 2007/04/29 02:21:33 das Exp $ # ################################################################################ ######################################################################################################## #------------------------------------------------------------------------------------------------------- # customizable settings DESTDIR ?= INSTALL_ROOT ?= INSTALL_ROOT ?= ${DESTDIR} BUILD_DIR ?= ${CURDIR}/../../build BUILD_DIR ?= ${CURDIR}/../../build SYMROOT ?= ${BUILD_DIR}/${PROJECT} OBJROOT ?= ${SYMROOT} EXTRA_CONFIGURE_ARGS ?= EXTRA_MAKE_ARGS ?= TARGET = Tcl INSTALL_PATH ?= /Library/Frameworks PREFIX ?= /usr/local BINDIR ?= ${PREFIX}/bin LIBDIR ?= ${INSTALL_PATH} MANDIR ?= ${PREFIX}/man # set to non-empty value to install manpages in addition to html help: INSTALL_MANPAGES ?= DEVBUILDSTYLE = Development DEPBUILDSTYLE = Deployment #------------------------------------------------------------------------------------------------------- # meta targets meta := all install embedded install-embedded clean distclean test styles := develop deploy PBXBUILD = /usr/bin/pbxbuild all := ${styles} all : ${all} install := ${styles:%=install-%} install : ${install} install-%: action := install- BUILD = ${PBXBUILD} SYMROOT="${BUILD_DIR}" -target "${TARGET}" embedded := ${styles:%=embedded-%} embedded : embedded-deploy install-embedded := ${embedded:%=install-%} install-embedded : install-embedded-deploy clean := ${styles:%=clean-%} clean : ${clean} clean-%: action := clean- distclean := ${styles:%=distclean-%} distclean : ${distclean} distclean-%: action := distclean- DEVBUILD = ${BUILD} -buildstyle "${DEVBUILDSTYLE}" DEPBUILD = ${BUILD} -buildstyle "${DEPBUILDSTYLE}" test := ${styles:%=test-%} test : ${test} test-%: action := test- targets := $(foreach v,${meta},${$v}) #------------------------------------------------------------------------------------------------------- # build styles INSTALLOPTS = INSTALL_ROOT="${INSTALL_ROOT}" BUILD_STYLE = CONFIGURE_ARGS = OBJ_DIR = ${OBJROOT}/${BUILD_STYLE} develop_make_args := BUILD_STYLE=Development CONFIGURE_ARGS=--enable-symbols deploy_make_args := BUILD_STYLE=Deployment INSTALL_TARGET=install-strip \ GENERIC_FLAGS=-DNDEBUG EMBEDDEDOPTS = EMBEDDED_BUILD=1 embedded_make_args := EMBEDDED_BUILD=1 install_make_args := INSTALL_BUILD=1 ################################################################################ ${targets}: ${MAKE} ${action}${PROJECT} \ $(foreach s,${styles} embedded install,$(if $(findstring $s,$@),${${s}_make_args})) all: develop deploy #------------------------------------------------------------------------------------------------------- # project specific settings install: install-develop install-deploy PROJECT := tcl PRODUCT_NAME := Tcl embedded: embedded-deploy UNIX_DIR := ${CURDIR}/../unix VERSION := $(shell awk -F= '/^TCL_VERSION/ {print $$2; nextfile}' ${UNIX_DIR}/configure.in) TCLSH := tclsh${VERSION} BUILD_TARGET := all tcltest install-embedded: install-embedded-deploy INSTALL_TARGET := install clean: clean-develop clean-deploy export CPPROG := cp -p ################################################################################ INSTALL_TARGETS = install-binaries install-libraries ifeq (${EMBEDDED_BUILD},) INSTALL_TARGETS += install-private-headers endif ifeq (${INSTALL_BUILD}_${EMBEDDED_BUILD}_${BUILD_STYLE},1__Deployment) INSTALL_TARGETS += html-tcl ifneq (${INSTALL_MANPAGES},) INSTALL_TARGETS += install-doc endif endif MAKE_VARS := INSTALL_ROOT INSTALL_TARGETS VERSION GENERIC_FLAGS MAKE_ARGS_V = $(foreach v,${MAKE_VARS},$v='${$v}') develop: ${DEVBUILD} build-${PROJECT}: target = ${BUILD_TARGET} install-${PROJECT}: target = ${INSTALL_TARGET} clean-${PROJECT} distclean-${PROJECT} test-${PROJECT}: \ target = $* deploy: ${DEPBUILD} DO_MAKE = +${MAKE} -C ${OBJ_DIR} ${target} ${MAKE_ARGS_V} ${MAKE_ARGS} ${EXTRA_MAKE_ARGS} install-develop: ${DEVBUILD} install ${INSTALLOPTS} #------------------------------------------------------------------------------------------------------- # build rules ${PROJECT}: install-deploy: ${MAKE} install-${PROJECT} INSTALL_ROOT=${OBJ_DIR}/ ${DEPBUILD} install ${INSTALLOPTS} embedded-develop: ${DEVBUILD} ${EMBEDDEDOPTS} ${OBJ_DIR}/Makefile: ${UNIX_DIR}/Makefile.in ${UNIX_DIR}/configure \ ${UNIX_DIR}/tclConfig.sh.in Tcl-Info.plist.in mkdir -p ${OBJ_DIR} && cd ${OBJ_DIR} && \ if [ ${UNIX_DIR}/configure -nt config.status ]; then ${UNIX_DIR}/configure \ --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} \ --mandir=${MANDIR} --enable-threads --enable-framework \ ${CONFIGURE_ARGS} ${EXTRA_CONFIGURE_ARGS}; else ./config.status; fi embedded-deploy: ${DEPBUILD} ${EMBEDDEDOPTS} build-${PROJECT}: ${OBJ_DIR}/Makefile ${DO_MAKE} ifeq (${INSTALL_BUILD},) # symolic link hackery to trick # 'make install INSTALL_ROOT=${OBJ_DIR}' # into building Tcl.framework and tclsh in ${SYMROOT} @cd ${OBJ_DIR} && mkdir -p $(dir ./${LIBDIR}) $(dir ./${BINDIR}) ${SYMROOT} && \ rm -f ./${LIBDIR} ./${BINDIR} && ln -fs ${SYMROOT} ./${LIBDIR} && \ ln -fs ${SYMROOT} ./${BINDIR} && ln -fs ${OBJ_DIR}/tcltest ${SYMROOT} endif install-${PROJECT}: build-${PROJECT} ifeq (${EMBEDDED_BUILD}_${INSTALL_ROOT},1_) install-embedded-develop: ${DEVBUILD} install ${INSTALLOPTS} ${EMBEDDEDOPTS} install-embedded-deploy: ${DEPBUILD} install ${INSTALLOPTS} ${EMBEDDEDOPTS} clean-develop: ${DEVBUILD} clean clean-deploy: @echo "Cannot install-embedded with empty INSTALL_ROOT !" && false endif ifeq (${EMBEDDED_BUILD},1) @rm -rf "${INSTALL_ROOT}/${LIBDIR}/Tcl.framework" endif ${DO_MAKE} ifeq (${INSTALL_BUILD},1) ifeq (${EMBEDDED_BUILD},1) # if we are embedding frameworks, don't install tclsh @rm -f "${INSTALL_ROOT}${BINDIR}/${TCLSH}" && \ rmdir -p "${INSTALL_ROOT}${BINDIR}" 2>&- || true else # redo prebinding (when not building for Mac OS X 10.4 or later only) @if [ "`echo "$${MACOSX_DEPLOYMENT_TARGET}" | \ awk -F '10\\.' '{print int($$2)}'`" -lt 4 -a "`echo "$${CFLAGS}" | \ awk -F '-mmacosx-version-min=10\\.' '{print int($$2)}'`" -lt 4 ]; \ then cd ${INSTALL_ROOT}/; \ if [ ! -d usr/lib ]; then mkdir -p usr && ln -fs /usr/lib usr/ && RM_USRLIB=1; fi; \ if [ ! -d System ]; then ln -fs /System . && RM_SYSTEM=1; fi; \ redo_prebinding -r . "./${LIBDIR}/${PRODUCT_NAME}.framework/Versions/${VERSION}/${PRODUCT_NAME}"; \ redo_prebinding -r . "./${BINDIR}/${TCLSH}"; \ if [ -n "$${RM_USRLIB:-}" ]; then rm -f usr/lib; rmdir -p usr 2>&-; fi; \ if [ -n "$${RM_SYSTEM:-}" ]; then rm -f System; fi; fi # install tclsh symbolic link @ln -fs ${TCLSH} ${INSTALL_ROOT}${BINDIR}/tclsh endif endif ifeq (${BUILD_STYLE}_${EMBEDDED_BUILD},Development_) # keep copy of debug library around, so that # Deployment build can be installed on top ${DEPBUILD} clean # of Development build without overwriting ################################################################################ # the debug library @cd ${INSTALL_ROOT}${LIBDIR}/${PRODUCT_NAME}.framework/Versions/${VERSION} && \ ln -f "${PRODUCT_NAME}" "${PRODUCT_NAME}_debug" endif clean-${PROJECT}: %-${PROJECT}: ${DO_MAKE} rm -rf ${SYMROOT}/{${PRODUCT_NAME}.framework,${TCLSH},tcltest} rm -f ${OBJ_DIR}{${LIBDIR},${BINDIR}} && \ rmdir -p ${OBJ_DIR}$(dir ${LIBDIR}) 2>&- || true && \ rmdir -p ${OBJ_DIR}$(dir ${BINDIR}) 2>&- || true forceRelink: @-cd ${BUILD_DIR}; \ rm -rf Tcl.framework tclsh8.4 \ Development.build/Tcl.build/Tcl Deployment.build/Tcl.build/Tcl distclean-${PROJECT}: %-${PROJECT}: clean-${PROJECT} ${DO_MAKE} rm -rf ${OBJ_DIR} test-${PROJECT}: %-${PROJECT}: build-${PROJECT} ${DO_MAKE} ################################################################################ #------------------------------------------------------------------------------------------------------- .PHONY: all install embedded clean develop deploy install-develop install-deploy \ .PHONY: ${meta} ${targets} ${PROJECT} build-${PROJECT} install-${PROJECT} \ embedded-develop embedded-deploy install-embedded-develop install-embedded-deploy \ clean-develop clean-deploy forceRelink \ clean-${PROJECT} distclean-${PROJECT} .NOTPARALLEL: ################################################################################ #-------------------------------------------------------------------------------------------------------

	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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	Tcl Mac OS X README ------------------- RCS: @(#) $Id: README,v 1.1.2.9 2007/04/29 02:21:33 das Exp $ This is the README file for the Mac OS X/Darwin version of Tcl. 1. Where to go for support -------------------------- - The tcl-mac mailing list on sourceforge is the best place to ask questions specific to Tcl & Tk on Mac OS X: http://lists.sourceforge.net/lists/listinfo/tcl-mac (this page also has a link to searchable archives of the list, please check them before asking on the list, many questions have already been answered). - For general Tcl/Tk questions, the newsgroup comp.lang.tcl is your best bet: http://groups.google.com/group/comp.lang.tcl/ - The Tcl'ers Wiki also has many pages dealing with Tcl & Tk on Mac OS X, see http://wiki.tcl.tk/references/3753! http://wiki.tcl.tk/references/8361! - Please report bugs with Tcl or Tk on Mac OS X to the sourceforge bug trackers: Tcl: http://sf.net/tracker/?func=add&group_id=10894&atid=110894 Tk: http://sf.net/tracker/?func=add&group_id=12997&atid=112997 please make sure that your report Tk specific bugs to the tktoolkit project bug tracker rather than the tcl project bug tracker. Mac OS X specific bugs should usually be assigned to 'das' or 'wolfsuit'. 2. Using Tcl on Mac OS X ------------------------ - At a minimum, Mac OS X 10.1 is required to run Tcl, but OS X 10.3 or higher is recommended (certain [file] operations behave incorrectly on earlier releases). - Unless weak-linking is used, Tcl built on Mac OS X 10.x will not run on 10.y with y < x; on the other hand Tcl built on 10.y will always run on 10.x with y <= x (but without any of the fixes and optimizations that would be available in a binary built on 10.x). Weak-linking is available on OS X 10.2 or later, it additionally allows Tcl built on 10.x to run on any 10.y with x > y >= z (for a chosen z >= 2). - Tcl extensions can be installed in any of: $HOME/Library/Tcl /Library/Tcl /Network/Library/Tcl /System/Library/Tcl $HOME/Library/Frameworks /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks (searched in that order). Given a potential package directory $pkg, Tcl on OSX checks for the file $pkg/Resources/Scripts/pkgIndex.tcl as well as the usual $pkg/pkgIndex.tcl. This allows building extensions as frameworks with all script files contained in the Resources/Scripts directory of the framework. - [load]able binary extensions can linked as either ordinary shared libraries (.dylib) or as MachO bundles (since 8.4.10/8.5a3); only bundles can be unloaded, and bundles are also loaded more efficiently from VFS (no temporary copy to the native filesystem required). - The 'deploy' target of macosx/Makefile installs the html manpages into the standard documentation location in the Tcl framework: Tcl.framework/Resources/Documentation/Reference/Tcl No nroff manpages are installed by default by the Makefile. - The Tcl framework can be installed in any of the system's standard framework directories: $HOME/Library/Frameworks /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks 3. Building Tcl on Mac OS X --------------------------- - At least Mac OS X 10.1 is required to build Tcl, and Apple's Developer Tools need to be installed (only the most recent version matching your OS release is supported). The Developer Tools installer is available on Mac OS X retail disks or is present in /Applications/Installers on Macs that came with OS X preinstalled. The most recent version can be downloaded from the ADC website http://connect.apple.com (after you register for free ADC membership). - Tcl is most easily built as a Mac OS X framework via Makefile in tcl/macosx (see below for details), but can also be built with the standard unix configure and make buildsystem in tcl/unix as on any other unix platform (indeed, the Makefile is just a wrapper around the unix buildsystem). The Mac OS X specific configure flags are --enable-framework and --disable-corefoundation (which disables CF and notably reverts to the standard select based notifier). - It is also possible to build with Apple's IDE via the tcl/macosx/Tcl.pbproj project, this simply calls through to the tcl/macosx/Makefile. - To build universal binaries, set CFLAGS as follows: export CFLAGS="-arch ppc -arch ppc64 -arch i386 -arch x86_64 \ -isysroot /Developer/SDKs/MacOSX10.4u.sdk -mmacosx-version-min=10.4" This requires Mac OS X 10.4 and Xcode 2.4 (or Xcode 2.2 if -arch x86_64 is omitted, but _not_ Xcode 2.1) and will work on any of the architectures (the -isysroot flag is only required on PowerPC Tiger). Note that configure requires CFLAGS to contain a least one architecture that can be run on the build machine (i.e. ppc on G3/G4, ppc or ppc64 on G5, ppc or i386 on Core and ppc, i386 or x86_64 on Core2/Xeon). Universal builds of Tcl TEA extensions are also possible with CFLAGS set as above, they will be [load]able by universal as well as thin binaries of Tcl. - To enable weak-linking, set the MACOSX_DEPLOYMENT_TARGET environment variable to the minimal OS version (>= 10.2) the binaries should be able to run on, e.g: export MACOSX_DEPLOYMENT_TARGET=10.2 This requires Mac OS X 10.2 and gcc 3.1; if you have gcc 4 or later you can set CFLAGS instead: export CFLAGS="-mmacosx-version-min=10.2" Support for weak-linking was added to the code for 8.4.14/8.5a5. Detailed Instructions for building with macosx/Makefile ------------------------------------------------------- - Unpack the tcl source release archive. - The following instructions assume the tcl source tree is named "tcl${ver}", where ${ver} is a shell variable containing the tcl version number (for example '8.4.12'). Setup the shell variable as follows: set ver="8.4.12" ;: if your shell is csh ver="8.4.12" ;: if your shell is sh The source tree will be named this way only if you are building from a release archive, if you are building from CVS, the version numbers will be missing; so set ${ver} to the empty string instead: set ver="" ;: if your shell is csh ver="" ;: if your shell is sh - The following steps will build Tcl from the Terminal, assuming you are located in the directory containing the tcl source tree: make -C tcl${ver}/macosx and the following will then install Tcl onto the root volume (admin password required): sudo make -C tcl${ver}/macosx install if you don't have the admin password, you can install into your home directory, instead by passing an INSTALL_ROOT argument to make: make -C tcl${ver}/macosx install INSTALL_ROOT="${HOME}/" - The default Makefile targets will build _both_ debug and optimized versions of the Tcl framework with the standard convention of naming the debug library Tcl.framework/Tcl_debug. This allows switching to the debug libraries at runtime by setting export DYLD_IMAGE_SUFFIX=_debug (c.f. man dyld for more details) If you only want to build and install the debug or optimized build, use the 'develop' or 'deploy' target variants of the Makefiles, respectively. For example, to build and install only the optimized versions: make -C tcl${ver}/macosx deploy sudo make -C tcl${ver}/macosx install-deploy

	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	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd"> <!-- Copyright (c) 2005-2007 Daniel A. Steffen <das@users.sourceforge.net> See the file "license.terms" for information on usage and redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. RCS: @(#) $Id: Tcl-Info.plist.in,v 1.1.2.3 2007/04/29 02:21:33 das Exp $ --> <plist version="1.0"> <dict> <key>CFBundleDevelopmentRegion</key> <string>English</string> <key>CFBundleExecutable</key> <string>@TCL_LIB_FILE@</string> <key>CFBundleGetInfoString</key> <string>Tcl @TCL_VERSION@@TCL_PATCH_LEVEL@, Copyright © @TCL_YEAR@ Tcl Core Team, Copyright © 2001-@TCL_YEAR@ Daniel A. Steffen, Initial MacOS X Port by Jim Ingham &amp; Ian Reid, Copyright © 2001-2002, Apple Computer, Inc.</string> <key>CFBundleIdentifier</key> <string>com.tcltk.tcllibrary</string> <key>CFBundleInfoDictionaryVersion</key> <string>6.0</string> <key>CFBundleName</key> <string>Tcl @TCL_VERSION@</string> <key>CFBundlePackageType</key> <string>FMWK</string> <key>CFBundleShortVersionString</key> <string>@TCL_VERSION@@TCL_PATCH_LEVEL@</string> <key>CFBundleSignature</key> <string>Tcl </string> <key>CFBundleVersion</key> <string>@TCL_VERSION@@TCL_PATCH_LEVEL@</string> </dict> </plist>

	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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	// !$*UTF8*$! { 00E2F845016E82EB0ACA28DC = { activeBuildStyle = 00E2F847016E82EB0ACA28DC; activeExecutable = F594E5F1030774B1016F146B; activeTarget = 00E2F84C016E8B780ACA28DC; addToTargets = ( ); codeSenseManager = F9D167E40610239A0027C147; executables = ( F53ACC52031D9AFE016F146B, F594E5F1030774B1016F146B, ); sourceControlManager = F9D167E30610239A0027C147; userBuildSettings = { SYMROOT = "${SRCROOT}/../../build/tcl"; }; }; 00E2F84C016E8B780ACA28DC = { activeExec = 0; }; F53ACC52031D9AFE016F146B = { activeArgIndex = 2147483647; activeArgIndices = ( NO, NO, ); argumentStrings = ( "${SRCROOT}/../../tcl/tests/all.tcl", "-verbose \"\"", ); configStateDict = { "PBXLSLaunchAction-0" = { PBXLSLaunchAction = 0; PBXLSLaunchStartAction = 1; PBXLSLaunchStdioStyle = 2; PBXLSLaunchStyle = 0; class = PBXLSRunLaunchConfig; displayName = "Executable Runner"; identifier = com.apple.Xcode.launch.runConfig; remoteHostInfo = ""; startActionInfo = ""; }; "PBXLSLaunchAction-1" = { PBXLSLaunchAction = 1; PBXLSLaunchStartAction = 1; PBXLSLaunchStdioStyle = 2; PBXLSLaunchStyle = 0; class = PBXGDB_LaunchConfig; displayName = GDB; identifier = com.apple.Xcode.launch.GDBMI_Config; remoteHostInfo = ""; startActionInfo = ""; }; }; cppStopOnCatchEnabled = 0; cppStopOnThrowEnabled = 0; customDataFormattersEnabled = 1; debuggerPlugin = GDBDebugging; disassemblyDisplayState = 0; dylibVariantSuffix = _debug; enableDebugStr = 0; environmentEntries = ( { active = YES; name = TCL_LIBRARY; value = "${SRCROOT}/../../tcl/library"; }, { active = NO; name = DYLD_PRINT_LIBRARIES; }, ); isa = PBXExecutable; launchableReference = F5C37CF303D5BEDF016F146B; libgmallocEnabled = 0; name = tcltest; shlibInfoDictList = ( ); sourceDirectories = ( ); startupPath = "<<ProductDirectory>>"; }; F594E5F1030774B1016F146B = { activeArgIndex = 2147483647; activeArgIndices = ( ); argumentStrings = ( ); configStateDict = { "PBXLSLaunchAction-0" = { PBXLSLaunchAction = 0; PBXLSLaunchStartAction = 1; PBXLSLaunchStdioStyle = 2; PBXLSLaunchStyle = 0; class = PBXLSRunLaunchConfig; displayName = "Executable Runner"; identifier = com.apple.Xcode.launch.runConfig; remoteHostInfo = ""; startActionInfo = ""; }; "PBXLSLaunchAction-1" = { PBXLSLaunchAction = 1; PBXLSLaunchStartAction = 1; PBXLSLaunchStdioStyle = 2; PBXLSLaunchStyle = 0; class = PBXGDB_LaunchConfig; displayName = GDB; identifier = com.apple.Xcode.launch.GDBMI_Config; remoteHostInfo = ""; startActionInfo = ""; }; }; cppStopOnCatchEnabled = 0; cppStopOnThrowEnabled = 0; customDataFormattersEnabled = 1; debuggerPlugin = GDBDebugging; disassemblyDisplayState = 0; dylibVariantSuffix = _debug; enableDebugStr = 0; environmentEntries = ( { active = NO; name = DYLD_PRINT_LIBRARIES; }, ); isa = PBXExecutable; launchableReference = F98F02E608E7EF9A00D0320A; libgmallocEnabled = 0; name = tclsh; shlibInfoDictList = ( ); sourceDirectories = ( ); startupPath = "<<ProductDirectory>>"; }; F5C37CF303D5BEDF016F146B = { isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.executable"; path = tcltest; refType = 3; sourceTree = BUILT_PRODUCTS_DIR; }; F98F02E608E7EF9A00D0320A = { isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.executable"; path = tclsh8.4; refType = 3; sourceTree = BUILT_PRODUCTS_DIR; }; F9D167E30610239A0027C147 = { fallbackIsa = XCSourceControlManager; isSCMEnabled = 0; isa = PBXSourceControlManager; scmConfiguration = { }; scmType = scm.cvs; }; F9D167E40610239A0027C147 = { indexTemplatePath = ""; isa = PBXCodeSenseManager; usesDefaults = 1; wantsCodeCompletion = 1; wantsCodeCompletionAutoSuggestions = 1; wantsCodeCompletionCaseSensitivity = 1; wantsCodeCompletionListAlways = 1; wantsCodeCompletionOnlyMatchingItems = 1; wantsCodeCompletionParametersIncluded = 1; wantsCodeCompletionPlaceholdersInserted = 1; wantsCodeCompletionTabCompletes = 1; wantsIndex = 1; }; }

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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405

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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173

- - - - - - - - - - - - - - - - + - + - - - - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - + + - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + + - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - - - + + + - - - + + - - + - - - + + + + + + + + + + + + + + + + + + + + + + + + + +

// !$*UTF8*$! { 005751AA02FB00930AC916F0 = { fRef = 005751AB02FB00930AC916F0; isa = PBXTextBookmark; name = "DefaultsDoc.rtf: 30"; rLen = 32; rLoc = 2777; rType = 0; vrLen = 1334; vrLoc = 2136; }; 005751AB02FB00930AC916F0 = { isa = PBXFileReference; name = DefaultsDoc.rtf; path = "/Developer/Applications/Project Builder.app/Contents/Resources/DefaultsDoc.rtf"; refType = 0; }; 00E2F845016E82EB0ACA28DC = { activeBuildStyle = 00E2F847016E82EB0ACA28DC; activeExecutable = F594E5F1030774B1016F146B; activeTarget = F50DC359017027D801DC9062; activeTarget = 00E2F84C016E8B780ACA28DC; addToTargets = ( 00E2F84C016E8B780ACA28DC, ); breakpoints = ( ); perUserDictionary = { PBXPerProjectTemplateStateSaveDate = 49920633; "PBXTemplateGeometry-F5314676015831810DCA290F" = { ContentSize = "{789, 551}"; LeftSlideOut = { Collapsed = NO; Frame = "{{0, 23}, {789, 528}}"; Split0 = { ActiveTab = 2; Collapsed = NO; Frame = "{{0, 0}, {789, 528}}"; Split0 = { Frame = "{{0, 204}, {789, 324}}"; }; SplitCount = 1; Tab0 = { Debugger = { codeSenseManager = F9D167E40610239A0027C147; Collapsed = NO; Frame = "{{0, 0}, {952, 321}}"; Split0 = { Frame = "{{0, 24}, {952, 297}}"; Split0 = { Frame = "{{0, 0}, {468, 297}}"; }; Split1 = { DebugVariablesTableConfiguration = ( Name, 123, Value, 85, Summary, 241.123, ); Frame = "{{477, 0}, {475, 297}}"; }; SplitCount = 2; }; SplitCount = 1; Tab0 = { executables = ( Frame = "{{0, 0}, {100, 50}}"; }; Tab1 = { Frame = "{{0, 0}, {100, 50}}"; }; TabCount = 2; TabsVisible = YES; }; Frame = "{{0, 0}, {952, 321}}"; LauncherConfigVersion = 7; }; Tab1 = { Frame = "{{0, 0}, {781, 452}}"; LauncherConfigVersion = 3; Runner = { Frame = "{{0, 0}, {781, 452}}"; }; }; Tab2 = { BuildMessageFrame = "{{0, 0}, {791, 191}}"; BuildTranscriptFrame = "{{0, 200}, {791, 0}}"; Frame = "{{0, 0}, {789, 198}}"; }; Tab3 = { Frame = "{{0, 0}, {612, 295}}"; }; TabCount = 4; TabsVisible = NO; }; SplitCount = 1; Tab0 = { Frame = "{{0, 0}, {300, 533}}"; GroupTreeTableConfiguration = ( TargetStatusColumn, 18, MainColumn, 267, ); F53ACC52031D9AFE016F146B, F594E5F1030774B1016F146B, ); }; Tab1 = { ClassesFrame = "{{0, 0}, {280, 398}}"; ClassesTreeTableConfiguration = ( PBXBookColumnIdentifier, 20, PBXClassColumnIdentifier, 237, ); Frame = "{{0, 0}, {278, 659}}"; MembersFrame = "{{0, 407}, {280, 252}}"; MembersTreeTableConfiguration = ( PBXBookColumnIdentifier, 20, PBXMethodColumnIdentifier, 236, ); }; Tab2 = { Frame = "{{0, 0}, {200, 100}}"; }; Tab3 = { Frame = "{{0, 0}, {200, 100}}"; TargetTableConfiguration = ( ActiveObject, 16, ObjectNames, 202.296, ); }; Tab4 = { BreakpointsTreeTableConfiguration = ( breakpointColumn, 197, enabledColumn, 31, ); Frame = "{{0, 0}, {250, 100}}"; }; TabCount = 5; TabsVisible = NO; }; StatusViewVisible = YES; Template = F5314676015831810DCA290F; ToolbarVisible = YES; WindowLocation = "{7, 385}"; }; PBXWorkspaceContents = ( sourceControlManager = F9D167E30610239A0027C147; { LeftSlideOut = { Split0 = { Split0 = { NavContent0 = { bookmark = 005751AA02FB00930AC916F0; history = ( F5BFE56402F8B7A901DC9062, F5BFE56702F8B7A901DC9062, 00F4D9CE02F9BA490AC916F0, ); prevStack = ( F5BFE56A02F8B7A901DC9062, ); }; NavCount = 1; NavGeometry0 = { Frame = "{{0, 0}, {571, 548}}"; NavBarVisible = YES; }; }; SplitCount = 1; Tab0 = { Debugger = { userBuildSettings = { SYMROOT = "${SRCROOT}/../../build/tcl"; Split0 = { SplitCount = 2; }; SplitCount = 1; TabCount = 2; }; LauncherConfigVersion = 7; }; }; Tab1 = { LauncherConfigVersion = 3; Runner = { }; }; TabCount = 4; }; SplitCount = 1; Tab1 = { OptionsSetName = "Default Options"; }; TabCount = 5; }; }, ); PBXWorkspaceGeometries = ( { ContentSize = "{855, 571}"; LeftSlideOut = { ActiveTab = 0; Collapsed = NO; Frame = "{{0, 23}, {855, 548}}"; Split0 = { Collapsed = NO; Frame = "{{284, 0}, {571, 548}}"; Split0 = { Frame = "{{0, 0}, {571, 548}}"; }; SplitCount = 1; Tab0 = { Debugger = { Collapsed = NO; Frame = "{{0, 0}, {681, 289}}"; Split0 = { Frame = "{{0, 24}, {681, 265}}"; Split0 = { Frame = "{{0, 0}, {333, 265}}"; }; Split1 = { DebugVariablesTableConfiguration = ( Name, 82.80298, Value, 104.074, Summary, 126.123, ); Frame = "{{342, 0}, {339, 265}}"; }; SplitCount = 2; }; SplitCount = 1; Tab0 = { Frame = "{{0, 0}, {100, 50}}"; }; Tab1 = { Frame = "{{0, 0}, {100, 50}}"; }; TabCount = 2; TabsVisible = YES; }; Frame = "{{0, 0}, {681, 289}}"; LauncherConfigVersion = 7; }; Tab1 = { Frame = "{{0, 0}, {681, 120}}"; LauncherConfigVersion = 3; Runner = { Frame = "{{0, 0}, {681, 120}}"; }; }; Tab2 = { BuildMessageFrame = "{{0, 0}, {683, 127}}"; BuildTranscriptFrame = "{{0, 136}, {683, 100}}"; Frame = "{{0, 0}, {681, 234}}"; }; Tab3 = { Frame = "{{0, 0}, {681, 238}}"; }; TabCount = 4; TabsVisible = NO; }; SplitCount = 1; Tab0 = { Frame = "{{0, 0}, {260, 548}}"; GroupTreeTableConfiguration = ( SCMStatusColumn, 22, TargetStatusColumn, 18, MainColumn, 205, ); }; Tab1 = { ClassesFrame = "{{0, 0}, {250, 333}}"; ClassesTreeTableConfiguration = ( PBXBookColumnIdentifier, 20, PBXClassColumnIdentifier, 207, ); Frame = "{{0, 0}, {248, 554}}"; MembersFrame = "{{0, 342}, {250, 212}}"; MembersTreeTableConfiguration = ( PBXBookColumnIdentifier, 20, PBXMethodColumnIdentifier, 206, ); }; Tab2 = { Frame = "{{0, 0}, {217, 554}}"; }; Tab3 = { Frame = "{{0, 0}, {239, 548}}"; TargetTableConfiguration = ( ActiveObject, 16, ObjectNames, 206, ); }; Tab4 = { BreakpointsTreeTableConfiguration = ( breakpointColumn, 197, enabledColumn, 31, ); Frame = "{{0, 0}, {250, 554}}"; }; TabCount = 5; TabsVisible = YES; }; StatusViewVisible = YES; Template = 64ABBB4501FA494900185B06; ToolbarVisible = YES; WindowLocation = "{77, 330}"; }, ); PBXWorkspaceStateSaveDate = 49920633; }; perUserProjectItems = { 005751AA02FB00930AC916F0 = 005751AA02FB00930AC916F0; 00F4D9CE02F9BA490AC916F0 = 00F4D9CE02F9BA490AC916F0; F5BFE56402F8B7A901DC9062 = F5BFE56402F8B7A901DC9062; F5BFE56702F8B7A901DC9062 = F5BFE56702F8B7A901DC9062; F5BFE56A02F8B7A901DC9062 = F5BFE56A02F8B7A901DC9062; }; projectwideBuildSettings = { OBJROOT = "/Volumes/TheCloset/jingham/tcl-tk/source/tcl-merge/Objects"; SYMROOT = "/Volumes/TheCloset/jingham/tcl-tk/source/tcl-merge/Products"; }; wantsIndex = 1; wantsSCM = 1; }; 00E2F84B016E8A830ACA28DC = { activeExec = 0; }; 00E2F84C016E8B780ACA28DC = { activeExec = 0; }; 00E2F84E016E92110ACA28DC = { activeExec = 0; }; 00F4D9CE02F9BA490AC916F0 = { fRef = 00F4D9CF02F9BA4A0AC916F0; isa = PBXTextBookmark; name = "DefaultsDoc.rtf: 30"; rLen = 32; rLoc = 2777; rType = 0; vrLen = 1334; vrLoc = 2136; }; 00F4D9CF02F9BA4A0AC916F0 = { isa = PBXFileReference; name = DefaultsDoc.rtf; path = "/Developer/Applications/Project Builder.app/Contents/Resources/DefaultsDoc.rtf"; refType = 0; F53ACC52031D9AFE016F146B = { activeArgIndex = 2147483647; activeArgIndices = ( NO, NO, ); argumentStrings = ( "${SRCROOT}/../../tcl/tests/all.tcl", "-verbose \"\"", ); configStateDict = { "PBXLSLaunchAction-0" = { PBXLSLaunchAction = 0; PBXLSLaunchStartAction = 1; PBXLSLaunchStdioStyle = 2; PBXLSLaunchStyle = 0; class = PBXLSRunLaunchConfig; displayName = "Executable Runner"; identifier = com.apple.Xcode.launch.runConfig; remoteHostInfo = ""; startActionInfo = ""; }; "PBXLSLaunchAction-1" = { PBXLSLaunchAction = 1; PBXLSLaunchStartAction = 1; PBXLSLaunchStdioStyle = 2; PBXLSLaunchStyle = 0; class = PBXGDB_LaunchConfig; displayName = GDB; identifier = com.apple.Xcode.launch.GDBMI_Config; remoteHostInfo = ""; startActionInfo = ""; }; }; cppStopOnCatchEnabled = 0; cppStopOnThrowEnabled = 0; customDataFormattersEnabled = 1; debuggerPlugin = GDBDebugging; disassemblyDisplayState = 0; dylibVariantSuffix = _debug; enableDebugStr = 0; environmentEntries = ( { active = YES; name = TCL_LIBRARY; value = "${SRCROOT}/../../tcl/library"; }, { active = NO; name = DYLD_PRINT_LIBRARIES; }, ); isa = PBXExecutable; launchableReference = F5C37CF303D5BEDF016F146B; libgmallocEnabled = 0; name = tcltest; shlibInfoDictList = ( ); sourceDirectories = ( ); startupPath = "<<ProductDirectory>>"; }; F50DC359017027D801DC9062 = { activeExec = 0; F594E5F1030774B1016F146B = { activeArgIndex = 2147483647; activeArgIndices = ( }; F5BFE56402F8B7A901DC9062 = { fRef = F5BFE56E02F8B7AA01DC9062; isa = PBXTextBookmark; name = "stat.h: 1"; rLen = 0; rLoc = 0; rType = 0; vrLen = 1666; vrLoc = 3618; }; F5BFE56702F8B7A901DC9062 = { fRef = F5F24F6E016ECAA401DC9062; isa = PBXTextBookmark; name = "tcl.h: 397"; rLen = 6; rLoc = 11199; rType = 0; vrLen = 1293; vrLoc = 10644; ); argumentStrings = ( ); configStateDict = { "PBXLSLaunchAction-0" = { PBXLSLaunchAction = 0; PBXLSLaunchStartAction = 1; PBXLSLaunchStdioStyle = 2; PBXLSLaunchStyle = 0; class = PBXLSRunLaunchConfig; displayName = "Executable Runner"; identifier = com.apple.Xcode.launch.runConfig; remoteHostInfo = ""; startActionInfo = ""; }; "PBXLSLaunchAction-1" = { PBXLSLaunchAction = 1; PBXLSLaunchStartAction = 1; PBXLSLaunchStdioStyle = 2; PBXLSLaunchStyle = 0; class = PBXGDB_LaunchConfig; displayName = GDB; identifier = com.apple.Xcode.launch.GDBMI_Config; remoteHostInfo = ""; startActionInfo = ""; }; }; cppStopOnCatchEnabled = 0; cppStopOnThrowEnabled = 0; customDataFormattersEnabled = 1; debuggerPlugin = GDBDebugging; disassemblyDisplayState = 0; dylibVariantSuffix = _debug; enableDebugStr = 0; environmentEntries = ( { active = NO; name = DYLD_PRINT_LIBRARIES; }, ); isa = PBXExecutable; launchableReference = F98F02E608E7EF9A00D0320A; libgmallocEnabled = 0; name = tclsh; shlibInfoDictList = ( ); sourceDirectories = ( ); startupPath = "<<ProductDirectory>>"; }; F5BFE56A02F8B7A901DC9062 = { F5C37CF303D5BEDF016F146B = { fRef = F5F24F6E016ECAA401DC9062; isa = PBXTextBookmark; name = "tcl.h: 397"; rLen = 6; isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.executable"; path = tcltest; rLoc = 11199; rType = 0; vrLen = 1293; refType = 3; sourceTree = BUILT_PRODUCTS_DIR; vrLoc = 10644; }; F5BFE56E02F8B7AA01DC9062 = { F98F02E608E7EF9A00D0320A = { isa = PBXFileReference; name = stat.h; path = /usr/include/sys/stat.h; refType = 0; lastKnownFileType = "compiled.mach-o.executable"; path = tclsh8.4; refType = 3; sourceTree = BUILT_PRODUCTS_DIR; }; F9D167E30610239A0027C147 = { fallbackIsa = XCSourceControlManager; isSCMEnabled = 0; isa = PBXSourceControlManager; scmConfiguration = { }; scmType = scm.cvs; }; F9D167E40610239A0027C147 = { indexTemplatePath = ""; isa = PBXCodeSenseManager; usesDefaults = 1; wantsCodeCompletion = 1; wantsCodeCompletionAutoSuggestions = 1; wantsCodeCompletionCaseSensitivity = 1; wantsCodeCompletionListAlways = 1; wantsCodeCompletionOnlyMatchingItems = 1; wantsCodeCompletionParametersIncluded = 1; wantsCodeCompletionPlaceholdersInserted = 1; wantsCodeCompletionTabCompletes = 1; wantsIndex = 1; }; }

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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228	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	- + - + - - + - - - - - - - - - - + - - - - - - - - - - - - - - - - + - - - - + - - - - + - - + - + - - - - - - - - - - - - - - - - - - + - - - - - - + - - + - - - - - - + - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - + + + - - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -	// !$*UTF8*$! { archiveVersion = 1; classes = { }; objectVersion = 38; objectVersion = 39; objects = { 00530A0D0173C8270ACA28DC = { 00E2F845016E82EB0ACA28DC = { buildActionMask = 12; files = ( buildSettings = { ); generatedFileNames = ( ); isa = PBXShellScriptBuildPhase; neededFileNames = ( ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/sh; shellScript = "# install to ${INSTALL_ROOT} with optional stripping\ncd ${TEMP_DIR}/..\nif test \"${INSTALL_STRIP}\" = \"YES\"; then\nexport INSTALL_PROGRAM='${INSTALL} ${INSTALL_STRIP_PROGRAM}'\nexport INSTALL_LIBRARY='${INSTALL} ${INSTALL_STRIP_LIBRARY}'\nelse\nexport INSTALL_PROGRAM='${INSTALL}'\nexport INSTALL_LIBRARY='${INSTALL}'\nfi\nexport CPPROG='cp -p'\ngnumake install-binaries install-libraries TCL_LIBRARY=\"@TCL_IN_FRAMEWORK@\" INSTALL_ROOT=\"${INSTALL_ROOT}\" SCRIPT_INSTALL_DIR=\"${INSTALL_ROOT}${LIBDIR}/Resources/Scripts\" INSTALL_PROGRAM=\"${INSTALL_PROGRAM}\" INSTALL_LIBRARY=\"${INSTALL_LIBRARY}\""; }; }; 00530A0E0173CC960ACA28DC = { buildActionMask = 12; files = ( ); generatedFileNames = ( ); isa = PBXShellScriptBuildPhase; neededFileNames = ( ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/sh; shellScript = "# fixup Framework structure\ncd \"${INSTALL_ROOT}${LIBDIR}\"\nln -fs Versions/Current/Headers ../..\nmv -f tclConfig.sh Resources\nln -fs \"Resources/tclConfig.sh\" ../..\nln -fs `ls libtclstub* | sed -e 's|.*|Versions/Current/&|'` ../..\nif [ \"${BUILD_STYLE}\" = \"Development\" ]; then\n\t# keep copy of debug library around, so that\n\t# Deployment build can be installed on top\n\t# of Development build without overwriting\n\t# the debug library\n\tcp -fp \"${PRODUCT_NAME}\" \"${PRODUCT_NAME}_debug\"\n\tln -fs \"Versions/Current/${PRODUCT_NAME}_debug\" ../..\nfi"; }; 00E2F845016E82EB0ACA28DC = { buildStyles = ( 00E2F847016E82EB0ACA28DC, 00E2F848016E82EB0ACA28DC, ); hasScannedForEncodings = 1; isa = PBXProject; mainGroup = 00E2F846016E82EB0ACA28DC; productRefGroup = 00E2F84A016E8A830ACA28DC; projectDirPath = ""; targets = ( 00E2F84E016E92110ACA28DC, 00E2F84B016E8A830ACA28DC, 00E2F84C016E8B780ACA28DC, ); }; 00E2F846016E82EB0ACA28DC = { children = ( F5306CA003CAC9AE016F146B, F5306C9F03CAC979016F146B, F5C88655017D604601DC9062, F5F24FEE016ED0DF01DC9062, 00E2F855016E922C0ACA28DC, 00E2F857016E92B00ACA28DC, 00E2F85A016E92B00ACA28DC, 00E2F84A016E8A830ACA28DC, ); isa = PBXGroup; refType = 4; sourceTree = "<group>"; }; 00E2F847016E82EB0ACA28DC = { buildRules = ( ); buildSettings = { EXTRA_CONFIGURE_FLAGS = "--enable-symbols"; INSTALL_STRIP = NO; MAKE_TARGET = develop; TEMP_DIR = "${OBJROOT}/Development.build/$(PROJECT_NAME).build/$(TARGET_NAME).build"; }; isa = PBXBuildStyle; name = Development; }; 00E2F848016E82EB0ACA28DC = { buildRules = ( ); buildSettings = { INSTALL_STRIP = YES; MAKE_TARGET = deploy; TEMP_DIR = "${OBJROOT}/Deployment.build/$(PROJECT_NAME).build/$(TARGET_NAME).build"; }; isa = PBXBuildStyle; name = Deployment; }; 00E2F84A016E8A830ACA28DC = { children = ( 00E2F84D016E92110ACA28DC, F53ACC73031DA405016F146B, F53ACC5C031D9D11016F146B, F53ACC73031DA405016F146B, F9A61C9D04C2B4E3006F5A0B, ); isa = PBXGroup; name = Products; refType = 4; }; 00E2F84B016E8A830ACA28DC = { buildArgumentsString = "-c \"if [ \\\"${ACTION}\\\" != \\\"clean\\\" ]; then if [ -z \\\"`find . ! \\\\( -path './*/*' -prune \\\\) -name Makefile -newer \\\"${SRCROOT}/../unix/configure\\\"`\\\" ]; then \\\"${SRCROOT}/../unix/configure\\\" --prefix=/usr --mandir=/usr/share/man --libdir=\\\"${LIBDIR}\\\" --includedir=\\\"${LIBDIR}/Headers\\\" --enable-threads --enable-framework ${EXTRA_CONFIGURE_FLAGS}; mkdir -p Tcl.framework; ln -fs ../Tcl Tcl.framework/Tcl; fi; fi\""; buildPhases = ( ); buildSettings = { EXTRA_CONFIGURE_FLAGS = ""; FRAMEWORK_VERSION = 8.4; INSTALL_PATH = /Library/Frameworks; LIBDIR = "${INSTALL_PATH}/${PRODUCT_NAME}.framework/Versions/${FRAMEWORK_VERSION}"; PRODUCT_NAME = Tcl; }; buildToolPath = /bin/sh; buildWorkingDirectory = "${TEMP_DIR}/.."; dependencies = ( ); isa = PBXLegacyTarget; name = Configure; sourceTree = "<group>"; passBuildSettingsInEnvironment = 1; productName = Configure; settingsToExpand = 6; settingsToPassInEnvironment = 287; settingsToPassOnCommandLine = 280; }; 00E2F84C016E8B780ACA28DC = { buildArgumentsString = "-c \"if [ \\\"${ACTION}\\\" != \\\"clean\\\" ]; then gnumake tclsh tcltest TCL_LIBRARY=\\\"@TCL_IN_FRAMEWORK@\\\" TCL_PACKAGE_PATH=\\\"~/Library/Tcl /Library/Tcl /Network/Library/Tcl /System/Library/Tcl ~/Library/Frameworks /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks\\\" DYLIB_INSTALL_DIR=\\\"${DYLIB_INSTALL_DIR}\\\" ${EXTRA_MAKE_FLAGS}; else gnumake distclean; fi\""; buildArgumentsString = "-c \"cd \\\"${TCL_SRCROOT}/macosx\\\" && ACTION=${ACTION} && gnumake \\${ACTION:+\\${ACTION/clean/distclean}-}${MAKE_TARGET} INSTALL_ROOT=\\\"${DSTROOT}\\\" INSTALL_PATH=\\\"${INSTALL_PATH}\\\" PREFIX=\\\"${PREFIX}\\\" BINDIR=\\\"${BINDIR}\\\" MANDIR=\\\"${MANDIR}\\\" \\${EXTRA_MAKE_FLAGS} ${ALL_SETTINGS}\""; buildPhases = ( ); buildSettings = { DYLIB_INSTALL_DIR = "${DYLIB_INSTALL_PATH}/${PRODUCT_NAME}.framework/Versions/${FRAMEWORK_VERSION}"; DYLIB_INSTALL_PATH = "${INSTALL_PATH}"; BINDIR = "${PREFIX}/bin"; EXTRA_MAKE_FLAGS = ""; FRAMEWORK_VERSION = 8.4; INSTALL_PATH = /Library/Frameworks; PRODUCT_NAME = Tcl; }; buildToolPath = /bin/sh; buildWorkingDirectory = "${TEMP_DIR}/.."; MANDIR = "${PREFIX}/man"; dependencies = ( F5877EB5031F7997016F146B, ); isa = PBXLegacyTarget; name = Make; PREFIX = /usr/local; passBuildSettingsInEnvironment = 1; productName = Make; settingsToExpand = 6; settingsToPassInEnvironment = 287; settingsToPassOnCommandLine = 280; }; 00E2F84D016E92110ACA28DC = { isa = PBXFrameworkReference; path = Tcl.framework; refType = 3; }; 00E2F84E016E92110ACA28DC = { buildPhases = ( F5877FB6031F97AF016F146B, F50DC36A01703B7301DC9062, F50DC367017033D701DC9062, F50DC3680170344801DC9062, 00E2F84F016E92110ACA28DC, F5BE9BBF02FB5974016F146B, 00530A0D0173C8270ACA28DC, 00530A0E0173CC960ACA28DC, F5877FBB031FA90A016F146B, F59AE5E3017AC67A01DC9062, ); buildSettings = { DSTROOT = "${TEMP_DIR}"; EXTRA_MAKE_INSTALL_FLAGS = ""; FRAMEWORK_VERSION = 8.4; INSTALL_PATH = /Library/Frameworks; LIBDIR = "${INSTALL_PATH}/${PRODUCT_NAME}.${WRAPPER_EXTENSION}/Versions/${FRAMEWORK_VERSION}"; PRODUCT_NAME = Tcl; TCL_SRCROOT = "${SRCROOT}/../../tcl"; WRAPPER_EXTENSION = framework; TEMP_DIR = "${PROJECT_TEMP_DIR}"; }; buildToolPath = /bin/bash; buildWorkingDirectory = "${SRCROOT}"; dependencies = ( F5877EB6031F79A4016F146B, ); isa = PBXFrameworkTarget; isa = PBXLegacyTarget; name = Tcl; productInstallPath = /Library/Frameworks; productName = TclLibrary; passBuildSettingsInEnvironment = 0; productName = Tcl; productReference = 00E2F84D016E92110ACA28DC; productSettingsXML = "<?xml version=\"1.0\" encoding=\"UTF-8\"?> <!DOCTYPE plist PUBLIC \"-//Apple Computer//DTD PLIST 1.0//EN\" \"http://www.apple.com/DTDs/PropertyList-1.0.dtd\"> <plist version=\"1.0\"> <dict> <key>CFBundleDevelopmentRegion</key> <string>English</string> <key>CFBundleExecutable</key> <string>Tcl</string> <key>CFBundleGetInfoString</key> <string>Tcl Library 8.4, Copyright © 2002 Tcl Core Team. MacOS X Port by Jim Ingham &lt;jingham@apple.com&gt; &amp; Ian Reid, Copyright © 2001-2002, Apple Computer, Inc.</string> <key>CFBundleIconFile</key> <string></string> <key>CFBundleIdentifier</key> <string>com.tcltk.tcllibrary</string> <key>CFBundleInfoDictionaryVersion</key> <string>6.0</string> <key>CFBundleName</key> <string>Tcl Library 8.4</string> <key>CFBundlePackageType</key> <string>FMWK</string> <key>CFBundleShortVersionString</key> <string>8.4.2</string> <key>CFBundleSignature</key> <string>Tcl </string> <key>CFBundleVersion</key> <string>8.4.2</string> </dict> </plist> "; }; 00E2F84F016E92110ACA28DC = { buildActionMask = 2147483647; files = ( F59D846A0338FAA4016F146B, F59D846B0338FAA4016F146B, F59D846E0338FAA4016F146B, F59D84620338F9CA016F146B, F59D846C0338FAA4016F146B, F59D846D0338FAA4016F146B, F5C093BB0342F7D6016F146B, ); isa = PBXHeadersBuildPhase; runOnlyForDeploymentPostprocessing = 0; }; 00E2F854016E922C0ACA28DC = { children = ( F5F24F87016ECAFC01DC9062, F5F24F88016ECAFC01DC9062, F5F24F89016ECAFC01DC9062, F5F24F8A016ECAFC01DC9062,
︙
298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320	161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185	+ +	F5F24FCF016ECAFC01DC9062, F5F24FD0016ECAFC01DC9062, ); isa = PBXGroup; name = Sources; path = ""; refType = 4; sourceTree = "<group>"; }; 00E2F855016E922C0ACA28DC = { children = ( 00E2F856016E92B00ACA28DC, 00E2F854016E922C0ACA28DC, ); isa = PBXGroup; name = generic; refType = 4; sourceTree = "<group>"; }; 00E2F856016E92B00ACA28DC = { children = ( F5F24F6B016ECAA401DC9062, F5F24F6C016ECAA401DC9062, F5F24F6D016ECAA401DC9062, F5F24F6E016ECAA401DC9062,
︙
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 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	195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256	+ + + + + +	F5F24F78016ECAA401DC9062, F5F24FD1016ECB1E01DC9062, F5F24FD2016ECB1E01DC9062, ); isa = PBXGroup; name = Headers; refType = 4; sourceTree = "<group>"; }; 00E2F857016E92B00ACA28DC = { children = ( 00E2F858016E92B00ACA28DC, 00E2F859016E92B00ACA28DC, ); isa = PBXGroup; name = macosx; refType = 4; sourceTree = "<group>"; }; 00E2F858016E92B00ACA28DC = { children = ( ); isa = PBXGroup; name = Headers; refType = 4; sourceTree = "<group>"; }; 00E2F859016E92B00ACA28DC = { children = ( F5A1836F018242A501DC9062, ); isa = PBXGroup; name = Sources; refType = 4; sourceTree = "<group>"; }; 00E2F85A016E92B00ACA28DC = { children = ( 00E2F85B016E92B00ACA28DC, 00E2F85C016E92B00ACA28DC, ); isa = PBXGroup; name = unix; refType = 4; sourceTree = "<group>"; }; 00E2F85B016E92B00ACA28DC = { children = ( F5F24FD6016ECC0F01DC9062, F5F24FD7016ECC0F01DC9062, ); isa = PBXGroup; name = Headers; refType = 4; sourceTree = "<group>"; }; 00E2F85C016E92B00ACA28DC = { children = ( F5F24FD8016ECC0F01DC9062, F5F24FD9016ECC0F01DC9062, F5F24FDB016ECC0F01DC9062, F5F24FDC016ECC0F01DC9062,
︙
394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433	265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364	+ - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + - - + + + - - + + - - + + + - - + - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - + - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	F5F24FE5016ECC0F01DC9062, F5F24FE6016ECC0F01DC9062, F5F24FE7016ECC0F01DC9062, ); isa = PBXGroup; name = Sources; refType = 4; sourceTree = "<group>"; }; //000 //001 //002 //003 //004 //F50 //F51 //F52 //F53 //F54 F50DC367017033D701DC9062 = { buildActionMask = 2147483647; files = ( ); isa = PBXFrameworksBuildPhase; runOnlyForDeploymentPostprocessing = 0; }; F50DC3680170344801DC9062 = { buildActionMask = 2147483647; files = ( ); isa = PBXResourcesBuildPhase; runOnlyForDeploymentPostprocessing = 0; }; F50DC36A01703B7301DC9062 = { buildActionMask = 2147483647; files = ( F59D84630338F9EC016F146B, F59D84640338F9ED016F146B, F59D84670338FA8B016F146B, F59D84680338FA8D016F146B, F59D84690338FA90016F146B, F5C093BA0342F7B4016F146B, ); isa = PBXSourcesBuildPhase; runOnlyForDeploymentPostprocessing = 0; }; F5306C9F03CAC979016F146B = { children = ( F5306CA303CAC9DE016F146B, F5306CA103CAC9DE016F146B, F5306CA203CAC9DE016F146B, ); isa = PBXGroup; name = "Build System"; refType = 4; sourceTree = "<group>"; }; F5306CA003CAC9AE016F146B = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = text; name = ChangeLog; path = ../ChangeLog; refType = 2; sourceTree = SOURCE_ROOT; }; F5306CA103CAC9DE016F146B = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = text.script.sh; name = configure.in; path = ../unix/configure.in; refType = 2; sourceTree = SOURCE_ROOT; }; F5306CA203CAC9DE016F146B = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = text; name = Makefile.in; path = ../unix/Makefile.in; refType = 2; sourceTree = SOURCE_ROOT; }; F5306CA303CAC9DE016F146B = { isa = PBXFileReference; lastKnownFileType = text; name = tcl.m4; path = ../unix/tcl.m4; refType = 2; sourceTree = SOURCE_ROOT; }; F53ACC5C031D9D11016F146B = { isa = PBXExecutableFileReference; name = tclsh8.4; isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.executable"; path = tclsh8.4; path = ../../build/tclsh8.4; refType = 2; refType = 3; sourceTree = BUILT_PRODUCTS_DIR; }; F53ACC73031DA405016F146B = { isa = PBXExecutableFileReference; name = tcltest; isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.executable"; path = tcltest; path = ../../build/tcltest; refType = 2; refType = 3; }; F5877EB5031F7997016F146B = { isa = PBXTargetDependency; target = 00E2F84B016E8A830ACA28DC; }; F5877EB6031F79A4016F146B = { isa = PBXTargetDependency; target = 00E2F84C016E8B780ACA28DC; }; F5877FB6031F97AF016F146B = { buildActionMask = 8; files = ( sourceTree = BUILT_PRODUCTS_DIR; ); generatedFileNames = ( ); isa = PBXShellScriptBuildPhase; neededFileNames = ( ); runOnlyForDeploymentPostprocessing = 1; shellPath = /bin/sh; shellScript = "# ensure we can overwrite a previous install\nif [ -d \"${INSTALL_ROOT}${INSTALL_PATH}/${PRODUCT_NAME}.${WRAPPER_EXTENSION}\" ]; then\n chmod -RH u+w \"${INSTALL_ROOT}${INSTALL_PATH}/${PRODUCT_NAME}.${WRAPPER_EXTENSION}\"\nfi"; }; F5877FBB031FA90A016F146B = { buildActionMask = 8; files = ( ); generatedFileNames = ( ); isa = PBXShellScriptBuildPhase; neededFileNames = ( ); runOnlyForDeploymentPostprocessing = 1; shellPath = /bin/sh; shellScript = "if [ -n \"${EMBEDDED_BUILD:-}\" ]; then\n# if we are embedding frameworks, don't install tclsh\nrm -f \"${INSTALL_ROOT}/usr/bin/tclsh${FRAMEWORK_VERSION}\"\nrmdir -p \"${INSTALL_ROOT}/usr/bin\" 2>&-\ntrue\nelse\n# redo prebinding\ncd \"${INSTALL_ROOT}\"\nif [ ! -d usr/lib ]; then mkdir -p usr; ln -fs /usr/lib usr/; RM_USRLIB=1; fi\nif [ ! -d System ]; then ln -fs /System .; RM_SYSTEM=1; fi\nredo_prebinding -r . \"./usr/bin/tclsh${FRAMEWORK_VERSION}\"\nif [ -n \"${RM_USRLIB:-}\" ]; then rm -f usr/lib; rmdir -p usr 2>&-; fi\nif [ -n \"${RM_SYSTEM:-}\" ]; then rm -f System; fi\n# install tclsh symbolic link\nmkdir -p \"${INSTALL_ROOT}/usr/bin\"\nln -fs \"tclsh${FRAMEWORK_VERSION}\" \"${INSTALL_ROOT}/usr/bin/tclsh\"\nfi"; }; F59AE5E3017AC67A01DC9062 = { buildActionMask = 8; files = ( ); generatedFileNames = ( ); isa = PBXShellScriptBuildPhase; neededFileNames = ( ); runOnlyForDeploymentPostprocessing = 1; shellPath = /bin/sh; shellScript = "if [ -z \"${EMBEDDED_BUILD:-}\" ]; then\n# build html documentation\nif [ \"${BUILD_STYLE}\" = \"Deployment\" ]; then\n cd \"${TEMP_DIR}/..\"\n export DYLD_FRAMEWORK_PATH=${SYMROOT}\n gnumake html DISTDIR=\"${INSTALL_ROOT}${LIBDIR}/Resources/English.lproj/Documentation/Reference\"\n cd \"${INSTALL_ROOT}${LIBDIR}/Resources/English.lproj/Documentation/Reference\"\n ln -fs contents.htm html/TclTOC.html\n rm -fr \"${PRODUCT_NAME}\"; mv -f html \"${PRODUCT_NAME}\"\nfi\nfi"; }; F59D84620338F9CA016F146B = { fileRef = F5F24F72016ECAA401DC9062; isa = PBXBuildFile; settings = { ATTRIBUTES = ( Private, ); }; }; F59D84630338F9EC016F146B = { fileRef = F5F24F73016ECAA401DC9062; isa = PBXBuildFile; settings = { }; }; F59D84640338F9ED016F146B = { fileRef = F5F24F74016ECAA401DC9062; isa = PBXBuildFile; settings = { }; }; F59D84670338FA8B016F146B = { fileRef = F5F24F6E016ECAA401DC9062; isa = PBXBuildFile; settings = { }; }; F59D84680338FA8D016F146B = { fileRef = F5F24F70016ECAA401DC9062; isa = PBXBuildFile; settings = { }; }; F59D84690338FA90016F146B = { fileRef = F5F24F77016ECAA401DC9062; isa = PBXBuildFile; settings = { }; }; F59D846A0338FAA4016F146B = { fileRef = F5F24F6E016ECAA401DC9062; isa = PBXBuildFile; settings = { }; }; F59D846B0338FAA4016F146B = { fileRef = F5F24F70016ECAA401DC9062; isa = PBXBuildFile; settings = { }; }; F59D846C0338FAA4016F146B = { fileRef = F5F24F73016ECAA401DC9062; isa = PBXBuildFile; settings = { ATTRIBUTES = ( Private, ); }; }; F59D846D0338FAA4016F146B = { fileRef = F5F24F74016ECAA401DC9062; isa = PBXBuildFile; settings = { ATTRIBUTES = ( Private, ); }; }; F59D846E0338FAA4016F146B = { fileRef = F5F24F77016ECAA401DC9062; isa = PBXBuildFile; settings = { }; }; F5A1836F018242A501DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; path = tclMacOSXBundle.c; refType = 2; }; F5BE9BBF02FB5974016F146B = { buildActionMask = 2147483647; files = ( sourceTree = SOURCE_ROOT; ); generatedFileNames = ( ); isa = PBXShellScriptBuildPhase; neededFileNames = ( ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/sh; shellScript = "# symolic link hackery to trick\n# 'make install INSTALL_ROOT=${TEMP_DIR}'\n# into building Tcl.framework and tclsh in ${SYMROOT}\ncd \"${TEMP_DIR}\"\nmkdir -p Library\nmkdir -p usr\nrm -f Library/Frameworks; ln -fs \"${SYMROOT}\" Library/Frameworks\nrm -f usr/bin; ln -fs \"${SYMROOT}\" usr/bin\nln -fs \"${TEMP_DIR}/../tcltest\" \"${SYMROOT}\""; }; F5C093BA0342F7B4016F146B = { fileRef = F5F24F76016ECAA401DC9062; isa = PBXBuildFile; settings = { }; }; F5C093BB0342F7D6016F146B = { fileRef = F5F24F76016ECAA401DC9062; isa = PBXBuildFile; settings = { ATTRIBUTES = ( Private, ); }; }; F5C88655017D604601DC9062 = { children = ( F5C88656017D604601DC9062, F5C88657017D60C901DC9062, F5C88658017D60C901DC9062, ); isa = PBXGroup; name = "Header Tools"; refType = 4; sourceTree = "<group>"; }; F5C88656017D604601DC9062 = { isa = PBXFileReference; lastKnownFileType = text; name = genStubs.tcl; path = ../tools/genStubs.tcl; refType = 2; sourceTree = SOURCE_ROOT; }; F5C88657017D60C901DC9062 = { isa = PBXFileReference; lastKnownFileType = text; name = tcl.decls; path = ../generic/tcl.decls; refType = 2; sourceTree = SOURCE_ROOT; }; F5C88658017D60C901DC9062 = { isa = PBXFileReference; lastKnownFileType = text; name = tclInt.decls; path = ../generic/tclInt.decls; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F6B016ECAA401DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = regcustom.h; path = ../generic/regcustom.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F6C016ECAA401DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = regerrs.h; path = ../generic/regerrs.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F6D016ECAA401DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = regguts.h; path = ../generic/regguts.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F6E016ECAA401DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = tcl.h; path = ../generic/tcl.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F6F016ECAA401DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = tclCompile.h; path = ../generic/tclCompile.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F70016ECAA401DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = tclDecls.h; path = ../generic/tclDecls.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F71016ECAA401DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = tclInitScript.h; path = ../generic/tclInitScript.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F72016ECAA401DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = tclInt.h; path = ../generic/tclInt.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F73016ECAA401DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = tclIntDecls.h; path = ../generic/tclIntDecls.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F74016ECAA401DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = tclIntPlatDecls.h; path = ../generic/tclIntPlatDecls.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F75016ECAA401DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = tclIO.h; path = ../generic/tclIO.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F76016ECAA401DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = tclMath.h; path = ../generic/tclMath.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F77016ECAA401DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = tclPlatDecls.h; path = ../generic/tclPlatDecls.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F78016ECAA401DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = tclRegexp.h; path = ../generic/tclRegexp.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F87016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = regc_color.c; path = ../generic/regc_color.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F88016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = regc_cvec.c; path = ../generic/regc_cvec.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F89016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = regc_lex.c; path = ../generic/regc_lex.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F8A016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = regc_locale.c; path = ../generic/regc_locale.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F8B016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = regc_nfa.c; path = ../generic/regc_nfa.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F8C016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = regcomp.c; path = ../generic/regcomp.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F8D016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = rege_dfa.c; path = ../generic/rege_dfa.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F8E016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = regerror.c; path = ../generic/regerror.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F8F016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = regexec.c; path = ../generic/regexec.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F90016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = regfree.c; path = ../generic/regfree.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F91016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = regfronts.c; path = ../generic/regfronts.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F92016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclAlloc.c; path = ../generic/tclAlloc.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F93016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclAsync.c; path = ../generic/tclAsync.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F94016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclBasic.c; path = ../generic/tclBasic.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F95016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclBinary.c; path = ../generic/tclBinary.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F96016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclCkalloc.c; path = ../generic/tclCkalloc.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F97016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclClock.c; path = ../generic/tclClock.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F98016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclCmdAH.c; path = ../generic/tclCmdAH.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F99016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclCmdIL.c; path = ../generic/tclCmdIL.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F9A016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclCmdMZ.c; path = ../generic/tclCmdMZ.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F9B016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclCompCmds.c; path = ../generic/tclCompCmds.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F9C016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclCompExpr.c; path = ../generic/tclCompExpr.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F9D016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclCompile.c; path = ../generic/tclCompile.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F9E016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclDate.c; path = ../generic/tclDate.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24F9F016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclEncoding.c; path = ../generic/tclEncoding.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FA0016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclEnv.c; path = ../generic/tclEnv.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FA1016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclEvent.c; path = ../generic/tclEvent.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FA2016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclExecute.c; path = ../generic/tclExecute.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FA3016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclFCmd.c; path = ../generic/tclFCmd.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FA4016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclFileName.c; path = ../generic/tclFileName.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FA5016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclGet.c; path = ../generic/tclGet.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FA6016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclHash.c; path = ../generic/tclHash.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FA7016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclHistory.c; path = ../generic/tclHistory.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FA8016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclIndexObj.c; path = ../generic/tclIndexObj.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FA9016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclInterp.c; path = ../generic/tclInterp.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FAA016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclIO.c; path = ../generic/tclIO.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FAB016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclIOCmd.c; path = ../generic/tclIOCmd.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FAC016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclIOGT.c; path = ../generic/tclIOGT.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FAD016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclIOSock.c; path = ../generic/tclIOSock.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FAE016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclIOUtil.c; path = ../generic/tclIOUtil.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FAF016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclLink.c; path = ../generic/tclLink.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FB0016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclListObj.c; path = ../generic/tclListObj.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FB1016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclLiteral.c; path = ../generic/tclLiteral.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FB2016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclLoad.c; path = ../generic/tclLoad.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FB3016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclLoadNone.c; path = ../generic/tclLoadNone.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FB4016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclMain.c; path = ../generic/tclMain.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FB5016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclNamesp.c; path = ../generic/tclNamesp.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FB6016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclNotify.c; path = ../generic/tclNotify.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FB7016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclObj.c; path = ../generic/tclObj.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FB8016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclPanic.c; path = ../generic/tclPanic.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FB9016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclParse.c; path = ../generic/tclParse.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FBA016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclParseExpr.c; path = ../generic/tclParseExpr.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FBB016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclPipe.c; path = ../generic/tclPipe.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FBC016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclPosixStr.c; path = ../generic/tclPosixStr.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FBD016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclPreserve.c; path = ../generic/tclPreserve.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FBE016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclProc.c; path = ../generic/tclProc.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FBF016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclRegexp.c; path = ../generic/tclRegexp.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FC0016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclResolve.c; path = ../generic/tclResolve.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FC1016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclResult.c; path = ../generic/tclResult.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FC2016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclScan.c; path = ../generic/tclScan.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FC3016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclStringObj.c; path = ../generic/tclStringObj.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FC4016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclStubInit.c; path = ../generic/tclStubInit.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FC5016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclStubLib.c; path = ../generic/tclStubLib.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FC6016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclTest.c; path = ../generic/tclTest.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FC7016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclTestObj.c; path = ../generic/tclTestObj.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FC8016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclTestProcBodyObj.c; path = ../generic/tclTestProcBodyObj.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FC9016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclThread.c; path = ../generic/tclThread.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FCA016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclThreadJoin.c; path = ../generic/tclThreadJoin.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FCB016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclThreadTest.c; path = ../generic/tclThreadTest.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FCC016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclTimer.c; path = ../generic/tclTimer.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FCD016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclUniData.c; path = ../generic/tclUniData.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FCE016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclUtf.c; path = ../generic/tclUtf.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FCF016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclUtil.c; path = ../generic/tclUtil.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FD0016ECAFC01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclVar.c; path = ../generic/tclVar.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FD1016ECB1E01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = regex.h; path = ../generic/regex.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FD2016ECB1E01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = tclPort.h; path = ../generic/tclPort.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FD3016ECB4901DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclPkg.c; path = ../generic/tclPkg.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FD6016ECC0F01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = tclUnixPort.h; path = ../unix/tclUnixPort.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FD7016ECC0F01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; name = tclUnixThrd.h; path = ../unix/tclUnixThrd.h; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FD8016ECC0F01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclAppInit.c; path = ../unix/tclAppInit.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FD9016ECC0F01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclLoadDyld.c; path = ../unix/tclLoadDyld.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FDB016ECC0F01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclUnixChan.c; path = ../unix/tclUnixChan.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FDC016ECC0F01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclUnixEvent.c; path = ../unix/tclUnixEvent.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FDD016ECC0F01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclUnixFCmd.c; path = ../unix/tclUnixFCmd.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FDE016ECC0F01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclUnixFile.c; path = ../unix/tclUnixFile.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FDF016ECC0F01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclUnixInit.c; path = ../unix/tclUnixInit.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FE0016ECC0F01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclUnixNotfy.c; path = ../unix/tclUnixNotfy.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FE1016ECC0F01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclUnixPipe.c; path = ../unix/tclUnixPipe.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FE2016ECC0F01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclUnixSock.c; path = ../unix/tclUnixSock.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FE3016ECC0F01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclUnixTest.c; path = ../unix/tclUnixTest.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FE4016ECC0F01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclUnixThrd.c; path = ../unix/tclUnixThrd.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FE5016ECC0F01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclUnixTime.c; path = ../unix/tclUnixTime.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FE6016ECC0F01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclXtNotify.c; path = ../unix/tclXtNotify.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FE7016ECC0F01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; name = tclXtTest.c; path = ../unix/tclXtTest.c; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FEE016ED0DF01DC9062 = { children = ( F5F24FEF016ED0DF01DC9062, F5F24FF0016ED0DF01DC9062, F5F24FF3016ED0DF01DC9062, F5F24FF4016ED0DF01DC9062,
︙
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	1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 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	+ + + - + + + - + + + + + - + + + - + + + + + + + - + + + - + + + + + + + - + + + + + + + - + + + + + + + + + + + + + + + + + + + + + +	F5F25007016ED0DF01DC9062, F5F25008016ED0DF01DC9062, F5F2500A016ED0DF01DC9062, ); isa = PBXGroup; name = Scripts; refType = 4; sourceTree = "<group>"; }; F5F24FEF016ED0DF01DC9062 = { isa = PBXFileReference; lastKnownFileType = text; name = auto.tcl; path = ../library/auto.tcl; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FF0016ED0DF01DC9062 = { includeInIndex = 0; isa = PBXFolderReference; isa = PBXFileReference; lastKnownFileType = folder; name = dde; path = ../library/dde; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FF3016ED0DF01DC9062 = { includeInIndex = 0; isa = PBXFolderReference; isa = PBXFileReference; lastKnownFileType = folder; name = encoding; path = ../library/encoding; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FF4016ED0DF01DC9062 = { isa = PBXFileReference; lastKnownFileType = text; name = history.tcl; path = ../library/history.tcl; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FF5016ED0DF01DC9062 = { includeInIndex = 0; isa = PBXFolderReference; isa = PBXFileReference; lastKnownFileType = folder; name = http; path = ../library/http; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FF6016ED0DF01DC9062 = { includeInIndex = 0; isa = PBXFolderReference; isa = PBXFileReference; lastKnownFileType = folder; name = http1.0; path = ../library/http1.0; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FFA016ED0DF01DC9062 = { isa = PBXFileReference; lastKnownFileType = text; name = init.tcl; path = ../library/init.tcl; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FFB016ED0DF01DC9062 = { isa = PBXFileReference; lastKnownFileType = text; name = ldAout.tcl; path = ../library/ldAout.tcl; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FFC016ED0DF01DC9062 = { includeInIndex = 0; isa = PBXFolderReference; isa = PBXFileReference; lastKnownFileType = folder; name = msgcat; path = ../library/msgcat; refType = 2; sourceTree = SOURCE_ROOT; }; F5F24FFE016ED0DF01DC9062 = { includeInIndex = 0; isa = PBXFolderReference; isa = PBXFileReference; lastKnownFileType = folder; name = opt; path = ../library/opt; refType = 2; sourceTree = SOURCE_ROOT; }; F5F25001016ED0DF01DC9062 = { isa = PBXFileReference; lastKnownFileType = text; name = package.tcl; path = ../library/package.tcl; refType = 2; sourceTree = SOURCE_ROOT; }; F5F25002016ED0DF01DC9062 = { isa = PBXFileReference; lastKnownFileType = text; name = parray.tcl; path = ../library/parray.tcl; refType = 2; sourceTree = SOURCE_ROOT; }; F5F25003016ED0DF01DC9062 = { includeInIndex = 0; isa = PBXFolderReference; isa = PBXFileReference; lastKnownFileType = folder; name = reg; path = ../library/reg; refType = 2; sourceTree = SOURCE_ROOT; }; F5F25005016ED0DF01DC9062 = { isa = PBXFileReference; lastKnownFileType = text; name = safe.tcl; path = ../library/safe.tcl; refType = 2; sourceTree = SOURCE_ROOT; }; F5F25007016ED0DF01DC9062 = { fileEncoding = 5; isa = PBXFileReference; lastKnownFileType = text; name = tclIndex; path = ../library/tclIndex; refType = 2; sourceTree = SOURCE_ROOT; }; F5F25008016ED0DF01DC9062 = { includeInIndex = 0; isa = PBXFolderReference; isa = PBXFileReference; lastKnownFileType = folder; name = tcltest; path = ../library/tcltest; refType = 2; sourceTree = SOURCE_ROOT; }; F5F2500A016ED0DF01DC9062 = { isa = PBXFileReference; lastKnownFileType = text; name = word.tcl; path = ../library/word.tcl; refType = 2; sourceTree = SOURCE_ROOT; }; //F50 //F51 //F52 //F53 //F54 //F90 //F91 //F92 //F93 //F94 F9A61C9D04C2B4E3006F5A0B = { explicitFileType = wrapper.framework; isa = PBXFileReference; path = Tcl.framework; refType = 3; sourceTree = BUILT_PRODUCTS_DIR; }; }; rootObject = 00E2F845016E82EB0ACA28DC; }

	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	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd"> <!-- Copyright (c) 2005-2007 Daniel A. Steffen <das@users.sourceforge.net> See the file "license.terms" for information on usage and redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. RCS: @(#) $Id: Tclsh-Info.plist.in,v 1.1.2.2 2007/06/06 09:54:33 das Exp $ --> <plist version="1.0"> <dict> <key>CFBundleDevelopmentRegion</key> <string>English</string> <key>CFBundleExecutable</key> <string>tclsh@TCL_VERSION@</string> <key>CFBundleGetInfoString</key> <string>Tcl Shell @TCL_VERSION@@TCL_PATCH_LEVEL@, Copyright © @TCL_YEAR@ Tcl Core Team, Copyright © 2001-@TCL_YEAR@ Daniel A. Steffen, Initial MacOS X Port by Jim Ingham &amp; Ian Reid, Copyright © 2001-2002, Apple Computer, Inc.</string> <key>CFBundleIdentifier</key> <string>com.tcltk.tclsh</string> <key>CFBundleInfoDictionaryVersion</key> <string>6.0</string> <key>CFBundleName</key> <string>tclsh</string> <key>CFBundlePackageType</key> <string>APPL</string> <key>CFBundleShortVersionString</key> <string>@TCL_VERSION@@TCL_PATCH_LEVEL@</string> <key>CFBundleSignature</key> <string>TclS</string> <key>CFBundleVersion</key> <string>@TCL_VERSION@@TCL_PATCH_LEVEL@</string> </dict> </plist>

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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126

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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232

- - + + - + + + + + - - - + + + - - - - + + + - - - - - - - + + + + + + - - - - - - + + + + + - - - - - - - + + + + + + - - - - + + + + - - - - - - - - + + + + + + + - + + + + + - + + - + - - + - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - - + + + + + - - + + + + + - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - + + + + + + + + + + + - - - + + +

/* * tclMacOSXBundle.c -- * * This file implements functions that inspect CFBundle structures * on MacOS X. * This file implements functions that inspect CFBundle structures on * MacOS X. * * Copyright 2001, Apple Computer, Inc. * Copyright 2001, Apple Computer, Inc. * Copyright (c) 2003-2007 Daniel A. Steffen <das@users.sourceforge.net> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * The following terms apply to all files originating from Apple * Computer, Inc. ("Apple") and associated with the software * unless explicitly disclaimed in individual files. * The following terms apply to all files originating from Apple * Computer, Inc. ("Apple") and associated with the software unless * explicitly disclaimed in individual files. * * * Apple hereby grants permission to use, copy, modify, * distribute, and license this software and its documentation * for any purpose, provided that existing copyright notices are * Apple hereby grants permission to use, copy, modify, distribute, and * license this software and its documentation for any purpose, provided * that existing copyright notices are retained in all copies and that * retained in all copies and that this notice is included * verbatim in any distributions. No written agreement, license, * or royalty fee is required for any of the authorized * uses. Modifications to this software may be copyrighted by * their authors and need not follow the licensing terms * described here, provided that the new terms are clearly * indicated on the first page of each file where they apply. * this notice is included verbatim in any distributions. No written * agreement, license, or royalty fee is required for any of the * authorized uses. Modifications to this software may be copyrighted by * their authors and need not follow the licensing terms described here, * provided that the new terms are clearly indicated on the first page of * each file where they apply. * * * IN NO EVENT SHALL APPLE, THE AUTHORS OR DISTRIBUTORS OF THE * SOFTWARE BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, * INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF * THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, * EVEN IF APPLE OR THE AUTHORS HAVE BEEN ADVISED OF THE * IN NO EVENT SHALL APPLE, THE AUTHORS OR DISTRIBUTORS OF THE SOFTWARE * BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR * CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS * DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF APPLE OR THE * AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. APPLE, * POSSIBILITY OF SUCH DAMAGE. APPLE, THE AUTHORS AND * DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, * BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS * SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND APPLE,THE * AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE * MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. * THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND * NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND * APPLE,THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE * MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. * * GOVERNMENT USE: If you are acquiring this software on behalf * of the U.S. government, the Government shall have only * "Restricted Rights" in the software and related documentation * as defined in the Federal Acquisition Regulations (FARs) in * GOVERNMENT USE: If you are acquiring this software on behalf of the * U.S. government, the Government shall have only "Restricted Rights" in * the software and related documentation as defined in the Federal * Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you are * Clause 52.227.19 (c) (2). If you are acquiring the software * on behalf of the Department of Defense, the software shall be * classified as "Commercial Computer Software" and the * Government shall have only "Restricted Rights" as defined in * Clause 252.227-7013 (c) (1) of DFARs. Notwithstanding the * foregoing, the authors grant the U.S. Government and others * acting in its behalf permission to use and distribute the * software in accordance with the terms specified in this * acquiring the software on behalf of the Department of Defense, the * software shall be classified as "Commercial Computer Software" and the * Government shall have only "Restricted Rights" as defined in Clause * 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the * authors grant the U.S. Government and others acting in its behalf * permission to use and distribute the software in accordance with the * terms specified in this license. * license. * * RCS: @(#) $Id: tclMacOSXBundle.c,v 1.3.2.6 2007/04/29 02:21:33 das Exp $ */ #include "tclPort.h" #ifdef HAVE_COREFOUNDATION #include <CoreFoundation/CoreFoundation.h> #include "tcl.h" #include <mach-o/dyld.h> #endif /* HAVE_COREFOUNDATION */ /* *---------------------------------------------------------------------- * * Tcl_MacOSXOpenBundleResources -- * * Given the bundle name for a shared library, this routine sets * libraryPath to the Resources/Scripts directory in the framework * package. If hasResourceFile is true, it will also open the main * package. If hasResourceFile is true, it will also open the main * resource file for the bundle. * * * Results: * TCL_OK if the bundle could be opened, and the Scripts folder found. * TCL_ERROR otherwise. * TCL_ERROR otherwise. * * Side effects: * libraryVariableName may be set, and the resource file opened. * *---------------------------------------------------------------------- */ int Tcl_MacOSXOpenBundleResources( Tcl_Interp *interp, CONST char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath) int hasResourceFile, int maxPathLen, char *libraryPath) { return Tcl_MacOSXOpenVersionedBundleResources(interp, bundleName, NULL, hasResourceFile, maxPathLen, libraryPath); }  /* *---------------------------------------------------------------------- * * Tcl_MacOSXOpenVersionedBundleResources -- * * Given the bundle and version name for a shared library (version name * can be NULL to indicate latest version), this routine sets libraryPath * to the Resources/Scripts directory in the framework package. If * hasResourceFile is true, it will also open the main resource file for * the bundle. * * Results: * TCL_OK if the bundle could be opened, and the Scripts folder found. * TCL_ERROR otherwise. * * Side effects: * libraryVariableName may be set, and the resource file opened. * *---------------------------------------------------------------------- */ int Tcl_MacOSXOpenVersionedBundleResources( Tcl_Interp *interp, CONST char *bundleName, CONST char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath) { #ifdef HAVE_COREFOUNDATION CFBundleRef bundleRef; CFStringRef bundleNameRef; CFURLRef libURL; libraryPath[0] = '\0'; bundleNameRef = CFStringCreateWithCString(NULL, bundleName, kCFStringEncodingUTF8); bundleNameRef = CFStringCreateWithCString(NULL, bundleName, kCFStringEncodingUTF8); bundleRef = CFBundleGetBundleWithIdentifier(bundleNameRef); CFRelease(bundleNameRef); if (bundleRef == 0) { return TCL_ERROR; if (bundleVersion && bundleRef) { /* * Create bundle from bundleVersion subdirectory of 'Versions'. */ } else { CFURLRef libURL; CFBundleRef versionedBundleRef = NULL; CFURLRef versionedBundleURL = NULL; CFStringRef bundleVersionRef = CFStringCreateWithCString(NULL, bundleVersion, kCFStringEncodingUTF8); CFURLRef bundleURL = CFBundleCopyBundleURL(bundleRef); if (hasResourceFile) { short refNum; refNum = CFBundleOpenBundleResourceMap(bundleRef); } libURL = CFBundleCopyResourceURL(bundleRef, CFSTR("Scripts"), NULL, NULL); if (libURL != NULL) { if (bundleURL) { CFStringRef bundleTailRef = CFURLCopyLastPathComponent(bundleURL); if (bundleTailRef) { if (CFStringCompare(bundleTailRef, bundleVersionRef, 0) == kCFCompareEqualTo) { versionedBundleRef = bundleRef; } CFRelease(bundleTailRef); } } if (bundleURL && !versionedBundleRef) { CFURLRef versURL = CFURLCreateCopyAppendingPathComponent(NULL, bundleURL, CFSTR("Versions"), TRUE); if (versURL) { versionedBundleURL = CFURLCreateCopyAppendingPathComponent( NULL, versURL, bundleVersionRef, TRUE); CFRelease(versURL); } CFRelease(bundleURL); } CFRelease(bundleVersionRef); if (versionedBundleURL) { versionedBundleRef = CFBundleCreate(NULL, versionedBundleURL); CFRelease(versionedBundleURL); } bundleRef = versionedBundleRef; } if (bundleRef) { if (hasResourceFile) { /* * FIXME: This is a quick fix, it is probably not right * for internationalization. * Dynamically acquire address for CFBundleOpenBundleResourceMap * symbol, since it is only present in full CoreFoundation on Mac * OS X and not in CFLite on pure Darwin. */ static int initialized = FALSE; static short (*openresourcemap)(CFBundleRef) = NULL; if (!initialized) { NSSymbol nsSymbol = NULL; if (NSIsSymbolNameDefinedWithHint( "_CFBundleOpenBundleResourceMap", "CoreFoundation")) { nsSymbol = NSLookupAndBindSymbolWithHint( "_CFBundleOpenBundleResourceMap","CoreFoundation"); if (nsSymbol) { openresourcemap = NSAddressOfSymbol(nsSymbol); } } initialized = TRUE; } if (openresourcemap) { short refNum; refNum = openresourcemap(bundleRef); } } libURL = CFBundleCopyResourceURL(bundleRef, CFSTR("Scripts"), NULL, NULL); if (libURL) { /* * FIXME: This is a quick fix, it is probably not right for * internationalization. */ if (CFURLGetFileSystemRepresentation(libURL, true, libraryPath, maxPathLen)) { } CFRelease(libURL); } else { return TCL_ERROR; } CFURLGetFileSystemRepresentation(libURL, TRUE, (unsigned char*) libraryPath, maxPathLen); CFRelease(libURL); } } if (libraryPath[0]) { return TCL_OK; } else { return TCL_ERROR; } } return TCL_OK; #else /* HAVE_COREFOUNDATION */ return TCL_ERROR; #endif /* HAVE_COREFOUNDATION */ }

	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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	/* * tclMacOSXNotify.c -- * * This file contains the implementation of a merged CFRunLoop/select() * based notifier, which is the lowest-level part of the Tcl event loop. * This file works together with generic/tclNotify.c. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright 2001, Apple Computer, Inc. * Copyright (c) 2005-2007 Daniel A. Steffen <das@users.sourceforge.net> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclMacOSXNotify.c,v 1.1.2.12 2007/04/29 02:21:33 das Exp $ */ #include "tclInt.h" #include "tclPort.h" #ifdef HAVE_COREFOUNDATION /* Traditional unix select-based notifier is * in tclUnixNotfy.c */ #include <CoreFoundation/CoreFoundation.h> #include <pthread.h> extern TclStubs tclStubs; extern Tcl_NotifierProcs tclOriginalNotifier; /* * This structure is used to keep track of the notifier info for a registered * file. */ typedef struct FileHandler { int fd; int mask; /* Mask of desired events: TCL_READABLE, * etc. */ int readyMask; /* Mask of events that have been seen since * the last time file handlers were invoked * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ ClientData clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; /* * The following structure is what is added to the Tcl event queue when file * handlers are ready to fire. */ typedef struct FileHandlerEvent { Tcl_Event header; /* Information that is standard for all * events. */ int fd; /* File descriptor that is ready. Used to find * the FileHandler structure for the file * (can't point directly to the FileHandler * structure because it could go away while * the event is queued). */ } FileHandlerEvent; /* * The following structure contains a set of select() masks to track readable, * writable, and exceptional conditions. */ typedef struct SelectMasks { fd_set readable; fd_set writable; fd_set exceptional; } SelectMasks; /* * The following static structure contains the state information for the * select based implementation of the Tcl notifier. One of these structures is * created for each thread that is using the notifier. */ typedef struct ThreadSpecificData { FileHandler *firstFileHandlerPtr; /* Pointer to head of file handler list. */ SelectMasks checkMasks; /* This structure is used to build up the * masks to be used in the next call to * select. Bits are set in response to calls * to Tcl_CreateFileHandler. */ SelectMasks readyMasks; /* This array reflects the readable/writable * conditions that were found to exist by the * last call to select. */ int numFdBits; /* Number of valid bits in checkMasks (one * more than highest fd for which * Tcl_WatchFile has been called). */ int onList; /* True if it is in this list */ unsigned int pollState; /* pollState is used to implement a polling * handshake between each thread and the * notifier thread. Bits defined below. */ struct ThreadSpecificData *nextPtr, *prevPtr; /* All threads that are currently waiting on * an event have their ThreadSpecificData * structure on a doubly-linked listed formed * from these pointers. You must hold the * notifierLock before accessing these * fields. */ CFRunLoopSourceRef runLoopSource; /* Any other thread alerts a notifier that an * event is ready to be processed by signaling * this CFRunLoopSource. */ CFRunLoopRef runLoop; /* This thread's CFRunLoop, needs to be woken * up whenever the runLoopSource is * signaled. */ int eventReady; /* True if an event is ready to be * processed. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * The following static indicates the number of threads that have initialized * notifiers. * * You must hold the notifierInitLock before accessing this variable. */ static int notifierCount = 0; /* * The following variable points to the head of a doubly-linked list of * ThreadSpecificData structures for all threads that are currently waiting on * an event. * * You must hold the notifierLock before accessing this list. */ static ThreadSpecificData *waitingListPtr = NULL; /* * The notifier thread spends all its time in select() waiting for a file * descriptor associated with one of the threads on the waitingListPtr list to * do something interesting. But if the contents of the waitingListPtr list * ever changes, we need to wake up and restart the select() system call. You * can wake up the notifier thread by writing a single byte to the file * descriptor defined below. This file descriptor is the input-end of a pipe * and the notifier thread is listening for data on the output-end of the same * pipe. Hence writing to this file descriptor will cause the select() system * call to return and wake up the notifier thread. * * You must hold the notifierLock lock before writing to the pipe. */ static int triggerPipe = -1; static int receivePipe = -1; /* Output end of triggerPipe */ /* * We use the Darwin-native spinlock API rather than pthread mutexes for * notifier locking: this radically simplifies the implementation and lowers * overhead. Note that these are not pure spinlocks, they employ various * strategies to back off and relinquish the processor, making them immune to * most priority-inversion livelocks (c.f. 'man 3 OSSpinLockLock' and Darwin * sources: xnu/osfmk/{ppc,i386}/commpage/spinlocks.s). */ #if defined(HAVE_LIBKERN_OSATOMIC_H) && defined(HAVE_OSSPINLOCKLOCK) /* * Use OSSpinLock API where available (Tiger or later). */ #include <libkern/OSAtomic.h> #if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040 /* * Support for weakly importing spinlock API. */ #define WEAK_IMPORT_SPINLOCKLOCK #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1050 #define VOLATILE volatile #else #define VOLATILE #endif #ifndef bool #define bool int #endif extern void OSSpinLockLock(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE; extern void OSSpinLockUnlock(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE; extern bool OSSpinLockTry(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE; extern void _spin_lock(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE; extern void _spin_unlock(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE; extern bool _spin_lock_try(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE; static void (* lockLock)(VOLATILE OSSpinLock *lock) = NULL; static void (* lockUnlock)(VOLATILE OSSpinLock *lock) = NULL; static bool (* lockTry)(VOLATILE OSSpinLock *lock) = NULL; #undef VOLATILE static pthread_once_t spinLockLockInitControl = PTHREAD_ONCE_INIT; static void SpinLockLockInit(void) { lockLock = OSSpinLockLock != NULL ? OSSpinLockLock : _spin_lock; lockUnlock = OSSpinLockUnlock != NULL ? OSSpinLockUnlock : _spin_unlock; lockTry = OSSpinLockTry != NULL ? OSSpinLockTry : _spin_lock_try; if (lockLock == NULL || lockUnlock == NULL) { Tcl_Panic("SpinLockLockInit: no spinlock API available"); } } #define SpinLockLock(p) lockLock(p) #define SpinLockUnlock(p) lockUnlock(p) #define SpinLockTry(p) lockTry(p) #else #define SpinLockLock(p) OSSpinLockLock(p) #define SpinLockUnlock(p) OSSpinLockUnlock(p) #define SpinLockTry(p) OSSpinLockTry(p) #endif /* HAVE_WEAK_IMPORT */ #define SPINLOCK_INIT OS_SPINLOCK_INIT #else /* * Otherwise, use commpage spinlock SPI directly. */ typedef uint32_t OSSpinLock; extern void _spin_lock(OSSpinLock *lock); extern void _spin_unlock(OSSpinLock *lock); extern int _spin_lock_try(OSSpinLock *lock); #define SpinLockLock(p) _spin_lock(p) #define SpinLockUnlock(p) _spin_unlock(p) #define SpinLockTry(p) _spin_lock_try(p) #define SPINLOCK_INIT 0 #endif /* HAVE_LIBKERN_OSATOMIC_H && HAVE_OSSPINLOCKLOCK */ /* * These spinlocks lock access to the global notifier state. */ static OSSpinLock notifierInitLock = SPINLOCK_INIT; static OSSpinLock notifierLock = SPINLOCK_INIT; /* * Macros abstracting notifier locking/unlocking */ #define LOCK_NOTIFIER_INIT SpinLockLock(&notifierInitLock) #define UNLOCK_NOTIFIER_INIT SpinLockUnlock(&notifierInitLock) #define LOCK_NOTIFIER SpinLockLock(&notifierLock) #define UNLOCK_NOTIFIER SpinLockUnlock(&notifierLock) /* * The pollState bits * POLL_WANT is set by each thread before it waits on its condition * variable. It is checked by the notifier before it does select. * POLL_DONE is set by the notifier if it goes into select after seeing * POLL_WANT. The idea is to ensure it tries a select with the * same bits the initial thread had set. */ #define POLL_WANT 0x1 #define POLL_DONE 0x2 /* * This is the thread ID of the notifier thread that does select. */ static pthread_t notifierThread; /* * Custom run loop mode containing only the run loop source for the * notifier thread. */ #ifndef TCL_EVENTS_ONLY_RUN_LOOP_MODE #define TCL_EVENTS_ONLY_RUN_LOOP_MODE "com.tcltk.tclEventsOnlyRunLoopMode" #endif #ifdef __CONSTANT_CFSTRINGS__ #define tclEventsOnlyRunLoopMode CFSTR(TCL_EVENTS_ONLY_RUN_LOOP_MODE) #else static CFStringRef tclEventsOnlyRunLoopMode = NULL; #endif /* * Static routines defined in this file. */ static void NotifierThreadProc(ClientData clientData) __attribute__ ((__noreturn__)); static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); #ifdef HAVE_PTHREAD_ATFORK static int atForkInit = 0; static void AtForkPrepare(void); static void AtForkParent(void); static void AtForkChild(void); #if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040 /* Support for weakly importing pthread_atfork. */ #define WEAK_IMPORT_PTHREAD_ATFORK extern int pthread_atfork(void (*prepare)(void), void (*parent)(void), void (*child)(void)) WEAK_IMPORT_ATTRIBUTE; #endif /* HAVE_WEAK_IMPORT */ #endif /* HAVE_PTHREAD_ATFORK */  /* *---------------------------------------------------------------------- * * Tcl_InitNotifier -- * * Initializes the platform specific notifier state. * * Results: * Returns a handle to the notifier state for this thread. * * Side effects: * None. * *---------------------------------------------------------------------- */ ClientData Tcl_InitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->eventReady = 0; #ifdef WEAK_IMPORT_SPINLOCKLOCK /* * Initialize support for weakly imported spinlock API. */ if (pthread_once(&spinLockLockInitControl, SpinLockLockInit)) { Tcl_Panic("Tcl_InitNotifier: pthread_once failed"); } #endif #ifndef __CONSTANT_CFSTRINGS__ if (!tclEventsOnlyRunLoopMode) { tclEventsOnlyRunLoopMode = CFSTR(TCL_EVENTS_ONLY_RUN_LOOP_MODE); } #endif /* * Initialize CFRunLoopSource and add it to CFRunLoop of this thread. */ if (!tsdPtr->runLoop) { CFRunLoopRef runLoop = CFRunLoopGetCurrent(); CFRunLoopSourceRef runLoopSource; CFRunLoopSourceContext runLoopSourceContext; bzero(&runLoopSourceContext, sizeof(CFRunLoopSourceContext)); runLoopSourceContext.info = tsdPtr; runLoopSource = CFRunLoopSourceCreate(NULL, 0, &runLoopSourceContext); if (!runLoopSource) { Tcl_Panic("Tcl_InitNotifier: could not create CFRunLoopSource"); } CFRunLoopAddSource(runLoop, runLoopSource, kCFRunLoopCommonModes); CFRunLoopAddSource(runLoop, runLoopSource, tclEventsOnlyRunLoopMode); tsdPtr->runLoopSource = runLoopSource; tsdPtr->runLoop = runLoop; } LOCK_NOTIFIER_INIT; #ifdef HAVE_PTHREAD_ATFORK /* * Install pthread_atfork handlers to reinitialize the notifier in the * child of a fork. */ if ( #ifdef WEAK_IMPORT_PTHREAD_ATFORK pthread_atfork != NULL && #endif !atForkInit) { int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild); if (result) { Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed"); } atForkInit = 1; } #endif if (notifierCount == 0) { int fds[2], status; /* * Initialize trigger pipe. */ if (pipe(fds) != 0) { Tcl_Panic("Tcl_InitNotifier: could not create trigger pipe"); } status = fcntl(fds[0], F_GETFL); status |= O_NONBLOCK; if (fcntl(fds[0], F_SETFL, status) < 0) { Tcl_Panic("Tcl_InitNotifier: could not make receive pipe non blocking"); } status = fcntl(fds[1], F_GETFL); status |= O_NONBLOCK; if (fcntl(fds[1], F_SETFL, status) < 0) { Tcl_Panic("Tcl_InitNotifier: could not make trigger pipe non blocking"); } receivePipe = fds[0]; triggerPipe = fds[1]; /* * Create notifier thread lazily in Tcl_WaitForEvent() to avoid * interfering with fork() followed immediately by execve() * (cannot execve() when more than one thread is present). */ notifierThread = 0; } notifierCount++; UNLOCK_NOTIFIER_INIT; return (ClientData) tsdPtr; }  /* *---------------------------------------------------------------------- * * Tcl_FinalizeNotifier -- * * This function is called to cleanup the notifier state before a thread * is terminated. * * Results: * None. * * Side effects: * May terminate the background notifier thread if this is the last * notifier instance. * *---------------------------------------------------------------------- */ void Tcl_FinalizeNotifier( ClientData clientData) /* Not used. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); LOCK_NOTIFIER_INIT; notifierCount--; /* * If this is the last thread to use the notifier, close the notifier pipe * and wait for the background thread to terminate. */ if (notifierCount == 0) { int result; if (triggerPipe < 0) { Tcl_Panic("Tcl_FinalizeNotifier: notifier pipe not initialized"); } /* * Send "q" message to the notifier thread so that it will terminate. * The notifier will return from its call to select() and notice that * a "q" message has arrived, it will then close its side of the pipe * and terminate its thread. Note the we can not just close the pipe * and check for EOF in the notifier thread because if a background * child process was created with exec, select() would not register * the EOF on the pipe until the child processes had terminated. [Bug: * 4139] [Bug: 1222872] */ write(triggerPipe, "q", 1); close(triggerPipe); if (notifierThread) { result = pthread_join(notifierThread, NULL); if (result) { Tcl_Panic("Tcl_FinalizeNotifier: unable to join notifier thread"); } notifierThread = 0; } close(receivePipe); triggerPipe = -1; } UNLOCK_NOTIFIER_INIT; LOCK_NOTIFIER; /* for concurrency with Tcl_AlertNotifier */ if (tsdPtr->runLoop) { tsdPtr->runLoop = NULL; /* * Remove runLoopSource from all CFRunLoops and release it. */ CFRunLoopSourceInvalidate(tsdPtr->runLoopSource); CFRelease(tsdPtr->runLoopSource); tsdPtr->runLoopSource = NULL; } UNLOCK_NOTIFIER; }  /* *---------------------------------------------------------------------- * * Tcl_AlertNotifier -- * * Wake up the specified notifier from any thread. This routine is called * by the platform independent notifier code whenever the Tcl_ThreadAlert * routine is called. This routine is guaranteed not to be called on a * given notifier after Tcl_FinalizeNotifier is called for that notifier. * * Results: * None. * * Side effects: * Signals the notifier condition variable for the specified notifier. * *---------------------------------------------------------------------- */ void Tcl_AlertNotifier( ClientData clientData) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; LOCK_NOTIFIER; if (tsdPtr->runLoop) { tsdPtr->eventReady = 1; CFRunLoopSourceSignal(tsdPtr->runLoopSource); CFRunLoopWakeUp(tsdPtr->runLoop); } UNLOCK_NOTIFIER; }  /* *---------------------------------------------------------------------- * * Tcl_SetTimer -- * * This function sets the current notifier timer value. This interface is * not implemented in this notifier because we are always running inside * of Tcl_DoOneEvent. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_SetTimer( Tcl_Time *timePtr) /* Timeout value, may be NULL. */ { /* * The interval timer doesn't do anything in this implementation, because * the only event loop is via Tcl_DoOneEvent, which passes timeout values * to Tcl_WaitForEvent. */ if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) { tclStubs.tcl_SetTimer(timePtr); } }  /* *---------------------------------------------------------------------- * * Tcl_ServiceModeHook -- * * This function is invoked whenever the service mode changes. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_ServiceModeHook( int mode) /* Either TCL_SERVICE_ALL, or * TCL_SERVICE_NONE. */ { }  /* *---------------------------------------------------------------------- * * Tcl_CreateFileHandler -- * * This function registers a file handler with the select notifier. * * Results: * None. * * Side effects: * Creates a new file handler structure. * *---------------------------------------------------------------------- */ void Tcl_CreateFileHandler( int fd, /* Handle of stream to watch. */ int mask, /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, and TCL_EXCEPTION: indicates * conditions under which proc should be * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ ClientData clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr; if (tclStubs.tcl_CreateFileHandler != tclOriginalNotifier.createFileHandlerProc) { tclStubs.tcl_CreateFileHandler(fd, mask, proc, clientData); return; } for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL; filePtr = filePtr->nextPtr) { if (filePtr->fd == fd) { break; } } if (filePtr == NULL) { filePtr = (FileHandler*) ckalloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; tsdPtr->firstFileHandlerPtr = filePtr; } filePtr->proc = proc; filePtr->clientData = clientData; filePtr->mask = mask; /* * Update the check masks for this file. */ if (mask & TCL_READABLE) { FD_SET(fd, &(tsdPtr->checkMasks.readable)); } else { FD_CLR(fd, &(tsdPtr->checkMasks.readable)); } if (mask & TCL_WRITABLE) { FD_SET(fd, &(tsdPtr->checkMasks.writable)); } else { FD_CLR(fd, &(tsdPtr->checkMasks.writable)); } if (mask & TCL_EXCEPTION) { FD_SET(fd, &(tsdPtr->checkMasks.exceptional)); } else { FD_CLR(fd, &(tsdPtr->checkMasks.exceptional)); } if (tsdPtr->numFdBits <= fd) { tsdPtr->numFdBits = fd+1; } }  /* *---------------------------------------------------------------------- * * Tcl_DeleteFileHandler -- * * Cancel a previously-arranged callback arrangement for a file. * * Results: * None. * * Side effects: * If a callback was previously registered on file, remove it. * *---------------------------------------------------------------------- */ void Tcl_DeleteFileHandler( int fd) /* Stream id for which to remove callback * function. */ { FileHandler *filePtr, *prevPtr; int i; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tclStubs.tcl_DeleteFileHandler != tclOriginalNotifier.deleteFileHandlerProc) { tclStubs.tcl_DeleteFileHandler(fd); return; } /* * Find the entry for the given file (and return if there isn't one). */ for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ; prevPtr = filePtr, filePtr = filePtr->nextPtr) { if (filePtr == NULL) { return; } if (filePtr->fd == fd) { break; } } /* * Update the check masks for this file. */ if (filePtr->mask & TCL_READABLE) { FD_CLR(fd, &(tsdPtr->checkMasks.readable)); } if (filePtr->mask & TCL_WRITABLE) { FD_CLR(fd, &(tsdPtr->checkMasks.writable)); } if (filePtr->mask & TCL_EXCEPTION) { FD_CLR(fd, &(tsdPtr->checkMasks.exceptional)); } /* * Find current max fd. */ if (fd+1 == tsdPtr->numFdBits) { tsdPtr->numFdBits = 0; for (i = fd-1; i >= 0; i--) { if (FD_ISSET(i, &(tsdPtr->checkMasks.readable)) || FD_ISSET(i, &(tsdPtr->checkMasks.writable)) || FD_ISSET(i, &(tsdPtr->checkMasks.exceptional))) { tsdPtr->numFdBits = i+1; break; } } } /* * Clean up information in the callback record. */ if (prevPtr == NULL) { tsdPtr->firstFileHandlerPtr = filePtr->nextPtr; } else { prevPtr->nextPtr = filePtr->nextPtr; } ckfree((char *) filePtr); }  /* *---------------------------------------------------------------------- * * FileHandlerEventProc -- * * This function is called by Tcl_ServiceEvent when a file event reaches * the front of the event queue. This function is responsible for * actually handling the event by invoking the callback for the file * handler. * * Results: * Returns 1 if the event was handled, meaning it should be removed from * the queue. Returns 0 if the event was not handled, meaning it should * stay on the queue. The only time the event isn't handled is if the * TCL_FILE_EVENTS flag bit isn't set. * * Side effects: * Whatever the file handler's callback function does. * *---------------------------------------------------------------------- */ static int FileHandlerEventProc( Tcl_Event *evPtr, /* Event to service. */ int flags) /* Flags that indicate what events to handle, * such as TCL_FILE_EVENTS. */ { int mask; FileHandler *filePtr; FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr; ThreadSpecificData *tsdPtr; if (!(flags & TCL_FILE_EVENTS)) { return 0; } /* * Search through the file handlers to find the one whose handle matches * the event. We do this rather than keeping a pointer to the file handler * directly in the event, so that the handler can be deleted while the * event is queued without leaving a dangling pointer. */ tsdPtr = TCL_TSD_INIT(&dataKey); for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL; filePtr = filePtr->nextPtr) { if (filePtr->fd != fileEvPtr->fd) { continue; } /* * The code is tricky for two reasons: * 1. The file handler's desired events could have changed since the * time when the event was queued, so AND the ready mask with the * desired mask. * 2. The file could have been closed and re-opened since the time * when the event was queued. This is why the ready mask is stored * in the file handler rather than the queued event: it will be * zeroed when a new file handler is created for the newly opened * file. */ mask = filePtr->readyMask & filePtr->mask; filePtr->readyMask = 0; if (mask != 0) { (*filePtr->proc)(filePtr->clientData, mask); } break; } return 1; }  /* *---------------------------------------------------------------------- * * Tcl_WaitForEvent -- * * This function is called by Tcl_DoOneEvent to wait for new events on * the message queue. If the block time is 0, then Tcl_WaitForEvent just * polls without blocking. * * Results: * Returns -1 if the select would block forever, otherwise returns 0. * * Side effects: * Queues file events that are detected by the select. * *---------------------------------------------------------------------- */ int Tcl_WaitForEvent( Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { FileHandler *filePtr; FileHandlerEvent *fileEvPtr; int mask; int waitForFiles; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) { return tclStubs.tcl_WaitForEvent(timePtr); } /* * Start notifier thread if necessary. */ LOCK_NOTIFIER_INIT; if (!notifierCount) { Tcl_Panic("Tcl_WaitForEvent: notifier not initialized"); } if (!notifierThread) { int result; pthread_attr_t attr; pthread_attr_init(&attr); pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); pthread_attr_setstacksize(&attr, 60 * 1024); result = pthread_create(&notifierThread, &attr, (void * (*)(void *))NotifierThreadProc, NULL); pthread_attr_destroy(&attr); if (result || !notifierThread) { Tcl_Panic("Tcl_WaitForEvent: unable to start notifier thread"); } } UNLOCK_NOTIFIER_INIT; /* * Place this thread on the list of interested threads, signal the * notifier thread, and wait for a response or a timeout. */ LOCK_NOTIFIER; if (!tsdPtr->runLoop) { Tcl_Panic("Tcl_WaitForEvent: CFRunLoop not initialized"); } waitForFiles = (tsdPtr->numFdBits > 0); if (timePtr != NULL && timePtr->sec == 0 && timePtr->usec == 0) { /* * Cannot emulate a polling select with a polling condition variable. * Instead, pretend to wait for files and tell the notifier thread * what we are doing. The notifier thread makes sure it goes through * select with its select mask in the same state as ours currently is. * We block until that happens. */ waitForFiles = 1; tsdPtr->pollState = POLL_WANT; timePtr = NULL; } else { tsdPtr->pollState = 0; } if (waitForFiles) { /* * Add the ThreadSpecificData structure of this thread to the list of * ThreadSpecificData structures of all threads that are waiting on * file events. */ tsdPtr->nextPtr = waitingListPtr; if (waitingListPtr) { waitingListPtr->prevPtr = tsdPtr; } tsdPtr->prevPtr = 0; waitingListPtr = tsdPtr; tsdPtr->onList = 1; write(triggerPipe, "", 1); } FD_ZERO(&(tsdPtr->readyMasks.readable)); FD_ZERO(&(tsdPtr->readyMasks.writable)); FD_ZERO(&(tsdPtr->readyMasks.exceptional)); if (!tsdPtr->eventReady) { CFTimeInterval waitTime; CFStringRef runLoopMode; if (timePtr == NULL) { waitTime = 1.0e10; /* Wait forever, as per CFRunLoop.c */ } else { waitTime = timePtr->sec + 1.0e-6 * timePtr->usec; } /* * If the run loop is already running (e.g. if Tcl_WaitForEvent was * called recursively), re-run it in a custom run loop mode containing * only the source for the notifier thread, otherwise wakeups from other * sources added to the common run loop modes might get lost. */ if ((runLoopMode = CFRunLoopCopyCurrentMode(tsdPtr->runLoop))) { CFRelease(runLoopMode); runLoopMode = tclEventsOnlyRunLoopMode; } else { runLoopMode = kCFRunLoopDefaultMode; } UNLOCK_NOTIFIER; CFRunLoopRunInMode(runLoopMode, waitTime, TRUE); LOCK_NOTIFIER; } tsdPtr->eventReady = 0; if (waitForFiles && tsdPtr->onList) { /* * Remove the ThreadSpecificData structure of this thread from the * waiting list. Alert the notifier thread to recompute its select * masks - skipping this caused a hang when trying to close a pipe * which the notifier thread was still doing a select on. */ if (tsdPtr->prevPtr) { tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr; } else { waitingListPtr = tsdPtr->nextPtr; } if (tsdPtr->nextPtr) { tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; } tsdPtr->nextPtr = tsdPtr->prevPtr = NULL; tsdPtr->onList = 0; write(triggerPipe, "", 1); } /* * Queue all detected file events before returning. */ for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL); filePtr = filePtr->nextPtr) { mask = 0; if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.readable))) { mask |= TCL_READABLE; } if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.writable))) { mask |= TCL_WRITABLE; } if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.exceptional))) { mask |= TCL_EXCEPTION; } if (!mask) { continue; } /* * Don't bother to queue an event if the mask was previously non-zero * since an event must still be on the queue. */ if (filePtr->readyMask == 0) { fileEvPtr = (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); } filePtr->readyMask = mask; } UNLOCK_NOTIFIER; return 0; }  /* *---------------------------------------------------------------------- * * NotifierThreadProc -- * * This routine is the initial (and only) function executed by the * special notifier thread. Its job is to wait for file descriptors to * become readable or writable or to have an exception condition and then * to notify other threads who are interested in this information by * signalling a condition variable. Other threads can signal this * notifier thread of a change in their interests by writing a single * byte to a special pipe that the notifier thread is monitoring. * * Result: * None. Once started, this routine never exits. It dies with the overall * process. * * Side effects: * The trigger pipe used to signal the notifier thread is created when * the notifier thread first starts. * *---------------------------------------------------------------------- */ static void NotifierThreadProc( ClientData clientData) /* Not used. */ { ThreadSpecificData *tsdPtr; fd_set readableMask; fd_set writableMask; fd_set exceptionalMask; int i, numFdBits = 0; long found; struct timeval poll = {0., 0.}, *timePtr; char buf[2]; /* * Look for file events and report them to interested threads. */ while (1) { FD_ZERO(&readableMask); FD_ZERO(&writableMask); FD_ZERO(&exceptionalMask); /* * Compute the logical OR of the select masks from all the waiting * notifiers. */ LOCK_NOTIFIER; timePtr = NULL; for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) { for (i = tsdPtr->numFdBits-1; i >= 0; --i) { if (FD_ISSET(i, &(tsdPtr->checkMasks.readable))) { FD_SET(i, &readableMask); } if (FD_ISSET(i, &(tsdPtr->checkMasks.writable))) { FD_SET(i, &writableMask); } if (FD_ISSET(i, &(tsdPtr->checkMasks.exceptional))) { FD_SET(i, &exceptionalMask); } } if (tsdPtr->numFdBits > numFdBits) { numFdBits = tsdPtr->numFdBits; } if (tsdPtr->pollState & POLL_WANT) { /* * Here we make sure we go through select() with the same mask * bits that were present when the thread tried to poll. */ tsdPtr->pollState |= POLL_DONE; timePtr = &poll; } } UNLOCK_NOTIFIER; /* * Set up the select mask to include the receive pipe. */ if (receivePipe >= numFdBits) { numFdBits = receivePipe + 1; } FD_SET(receivePipe, &readableMask); if (select(numFdBits, &readableMask, &writableMask, &exceptionalMask, timePtr) == -1) { /* * Try again immediately on an error. */ continue; } /* * Alert any threads that are waiting on a ready file descriptor. */ LOCK_NOTIFIER; for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) { found = 0; for (i = tsdPtr->numFdBits-1; i >= 0; --i) { if (FD_ISSET(i, &(tsdPtr->checkMasks.readable)) && FD_ISSET(i, &readableMask)) { FD_SET(i, &(tsdPtr->readyMasks.readable)); found = 1; } if (FD_ISSET(i, &(tsdPtr->checkMasks.writable)) && FD_ISSET(i, &writableMask)) { FD_SET(i, &(tsdPtr->readyMasks.writable)); found = 1; } if (FD_ISSET(i, &(tsdPtr->checkMasks.exceptional)) && FD_ISSET(i, &exceptionalMask)) { FD_SET(i, &(tsdPtr->readyMasks.exceptional)); found = 1; } } if (found || (tsdPtr->pollState & POLL_DONE)) { tsdPtr->eventReady = 1; if (tsdPtr->onList) { /* * Remove the ThreadSpecificData structure of this thread * from the waiting list. This prevents us from * continuously spining on select until the other threads * runs and services the file event. */ if (tsdPtr->prevPtr) { tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr; } else { waitingListPtr = tsdPtr->nextPtr; } if (tsdPtr->nextPtr) { tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; } tsdPtr->nextPtr = tsdPtr->prevPtr = NULL; tsdPtr->onList = 0; tsdPtr->pollState = 0; } if (tsdPtr->runLoop) { CFRunLoopSourceSignal(tsdPtr->runLoopSource); CFRunLoopWakeUp(tsdPtr->runLoop); } } } UNLOCK_NOTIFIER; /* * Consume the next byte from the notifier pipe if the pipe was * readable. Note that there may be multiple bytes pending, but to * avoid a race condition we only read one at a time. */ if (FD_ISSET(receivePipe, &readableMask)) { i = read(receivePipe, buf, 1); if ((i == 0) || ((i == 1) && (buf[0] == 'q'))) { /* * Someone closed the write end of the pipe or sent us a Quit * message [Bug: 4139] and then closed the write end of the * pipe so we need to shut down the notifier thread. */ break; } } } pthread_exit(0); }  #ifdef HAVE_PTHREAD_ATFORK /* *---------------------------------------------------------------------- * * AtForkPrepare -- * * Lock the notifier in preparation for a fork. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void AtForkPrepare(void) { LOCK_NOTIFIER_INIT; LOCK_NOTIFIER; }  /* *---------------------------------------------------------------------- * * AtForkParent -- * * Unlock the notifier in the parent after a fork. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void AtForkParent(void) { UNLOCK_NOTIFIER; UNLOCK_NOTIFIER_INIT; }  /* *---------------------------------------------------------------------- * * AtForkChild -- * * Unlock and reinstall the notifier in the child after a fork. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void AtForkChild(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); UNLOCK_NOTIFIER; UNLOCK_NOTIFIER_INIT; if (tsdPtr->runLoop) { tsdPtr->runLoop = NULL; CFRunLoopSourceInvalidate(tsdPtr->runLoopSource); CFRelease(tsdPtr->runLoopSource); tsdPtr->runLoopSource = NULL; } if (notifierCount > 0) { notifierCount = 0; /* * Assume that the return value of Tcl_InitNotifier in the child will * be identical to the one stored as clientData in tclNotify.c's * ThreadSpecificData by the parent's TclInitNotifier, so discard the * return value here. This assumption may require the fork() to be * executed in the main thread of the parent, otherwise * Tcl_AlertNotifier may break in the child. */ Tcl_InitNotifier(); } } #endif /* HAVE_PTHREAD_ATFORK */ #endif /* HAVE_COREFOUNDATION */

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	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	- + + + - + - + + + + - - - + + + - + + + + - + - - - - + + + + + - - - - - + + + + + + + + + +	README -- Tcl test suite design document. RCS: @(#) $Id: README,v 1.11 2002/08/08 14:50:51 dgp Exp $ RCS: @(#) $Id: README,v 1.11.2.1 2003/04/01 21:13:07 dgp Exp $ Contents: --------- 1. Introduction 2. Running tests 3. Adding tests 2. Incompatibilities with prior Tcl versions 4. Incompatibilities with prior Tcl versions 1. Introduction: ---------------- This directory contains a set of validation tests for the Tcl commands and C Library procedures for Tcl. Each of the files whose name ends in ".test" is intended to fully exercise the functions in the C source file that corresponds to the file prefix. The C functions and/or Tcl commands tested by a given file are listed in the first line of the file. You can run the tests in three ways: 2. Running tests: ----------------- We recommend that you use the "test" target of Tcl's Makefile to run the test suite. From the directory in which you build Tcl, simply (a) type "make test" in ../unix; this will create the tcltest executable and run all of the tests. At least "make tcltest" must be run to create the tcltest executable for the other type "make test". This will create a special executable named tcltest in which the testing scripts will be evaluated. To create the tcltest executable without running the test suite, simple type options. "make tcltest". All the configuration options of the tcltest package are available during a "make test" by defining the TESTFLAGS environment variable. For example,if you wish to run only those tests in the file append.test, (b) type "tcltest <testFile> ?<option> <value>? you can type: where the options and values are the configuration options of the tcltest package. (c) start up tcltest in this directory, then "source" the test make test TESTFLAGS="-file append.test" For interactive testing, the Tcl Makefile provides the "runtest" target. Type "make runtest" in your build directory, and the tcltest executable will be created, if necessary, then it will run interactively. At the file (for example, type "source parse.test"). To run all of the tests, type "source all.tcl". To use the options in interactive mode, you can set them with the tcltest::configure command. Set constraints with the tcltest::testConstraints command. command prompt, you may type any Tcl commands. If you type "source ../tests/all.tcl", the test suite will run. You may use the tcltest::configure command to configure the test suite run as an alternative to command line options via TESTFLAGS. You might also wish to use the tcltest::testConstraint command to select the constraints that govern which tests are run. See the documentation for the tcltest package for details. 3. Adding tests: ---------------- Please see the tcltest man page for more information regarding how to write and run tests. Please note that the all.tcl file will source your new test file if the filename matches the tests/*.test pattern (as it should). The names of test files that contain regression (or glass-box) tests
︙
56 57 58 59 60 61 62 63 64 65 66 67 68 69 70	70 71 72 73 74 75 76 77 78 79 80 81 82 83 84	- +	properly to be sure of this. Be sure your tests can run cross-platform in both a build environment as well as an installation environment. If your test file contains tests that should not be run in one or more of those cases, please use the constraints mechanism to skip those tests. 2. Incompatibilities of package tcltest 2.1 with 4. Incompatibilities of package tcltest 2.1 with testing machinery of very old versions of Tcl: ------------------------------------------------ 1) Global variables such as VERBOSE, TESTS, and testConfig of the old machinery correspond to the [configure -verbose], [configure -match], and [testConstraint] commands of tcltest 2.1, respectively.
︙
84 85 86 87 88 89 90	98 99 100 101 102 103 104 105 106 107 108 109	+ + + + +	5) The "defs" and "defs.tcl" files no longer exist. 6) Instead of creating a doAllTests file in the tests directory, to run all nonPortable tests, just use the "-constraints nonPortable" command line flag. If you are running interactively, you can run [tcltest::testConstraint nonPortable 1] (after loading the tcltest package). 7) Direct evaluation of the *.test files by the "source" command is no longer recommended. Instead, "source all.tcl" and use the "-file" and "-notfile" options of tcltest::configure to control which *.test files are evaluated.

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	# Commands covered: append lappend # # 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-1996 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. # # RCS: @(#) $Id: append.test,v 1.7 2001/07/03 23:39:24 hobbs Exp $ # RCS: @(#) $Id: append.test,v 1.7.12.1 2006/10/05 11:44:04 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } catch {unset x}
︙
139 140 141 142 143 144 145 146 147 148 149 150 151 152	139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161	+ + + + + + + + +	catch {unset x} lappend x(0) } {} test append-4.20 {lappend command} { catch {unset x} lappend x(0) abc } {abc} unset x test append-4.21 {lappend command} { set x \" list [catch {lappend x} msg] $msg } {1 {unmatched open quote in list}} test append-4.22 {lappend command} { set x \" list [catch {lappend x abc} msg] $msg } {1 {unmatched open quote in list}} proc check {var size} { set l [llength $var] if {$l != $size} { return "length mismatch: should have been $size, was $l" } for {set i 0} {$i < $size} {set i [expr $i+1]} {
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	# Commands covered: append lappend # # 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-1996 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. # # RCS: @(#) $Id: appendComp.test,v 1.5 2001/11/23 01:25:38 das Exp $ # RCS: @(#) $Id: appendComp.test,v 1.5.4.1 2004/10/28 00:01:05 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } catch {unset x}
︙
194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212	194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212	- + - +	proc foo {} { lappend x } foo } {} test appendComp-4.18 {lappend command} { proc foo {} { lappend x {} } foo } {{}} test append-4.19 {lappend command} { test appendComp-4.19 {lappend command} { proc foo {} { lappend x(0) } foo } {} test append-4.20 {lappend command} { test appendComp-4.20 {lappend command} { proc foo {} { lappend x(0) abc } foo } {abc} proc check {var size} { set l [llength $var] if {$l != $size} {
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	# Commands covered: auto_mkindex auto_import # # This file contains tests related to autoloading and generating # the autoloading index. # # Copyright (c) 1998 Lucent Technologies, 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. # # RCS: @(#) $Id: autoMkindex.test,v 1.14 2002/10/03 13:34:32 dkf Exp $ # RCS: @(#) $Id: autoMkindex.test,v 1.14.2.1 2004/10/28 00:01:06 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } makeFile {# Test file for:
︙
322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344	322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344	- + - + - +	makeFile { proc {[magic mojo proc]} {} {} } [file join pkg magicchar2.tcl] test autoMkindex-5.2 {correctly locate auto loaded procs with []} { file delete tclIndex set res {} set result {} if { ![catch {auto_mkindex . pkg/magicchar2.tcl}] } { # Make a slave interp to test the autoloading set c [interp create] $c eval {lappend auto_path [pwd]} set res [$c eval {catch {{[magic mojo proc]}}}] set result [$c eval {catch {{[magic mojo proc]}}}] interp delete $c } set res set result } 0 removeFile [file join pkg magicchar2.tcl] removeDirectory pkg # Clean up.
︙

︙
11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33	11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34	- + +	# # Copyright (c) 1997 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. # # RCS: @(#) $Id: basic.test,v 1.25 2003/02/16 01:36:32 msofer Exp $ # RCS: @(#) $Id: basic.test,v 1.25.2.7 2005/03/18 16:33:43 dgp Exp $ # package require tcltest 2 namespace import -force ::tcltest::* testConstraint testcmdtoken [llength [info commands testcmdtoken]] testConstraint testcmdtrace [llength [info commands testcmdtrace]] testConstraint testcreatecommand [llength [info commands testcreatecommand]] testConstraint testevalex [llength [info commands testevalex]] testConstraint exec [llength [info commands exec]] # This variable needs to be changed when the major or minor version number for # Tcl changes. set tclvers 8.4 catch {namespace delete test_ns_basic}
︙
128 129 130 131 132 133 134 135 136 137 138 139 140 141 142	129 130 131 132 133 134 135 136 137 138 139 140 141 142 143	- +	return [namespace current] } } } list [catch {test_interp hide test_ns_basic::p x} msg] $msg \ [catch {test_interp hide x test_ns_basic::p} msg1] $msg1 \ [interp delete test_interp] } {1 {can only hide global namespace commands (use rename then hide)} 1 {cannot use namespace qualifiers as hidden commandtoken (rename)} {}} } {1 {can only hide global namespace commands (use rename then hide)} 1 {cannot use namespace qualifiers in hidden command token (rename)} {}} test basic-12.2 {Tcl_HideCommand, a hidden cmd remembers its containing namespace} { catch {namespace delete test_ns_basic} catch {rename cmd ""} proc cmd {} { ;# note that this is global return [namespace current] }
︙
426 427 428 429 430 431 432 433 434 435 436 437 438 439	427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458	+ + + + + + + + + + + + + + + + + +	set x {} vwait x close $f removeFile test1 rename bgerror {} set x } "foo\n while executing\n\"error foo\"" test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} { # # Follow the pure-list branch in a manner that # a - the pure-list internal rep is destroyed by shimmering # b - the command returns an error # As the error code in Tcl_EvalObjv accesses the list elements, this will # cause a segfault if [Bug 1119369] has not been fixed. # set SRC [list foo 1] ;# pure-list command proc foo str { # Shimmer pure-list to cmdName, cleanup and error proc $::SRC {} {}; $::SRC error "BAD CALL" } catch {eval $SRC} } 1 test basic-27.1 {Tcl_ExprLong} {emptyTest} { } {} test basic-28.1 {Tcl_ExprDouble} {emptyTest} { } {}
︙
532 533 534 535 536 537 538 539 540 541 542 543 544 545	551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573	+ + + + + + + + +	test basic-39.9 {Tcl_CreateObjTrace, status return unknown} {testcmdtrace} { proc OtherStatus { args } { error "Shouldn't get here" } set x 1; list [catch {testcmdtrace resulttest {OtherStatus $x}} result] [set result] } {6 {}} test basic-39.10 {Tcl_CreateTrace, correct level interpretation} {testcmdtrace} { proc foo {} {uplevel 1 bar} proc bar {} {uplevel 1 grok} proc grok {} {uplevel 1 spock} proc spock {} {uplevel 1 fascinating} proc fascinating {} {} testcmdtrace leveltest {foo} } {foo {foo} {uplevel 1 bar} {uplevel 1 bar} bar {bar} {uplevel 1 grok} {uplevel 1 grok}} test basic-40.1 {Tcl_DeleteTrace} {emptyTest} { # the above tests have tested Tcl_DeleteTrace } {} test basic-41.1 {Tcl_AddErrorInfo} {emptyTest} { } {}
︙
571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656	599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708	- + - - + + + + - + + - - - + - + - + + + + - + + - - - + - + - + + + + - + + - - - - + + - - - - + + - + + + + - + + - - - + - + + + + + + + + + + + + + + + + + + + +	append msg "${newMsg}\n" } close $f } error] list $res $msg } {1 {invoked "continue" outside of a loop while executing "continue "continue" " DONE }} test basic-46.2 {Tcl_AllowExceptions: exception return not allowed} {exec} { test basic-46.2 {Tcl_AllowExceptions: exception return not allowed} -setup { set fName [makeFile { puts hello break } BREAKtest] } -constraints { exec } -body { set res [list [catch {exec [interpreter] $fName} msg] $msg] exec [interpreter] $fName } -cleanup { removeFile BREAKtest regsub {file ".*BREAKtest"} $res {file "BREAKtest"} res set res } {1 {hello } -returnCodes error -match glob -result {hello invoked "break" outside of a loop while executing "break" (file "BREAKtest" line 3)}} (file "*BREAKtest" line 3)} test basic-46.3 {Tcl_AllowExceptions: exception return not allowed} {exec} { test basic-46.3 {Tcl_AllowExceptions: exception return not allowed} -setup { set fName [makeFile { interp alias {} patch {} info patchlevel patch break } BREAKtest] } -constraints { exec } -body { set res [list [catch {exec [interpreter] $fName} msg] $msg] exec [interpreter] $fName } -cleanup { removeFile BREAKtest regsub {file ".*BREAKtest"} $res {file "BREAKtest"} res set res } {1 {invoked "break" outside of a loop } -returnCodes error -match glob -result {invoked "break" outside of a loop while executing "break" (file "BREAKtest" line 4)}} (file "*BREAKtest" line 4)} test basic-46.4 {Tcl_AllowExceptions: exception return not allowed} {exec} { test basic-46.4 {Tcl_AllowExceptions: exception return not allowed} -setup { set fName [makeFile { foo [set a 1] [break] } BREAKtest] } -constraints { exec } -body { set res [list [catch {exec [interpreter] $fName} msg] $msg] exec [interpreter] $fName } -cleanup { removeFile BREAKtest regsub {file ".*BREAKtest"} $res {file "BREAKtest"} res set res } {1 {invoked "break" outside of a loop while executing } -returnCodes error -match glob -result {invoked "break" outside of a loop while executing* "break" invoked from within "foo [set a 1] [break]" (file "BREAKtest" line 2)}} "foo \[set a 1] \[break]" (file "*BREAKtest" line 2)} test basic-46.5 {Tcl_AllowExceptions: exception return not allowed} {exec} { test basic-46.5 {Tcl_AllowExceptions: exception return not allowed} -setup { set fName [makeFile { return -code return } BREAKtest] } -constraints { exec } -body { set res [list [catch {exec [interpreter] $fName} msg] $msg] exec [interpreter] $fName } -cleanup { removeFile BREAKtest regsub {file ".*BREAKtest"} $res {file "BREAKtest"} res set res } {1 {command returned bad code: 2 } -returnCodes error -match glob -result {command returned bad code: 2 while executing "return -code return" (file "BREAKtest" line 2)}} (file "*BREAKtest" line 2)} test basic-47.1 {Tcl_EvalEx: check for missing close-bracket} -body { subst {a[set b [format cd]} } -returnCodes error -result {missing close-bracket} test basic-49.1 {Tcl_EvalEx: verify TCL_EVAL_GLOBAL operation} testevalex { set ::x global namespace eval ns { variable x namespace testevalex {set x changed} global set ::result [list $::x $x] } namespace delete ns set ::result } {changed namespace} test basic-49.2 {Tcl_EvalEx: verify TCL_EVAL_GLOBAL operation} testevalex { set ::x global namespace eval ns { variable x namespace testevalex {set ::context $x} global } namespace delete ns set ::context } {global} # cleanup catch {eval namespace delete [namespace children :: test_ns_*]} catch {namespace delete george} catch {interp delete test_interp} catch {rename p ""} catch {rename q ""} catch {rename cmd ""} catch {rename value:at: ""} catch {unset x} ::tcltest::cleanupTests return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	# This file tests the tclBinary.c file and the "binary" Tcl command. # # 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) 1997 by 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. # # RCS: @(#) $Id: binary.test,v 1.11 2003/02/21 21:54:11 dkf Exp $ # RCS: @(#) $Id: binary.test,v 1.11.2.4 2006/04/05 15:17:06 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } test binary-0.1 {DupByteArrayInternalRep} {
︙
528 529 530 531 532 533 534 535 536 537 538 539 540 541	528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545	+ + + +	set a {1.6 3.4} binary format d1 $a } \x3f\xf9\x99\x99\x99\x99\x99\x9a test binary-14.17 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} { set a {1.6 3.4} binary format d1 $a } \x9a\x99\x99\x99\x99\x99\xf9\x3f test binary-14.18 {FormatNumber: Bug 1116542} { binary scan [binary format d 1.25] d w set w } 1.25 test binary-15.1 {Tcl_BinaryObjCmd: format} { list [catch {binary format ax*a "y" "z"} msg] $msg } {1 {cannot use "*" in format string with "x"}} test binary-15.2 {Tcl_BinaryObjCmd: format} { binary format axa "y" "z" } y\x00z
︙
1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468	1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472	- + - +	} {2 1 1.6} test binary-41.8 {ScanNumber: word alignment} {nonPortable pcOnly} { catch {unset arg1; unset arg2} list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2 } {2 1 1.6} test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} {} { catch {binary ""} result catch {binary ?} result set result } {bad option "": must be format or scan} } {bad option "?": must be format or scan} # Wide int (guaranteed at least 64-bit) handling test binary-43.1 {Tcl_BinaryObjCmd: format wide int} {} { binary format w 7810179016327718216 } HelloTcl test binary-43.2 {Tcl_BinaryObjCmd: format wide int} {} { binary format W 7810179016327718216
︙
1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499	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	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	binary scan [binary format sws 16450 -1 19521] c* x set x } {66 64 -1 -1 -1 -1 -1 -1 -1 -1 65 76} test binary-45.2 {Tcl_BinaryObjCmd: combined wide int handling} { binary scan [binary format sWs 16450 0x7fffffff 19521] c* x set x } {66 64 0 0 0 0 127 -1 -1 -1 65 76} test binary-46.1 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} { binary format a* \u20ac } \u00ac test binary-46.2 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} { list [binary scan [binary format a* \u20ac\u20bd] s x] $x } {1 -16980} test binary-46.3 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} { set x {} set y {} set z {} list [binary scan [binary format a* \u20ac\u20bd] aaa x y z] $x $y $z } "2 \u00ac \u00bd {}" test binary-46.4 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} { set x [encoding convertto iso8859-15 \u20ac] set y [binary format a* $x] list $x $y } "\u00a4 \u00a4" test binary-46.5 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} { set x [binary scan \u00a4 a* y] list $x $y [encoding convertfrom iso8859-15 $y] } "1 \u00a4 \u20ac" test binary-47.1 {Tcl_BinaryObjCmd: number cache reference count handling} { # This test is only reliable when memory debugging is turned on, # but without even memory debugging it should still generate the # expected answers and might therefore still pick up memory corruption # caused by [Bug 851747]. list [binary scan aba ccc x x x] $x } {3 97} # cleanup ::tcltest::cleanupTests return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	# Commands covered: clock # # 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) 1995-1998 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. # # RCS: @(#) $Id: clock.test,v 1.22 2003/02/01 21:27:55 kennykb Exp $ # RCS: @(#) $Id: clock.test,v 1.22.2.7 2006/07/30 17:05:43 kennykb Exp $ set env(LC_TIME) POSIX if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* }
︙
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	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	- - - - - - - - - - - + + + + + + + + + + + + + + - - - - - - - + + + + + + + + + - - - - - + + + + + +	} {1 {bad switch "-": must be -milliseconds}} # clock format test clock-3.1 {clock format tests} {unixOnly} { set clockval 657687766 clock format $clockval -format {%a %b %d %I:%M:%S %p %Y} -gmt true } {Sun Nov 04 03:02:46 AM 1990} test clock-3.2 {clock format tests} { # TCL_USE_TIMEZONE_VAR catch {set oldtz $env(TZ)} set env(TZ) PST set x {} append x [clock format 863800000 -format %Z -gmt 1] append x [set env(TZ)] catch {unset env(TZ); set env(TZ) $oldtz} set x } {GMTPST} test clock-3.2 {clock format tests} \ -body { # TCL_USE_TIMEZONE_VAR catch {set oldtz $env(TZ)} set env(TZ) PST set x {} append x [clock format 863800000 -format %Z -gmt 1] append x [set env(TZ)] catch {unset env(TZ); set env(TZ) $oldtz} set x } \ -match regexp \ -result {(?:GMT|UTC)PST} test clock-3.3 {clock format tests} { # tzset() under Borland doesn't seem to set up tzname[] for local # timezone, which caused "clock format" to think that %Z was an invalid # string. Don't care about answer, just that test runs w/o error. clock format 863800000 -format %Z set x {} } {} test clock-3.4 {clock format tests} { # tzset() under Borland doesn't seem to set up tzname[] for gmt timezone. # tzset() under MSVC has the following weird observed behavior: # First time we call "clock format [clock seconds] -format %Z -gmt 1" # we get "GMT", but on all subsequent calls we get the current time # zone string, even though env(TZ) is GMT and the variable _timezone # is 0. test clock-3.4 {clock format tests} \ -body { # tzset() under Borland doesn't seem to set up tzname[] for gmt # timezone. tzset() under MSVC has the following weird observed # behavior: # First time we call "clock format [clock seconds] -format %Z -gmt 1" # we get "GMT", but on all subsequent calls we get the current time # zone string, even though env(TZ) is GMT and the variable _timezone # is 0. set x {} append x [clock format 863800000 -format %Z -gmt 1] append x [clock format 863800000 -format %Z -gmt 1] } {GMTGMT} set x {} append x [clock format 863800000 -format %Z -gmt 1] append x [clock format 863800000 -format %Z -gmt 1] } \ -match regexp \ -result {GMTGMT|UTCUTC} test clock-3.5 {clock format tests} { list [catch {clock format} msg] $msg } {1 {wrong # args: should be "clock format clockval ?-format string? ?-gmt boolean?"}} test clock-3.6 {clock format tests} { list [catch {clock format foo} msg] $msg } {1 {expected integer but got "foo"}} test clock-3.7 {clock format tests} {unixOrPc} {
︙
124 125 126 127 128 129 130 131 132 133 134 135 136 137	130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165	+ + + + + + + + + + + + + + + + + + + + + +	set oldenc [encoding system] encoding system iso8859-1 set res [clock format 0 -format \u00c4] encoding system $oldenc unset oldenc set res } "\u00c4" # Bug 942078 test clock-3.14 {change of time zone} -setup { catch { unset oldTZ } if { [info exists env(TZ)] } { set oldTZ $env(TZ) } } -body { set env(TZ) PST8PDT set s [clock format 0 -format %H%M] set env(TZ) GMT0 append s -[clock format 0 -format %H%M] } -cleanup { if { [info exists oldTZ] } { set env(TZ) $oldTZ unset oldTZ } else { unset env(TZ) } } -result {1600-0000} # clock scan test clock-4.1 {clock scan tests} { list [catch {clock scan} msg] $msg } {1 {wrong # args: should be "clock scan dateString ?-base clockValue? ?-gmt boolean?"}} test clock-4.2 {clock scan tests} { list [catch {clock scan "bad-string"} msg] $msg
︙
203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 355 356 357 358 359 360 361 362 363	231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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	- + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - +	clock format $time -format {%b %d, %Y %H:%M:%S} } "Oct 23, 1992 00:00:00" # CLOCK SCAN REAL TESTS # We use 5am PST, 31-12-1999 as the base for these scans because irrespective # of your local timezone it should always give us times on December 31, 1999 set 5amPST 946645200 test clock-4.18 {clock scan, number meridian} { test clock-4.19 {clock scan, number meridian} { set t1 [clock scan "5 am" -base $5amPST -gmt true] set t2 [clock scan "5 pm" -base $5amPST -gmt true] set t3 [clock scan "5 a.m." -base $5amPST -gmt true] set t4 [clock scan "5 p.m." -base $5amPST -gmt true] list \ [clock format $t1 -format {%b %d, %Y %H:%M:%S} -gmt true] \ [clock format $t2 -format {%b %d, %Y %H:%M:%S} -gmt true] \ [clock format $t3 -format {%b %d, %Y %H:%M:%S} -gmt true] \ [clock format $t4 -format {%b %d, %Y %H:%M:%S} -gmt true] } [list "Dec 31, 1999 05:00:00" "Dec 31, 1999 17:00:00" \ "Dec 31, 1999 05:00:00" "Dec 31, 1999 17:00:00"] test clock-4.19 {clock scan, number:number meridian} { test clock-4.20 {clock scan, number:number meridian} { clock format [clock scan "5:30 pm" -base $5amPST -gmt true] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Dec 31, 1999 17:30:00" test clock-4.20 {clock scan, number:number-timezone} { test clock-4.21 {clock scan, number:number-timezone} { clock format [clock scan "00:00-0800" -gmt true -base $5amPST] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Dec 31, 1999 08:00:00" test clock-4.21 {clock scan, number:number:number o_merid} { test clock-4.22 {clock scan, number:number:number o_merid} { clock format [clock scan "8:00:00" -gmt true -base $5amPST] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Dec 31, 1999 08:00:00" test clock-4.22 {clock scan, number:number:number o_merid} { test clock-4.23 {clock scan, number:number:number o_merid} { clock format [clock scan "8:00:00 am" -gmt true -base $5amPST] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Dec 31, 1999 08:00:00" test clock-4.23 {clock scan, number:number:number o_merid} { test clock-4.24 {clock scan, number:number:number o_merid} { clock format [clock scan "8:00:00 pm" -gmt true -base $5amPST] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Dec 31, 1999 20:00:00" test clock-4.24 {clock scan, number:number:number-timezone} { test clock-4.25 {clock scan, number:number:number-timezone} { clock format [clock scan "00:00:30-0800" -gmt true -base $5amPST] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Dec 31, 1999 08:00:30" test clock-4.25 {clock scan, DST for days} { test clock-4.26 {clock scan, DST for days} { clock scan "tomorrow" -base [clock scan "19991031 00:00:00"] } [clock scan "19991101 00:00:00"] test clock-4.26 {clock scan, DST for days} { test clock-4.27 {clock scan, DST for days} { clock scan "yesterday" -base [clock scan "19991101 00:00:00"] } [clock scan "19991031 00:00:00"] test clock-4.27 {clock scan, day} knownBug { test clock-4.28 {clock scan, day} knownBug { clock format [clock scan "Monday" -gmt true -base 946627200] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Jan 03, 2000 00:00:00" test clock-4.28 {clock scan, number/number} { test clock-4.29 {clock scan, number/number} { clock format [clock scan "1/1" -gmt true -base 946627200] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Jan 01, 1999 00:00:00" test clock-4.28 {clock scan, number/number} { test clock-4.30 {clock scan, number/number} { clock format [clock scan "1/1/1999" -gmt true -base 946627200] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Jan 01, 1999 00:00:00" test clock-4.28 {clock scan, number/number} { test clock-4.31 {clock scan, number/number} { clock format [clock scan "19990101" -gmt true -base 946627200] \ -format {%b %d, %Y %H:%M:%S} -gmt true } "Jan 01, 1999 00:00:00" test clock-4.29 {clock scan, relative minutes} { test clock-4.32 {clock scan, relative minutes} { clock scan "now + 1 minute" -base 946627200 } 946627260 test clock-4.30 {clock scan, relative minutes} { test clock-4.33 {clock scan, relative minutes} { clock scan "now +1 minute" -base 946627200 } 946627260 test clock-4.31 {clock scan, relative minutes} { test clock-4.34 {clock scan, relative minutes} { clock scan "now 1 minute" -base 946627200 } 946627260 test clock-4.32 {clock scan, relative minutes} { test clock-4.35 {clock scan, relative minutes} { clock scan "now - 1 minute" -base 946627200 } 946627140 test clock-4.33 {clock scan, relative minutes} { test clock-4.36 {clock scan, relative minutes} { clock scan "now -1 minute" -base 946627200 } 946627140 test clock-4.34 {clock scan, day of week} { test clock-4.37 {clock scan, day of week} { clock format [clock scan "wednesday" -base [clock scan 20000112]] \ -format {%b %d, %Y} } "Jan 12, 2000" test clock-4.35 {clock scan, next day of week} { test clock-4.38 {clock scan, next day of week} { clock format [clock scan "next wednesday" -base [clock scan 20000112]] \ -format {%b %d, %Y} } "Jan 19, 2000" test clock-4.36 {clock scan, day of week} { test clock-4.39 {clock scan, day of week} { clock format [clock scan "thursday" -base [clock scan 20000112]] \ -format {%b %d, %Y} } "Jan 13, 2000" test clock-4.37 {clock scan, next day of week} { test clock-4.40 {clock scan, next day of week} { clock format [clock scan "next thursday" -base [clock scan 20000112]] \ -format {%b %d, %Y} } "Jan 20, 2000" # weekday specification and base. test clock-4.38 {2nd monday in november} { test clock-4.41 {2nd monday in november} { set res {} foreach i {91 92 93 94 95 96} { set nov8th [clock scan 11/8/$i] set monday [clock scan monday -base $nov8th] lappend res [clock format $monday -format %Y-%m-%d] } set res } {1991-11-11 1992-11-09 1993-11-08 1994-11-14 1995-11-13 1996-11-11} test clock-4.39 {2nd monday in november (2nd try)} { test clock-4.42 {2nd monday in november (2nd try)} { set res {} foreach i {91 92 93 94 95 96} { set nov1th [clock scan 11/1/$i] set monday [clock scan "2 monday" -base $nov1th] lappend res [clock format $monday -format %Y-%m-%d] } set res } {1991-11-11 1992-11-09 1993-11-08 1994-11-14 1995-11-13 1996-11-11} test clock-4.40 {last monday in november} { test clock-4.43 {last monday in november} { set res {} foreach i {91 92 93 94 95 96} { set dec1th [clock scan 12/1/$i] set monday [clock scan "monday 1 week ago" -base $dec1th] lappend res [clock format $monday -format %Y-%m-%d] } set res } {1991-11-25 1992-11-30 1993-11-29 1994-11-28 1995-11-27 1996-11-25} test clock-4.40 {2nd monday in november} knownBug { test clock-4.44 {2nd monday in november} knownBug { set res {} foreach i {91 92 93 94 95 96} { set nov8th [clock scan 11/8/$i -gmt 1] set monday [clock scan monday -base $nov8th -gmt 1] lappend res [clock format $monday -format %Y-%m-%d -gmt 1] } set res } {1991-11-11 1992-11-09 1993-11-08 1994-11-14 1995-11-13 1996-11-11} test clock-4.41 {2nd monday in november (2nd try)} knownBug { test clock-4.45 {2nd monday in november (2nd try)} knownBug { set res {} foreach i {91 92 93 94 95 96} { set nov1th [clock scan 11/1/$i -gmt 1] set monday [clock scan "2 monday" -base $nov1th -gmt 1] lappend res [clock format $monday -format %Y-%m-%d -gmt 1] } set res } {1991-11-11 1992-11-09 1993-11-08 1994-11-14 1995-11-13 1996-11-11} test clock-4.40 {last monday in november} knownBug { test clock-4.46 {last monday in november} knownBug { set res {} foreach i {91 92 93 94 95 96} { set dec1th [clock scan 12/1/$i -gmt 1] set monday [clock scan "monday 1 week ago" -base $dec1th -gmt 1] lappend res [clock format $monday -format %Y-%m-%d -gmt 1] } set res } {1991-11-25 1992-11-30 1993-11-29 1994-11-28 1995-11-27 1996-11-25} test clock-4.41 {ago with multiple relative units} { test clock-4.47 {ago with multiple relative units} { set base [clock scan "12/31/1999 00:00:00"] set res [clock scan "2 days 2 hours ago" -base $base] expr {$base - $res} } 180000 # clock seconds test clock-5.1 {clock seconds tests} {
︙
439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465	467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658	- + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	set 5amPST 946645200 test clock-8.1 {clock scan midnight/gmt range bug 413397} { set fmt "%m/%d" list [clock format [clock scan year -base $5amPST -gmt 0] -format $fmt] \ [clock format [clock scan year -base $5amPST -gmt 1] -format $fmt] } {12/31 12/31} set ::tcltest::testConstraints(needPST) [expr { ::tcltest::testConstraint needPST [expr { [regexp {^(Pacific.*|P[DS]T)$} [clock format 1 -format %Z]] && ([clock format 1 -format %s] != "%s") }] test clock-9.1 {%s gmt testing} {needPST} { # Note that this test will fail if the strftime on the underlying # system doesn't support the %s format group. Systems that are known # to have trouble include the native C libraries on AIX and HP-UX # We need PST to guarantee the difference value below, and %s isn't # valid on all OSes (like Solaris). set s 100000 set a [clock format $s -format %s -gmt 0] set b [clock format $s -format %s -gmt 1] # This should be the offset in seconds between current locale and GMT. # This didn't seem to be correctly on Windows until the fix for # Bug #559376, which fiddled with env(TZ) when -gmt 1 was used. # It's hard-coded to check P[SD]T now. (8 hours) set c [expr {$b-$a}] } {28800} ::tcltest::testConstraint percentG \ [expr { ![catch { clock format 0 -format %G -gmt true } y1970] && $y1970 eq {1970} }] test clock-10.0 {Can strftime do %G?} { clock format 0 -format %G -gmt true } 1970 test clock-10.1 {ISO week-based calendar 2000-W52-1} {percentG} { clock format 977702400 -format {%a %A %g %G %u %V %w} -gmt true; # 2000-12-25 } {Mon Monday 00 2000 1 52 1} test clock-10.2 {ISO week-based calendar 2000-W52-7} {percentG} { clock format 978220800 -format {%a %A %g %G %u %V %w} -gmt true; # 2000-12-31 } {Sun Sunday 00 2000 7 52 0} test clock-10.3 {ISO week-based calendar 2001-W01-1} {percentG} { clock format 978307200 -format {%a %A %g %G %u %V %w} -gmt true; # 2001-1-1 } {Mon Monday 01 2001 1 01 1} test clock-10.4 {ISO week-based calendar 2001-W01-7} {percentG} { clock format 978825600 -format {%a %A %g %G %u %V %w} -gmt true; # 2001-1-7 } {Sun Sunday 01 2001 7 01 0} test clock-10.5 {ISO week-based calendar 2001-W02-1} {percentG} { clock format 978912000 -format {%a %A %g %G %u %V %w} -gmt true; # 2001-1-8 } {Mon Monday 01 2001 1 02 1} test clock-10.6 {ISO week-based calendar 2001-W52-1} {percentG} { clock format 1009152000 -format {%a %A %g %G %u %V %w} -gmt true; # 2001-12-24 } {Mon Monday 01 2001 1 52 1} test clock-10.7 {ISO week-based calendar 2001-W52-7} {percentG} { clock format 1009670400 -format {%a %A %g %G %u %V %w} -gmt true; # 2001-12-30 } {Sun Sunday 01 2001 7 52 0} test clock-10.8 {ISO week-based calendar 2002-W01-1} {percentG} { clock format 1009756800 -format {%a %A %g %G %u %V %w} -gmt true; # 2001-12-31 } {Mon Monday 02 2002 1 01 1} test clock-10.9 {ISO week-based calendar 2002-W01-2} {percentG} { clock format 1009843200 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-1-1 } {Tue Tuesday 02 2002 2 01 2} test clock-10.10 {ISO week-based calendar 2002-W01-7} {percentG} { clock format 1010275200 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-1-6 } {Sun Sunday 02 2002 7 01 0} test clock-10.11 {ISO week-based calendar 2002-W02-1} {percentG} { clock format 1010361600 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-1-7 } {Mon Monday 02 2002 1 02 1} test clock-10.12 {ISO week-based calendar 2002-W52-1} {percentG} { clock format 1040601600 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-12-23 } {Mon Monday 02 2002 1 52 1} test clock-10.13 {ISO week-based calendar 2002-W52-7} {percentG} { clock format 1041120000 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-12-29 } {Sun Sunday 02 2002 7 52 0} test clock-10.14 {ISO week-based calendar 2003-W01-1} {percentG} { clock format 1041206400 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-12-30 } {Mon Monday 03 2003 1 01 1} test clock-10.15 {ISO week-based calendar 2003-W01-2} {percentG} { clock format 1041292800 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-12-31 } {Tue Tuesday 03 2003 2 01 2} test clock-10.16 {ISO week-based calendar 2003-W01-3} {percentG} { clock format 1041379200 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-1-1 } {Wed Wednesday 03 2003 3 01 3} test clock-10.17 {ISO week-based calendar 2003-W01-7} {percentG} { clock format 1041724800 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-1-5 } {Sun Sunday 03 2003 7 01 0} test clock-10.18 {ISO week-based calendar 2003-W02-1} {percentG} { clock format 1041811200 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-1-6 } {Mon Monday 03 2003 1 02 1} test clock-10.19 {ISO week-based calendar 2003-W52-1} {percentG} { clock format 1072051200 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-12-22 } {Mon Monday 03 2003 1 52 1} test clock-10.20 {ISO week-based calendar 2003-W52-7} {percentG} { clock format 1072569600 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-12-28 } {Sun Sunday 03 2003 7 52 0} test clock-10.21 {ISO week-based calendar 2004-W01-1} {percentG} { clock format 1072656000 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-12-29 } {Mon Monday 04 2004 1 01 1} test clock-10.22 {ISO week-based calendar 2004-W01-3} {percentG} { clock format 1072828800 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-12-31 } {Wed Wednesday 04 2004 3 01 3} test clock-10.23 {ISO week-based calendar 2004-W01-4} {percentG} { clock format 1072915200 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-1-1 } {Thu Thursday 04 2004 4 01 4} test clock-10.24 {ISO week-based calendar 2004-W01-7} {percentG} { clock format 1073174400 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-1-4 } {Sun Sunday 04 2004 7 01 0} test clock-10.25 {ISO week-based calendar 2004-W02-1} {percentG} { clock format 1073260800 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-1-5 } {Mon Monday 04 2004 1 02 1} test clock-10.26 {ISO week-based calendar 2004-W52-1} {percentG} { clock format 1103500800 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-12-20 } {Mon Monday 04 2004 1 52 1} test clock-10.27 {ISO week-based calendar 2004-W52-7} {percentG} { clock format 1104019200 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-12-26 } {Sun Sunday 04 2004 7 52 0} test clock-10.28 {ISO week-based calendar 2004-W53-1} {percentG} { clock format 1104105600 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-12-27 } {Mon Monday 04 2004 1 53 1} test clock-10.29 {ISO week-based calendar 2004-W53-5} {percentG} { clock format 1104451200 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-12-31 } {Fri Friday 04 2004 5 53 5} test clock-10.30 {ISO week-based calendar 2004-W53-6} {percentG} { clock format 1104537600 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-1-1 } {Sat Saturday 04 2004 6 53 6} test clock-10.31 {ISO week-based calendar 2004-W53-7} {percentG} { clock format 1104624000 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-1-2 } {Sun Sunday 04 2004 7 53 0} test clock-10.32 {ISO week-based calendar 2005-W01-1} {percentG} { clock format 1104710400 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-1-3 } {Mon Monday 05 2005 1 01 1} test clock-10.33 {ISO week-based calendar 2005-W01-7} {percentG} { clock format 1105228800 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-1-9 } {Sun Sunday 05 2005 7 01 0} test clock-10.34 {ISO week-based calendar 2005-W02-1} {percentG} { clock format 1105315200 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-1-10 } {Mon Monday 05 2005 1 02 1} test clock-10.35 {ISO week-based calendar 2005-W52-1} {percentG} { clock format 1135555200 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-12-26 } {Mon Monday 05 2005 1 52 1} test clock-10.36 {ISO week-based calendar 2005-W52-6} {percentG} { clock format 1135987200 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-12-31 } {Sat Saturday 05 2005 6 52 6} test clock-10.37 {ISO week-based calendar 2005-W52-7} {percentG} { clock format 1136073600 -format {%a %A %g %G %u %V %w} -gmt true; # 2006-1-1 } {Sun Sunday 05 2005 7 52 0} test clock-10.38 {ISO week-based calendar 2006-W01-1} {percentG} { clock format 1136160000 -format {%a %A %g %G %u %V %w} -gmt true; # 2006-1-2 } {Mon Monday 06 2006 1 01 1} test clock-10.39 {ISO week-based calendar 2006-W01-7} {percentG} { clock format 1136678400 -format {%a %A %g %G %u %V %w} -gmt true; # 2006-1-8 } {Sun Sunday 06 2006 7 01 0} test clock-10.40 {ISO week-based calendar 2006-W02-1} {percentG} { clock format 1136764800 -format {%a %A %g %G %u %V %w} -gmt true; # 2006-1-9 } {Mon Monday 06 2006 1 02 1} test clock-10.41 {ISO week-based calendar 2009-W52-1} {percentG} { clock format 1261353600 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-12-21 } {Mon Monday 09 2009 1 52 1} test clock-10.42 {ISO week-based calendar 2009-W52-7} {percentG} { clock format 1261872000 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-12-27 } {Sun Sunday 09 2009 7 52 0} test clock-10.43 {ISO week-based calendar 2009-W53-1} {percentG} { clock format 1261958400 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-12-28 } {Mon Monday 09 2009 1 53 1} test clock-10.44 {ISO week-based calendar 2009-W53-4} {percentG} { clock format 1262217600 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-12-31 } {Thu Thursday 09 2009 4 53 4} test clock-10.45 {ISO week-based calendar 2009-W53-5} {percentG} { clock format 1262304000 -format {%a %A %g %G %u %V %w} -gmt true; # 2010-1-1 } {Fri Friday 09 2009 5 53 5} test clock-10.46 {ISO week-based calendar 2009-W53-7} {percentG} { clock format 1262476800 -format {%a %A %g %G %u %V %w} -gmt true; # 2010-1-3 } {Sun Sunday 09 2009 7 53 0} test clock-10.47 {ISO week-based calendar 2010-W01-1} {percentG} { clock format 1262563200 -format {%a %A %g %G %u %V %w} -gmt true; # 2010-1-4 } {Mon Monday 10 2010 1 01 1} test clock-10.48 {ISO week-based calendar 2010-W01-7} {percentG} { clock format 1263081600 -format {%a %A %g %G %u %V %w} -gmt true; # 2010-1-10 } {Sun Sunday 10 2010 7 01 0} test clock-10.49 {ISO week-based calendar 2010-W02-1} {percentG} { clock format 1263168000 -format {%a %A %g %G %u %V %w} -gmt true; # 2010-1-11 } {Mon Monday 10 2010 1 02 1} test clock-41.1 {regression test - format group %k when hour is 0 } { clock format 0 -format %k -gmt true } { 0} # cleanup ::tcltest::cleanupTests return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	# The file tests the tclCmdAH.c file. # # 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) 1996-1998 by 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. # # RCS: @(#) $Id: cmdAH.test,v 1.30 2003/01/09 10:38:32 vincentdarley Exp $ # RCS: @(#) $Id: cmdAH.test,v 1.30.2.6 2006/10/01 13:17:34 patthoyts Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 namespace import -force ::tcltest::* } tcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]]
︙
82 83 84 85 86 87 88 89 90 91 92 93 94 95	82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98	+ + +	} 1 test cmdAH-2.5 {Tcl_CdObjCmd} { list [catch {cd ~~} msg] $msg } {1 {user "~" doesn't exist}} test cmdAH-2.6 {Tcl_CdObjCmd} { list [catch {cd _foobar} msg] $msg } {1 {couldn't change working directory to "_foobar": no such file or directory}} test cmdAH-2.6.1 {Tcl_CdObjCmd} { list [catch {cd ""} msg] $msg } {1 {couldn't change working directory to "": no such file or directory}} test cmdAH-2.7 {Tcl_ConcatObjCmd} { concat } {} test cmdAH-2.8 {Tcl_ConcatObjCmd} { concat a } a
︙
176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204	179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207	- + - + - +	test cmdAH-5.4 {Tcl_FileObjCmd} { list [catch {file exists ""} msg] $msg } {0 0} #volume test cmdAH-6.1 {Tcl_FileObjCmd: volumes} { list [catch {file volumes x} msg] $msg list [catch {file volumes x} msg] $msg } {1 {wrong # args: should be "file volumes"}} test cmdAH-6.2 {Tcl_FileObjCmd: volumes} { set volumeList [file volumes] if { [llength $volumeList] == 0 } { set result 0 } else { set result 1 } } } {1} test cmdAH-6.3 {Tcl_FileObjCmd: volumes} {macOrUnix} { set volumeList [file volumes] catch [list glob -nocomplain [lindex $volumeList 0]*] } {0} test cmdAH-6.4 {Tcl_FileObjCmd: volumes} {pcOnly} { test cmdAH-6.4 {Tcl_FileObjCmd: volumes} winOnly { set volumeList [string tolower [file volumes]] list [catch {lsearch $volumeList "c:/"} element] [expr $element != -1] [catch {list glob -nocomplain [lindex $volumeList $element]*}] } {0 1 0} test cmdAH-6.5 {cd} {unixOnly nonPortable} { set dir [pwd] cd /
︙
392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429	395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432	- + - + - + - +	test cmdAH-8.42 {Tcl_FileObjCmd: dirname} { testsetplatform mac list [catch {file dirname ~:baz} msg] $msg } {0 ~:} test cmdAH-8.43 {Tcl_FileObjCmd: dirname} { global env set temp $env(HOME) set env(HOME) "/home/test" set env(HOME) "/homewontexist/test" testsetplatform unix set result [list [catch {file dirname ~} msg] $msg] set env(HOME) $temp set result } {0 /home} } {0 /homewontexist} test cmdAH-8.44 {Tcl_FileObjCmd: dirname} { global env set temp $env(HOME) set env(HOME) "~" testsetplatform unix set result [list [catch {file dirname ~} msg] $msg] set env(HOME) $temp set result } {0 ~} test cmdAH-8.45 {Tcl_FileObjCmd: dirname} { global env set temp $env(HOME) set env(HOME) "/home/test" set env(HOME) "/homewontexist/test" testsetplatform windows set result [list [catch {file dirname ~} msg] $msg] set env(HOME) $temp set result } {0 /home} } {0 /homewontexist} test cmdAH-8.46 {Tcl_FileObjCmd: dirname} { global env set temp $env(HOME) set env(HOME) "/home/test" testsetplatform mac set result [list [catch {file dirname ~} msg] $msg] set env(HOME) $temp
︙
1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100	1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103	- + - - + + - + - + - + - +	removeDirectory $dirfile set dirfile [makeDirectory dir.file] set gorpfile [makeFile abcde gorp.file] test cmdAH-18.1 {Tcl_FileObjCmd: executable} {testchmod} { list [catch {file executable a b} msg] $msg } {1 {wrong # args: should be "file executable name"}} test cmdAH-18.2 {Tcl_FileObjCmd: executable} {testchmod} { test cmdAH-18.2 {Tcl_FileObjCmd: executable} {testchmod notRoot} { file executable $gorpfile } 0 test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly testchmod} { # Only on unix will setting the execute bit on a regular file # cause that file to be executable. # cause that file to be executable. testchmod 0775 $gorpfile file exe $gorpfile } 1 test cmdAH-18.4 {Tcl_FileObjCmd: executable} {macOnly testchmod} { # On mac, the only executable files are of type APPL. set x [file exe $gorpfile] set x [file exe $gorpfile] file attrib $gorpfile -type APPL lappend x [file exe $gorpfile] } {0 1} test cmdAH-18.5 {Tcl_FileObjCmd: executable} {pcOnly testchmod} { test cmdAH-18.5 {Tcl_FileObjCmd: executable} {winOnly testchmod} { # On pc, must be a .exe, .com, etc. set x [file exe $gorpfile] set gorpexe [makeFile foo gorp.exe] lappend x [file exe $gorpexe] removeFile $gorpexe set x } {0 1} test cmdAH-18.6 {Tcl_FileObjCmd: executable} {testchmod} { # Directories are always executable. file exe $dirfile } 1 removeDirectory $dirfile removeFile $gorpfile set linkfile [file join [temporaryDirectory] link.file] file delete $linkfile
︙
1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337	1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361	- + + + + + + + + + + + + + + + + + + + + + - + - + - + - + - - + + +	file mkdir $dirA/b $dirB/a/c set res [list [file isdirectory $dirA/b] [file isdirectory $dirB/a/c]] file delete -force $dirA file delete -force $dirB set res } {1 1} # mtime # mtime proc waitForEvenSecondForFAT {} { # Windows 9x uses filesystems (the FAT* family of FSes) without # enough data in its timestamps for even per-second-accurate # timings. :^( # This procedure based on work by Helmut Giese global tcl_platform if {$tcl_platform(platform) ne "windows"} {return} if {[lindex [file system [temporaryDirectory]] 1] == "NTFS"} {return} # Assume non-NTFS means FAT{12,16,32} and hence in need of special help set start [clock seconds] while {1} { set now [clock seconds] if {$now!=$start && !($now & 1)} { return } after 50 } } set file [makeFile "data" touch.me] test cmdAH-24.1 {Tcl_FileObjCmd: mtime} { list [catch {file mtime a b c} msg] $msg } {1 {wrong # args: should be "file mtime name ?time?"}} # Check (allowing for clock-skew and OS interrupts as best we can) # that the change in mtime on a file being written is the time elapsed # between writes. Note that this can still fail on very busy systems # if there are long preemptions between the writes and the reading of # the clock, but there's not much you can do about that other than the # completely horrible "keep on trying to write until you managed to do # it all in less than a second." - DKF test cmdAH-24.2 {Tcl_FileObjCmd: mtime} { waitForEvenSecondForFAT set f [open $gorpfile w] puts $f "More text" set localOld [clock seconds] close $f set clockOld [clock seconds] set old [file mtime $gorpfile] set fileOld [file mtime $gorpfile] after 2000 set f [open $gorpfile w] puts $f "More text" set localNew [clock seconds] close $f set clockNew [clock seconds] set new [file mtime $gorpfile] set fileNew [file mtime $gorpfile] expr { ($new > $old) && ($localNew > $localOld) && (abs(($new-$old) - ($localNew-$localOld)) <= 1) (($fileNew > $fileOld) && ($clockNew > $clockOld) && (abs(($fileNew-$fileOld) - ($clockNew-$clockOld)) <= 1)) ? "1" : "file:($fileOld=>$fileNew) clock:($clockOld=>$clockNew)" } } {1} test cmdAH-24.3 {Tcl_FileObjCmd: mtime} { catch {unset stat} file stat $gorpfile stat list [expr {[file mtime $gorpfile] == $stat(mtime)}] \ [expr {[file atime $gorpfile] == $stat(atime)}]
︙
1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395	1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 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	- + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	if {[string equal $tcl_platform(platform) "unix"]} { set name /tmp/tcl.test.[pid] } else { set name [file join [temporaryDirectory] tf] } # Make sure that a new file's time is correct. 10 seconds variance # Make sure that a new file's time is correct. 10 seconds variance # is allowed used due to slow networks or clock skew on a network drive. file delete -force $name close [open $name w] set a [expr abs([clock seconds]-[file mtime $name])<10] file delete $name set a } {1} test cmdAH-24.7 {Tcl_FileObjCmd: mtime} { list [catch {file mtime $file notint} msg] $msg } {1 {expected integer but got "notint"}} test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} { test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} macOrUnix { set mtime [file mtime $file] after 1100; # pause a sec to notice change in mtime set newmtime [clock seconds] set modmtime [file mtime $file $newmtime] expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} } 1 test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} { test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} macOrUnix { set oldfile $file # introduce some non-ascii characters. append file \u2022 file delete -force $file file rename $oldfile $file set mtime [file mtime $file] after 1100; # pause a sec to notice change in mtime set newmtime [clock seconds] set err [catch {file mtime $file $newmtime} modmtime] file rename $file $oldfile if {$err} { error $modmtime } expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} } 1 test cmdAH-24.10 {Tcl_FileObjCmd: mtime touch} winOnly { waitForEvenSecondForFAT set mtime [file mtime $file] after 2100; # pause two secs to notice change in mtime on FAT fs'es set newmtime [clock seconds] set modmtime [file mtime $file $newmtime] expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} } 1 test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} winOnly { waitForEvenSecondForFAT set oldfile $file # introduce some non-ascii characters. append file \u2022 file delete -force $file file rename $oldfile $file set mtime [file mtime $file] after 2100; # pause two secs to notice change in mtime on FAT fs'es set newmtime [clock seconds] set err [catch {file mtime $file $newmtime} modmtime] file rename $file $oldfile if {$err} { error $modmtime } expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} } 1 removeFile touch.me rename waitForEvenSecondForFAT {} test cmdAH-24.12 {Tcl_FileObjCmd: mtime and daylight savings} { set name [file join [temporaryDirectory] clockchange] file delete -force $name close [open $name w] set time [clock scan "21:00:00 October 30 2004 GMT"] file mtime $name $time set newmtime [file mtime $name] file delete $name expr {$newmtime == $time ? 1 : "$newmtime != $time"} } {1} # bug 1420432: setting mtime fails for directories on windows. test cmdAH-24.13 {Tcl_FileObjCmd: directory mtime} { set dirname [file join [temporaryDirectory] tmp[pid]] file delete -force $dirname file mkdir $dirname set res [catch { set old [file mtime $dirname] file mtime $dirname 0 set new [file mtime $dirname] list $new [expr {$old != $new}] } err] file delete -force $dirname list $res $err } {0 {0 1}} # owned test cmdAH-25.1 {Tcl_FileObjCmd: owned} { list [catch {file owned a b} msg] $msg } {1 {wrong # args: should be "file owned name"}} test cmdAH-25.2 {Tcl_FileObjCmd: owned} {
︙
1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425	1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502	- +	list [catch {file readlink _bogus_} msg] [string tolower $msg] \ [string tolower $errorCode] } {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}} test cmdAH-26.4 {Tcl_FileObjCmd: readlink errors} {macOnly nonPortable} { list [catch {file readlink _bogus_} msg] [string tolower $msg] \ [string tolower $errorCode] } {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}} test cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {pcOnly nonPortable} { test cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {winOnly nonPortable} { list [catch {file readlink _bogus_} msg] [string tolower $msg] \ [string tolower $errorCode] } {1 {could not readlink "_bogus_": invalid argument} {posix einval {invalid argument}}} # size test cmdAH-27.1 {Tcl_FileObjCmd: size} {
︙
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	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	- + - + - + - - + +	set filename [makeFile "" foo.text] file stat $filename stat set x [expr {$stat(mode) > 0}] removeFile $filename set x } 1 test cmdAH-28.9 {Tcl_FileObjCmd: stat} {pcOnly} { test cmdAH-28.9 {Tcl_FileObjCmd: stat} winOnly { # stat of root directory was failing. # don't care about answer, just that test runs. # relative paths that resolve to root set old [pwd] cd c:/ file stat c: stat file stat c: stat file stat c:. stat file stat . stat cd $old file stat / stat file stat c:/ stat file stat c:/. stat } {} test cmdAH-28.10 {Tcl_FileObjCmd: stat} {pcOnly nonPortable} { test cmdAH-28.10 {Tcl_FileObjCmd: stat} {winOnly nonPortable} { # stat of root directory was failing. # don't care about answer, just that test runs. file stat //pop/$env(USERNAME) stat file stat //pop/$env(USERNAME)/ stat file stat //pop/$env(USERNAME)/. stat } {} test cmdAH-28.11 {Tcl_FileObjCmd: stat} {pcOnly nonPortable} { } {} test cmdAH-28.11 {Tcl_FileObjCmd: stat} {winOnly nonPortable} { # stat of network directory was returning id of current local drive. set old [pwd] cd c:/ file stat //pop/$env(USERNAME) stat cd $old
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	- +	# This file contains a collection of tests for the procedures in the # file tclCmdIL.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 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. # # RCS: @(#) $Id: cmdIL.test,v 1.14 2001/09/28 15:32:17 dkf Exp $ # RCS: @(#) $Id: cmdIL.test,v 1.14.6.2 2007/03/10 14:57:38 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } test cmdIL-1.1 {Tcl_LsortObjCmd procedure} {
︙
100 101 102 103 104 105 106 107 108 109 110 111 112 113	100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118	+ + + + +	} [list 0 [list [list a b] [list c d]]] # Note that the required order only exists in the end-1'th element; # indexing using the end element or any fixed offset from the start # will not work... test cmdIL-1.26 {Tcl_LsortObjCmd procedure, offset indexing from end} { lsort -index end-1 {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}} } {{c 4 5 6 d h} {a 1 e i} {b 2 3 f g}} test cmdIL-1.29 {Tcl_LsortObjCmd procedure, loss of list rep during sorting} { set l {1 2 3} proc testcmp args {string length $::l} string length [lsort -command testcmp $l] } 5 # Can't think of any good tests for the MergeSort and MergeLists # procedures, except a bunch of random lists to sort. test cmdIL-2.1 {MergeSort and MergeLists procedures} { set result {} set r 1435753299
︙
203 204 205 206 207 208 209 210 211 212 213 214 215 216 217	208 209 210 211 212 213 214 215 216 217 218 219 220 221 222	- +	lsort -command {cmp {this argument is very very long in order to make the dstring overflow its statically allocated space}} {{this first element is also long in order to help expand the dstring} {the second element, last but not least, is quite long also, in order to make absolutely sure that space is allocated dynamically for the dstring}} } {{the second element, last but not least, is quite long also, in order to make absolutely sure that space is allocated dynamically for the dstring} {this first element is also long in order to help expand the dstring}} test cmdIL-3.17 {SortCompare procedure, -command option, non-integer result} { proc cmp {a b} { return foow } list [catch {lsort -command cmp {48 6}} msg] $msg } {1 {-compare command returned non-numeric result}} } {1 {-compare command returned non-integer result}} test cmdIL-3.18 {SortCompare procedure, -command option} { proc cmp {a b} { expr {$b - $a} } lsort -command cmp {48 6 18 22 21 35 36} } {48 36 35 22 21 18 6} test cmdIL-3.19 {SortCompare procedure, -decreasing option} {
︙

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	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	- + - + - - - - - - + + + +	# The tests in this file cover the procedures in tclCmdMZ.c. # # 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. # # RCS: @(#) $Id: cmdMZ.test,v 1.13 2002/07/19 08:52:27 dkf Exp $ # RCS: @(#) $Id: cmdMZ.test,v 1.13.2.3 2004/02/25 23:38:16 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest package require tcltest 2.1 namespace import -force ::tcltest::* } set tcltest::testConstraints(nonLinuxOnly) \ [expr {![string equal Linux $tcl_platform(os)]}] # Tcl_PwdObjCmd test cmdMZ-1.1 {Tcl_PwdObjCmd} { list [catch {pwd a} msg] $msg } {1 {wrong # args: should be "pwd"}} test cmdMZ-1.2 {Tcl_PwdObjCmd: simple pwd} { catch pwd } 0 test cmdMZ-1.3 {Tcl_PwdObjCmd: simple pwd} { expr [string length pwd]>0 } 1 test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} {unixOnly nonLinuxOnly} { # We don't want this test to run on Linux because they do a # permissions caching trick which causes this to fail. The # caching is incorrect, but we have no control over that. test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} {unixOnly nonPortable} { # This test fails on various unix platforms (eg Linux) where # permissions caching causes this to fail. The caching is strictly # incorrect, but we have no control over that. set foodir [file join [temporaryDirectory] foo] file delete -force $foodir file mkdir $foodir set cwd [pwd] cd $foodir file attr . -permissions 000 set result [list [catch {pwd} msg] $msg]
︙
82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105	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 116 117 118	+ + + + + + + + + + + + + + - + + - + + - - +	} {1 {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}} test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} {unixOrPc} { list [catch {source} msg] $msg } {1 {wrong # args: should be "source fileName"}} test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} {unixOrPc} { list [catch {source a b} msg] $msg } {1 {wrong # args: should be "source fileName"}} proc ListGlobMatch {expected actual} { if {[llength $expected] != [llength $actual]} { return 0 } foreach e $expected a $actual { if {![string match $e $a]} { return 0 } } return 1 } customMatch listGlob ListGlobMatch test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -body { test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -setup { set file [makeFile { set x 146 error "error in sourced file" set y $x } source.file] } -body { set result [list [catch {source $file} msg] $msg $errorInfo] list [catch {source $file} msg] $msg $errorInfo } -cleanup { removeFile source.file set result } -match glob -result {1 {error in sourced file} {error in sourced file } -match listGlob -result {1 {error in sourced file} {error in sourced file while executing "error "error in sourced file"" (file "*" line 3) invoked from within "source $file"}} test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} { set file [makeFile {list result} source.file]
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	# This file contains tests for the files tclCompile.c, tclCompCmds.c # and tclLiteral.c # # 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) 1997 by 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. # # RCS: @(#) $Id: compile.test,v 1.24 2003/01/08 00:34:59 dgp Exp $ # RCS: @(#) $Id: compile.test,v 1.24.2.3 2004/10/26 20:14:36 dgp Exp $ package require tcltest 2 namespace import -force ::tcltest::* # The following tests are very incomplete, although the rest of the # test suite covers this file fairly well.
︙
110 111 112 113 114 115 116 117 118 119 120 121 122 123	110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134	+ + + + + + + + + + +	set fail [catch { return 1 }] ; # {} return 2 } foo } {2} test compile-3.5 {TclCompileCatchCmd: recover from error, [Bug 705406]} { proc foo {} { catch { if {[a]} { if b {} } } } list [catch foo msg] $msg } {0 1} test compile-4.1 {TclCompileForCmd: command substituted test expression} { set i 0 set j 0 # Should be "forever" for {} [expr $i < 3] {} { set j [incr i]
︙
305 306 307 308 309 310 311 312 313 314 315 316 317 318	316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	# Test to catch buffer overrun in TclCompileTokens from buf 530320 test compile-12.3 {check for a buffer overrun} { proc crash {} { puts $array([expr {a+2}]) } list [catch crash msg] $msg } {1 {syntax error in expression "a+2": variable references require preceding $}} test compile-12.4 {TclCleanupLiteralTable segfault} { # Tcl Bug 1001997 # Here, we're trying to test a case that causes a crash in # TclCleanupLiteralTable. The conditions that we're trying to # establish are: # - TclCleanupLiteralTable is attempting to clean up a bytecode # object in the literal table. # - The bytecode object in question contains the only reference # to another literal. # - The literal in question is in the same hash bucket as the bytecode # object, and immediately follows it in the chain. # Since newly registered literals are added at the FRONT of the # bucket chains, and since the bytecode object is registered before # its literals, this is difficult to achieve. What we do is: # (a) do a [namespace eval] of a string that's calculated to # hash into the same bucket as a literal that it contains. # In this case, the script and the variable 'bugbug' # land in the same bucket. # (b) do a [namespace eval] of a string that contains enough # literals to force TclRegisterLiteral to rebuild the global # literal table. The newly created hash buckets will contain # the literals, IN REVERSE ORDER, thus putting the bytecode # immediately ahead of 'bugbug' and 'bug4345bug'. The bytecode # object will contain the only references to those two literals. # (c) Delete the interpreter to invoke TclCleanupLiteralTable # and tickle the bug. proc foo {} { set i [interp create] $i eval { namespace eval ::w {concat 4649; variable bugbug} namespace eval ::w { concat x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 \ x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 \ x21 x22 x23 x24 x25 x26 x27 x28 x29 x30 \ x31 x32 X33 X34 X35 X36 X37 X38 X39 X40 \ x41 x42 x43 x44 x45 x46 x47 x48 x49 x50 \ x51 x52 x53 x54 x55 x56 x57 x58 x59 x60 \ x61 x62 x63 x64 concat y1 y2 y3 y4 y5 y6 y7 y8 y9 y10 \ y11 y12 y13 y14 y15 y16 y17 y18 y19 y20 \ y21 y22 y23 y24 y25 y26 y27 y28 y29 y30 \ y31 y32 Y33 Y34 Y35 Y36 Y37 Y38 Y39 Y40 \ y41 y42 y43 y44 y45 y46 y47 y48 y49 y50 \ y51 y52 y53 y54 y55 y56 y57 y58 y59 y60 \ y61 y62 y63 y64 concat z1 z2 z3 z4 z5 z6 z7 z8 z9 z10 \ z11 z12 z13 z14 z15 z16 z17 z18 z19 z20 \ z21 z22 z23 z24 z25 z26 z27 z28 z29 z30 \ z31 z32 } } interp delete $i; # must not crash return ok } foo } ok # Special test for underestimating the maxStackSize required for a # compiled command. A failure will cause a segfault in the child # process. test compile-13.1 {testing underestimate of maxStackSize in list cmd} {exec} { set body {set x [list} for {set i 0} {$i < 3000} {incr i} {
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	- +	# This file contains a collection of tests for tclEncoding.c # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1997 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. # # RCS: @(#) $Id: encoding.test,v 1.16 2003/02/21 02:40:58 hobbs Exp $ # RCS: @(#) $Id: encoding.test,v 1.16.2.3 2006/10/05 21:24:56 hobbs Exp $ package require tcltest 2 namespace import -force ::tcltest::* proc toutf {args} { global x lappend x "toutf $args"
︙
286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303	286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319	+ + + + + + + + + + + + + + + - - + + +	test encoding-14.1 {BinaryProc} { encoding convertto identity \x12\x34\x56\xff\x69 } "\x12\x34\x56\xc3\xbf\x69" test encoding-15.1 {UtfToUtfProc} { encoding convertto utf-8 \xa3 } "\xc2\xa3" test encoding-15.2 {UtfToUtfProc null character output} { set x \u0000 set y [encoding convertto utf-8 \u0000] set y [encoding convertfrom identity $y] binary scan $y H* z list [string bytelength $x] [string bytelength $y] $z } {2 1 00} test encoding-15.3 {UtfToUtfProc null character input} { set x [encoding convertfrom identity \x00] set y [encoding convertfrom utf-8 $x] binary scan [encoding convertto identity $y] H* z list [string bytelength $x] [string bytelength $y] $z } {1 2 c080} test encoding-16.1 {UnicodeToUtfProc} { encoding convertfrom unicode NN } "\u4e4e" set val [encoding convertfrom unicode NN] list $val [format %x [scan $val %c]] } "\u4e4e 4e4e" test encoding-17.1 {UtfToUnicodeProc} { } {} test encoding-18.1 {TableToUtfProc} { } {}
︙
328 329 330 331 332 333 334 335 336 337 338 339 340 341 342	344 345 346 347 348 349 350 351 352 353 354 355 356 357 358	- +	cd [temporaryDirectory] set fid [open iso2022.txt w] fconfigure $fid -encoding binary puts -nonewline $fid $::iso2022encData close $fid test encoding-23.2 {iso2022-jp escape encoding test} { test encoding-23.1 {iso2022-jp escape encoding test} { string equal $::iso2022uniData $::iso2022uniData2 } 1 test encoding-23.2 {iso2022-jp escape encoding test} { # This checks that 'gets' isn't resetting the encoding inappropriately. # [Bug #523988] set fid [open iso2022.txt r] fconfigure $fid -encoding iso2022-jp
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	# Commands covered: none (tests environment variable implementation) # # 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. # # RCS: @(#) $Id: env.test,v 1.17 2002/10/03 13:34:32 dkf Exp $ # RCS: @(#) $Id: env.test,v 1.17.2.5 2007/01/19 01:05:50 das Exp $ package require tcltest 2 namespace import -force ::tcltest::* # # These tests will run on any platform (and indeed crashed # on the Mac). So put them before you test for the existance
︙
71 72 73 74 75 76 77 78 79 80 81 82 83 84 85	71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90	+ - + + + + +	set names [lsort [array names env]] if {$tcl_platform(platform) == "windows"} { lrem names HOME lrem names COMSPEC lrem names ComSpec lrem names "" } foreach name { foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY SHLIB_PATH } { TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING __CF_USER_TEXT_ENCODING SECURITYSESSIONID } { lrem names $name } foreach p $names { puts "$p=$env($p)" } exit } printenv]
︙
94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118	99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127	- + + - - - - + + + + + + +	} return $out } # Save the current environment variables at the start of the test. foreach name [array names env] { set env2($name) $env($name) set env2([string toupper $name]) $env($name) unset env($name) } # Added the following lines so that child tcltest can actually find its # library if the initial tcltest is run from a non-standard place. # ('saved' env vars) foreach name { foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH} { if {[info exists env2($name)]} { set env($name) $env2($name); } TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING SECURITYSESSIONID} { if {[info exists env2($name)]} { set env($name) $env2($name); } } test env-2.1 {adding environment variables} {exec} { getenv } {} set env(NAME1) "test string"
︙
227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259	236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263	+ + + + + + + - - - - - - - - - - - -	set result } {1 a 1} test env-5.5 {corner cases - cannot have null entries on Windows} {pcOnly} { set env() a catch {set env()} } {1} test env-6.1 {corner cases - add lots of env variables} {} { set size [array size env] for {set i 0} {$i < 100} {incr i} { set env(BOGUS$i) $i } expr {[array size env] - $size} } 100 # Restore the environment variables at the end of the test. foreach name [array names env] { unset env($name) } foreach name [array names env2] { set env($name) $env2($name) } # cleanup removeFile $printenvScript ::tcltest::cleanupTests return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	- + - +	# Commands covered: error, catch # # 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-1996 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. # # RCS: @(#) $Id: error.test,v 1.9 2002/01/29 03:03:02 hobbs Exp $ # RCS: @(#) $Id: error.test,v 1.9.2.3 2006/01/11 17:29:46 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest package require tcltest 2 namespace import -force ::tcltest::* } proc foo {} { global errorInfo set a [catch {format [error glorp2]} b] error {Human-generated}
︙
172 173 174 175 176 177 178 179 180 181 182 183	172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227	+ + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	# Make sure that catch resets error information test error-6.1 {catch must reset error state} { catch {error outer [catch {error inner inner.errorInfo inner.errorCode}]} list $errorCode $errorInfo } {NONE 1} test error-6.3 {catch must reset error state} { set errorCode BUG catch {error outer [catch set]} list $errorCode $errorInfo } {NONE 1} test error-6.4 {catch must reset error state} { catch {error [catch {error foo bar baz}] 1} list $errorCode $errorInfo } {NONE 1} test error-6.7 {catch must reset error state} { proc foo {} { return -code error -errorinfo [catch {error foo bar baz}] } catch foo list $errorCode } {NONE} test error-6.9 {catch must reset error state} { proc foo {} { return -code error [catch {error foo bar baz}] } catch foo list $errorCode } {NONE} namespace eval ::tcl::test::error { test error-7.0 {Bug 1397843} -body { variable cmds proc EIWrite args { variable cmds lappend cmds [lindex [info level -2] 0] } proc BadProc {} { set i a incr i } trace add variable ::errorInfo write [namespace code EIWrite] catch BadProc trace remove variable ::errorInfo write [namespace code EIWrite] set cmds } -match glob -result {*BadProc*} } namespace delete ::tcl::test::error # cleanup catch {rename p ""} ::tcltest::cleanupTests return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	# This file contains a collection of tests for the procedures in the file # tclEvent.c, which includes the "update", and "vwait" Tcl # commands. Sourcing this file into Tcl runs the tests and generates # output for errors. No output means no errors were found. # # Copyright (c) 1995-1997 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. # # RCS: @(#) $Id: event.test,v 1.20 2002/07/10 11:56:44 dgp Exp $ # RCS: @(#) $Id: event.test,v 1.20.2.1 2006/11/28 16:29:47 kennykb Exp $ package require tcltest 2 namespace import -force ::tcltest::* testConstraint testfilehandler [llength [info commands testfilehandler]] testConstraint testexithandler [llength [info commands testexithandler]] testConstraint testfilewait [llength [info commands testfilewait]]
︙
582 583 584 585 586 587 588 589 590 591 592 593 594	582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	set result "" lappend result [testfilewait $f readable 100] lappend result [testfilewait $f readable -1] close $f set result } {{} readable} test event-14.1 {Tcl_WaitForFile procedure, readable, big fd} \ -constraints {testfilehandler unix} \ -setup { set chanList {} for {set i 0} {$i < 32} {incr i} { lappend chanList [open /dev/null r] } } \ -body { foreach i [after info] { after cancel $i } after 100 set x timeout testfilehandler close testfilehandler create 1 off off set x "no timeout" set result [testfilehandler wait 1 readable 0] update testfilehandler close list $result $x } \ -result {{} {no timeout}} \ -cleanup { foreach chan $chanList {close $chan} } test event-14.2 {Tcl_WaitForFile procedure, readable, big fd} \ -constraints {testfilehandler unix} \ -setup { set chanList {} for {set i 0} {$i < 32} {incr i} { lappend chanList [open /dev/null r] } } \ -body { foreach i [after info] { after cancel $i } after 100 set x timeout testfilehandler close testfilehandler create 1 off off set x "no timeout" set result [testfilehandler wait 1 readable 100] update testfilehandler close list $result $x } \ -result {{} timeout} \ -cleanup { foreach chan $chanList {close $chan} } test event-14.3 {Tcl_WaitForFile procedure, readable, big fd} \ -constraints {testfilehandler unix} \ -setup { set chanList {} for {set i 0} {$i < 32} {incr i} { lappend chanList [open /dev/null r] } } \ -body { foreach i [after info] { after cancel $i } after 100 set x timeout testfilehandler close testfilehandler create 1 off off testfilehandler fillpartial 1 set x "no timeout" set result [testfilehandler wait 1 readable 100] update testfilehandler close list $result $x } \ -result {readable {no timeout}} \ -cleanup { foreach chan $chanList {close $chan} } test event-14.4 {Tcl_WaitForFile procedure, writable, big fd} \ -constraints {testfilehandler unix nonPortable} \ -setup { set chanList {} for {set i 0} {$i < 32} {incr i} { lappend chanList [open /dev/null r] } } \ -body { foreach i [after info] { after cancel $i } after 100 set x timeout testfilehandler close testfilehandler create 1 off off testfilehandler fill 1 set x "no timeout" set result [testfilehandler wait 1 writable 0] update testfilehandler close list $result $ } \ -result {{} {no timeout}} \ -cleanup { foreach chan $chanList {close $chan} } test event-14.5 {Tcl_WaitForFile procedure, writable, big fd} \ -constraints {testfilehandler unix nonPortable} \ -setup { set chanList {} for {set i 0} {$i < 32} {incr i} { lappend chanList [open /dev/null r] } } \ -body { foreach i [after info] { after cancel $i } after 100 set x timeout testfilehandler close testfilehandler create 1 off off testfilehandler fill 1 set x "no timeout" set result [testfilehandler wait 1 writable 100] update testfilehandler close list $result $x } \ -result {{} timeout} \ -cleanup { foreach chan $chanList {close $chan} } test event-14.6 {Tcl_WaitForFile procedure, writable, big fd} \ -constraints {testfilehandler unix} \ -setup { set chanList {} for {set i 0} {$i < 32} {incr i} { lappend chanList [open /dev/null r] } } \ -body { foreach i [after info] { after cancel $i } after 100 set x timeout testfilehandler close testfilehandler create 1 off off set x "no timeout" set result [testfilehandler wait 1 writable 100] update testfilehandler close list $result $x } \ -result {writable {no timeout}} \ -cleanup { foreach chan $chanList {close $chan} } test event-14.7 {Tcl_WaitForFile, don't call other event handlers, big fd} \ -constraints {testfilehandler unix} \ -setup { set chanList {} for {set i 0} {$i < 32} {incr i} { lappend chanList [open /dev/null r] } } \ -body { foreach i [after info] { after cancel $i } after 100 lappend x timeout after idle lappend x idle testfilehandler close testfilehandler create 1 off off set x "" set result [list [testfilehandler wait 1 readable 200] $x] update testfilehandler close lappend result $x } \ -result {{} {} {timeout idle}} \ -cleanup { foreach chan $chanList {close $chan} } test event-14.8 {Tcl_WaitForFile procedure, waiting indefinitely, big fd} \ -constraints {testfilewait unix} \ -body { set f [open "|sleep 2" r] set result "" lappend result [testfilewait $f readable 100] lappend result [testfilewait $f readable -1] close $f set result } \ -setup { set chanList {} for {set i 0} {$i < 32} {incr i} { lappend chanList [open /dev/null r] } } \ -result {{} readable} \ -cleanup { foreach chan $chanList {close $chan} } # cleanup foreach i [after info] { after cancel $i } ::tcltest::cleanupTests return

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	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	- + - +	# Commands covered: exec # # 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-1994 The Regents of the University of California. # Copyright (c) 1994-1997 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. # # RCS: @(#) $Id: exec.test,v 1.16 2003/02/04 18:23:35 vincentdarley Exp $ # RCS: @(#) $Id: exec.test,v 1.16.2.7 2006/01/16 19:31:19 rmax Exp $ package require tcltest 2 namespace import -force ::tcltest::* # All tests require the "exec" command. # Skip them if exec is not defined. testConstraint exec [llength [info commands exec]] catch {unset path} unset -nocomplain path set path(echo) [makeFile { puts -nonewline [lindex $argv 0] foreach str [lrange $argv 1 end] { puts -nonewline " $str" } puts {} exit
︙
134 135 136 137 138 139 140 141 142 143 144 145 146 147 148	134 135 136 137 138 139 140 141 142 143 144 145 146 147 148	- +	# occur before writing out the temp file. exec [interpreter] $path(cat) << "\uE9\uE0\uFC\uF1" } "\uE9\uE0\uFC\uF1" # I/O redirection: output to file. set path(gorp.file) [makeFile {} gorp.file] removeFile gorp.file file delete $path(gorp.file) test exec-3.1 {redirecting output to file} {exec} { exec [interpreter] $path(echo) "Some simple words" > $path(gorp.file) exec [interpreter] $path(cat) $path(gorp.file) } "Some simple words" test exec-3.2 {redirecting output to file} {exec stdio} { exec [interpreter] $path(echo) "More simple words" | >$path(gorp.file) [interpreter] $path(cat) | [interpreter] $path(cat)
︙
175 176 177 178 179 180 181 182 183 184 185 186 187 188 189	175 176 177 178 179 180 181 182 183 184 185 186 187 188 189	- +	puts $f "Line 3" close $f exec [interpreter] $path(cat) $path(gorp.file) } "Line 1\nMore text\nEven more\nLine 3" # I/O redirection: output and stderr to file. removeFile gorp.file file delete $path(gorp.file) test exec-4.1 {redirecting output and stderr to file} {exec} { exec [interpreter] "$path(echo)" "test output" >& $path(gorp.file) exec [interpreter] "$path(cat)" "$path(gorp.file)" } "test output" test exec-4.2 {redirecting output and stderr to file} {exec} { list [exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" >&$path(gorp.file)] \
︙
260 261 262 263 264 265 266 267 268 269 270 271 272 273 274	260 261 262 263 264 265 266 267 268 269 270 271 272 273 274	- +	exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" \ |& [interpreter] "$path(sh)" -c "\"$path(echo)\" second msg 1>&2 ; \"$path(cat)\"" |& [interpreter] "$path(cat)" } "second msg\nfoo bar" # I/O redirection: combinations. set path(gorp.file2) [makeFile {} gorp.file2] removeFile gorp.file2 file delete $path(gorp.file2) test exec-7.1 {multiple I/O redirections} {exec} { exec << "command input" > $path(gorp.file2) [interpreter] $path(cat) < $path(gorp.file) exec [interpreter] $path(cat) $path(gorp.file2) } {Just a few thoughts} test exec-7.2 {multiple I/O redirections} {exec} { exec < $path(gorp.file) << "command input" [interpreter] $path(cat)
︙
398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430	398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434	- + + + + + - +	close $f test exec-10.20 {errors in exec invocation} {exec} { list [catch {exec ~non_existent_user/foo/bar} msg] $msg } {1 {user "non_existent_user" doesn't exist}} test exec-10.21 {errors in exec invocation} {exec} { list [catch {exec [interpreter] true | ~xyzzy_bad_user/x | false} msg] $msg } {1 {user "xyzzy_bad_user" doesn't exist}} test exec-10.22 {errors in exec invocation} \ -constraints exec \ -returnCodes 1 \ -body {exec echo test > ~non_existent_user/foo/bar} \ -result {user "non_existent_user" doesn't exist} # Commands in background. test exec-11.1 {commands in background} {exec} { set x [lindex [time {exec [interpreter] $path(sleep) 2 &}] 0] expr $x<1000000 } 1 test exec-11.2 {commands in background} {exec} { list [catch {exec [interpreter] $path(echo) a &b} msg] $msg } {0 {a &b}} test exec-11.3 {commands in background} {exec} { llength [exec [interpreter] $path(sleep) 1 &] } 1 test exec-11.4 {commands in background} {exec stdio} { llength [exec [interpreter] $path(sleep) 1 | [interpreter] $path(sleep) 1 | [interpreter] $path(sleep) 1 &] } 3 test exec-11.5 {commands in background} {exec} { set f [open $path(gorp.file) w] puts $f [format { catch { exec [info nameofexecutable] {%s} foo & } } $path(echo)] puts $f [list catch [list exec [info nameofexecutable] $path(echo) foo &]] close $f string compare "foo" [exec [interpreter] $path(gorp.file)] } 0 # Make sure that background commands are properly reaped when # they eventually die.
︙
480 481 482 483 484 485 486 487 488 489 490 491 492 493	484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	list [catch {exec [interpreter] $path(cat) > a/b/c} msg] [string tolower $errorCode] } {1 {posix enoent {no such file or directory}}} test exec-13.3 {setting errorCode variable} {exec} { set x [catch {exec _weird_cmd_} msg] list $x [string tolower $msg] [lindex $errorCode 0] \ [string tolower [lrange $errorCode 2 end]] } {1 {couldn't execute "_weird_cmd_": no such file or directory} POSIX {{no such file or directory}}} test exec-13.4 {extended exit result codes} { -constraints {win} -setup { set tmp [makeFile {exit 0x00000101} tmpfile.exec-13.4] } -body { list [catch {exec [interpreter] $tmp} err]\ [lreplace $::errorCode 1 1 {}] } -cleanup { removeFile $tmp } -result {1 {CHILDSTATUS {} 257}} } test exec-13.5 {extended exit result codes: max value} { -constraints {win} -setup { set tmp [makeFile {exit 0x3fffffff} tmpfile.exec-13.5] } -body { list [catch {exec [interpreter] $tmp} err]\ [lreplace $::errorCode 1 1 {}] } -cleanup { removeFile $tmp } -result {1 {CHILDSTATUS {} 1073741823}} } test exec-13.6 {extended exit result codes: signalled} { -constraints {win} -setup { set tmp [makeFile {exit 0xffffffff} tmpfile.exec-13.6] } -body { list [catch {exec [interpreter] $tmp} err]\ [lreplace $::errorCode 1 1 {}] } -cleanup { removeFile $tmp } -result {1 {CHILDKILLED {} SIGABRT SIGABRT}} } # Switches before the first argument test exec-14.1 {-keepnewline switch} {exec} { exec -keepnewline [interpreter] $path(echo) foo } "foo\n" test exec-14.2 {-keepnewline switch} {exec} {
︙
537 538 539 540 541 542 543 544 545 546 547 548 549 550	586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603	+ + + +	} {First line foo bar} test exec-15.6 {standard error redirection} {exec stdio} { exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" > "$path(gorp.file2)" 2> "$path(gorp.file)" \ >& "$path(gorp.file)" 2> "$path(gorp.file2)" | [interpreter] "$path(echo)" biz baz list [exec [interpreter] "$path(cat)" "$path(gorp.file)"] [exec [interpreter] "$path(cat)" "$path(gorp.file2)"] } {{biz baz} {foo bar}} test exec-15.7 {standard error redirection 2>@1} {exec stdio} { # This redirects stderr output into normal result output from exec exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" 2>@1 } {foo bar} test exec-16.1 {flush output before exec} {exec} { set f [open $path(gorp.file) w] puts $f "First line" exec [interpreter] $path(echo) "Second line" >@ $f puts $f "Third line" close $f
︙
563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582	616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636	- - - - - + + + + + + + -	Second line Third line} set path(script) [makeFile {} script] test exec-17.1 { inheriting standard I/O } {exec} { set f [open $path(script) w] puts $f [format {close stdout set f [open {%s} w] catch {exec [info nameofexecutable] {%s} foobar &} exec [info nameofexecutable] {%s} 2 close $f puts -nonewline $f {close stdout set f [} puts $f [list open $path(gorp.file) w]] puts $f [list catch \ [list exec [info nameofexecutable] $path(echo) foobar &]] puts $f [list exec [info nameofexecutable] $path(sleep) 2] puts $f {close $f} } $path(gorp.file) $path(echo) $path(sleep)] close $f catch {exec [interpreter] $path(script)} result set f [open $path(gorp.file) r] lappend result [read $f] close $f set result } {{foobar
︙
590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605	644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +	set fout [open $path(fooblah) w] puts $fout "contents" close $fout set res [list [catch {exec cat $path(fooblah)} msg] $msg] removeFile $f set res } {0 contents} # Note that this test cannot be adapted to work on Windows; that platform has # no kernel support for an analog of O_APPEND. test exec-19.1 {exec >> uses O_APPEND} { -constraints {exec unix} -setup { set tmpfile [makeFile {0} tmpfile.exec-19.1] } -body { # Note that we have to allow for the current contents of the # temporary file, which is why the result is 14 and not 12 exec /bin/sh -c \ {for a in 1 2 3; do sleep 1; echo $a; done} >>$tmpfile & exec /bin/sh -c \ {for a in a b c; do sleep 1; echo $a; done} >>$tmpfile & # The above two shell invokations take about 3 seconds to # finish, so allow 5s (in case the machine is busy) after 5000 # Check that no bytes have got lost through mixups with # overlapping appends, which is only guaranteed to work when # we set O_APPEND on the file descriptor in the [exec >>...] file size $tmpfile } -cleanup { removeFile $tmpfile } -result 14 } # cleanup foreach file {script gorp.file gorp.file2 echo cat wc sh sleep exit err} { removeFile $file } unset -nocomplain path ::tcltest::cleanupTests return

︙
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	- +	# # Copyright (c) 1997 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. # # RCS: @(#) $Id: execute.test,v 1.13 2003/02/25 16:18:54 msofer Exp $ # RCS: @(#) $Id: execute.test,v 1.13.2.2 2004/10/28 00:01:07 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } catch {eval namespace delete [namespace children :: test_ns_*]}
︙
708 709 710 711 712 713 714 715 716 717 718 719 720 721	708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733	+ + + + + + + + + + + +	} 0 test execute-7.33 {Wide int handling} {longIs32bit} { expr {0x1 * 1024 * 1024 * 1024 * 1024} } 0 test execute-7.34 {Wide int handling} {longIs32bit} { expr {wide(0x1) * 1024 * 1024 * 1024 * 1024} } 1099511627776 test execute-8.1 {Stack protection} -setup { # If [Bug #804681] has not been properly # taken care of, this should segfault proc whatever args {llength $args} trace add variable ::errorInfo {write unset} whatever } -body { expr {1+9/0} } -cleanup { trace remove variable ::errorInfo {write unset} whatever rename whatever {} } -returnCodes error -match glob -result * # cleanup if {[info commands testobj] != {}} { testobj freeallvars } catch {eval namespace delete [namespace children :: test_ns_*]} catch {rename foo ""}
︙

︙
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	- +	# Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: expr-old.test,v 1.16 2002/08/05 03:24:41 dgp Exp $ # RCS: @(#) $Id: expr-old.test,v 1.16.2.5 2006/05/04 12:34:39 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 namespace import -force ::tcltest::* } if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
︙
190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213	190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213	- - + + - - - - + + + +	test expr-old-4.20 {string operators} {expr {"abd" eq "abd"}} 1 test expr-old-4.21 {string operators} {expr {"abc" ne "abd"}} 1 test expr-old-4.22 {string operators} {expr {"abd" ne "abd"}} 0 test expr-old-4.23 {string operators} {expr {"" eq "abd"}} 0 test expr-old-4.24 {string operators} {expr {"" eq ""}} 1 test expr-old-4.25 {string operators} {expr {"abd" ne ""}} 1 test expr-old-4.26 {string operators} {expr {"" ne ""}} 0 test expr-old-4.26 {string operators} {expr {"longerstring" eq "shorter"}} 0 test expr-old-4.26 {string operators} {expr {"longerstring" ne "shorter"}} 1 test expr-old-4.27 {string operators} {expr {"longerstring" eq "shorter"}} 0 test expr-old-4.28 {string operators} {expr {"longerstring" ne "shorter"}} 1 # The following tests are non-portable because on some systems "+" # and "-" can be parsed as numbers. test expr-old-4.19 {string operators} {nonPortable} {expr {"0" == "+"}} 0 test expr-old-4.20 {string operators} {nonPortable} {expr {"0" == "-"}} 0 test expr-old-4.21 {string operators} {expr {1?"foo":"bar"}} foo test expr-old-4.22 {string operators} {expr {0?"foo":"bar"}} bar test expr-old-4.29 {string operators} {nonPortable} {expr {"0" == "+"}} 0 test expr-old-4.30 {string operators} {nonPortable} {expr {"0" == "-"}} 0 test expr-old-4.31 {string operators} {expr {1?"foo":"bar"}} foo test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar # Operators that aren't legal on string operands. test expr-old-5.1 {illegal string operations} { list [catch {expr {-"a"}} msg] $msg } {1 {can't use non-numeric string as operand of "-"}} test expr-old-5.2 {illegal string operations} {
︙
807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836	807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836	- + - +	list [catch {expr rand(24)} msg] $msg } {1 {too many arguments for math function}} test expr-old-32.47 {math functions in expressions} { list [catch {expr srand()} msg] $msg } {1 {too few arguments for math function}} test expr-old-32.48 {math functions in expressions} { list [catch {expr srand(3.79)} msg] $msg } {1 {can't use floating-point value as argument to srand}} } {1 {expected integer but got "3.79"}} test expr-old-32.49 {math functions in expressions} { list [catch {expr srand("")} msg] $msg } {1 {argument to math function didn't have numeric value}} test expr-old-32.50 {math functions in expressions} { set result [expr round(srand(12345) * 1000)] for {set i 0} {$i < 10} {incr i} { lappend result [expr round(rand() * 1000)] } set result } {97 834 948 36 12 51 766 585 914 784 333} test expr-old-32.51 {math functions in expressions} { list [catch {expr {srand([lindex "6ty" 0])}} msg] $msg } {1 {argument to math function didn't have numeric value}} test expr-old-32.52 {math functions in expressions} { expr {srand(1<<37) < 1} expr {srand(int(1<<37)) < 1} } {1} test expr-old-32.53 {math functions in expressions} { expr {srand((1<<31) - 1) > 0} } {1} test expr-old-33.1 {conversions and fancy args to math functions} { expr hypot ( 3 , 4 )
︙
978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996	978 979 980 981 982 983 984 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 1010 1011	+ + + + + + + + + + + + + + +	} else { test expr-old-38.1 {Verify Tcl_ExprString's basic operation} { list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \ [catch {testexprstring "1+"} msg] $msg } {5 10.2 1 {syntax error in expression "1+": premature end of expression}} } # # Test for bug #908375: rounding numbers that do not fit in a # long but do fit in a wide # test expr-old-39.1 {Rounding with wide result} { set x 1.0e10 set y [expr $x + 0.1] catch { set x [list [expr {$x == round($y)}] [expr $x == -round(-$y)]] } set x } {1 1} unset -nocomplain x y # Special test for Pentium arithmetic bug of 1994: if {(4195835.0 - (4195835.0/3145727.0)*3145727.0) == 256.0} { puts "Warning: this machine contains a defective Pentium processor" puts "that performs arithmetic incorrectly. I recommend that you" puts "call Intel customer service immediately at 1-800-628-8686" puts "to request a replacement processor." } # cleanup ::tcltest::cleanupTests return

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	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	- + +	# Commands covered: expr # # 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) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: expr.test,v 1.17 2002/07/31 09:33:45 dkf Exp $ # RCS: @(#) $Id: expr.test,v 1.17.2.12 2006/03/23 16:40:32 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } testConstraint registeredMathFuncs [expr { ([catch {expr T1()} msg] != 1) || ($msg ne {unknown math function "T1"}) }] testConstraint wideIs64bit [expr {(0x80000000 > 0) && (0x8000000000000000 < 0)}] # procedures used below proc put_hello_char {c} { global a append a [format %c $c] return $c }
︙
293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308	294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309	- - + +	catch {expr 2**3==6} msg set msg } {syntax error in expression "2**3==6": unexpected operator *} test expr-8.11 {CompileEqualityExpr: error compiling equality arm} { catch {expr 2!=x} msg set msg } {syntax error in expression "2!=x": variable references require preceding $} test expr-8.14 {CompileBitAndExpr: equality expr} {expr {"a"eq"a"}} 1 test expr-8.14 {CompileBitAndExpr: equality expr} {expr {"\374" eq "ü"}} 1 test expr-8.12 {CompileBitAndExpr: equality expr} {expr {"a"eq"a"}} 1 test expr-8.13 {CompileBitAndExpr: equality expr} {expr {"\374" eq "ü"}} 1 test expr-8.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0 test expr-8.15 {CompileBitAndExpr: equality expr} {expr 2.0eq2} 0 test expr-8.16 {CompileBitAndExpr: equality expr} {expr 3.2ne2.2} 1 test expr-8.17 {CompileBitAndExpr: equality expr} {expr 01eq1} 0 test expr-8.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0 test expr-8.19 {CompileBitAndExpr: equality expr} {expr {"abc" ne "abd"}} 1 test expr-8.20 {CompileBitAndExpr: error in equality expr} {
︙
801 802 803 804 805 806 807 808 809 810 811 812 813 814	802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	} {1 {floating-point value too large to represent}} test expr-22.7 {non-numeric floats} nonPortable { list [catch {expr {1 / NaN}} msg] $msg } {1 {can't use non-numeric floating-point value as operand of "/"}} test expr-22.8 {non-numeric floats} nonPortable { list [catch {expr {1 / Inf}} msg] $msg } {1 {can't use infinite floating-point value as operand of "/"}} # Make sure [Bug 761471] stays fixed. test expr-22.9 {non-numeric floats: shared object equality and NaN} nonPortable { set x NaN expr {$x == $x} } 0 # Some compilers get this wrong; ensure that we work around it correctly test expr-24.1 {expr edge cases; shifting} {expr int(5)>>31} 0 test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0 test expr-24.3 {expr edge cases; shifting} {expr wide(5)>>31} 0 test expr-24.4 {expr edge cases; shifting} {expr wide(5)>>63} 0 test expr-24.5 {expr edge cases; shifting} nonPortable {expr int(5)<<31} 0 test expr-24.6 {expr edge cases; shifting} nonPortable {expr int(5)<<63} 0 test expr-24.7 {expr edge cases; shifting} {expr wide(5)<<31} 10737418240 test expr-24.8 {expr edge cases; shifting} nonPortable {expr wide(5)<<63} -9223372036854775808 test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0 test expr-38.1 {abs of smallest 32-bit integer [Bug 1241572]} {wideIs64bit} { expr {abs(int(-2147483648))} } 2147483648 test expr-46.1 {round() rounds to +-infinity} { expr round(0.5) } 1 test expr-46.2 {round() rounds to +-infinity} { expr round(1.5) } 2 test expr-46.3 {round() rounds to +-infinity} { expr round(-0.5) } -1 test expr-46.4 {round() rounds to +-infinity} { expr round(-1.5) } -2 test expr-46.5 {round() overflow} { list [catch {expr round(9.2233720368547758e+018)} result] $result } {1 {integer value too large to represent}} test expr-46.6 {round() overflow} { list [catch {expr round(-9.2233720368547758e+018)} result] $result } {1 {integer value too large to represent}} test expr-46.7 {round() bad value} { set x trash list [catch {expr {round($x)}} result] $result } {1 {argument to math function didn't have numeric value}} test expr-46.8 {round() already an integer} { set x 123456789012 incr x expr round($x) } 123456789013 test expr-46.9 {round() boundary case - 1/2 - 1 ulp} { set x 0.25 set bit 0.125 while 1 { set newx [expr {$x + $bit}] if { $newx == $x || $newx == 0.5 } break set x $newx set bit [expr { $bit / 2.0 }] } expr {round($x)} } 0 test expr-46.10 {round() boundary case - 1/2 + 1 ulp} { set x 0.75 set bit 0.125 while 1 { set newx [expr { $x - $bit }] if { $newx == $x || $newx == 0.5 } break set x $newx set bit [expr { $bit / 2.0 }] } expr {round($x)} } 1 test expr-46.11 {round() boundary case - -1/2 - 1 ulp} { set x -0.75 set bit 0.125 while 1 { set newx [expr { $x + $bit }] if { $newx == $x || $newx == -0.5 } break set x $newx set bit [expr { $bit / 2.0 }] } expr {round($x)} } -1 test expr-46.12 {round() boundary case - -1/2 + 1 ulp} { set x -0.25 set bit 0.125 while 1 { set newx [expr { $x - $bit }] if { $newx == $x || $newx == -0.5 } break set x $newx set bit [expr { $bit / 2.0 }] } expr {round($x)} } 0 test expr-46.13 {round() boundary case - round down} { expr {round(2147483647 - 0.51)} } 2147483646 test expr-46.14 {round() boundary case - round up} { expr {round(2147483647 - 0.50)} } 2147483647 test expr-46.15 {round() boundary case - round up to wide} { expr {round(2147483647 + 0.50)} } [expr {wide(2147483647) + 1}] test expr-46.16 {round() boundary case - round up} { expr {round(-2147483648 + 0.51)} } -2147483647 test expr-46.17 {round() boundary case - round down} { expr {round(-2147483648 + 0.50)} } -2147483648 test expr-46.18 {round() boundary case - round down to wide} { expr {round(-2147483648 - 0.50)} } [expr {wide(-2147483648) - 1}] # cleanup if {[info exists a]} { unset a } ::tcltest::cleanupTests return

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	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	- + + + +	# This file tests the tclFCmd.c file. # # 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) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 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. # # RCS: @(#) $Id: fCmd.test,v 1.26 2003/02/12 19:18:13 vincentdarley Exp $ # RCS: @(#) $Id: fCmd.test,v 1.26.2.9 2007/05/17 14:18:42 dgp Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]] tcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]] tcltest::testConstraint notNetworkFilesystem 0 testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}] testConstraint 2000orNewer [expr {![testConstraint 95or98]}] # Several tests require need to match results against the unix username set user {} if {$tcl_platform(platform) == "unix"} { catch {set user [exec whoami]} if {$user == ""} { catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
︙
90 91 92 93 94 95 96 97 98 99 100 101 102 103	93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108	+ +	proc contents {file} { set f [open $file r] set r [read $f] close $f set r } cd [temporaryDirectory] set ::tcltest::testConstraints(fileSharing) 0 set ::tcltest::testConstraints(notFileSharing) 1 if {$tcl_platform(platform) == "macintosh"} { catch {file delete -force foo.dir} file mkdir foo.dir
︙
477 478 479 480 481 482 483 484 485 486 487 488 489 490 491	482 483 484 485 486 487 488 489 490 491 492 493 494 495 496	- +	} [subst {1 {can't overwrite file "[file join td2 td1]" with directory "td1"}}] test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} {notRoot} { cleanup createfile tf1 file mkdir [file join td1 tf1] list [catch {file rename -force tf1 td1} msg] $msg } [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}] test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} {notRoot} { test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} {notRoot notNetworkFilesystem} { cleanup file mkdir [file join td1 td2] file mkdir td2 createfile [file join td2 tf1] file rename -force td2 td1 file exists [file join td1 td2 tf1] } {1}
︙
665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682	670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691	- + - - - + + + + + + +	# Labelled knownBug because it is dangerous [Bug: 3881] file mkdir td1 file attr td1 -perm 040000 set result [list [catch {file rename ~$user td1} msg] $msg] file delete -force td1 set result } "1 {error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied}" test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} { {unixOnly notRoot} { file tail ~$user } "$user" string equal [file tail ~$user] ~$user } 0 test fCmd-8.3 {file copy and path translation: ensure correct error} { list [catch {file copy ~ [file join this file doesnt exist]} res] $res } [list 1 \ "error copying \"~\" to \"[file join this file doesnt exist]\":\ no such file or directory"] test fCmd-9.1 {file rename: comprehensive: EACCES} {unixOnly notRoot} { cleanup file mkdir td1 file mkdir td2 file attr td2 -perm 040000 set result [list [catch {file rename td1 td2/} msg] $msg]
︙
742 743 744 745 746 747 748 749 750 751 752 753 754 755 756	751 752 753 754 755 756 757 758 759 760 761 762 763 764 765	- +	set msg [list [catch {file rename tf1 tf2} msg] $msg] file rename -force tfs1 tfd1 file rename -force tfs2 tfd2 file rename -force tfs3 tfd3 file rename -force tfs4 tfd4 list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] } {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0} test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {notRoot testchmod} { test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {notRoot testchmod notNetworkFilesystem} { # Under unix, you can rename a read-only directory, but you can't # move it into another directory. cleanup file mkdir td1 file mkdir [file join td2 td1] file mkdir tds1
︙
827 828 829 830 831 832 833 834 835 836 837 838 839 840 841	836 837 838 839 840 841 842 843 844 845 846 847 848 849 850	- +	set w4 [file writable [file join td3 td4]] } else { set w4 0 } list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ [file writable [file join td3 td3]] $w4 } [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}] test fCmd-9.12 {file rename: comprehensive: target exists} {notRoot testchmod} { test fCmd-9.12 {file rename: comprehensive: target exists} {notRoot testchmod notNetworkFilesystem} { cleanup file mkdir [file join td1 td2] [file join td2 td1] if {$tcl_platform(platform) != "macintosh"} { testchmod 555 [file join td2 td1] } file mkdir [file join td3 td4] [file join td4 td3] file rename -force td3 td4
︙
880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908	889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931	- + + + + + + + + + + + + + + +	createfile tf1 tf1 createfile tf2 tf2 testchmod 444 tf2 file copy tf1 tf3 file copy tf2 tf4 list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4] } {{tf1 tf2 tf3 tf4} tf1 tf2 1 0} test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc testchmod} { test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc 95or98 testchmod} { cleanup file mkdir [file join td1 tdx] file mkdir [file join td2 tdy] testchmod 555 td2 file copy td1 td3 file copy td2 td4 set msg [list [lsort [glob td*]] [glob -directory td3 t*] \ [glob -directory td4 t*] [file writable td3] [file writable td4]] if {$tcl_platform(platform) != "macintosh"} { testchmod 755 td2 testchmod 755 td4 } set msg } [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0}] test fCmd-10.3.1 {file copy: comprehensive: dir to new name} {notRoot pc 2000orNewer testchmod} { # On Windows with ACLs, copying a directory is defined like this cleanup file mkdir [file join td1 tdx] file mkdir [file join td2 tdy] testchmod 555 td2 file copy td1 td3 file copy td2 td4 set msg [list [lsort [glob td*]] [glob -directory td3 t*] \ [glob -directory td4 t*] [file writable td3] [file writable td4]] testchmod 755 td2 testchmod 755 td4 set msg } [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1}] test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testchmod} { cleanup createfile tf1 createfile tf2 createfile tfs1 createfile tfs2 createfile tfs3
︙
967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005	990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051	- + + + + + + + + + + + + + + + + + + + + + + + +	testchmod 444 tf2 file copy tf1 [file join td1 tf3] file copy tf2 [file join td1 tf4] list [lsort [glob tf*]] [lsort [glob -directory td1 t*]] \ [file writable [file join td1 tf3]] [file writable [file join td1 tf4]] } [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}] test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \ {notRoot unixOrPc testchmod} { {notRoot unixOrPc 95or98 testchmod} { cleanup file mkdir td1 file mkdir td2 file mkdir td3 testchmod 555 td2 file copy td1 [file join td3 td3] file copy td2 [file join td3 td4] list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ [file writable [file join td3 td3]] [file writable [file join td3 td4]] } [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}] test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} \ {notRoot pc 2000orNewer testchmod} { # On Windows with ACLs, copying a directory is defined like this cleanup file mkdir td1 file mkdir td2 file mkdir td3 testchmod 555 td2 file copy td1 [file join td3 td3] file copy td2 [file join td3 td4] list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ [file writable [file join td3 td3]] [file writable [file join td3 td4]] } [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 1}] test fCmd-10.9 {file copy: comprehensive: source and target incompatible} \ {notRoot} { cleanup file mkdir td1 createfile tf1 list [catch {file copy -force td1 tf1} msg] $msg } {1 {can't overwrite file "tf1" with directory "td1"}} test fCmd-10.10 {file copy: comprehensive: source and target incompatible} \ {notRoot} { cleanup file mkdir [file join td1 tf1] createfile tf1 list [catch {file copy -force tf1 td1} msg] $msg } [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}] test fCmd-10.11 {file copy: copy to empty file name} { cleanup createfile tf1 list [catch {file copy tf1 ""} msg] $msg } {1 {error copying "tf1" to "": no such file or directory}} test fCmd-10.12 {file rename: rename to empty file name} { cleanup createfile tf1 list [catch {file rename tf1 ""} msg] $msg } {1 {error renaming "tf1" to "": no such file or directory}} cleanup # old tests test fCmd-11.1 {TclFileRenameCmd: -- option } {notRoot} { catch {file delete -force -- -tfa1} set s [createfile -tfa1]
︙
1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687	1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733	- + - +	set r1 [catch {file rename tfa tfad}] set result [expr $r1 && [file isdir tfa]] file delete -force tfa tfad set result } {1} test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} \ {notRoot} { {notRoot notNetworkFilesystem} { catch {file delete -force -- tfa tfad} file mkdir tfa tfad/tfa file rename -force tfa tfad set result [expr ![file isdir tfa]] file delete -force tfad set result } {1} test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} \ {notRoot} { catch {file delete -force -- tfa tfad} file mkdir tfa tfad/tfa/file set r1 [catch {file rename tfa tfad}] set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]] file delete -force tfa tfad set result } {1} test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} \ {notRoot} { {notRoot notNetworkFilesystem} { catch {file delete -force -- tfa tfad} file mkdir tfa tfad/tfa/file set r1 [catch {file rename -force tfa tfad}] set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]] file delete -force tfa tfad set result } {1}
︙
1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822	1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877	+ + + + + + + + +	file attributes tfa/a -permissions 0000 set result [catch {file delete -force tfa}] file attributes tfa/a -permissions 0777 file delete -force tfa set result } {1} test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} \ {unix notRoot} { catch {file delete -force -- tfa} file mkdir tfa for {set i 1} {$i <= 300} {incr i} {createfile tfa/testfile_$i} set result [catch {file delete -force tfa} msg] while {[catch {file delete -force tfa}]} {} list $result $msg } {0 {}} # # Feature testing for TclCopyFilesCmd # test fCmd-21.1 {copy : single file to nonexistant } {notRoot} { catch {file delete -force -- tfa1 tfa2} set s [createfile tfa1]
︙
2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220	2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276	+	test fCmd-28.3 {file link} { list [catch {file link abc b c} msg] $msg } {1 {bad switch "abc": must be -symbolic or -hard}} test fCmd-28.4 {file link} { list [catch {file link -abc b c} msg] $msg } {1 {bad switch "-abc": must be -symbolic or -hard}} cd [workingDirectory] makeDirectory abc.dir makeDirectory abc2.dir makeFile contents abc.file makeFile contents abc2.file cd [temporaryDirectory]
︙
2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360	2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416	- + - +	file copy abc2.file abc.dir cd [workingDirectory] test fCmd-28.16 {file link: glob inside link} {linkDirectory} { cd [temporaryDirectory] file delete -force abc.link file link abc.link abc.dir set res [glob -dir abc.link -tails *] set res [lsort [glob -dir abc.link -tails *]] cd [workingDirectory] set res } {abc.file abc2.file} } [lsort [list abc.file abc2.file]] test fCmd-28.17 {file link: glob -type l} {linkDirectory} { cd [temporaryDirectory] set res [glob -dir [pwd] -type l -tails abc*] cd [workingDirectory] set res } {abc.link}
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	# This file tests the filename manipulation routines. # # 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) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 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. # # RCS: @(#) $Id: fileName.test,v 1.30 2003/02/12 18:57:51 vincentdarley Exp $ # RCS: @(#) $Id: fileName.test,v 1.30.2.7 2005/06/21 19:07:58 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]]
︙
327 328 329 330 331 332 333 334 335 336 337 338 339 340 341	327 328 329 330 331 332 333 334 335 336 337 338 339 340 341	- +	regsub -all ":" $norm "/" norm # make sure we can delete the directory we created cd $oldDir file delete -force $nastydir set norm } err] cd $oldDir catch {file delete -force tildetmp} catch {file delete -force [file join [temporaryDirectory] tildetmp]} list $res $err } {0 tildetmp/~tilde} test filename-5.1 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a:b } {a: b}
︙
891 892 893 894 895 896 897 898 899 900 901 902 903 904	891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	testsetplatform win file join foo .. bar } {foo/../bar} test filename-9.18 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join foo/./bar } {foo/./bar} test filename-9.19 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win set res {} lappend res \ [file join {C:\foo\bar}] \ [file join C:/blah {C:\foo\bar}] \ [file join C:/blah C:/blah {C:\foo\bar}] } {C:/foo/bar C:/foo/bar C:/foo/bar} test filename-9.19.1 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win set res {} lappend res \ [file join {foo\bar}] \ [file join C:/blah {foo\bar}] \ [file join C:/blah C:/blah {foo\bar}] } {foo/bar C:/blah/foo/bar C:/blah/foo/bar} test filename-9.19.2 {Tcl_JoinPath: win} {testsetplatform winOnly} { testsetplatform win set res {} lappend res \ [file join {foo\bar}] \ [file join [pwd] {foo\bar}] \ [file join [pwd] [pwd] {foo\bar}] string map [list [pwd] pwd] $res } {foo/bar pwd/foo/bar pwd/foo/bar} test filename-9.20 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix set res {} lappend res \ [file join {/foo/bar}] \ [file join /x {/foo/bar}] \ [file join /x /x {/foo/bar}] } {/foo/bar /foo/bar /foo/bar} test filename-9.21 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac set res {} lappend res \ [file join {/foo/bar}] \ [file join drive: {/foo/bar}] \ [file join drive: drive: {/foo/bar}] } {foo:bar foo:bar foo:bar} test filename-9.22 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac set res {} lappend res \ [file join {foo:bar}] \ [file join drive: {foo:bar}] \ [file join drive: drive: {foo:bar}] } {foo:bar foo:bar foo:bar} test filename-9.23 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win set res {} lappend res \ [file join {foo\bar}] \ [file join C:/blah {foo\bar}] \ [file join C:/blah C:/blah {foo\bar}] string map [list C:/blah ""] $res } {foo/bar /foo/bar /foo/bar} test filename-9.24 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix set res {} lappend res \ [file join {foo/bar}] \ [file join /x {foo/bar}] \ [file join /x /x {foo/bar}] string map [list /x ""] $res } {foo/bar /foo/bar /foo/bar} test filename-9.25 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac set res {} lappend res \ [file join {foo/bar}] \ [file join drive: {foo/bar}] \ [file join drive: drive: {foo/bar}] string map [list drive: ""] $res } {:foo:bar foo:bar foo:bar} test filename-9.26 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac set res {} lappend res \ [file join {:foo:bar}] \ [file join drive: {:foo:bar}] \ [file join drive: drive: {:foo:bar}] string map [list drive: ""] $res } {:foo:bar foo:bar foo:bar} test filename-10.1 {Tcl_TranslateFileName} {testsetplatform} { testsetplatform unix list [catch {testtranslatefilename foo} msg] $msg } {0 foo} test filename-10.2 {Tcl_TranslateFileName} {testsetplatform} { testsetplatform windows
︙
1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341	1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433	+ + + + + + +	list [catch {lsort [glob -type d -dir $globname *]} msg] $msg } [list 0 [lsort [list [file join $globname a1]\ [file join $globname a2]\ [file join $globname a3]]]] test filename-11.21 {Tcl_GlobCmd} { list [catch {lsort [glob -type d -path $globname *]} msg] $msg } [list 0 [lsort [list $globname]]] test filename-11.21.1 {Tcl_GlobCmd} { close [open {[tcl].testremains} w] set res [list [catch {lsort [glob -path {[tcl]} *]} msg] $msg] file delete -force {[tcl].testremains} set res } [list 0 {{[tcl].testremains}}] # Get rid of file/dir if it exists, since it will have # been left behind by a previous failed run. if {[file exists $horribleglobname]} { file delete -force $horribleglobname } file rename globTest $horribleglobname
︙
1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565	1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	} "$globPreResult$x1 $globPreResult$y1" test filename-12.5 {simple globbing} { list [catch {glob globTest\\/x1.c} msg] $msg } "0 $globPreResult$x1" test filename-12.6 {simple globbing} { list [catch {glob globTest\\/\\x1.c} msg] $msg } "0 $globPreResult$x1" test filename-12.7 {globbing at filesystem root} {unixOnly} { set res1 [glob -nocomplain /*] set res2 [glob -path / *] set equal [string equal $res1 $res2] if {!$equal} { lappend equal "not equal" $res1 $res2 } set equal } {1} test filename-12.8 {globbing at filesystem root} {unixOnly} { set dir [lindex [glob -type d /*] 0] set first [string range $dir 0 1] set res1 [glob -nocomplain ${first}*] set res2 [glob -path $first *] set equal [string equal $res1 $res2] if {!$equal} { lappend equal "not equal" $res1 $res2 } set equal } {1} test filename-12.9 {globbing at filesystem root} {winOnly} { # Can't grab just anything from 'file volumes' because we need a dir # that has subdirs - assume that C:/ exists across Windows machines. set dir [lindex [glob -type d C:/*] 0] set first [string range $dir 0 3] set res1 [glob -nocomplain ${first}*] set res2 [glob -path $first *] set equal [string equal $res1 $res2] if {!$equal} { lappend equal "not equal" $res1 $res2 } set equal } {1} test filename-13.1 {globbing with brace substitution} { list [catch {glob globTest/\{\}} msg] $msg } "0 $globPreResult" test filename-13.2 {globbing with brace substitution} { list [catch {glob globTest/\{} msg] $msg } {1 {unmatched open-brace in file name}}
︙
1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884	1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016	+ + + + + + +	set res [glob -nocomplain -dir [temporaryDirectory]/execglob \ -tails -types x *] removeFile execglob/abc.exe removeFile execglob/abc.notexecutable removeDirectory execglob set res } {abc.exe} test fileName-18.1 {windows - split ADS name correctly} {winOnly} { # bug 1194458 set x [file split c:/c:d] set y [eval [linsert $x 0 file join]] list $x $y } {{c:/ ./c:d} c:/c:d} # cleanup catch {file delete -force C:/globTest} cd [temporaryDirectory] file delete -force globTest cd $oldpwd set env(HOME) $oldhome
︙

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	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	- + + + + +	# This file tests the filesystem and vfs internals. # # 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) 2002 Vincent Darley. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest package require tcltest 2 namespace eval ::tcl::test::fileSystem { catch { namespace import ::tcltest::cleanupTests namespace import ::tcltest::makeDirectory namespace import ::tcltest::makeFile namespace import ::tcltest::removeDirectory namespace import ::tcltest::removeFile namespace import ::tcltest::test } catch { file delete -force link.file file delete -force dir.link file delete -force [file join dir.file linkinside.file] } cd [tcltest::temporaryDirectory] makeFile "test file" gorp.file makeDirectory dir.file makeFile "test file in directory" [file join dir.file inside.file] if {[catch { file link link.file gorp.file file link \ [file join dir.file linkinside.file] \ [file join dir.file inside.file] file link dir.link dir.file }]} { tcltest::testConstraint hasLinks 0 } else { tcltest::testConstraint hasLinks 1 } tcltest::testConstraint testsimplefilesystem \ [string equal testsimplefilesystem [info commands testsimplefilesystem]] test filesystem-1.0 {link normalisation} {hasLinks} { string equal [file normalize gorp.file] [file normalize link.file] } {0} test filesystem-1.1 {link normalisation} {hasLinks} { string equal [file normalize dir.file] [file normalize dir.link] } {0}
︙
385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413	389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418	- + - + +	list [catch {file writable ""} msg] $msg } {0 0} # Make sure the testfilesystem hasn't been registered. while {![catch {testfilesystem 0}]} {} } test filesystem-7.1 {load from vfs} {win} { test filesystem-7.1 {load from vfs} {win testsimplefilesystem} { # This may cause a crash on exit set dir [pwd] cd [file dirname [info nameof]] set dde [lindex [glob *dde*[info sharedlib]] 0] testsimplefilesystem 1 # This loads dde via a complex copy-to-temp operation load simplefs:/$dde dde testsimplefilesystem 0 cd $dir set res "ok" # The real result of this test is what happens when Tcl exits. } {ok} test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} { test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} \ {testsimplefilesystem} { set dir [pwd] cd [tcltest::temporaryDirectory] # We created this file several tests ago. set origtime [file mtime gorp.file] testsimplefilesystem 1 file delete -force theCopy file copy simplefs:/gorp.file theCopy
︙
451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476	456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621	- + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	makeDirectory $dir makeFile "contents" [file join abc foo] cd $dir set res [file exists [lindex [glob *] 0]] cd .. removeFile [file join abc foo] removeDirectory abc removeDirectory def cd $origdir set res } {1} test filesystem-8.3 {path objects and empty string} { set anchor "" set dst foo set res $dst set yyy [file split $anchor] set dst [file join $anchor $dst] lappend res $dst $yyy } {foo foo {}} proc TestFind1 {d f} { set r1 [file exists [file join $d $f]] lappend res "[file join $d $f] found: $r1" lappend res "is dir a dir? [file isdirectory $d]" set r2 [file exists [file join $d $f]] lappend res "[file join $d $f] found: $r2" set res } proc TestFind2 {d f} { set r1 [file exists [file join $d $f]] lappend res "[file join $d $f] found: $r1" lappend res "is dir a dir? [file isdirectory [file join $d]]" set r2 [file exists [file join $d $f]] lappend res "[file join $d $f] found: $r2" set res } test filesystem-9.1 {path objects and join and object rep} { set origdir [pwd] cd [tcltest::temporaryDirectory] file mkdir [file join a b c] set res [TestFind1 a [file join b . c]] file delete -force a cd $origdir set res } {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}} test filesystem-9.2 {path objects and join and object rep} { set origdir [pwd] cd [tcltest::temporaryDirectory] file mkdir [file join a b c] set res [TestFind2 a [file join b . c]] file delete -force a cd $origdir set res } {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}} test filesystem-9.2.1 {path objects and join and object rep} { set origdir [pwd] cd [tcltest::temporaryDirectory] file mkdir [file join a b c] set res [TestFind2 a [file join b .]] file delete -force a cd $origdir set res } {{a/b/. found: 1} {is dir a dir? 1} {a/b/. found: 1}} test filesystem-9.3 {path objects and join and object rep} { set origdir [pwd] cd [tcltest::temporaryDirectory] file mkdir [file join a b c] set res [TestFind1 a [file join b .. b c]] file delete -force a cd $origdir set res } {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}} test filesystem-9.4 {path objects and join and object rep} { set origdir [pwd] cd [tcltest::temporaryDirectory] file mkdir [file join a b c] set res [TestFind2 a [file join b .. b c]] file delete -force a cd $origdir set res } {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}} test filesystem-9.5 {path objects and file tail and object rep} { set origdir [pwd] cd [tcltest::temporaryDirectory] file mkdir dgp close [open dgp/test w] foreach relative [glob -nocomplain [file join * test]] { set absolute [file join [pwd] $relative] set res [list [file tail $absolute] "test"] } file delete -force dgp cd $origdir set res } {test test} test filesystem-9.6 {path objects and file join and object rep} {winOnly} { set res {} set p "C:\\toto" lappend res [file join $p toto] file isdirectory $p lappend res [file join $p toto] } {C:/toto/toto C:/toto/toto} test filesystem-9.7 {path objects and glob and file tail and tilde} { set res {} set origdir [pwd] cd [tcltest::temporaryDirectory] file mkdir tilde close [open tilde/~testNotExist w] cd tilde set file [lindex [glob *test*] 0] lappend res [file exists $file] [catch {file tail $file} r] $r lappend res $file lappend res [file exists $file] [catch {file tail $file} r] $r lappend res [catch {file tail $file} r] $r cd .. file delete -force tilde cd $origdir set res } {0 1 {user "testNotExist" doesn't exist} ~testNotExist 0 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}} test filesystem-9.8 {path objects and glob and file tail and tilde} { set res {} set origdir [pwd] cd [tcltest::temporaryDirectory] file mkdir tilde close [open tilde/~testNotExist w] cd tilde set file1 [lindex [glob *test*] 0] set file2 "~testNotExist" lappend res $file1 $file2 lappend res [catch {file tail $file1} r] $r lappend res [catch {file tail $file2} r] $r cd .. file delete -force tilde cd $origdir set res } {~testNotExist ~testNotExist 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}} test filesystem-9.9 {path objects and glob and file tail and tilde} { set res {} set origdir [pwd] cd [tcltest::temporaryDirectory] file mkdir tilde close [open tilde/~testNotExist w] cd tilde set file1 [lindex [glob *test*] 0] set file2 "~testNotExist" lappend res [catch {file exists $file1} r] $r lappend res [catch {file exists $file2} r] $r lappend res [string equal $file1 $file2] cd .. file delete -force tilde cd $origdir set res } {0 0 0 0 1} cleanupTests } namespace delete ::tcl::test::fileSystem return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	# Commands covered: foreach, continue, break # # 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-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. # # RCS: @(#) $Id: foreach.test,v 1.8 2001/09/19 18:17:54 hobbs Exp $ # RCS: @(#) $Id: foreach.test,v 1.8.8.3 2007/03/13 16:26:33 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } catch {unset a}
︙
167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252	167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262	- - + + - + - - + + - - + + - - + + - + - + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - -	set x [expr $x + 1] } set x } 13.0 # Check "continue". test foreach-4.1 {continue tests} {catch continue} 4 test foreach-4.2 {continue tests} { test foreach-5.1 {continue tests} {catch continue} 4 test foreach-5.2 {continue tests} { set a {} foreach i {a b c d} { if {[string compare $i "b"] == 0} continue set a [concat $a $i] } set a } {a c d} test foreach-4.3 {continue tests} { test foreach-5.3 {continue tests} { set a {} foreach i {a b c d} { if {[string compare $i "b"] != 0} continue set a [concat $a $i] } set a } {b} test foreach-4.4 {continue tests} {catch {continue foo} msg} 1 test foreach-4.5 {continue tests} { test foreach-5.4 {continue tests} {catch {continue foo} msg} 1 test foreach-5.5 {continue tests} { catch {continue foo} msg set msg } {wrong # args: should be "continue"} # Check "break". test foreach-5.1 {break tests} {catch break} 3 test foreach-5.2 {break tests} { test foreach-6.1 {break tests} {catch break} 3 test foreach-6.2 {break tests} { set a {} foreach i {a b c d} { if {[string compare $i "c"] == 0} break set a [concat $a $i] } set a } {a b} test foreach-5.3 {break tests} {catch {break foo} msg} 1 test foreach-5.4 {break tests} { test foreach-6.3 {break tests} {catch {break foo} msg} 1 test foreach-6.4 {break tests} { catch {break foo} msg set msg } {wrong # args: should be "break"} # Check for bug #406709 test foreach-5.5 {break tests} { test foreach-6.5 {break tests} { proc a {} { set a 1 foreach b b {list [concat a; break]; incr a} incr a } a } {2} # Test for incorrect "double evaluation" semantics test foreach-6.1 {delayed substitution of body} { test foreach-7.1 {delayed substitution of body} { proc foo {} { set a 0 foreach a [list 1 2 3] " set x $a " set x } foo } {0} # [Bug 1671138]; infinite loop with empty var list in bytecompiled version test foreach-9.1 {compiled empty var list} { proc foo {} { foreach {} x { error "reached body" } } list [catch { foo } msg] $msg } {1 {foreach varlist is empty}} test foreach-10.1 {foreach: [Bug 1671087]} -setup { proc demo {} { set vals {1 2 3 4} trace add variable x write {string length $vals ;# } foreach {x y} $vals {format $y} } } -body { demo } -cleanup { rename demo {} } -result {} # cleanup catch {unset a} catch {unset x} ::tcltest::cleanupTests return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	# Commands covered: format # # 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-1994 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: format.test,v 1.11 2002/06/22 04:19:47 dgp Exp $ # RCS: @(#) $Id: format.test,v 1.11.2.8 2005/10/13 21:45:32 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } # The following code is needed because some versions of SCO Unix have
︙
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 116 117 118 119 120 121 122 123 124	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 116 117 118 119 120 121 122 123 124	- + - + - + - + - + - + - + - + - + - + - +	} {abcd This is a very long test string. % x x} test format-2.5 {string formatting, embedded nulls} { format "%10s" abc\0def } " abc\0def" test format-2.6 {string formatting, international chars} { format "%10s" abc\ufeffdef } " abc\ufeffdef" test format-2.6 {string formatting, international chars} { test format-2.7 {string formatting, international chars} { format "%.5s" abc\ufeffdef } "abc\ufeffd" test format-2.7 {string formatting, international chars} { test format-2.8 {string formatting, international chars} { format "foo\ufeffbar%s" baz } "foo\ufeffbarbaz" test format-2.8 {string formatting, width} { test format-2.9 {string formatting, width} { format "a%5sa" f } "a fa" test format-2.8 {string formatting, width} { test format-2.10 {string formatting, width} { format "a%-5sa" f } "af a" test format-2.8 {string formatting, width} { test format-2.11 {string formatting, width} { format "a%2sa" foo } "afooa" test format-2.8 {string formatting, width} { test format-2.12 {string formatting, width} { format "a%0sa" foo } "afooa" test format-2.8 {string formatting, precision} { test format-2.13 {string formatting, precision} { format "a%.2sa" foobarbaz } "afoa" test format-2.8 {string formatting, precision} { test format-2.14 {string formatting, precision} { format "a%.sa" foobarbaz } "aa" test format-2.8 {string formatting, precision} { test format-2.15 {string formatting, precision} { list [catch {format "a%.-2sa" foobarbaz} msg] $msg } {1 {bad field specifier "-"}} test format-2.8 {string formatting, width and precision} { test format-2.16 {string formatting, width and precision} { format "a%5.2sa" foobarbaz } "a foa" test format-2.8 {string formatting, width and precision} { test format-2.17 {string formatting, width and precision} { format "a%5.7sa" foobarbaz } "afoobarba" test format-3.1 {Tcl_FormatObjCmd: character formatting} { format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 65 65 65 65 65 65 3 65 -4 65 } "|A|A|A|A|A | A| A|A |" test format-3.2 {Tcl_FormatObjCmd: international character formatting} {
︙
361 362 363 364 365 366 367 368 369 370 371 372 373 374	361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382	+ + + + + + + +	} -1 test format-10.2 {"h" format specifier} {nonPortable} { format %hx 0x10fff } fff test format-10.3 {"h" format specifier} {nonPortable} { format %hd 0x10000 } 0 test format-10.4 {"h" format specifier} { # Bug 1154163: This is minimal behaviour for %hx specifier! format %hx 1 } 1 test format-10.5 {"h" format specifier} { # Bug 1284178: Highly out-of-range values shouldn't cause errors format %hu 0x100000000 } 0 test format-11.1 {XPG3 %$n specifiers} { format {%2$d %1$d} 4 5 } {5 4} test format-11.2 {XPG3 %$n specifiers} { format {%2$d %1$d %1$d %3$d} 4 5 6 } {5 4 4 6}
︙
489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511	497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560	- - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	::tcltest::testConstraint 64bitInts \ [expr {0x80000000 > 0}] ::tcltest::testConstraint wideIntExpressions \ [expr {wide(0x80000000) != int(0x80000000)}] test format-17.1 {testing %d with wide} {64bitInts wideIntExpressions} { list [catch {format %d 7810179016327718216} msg] $msg } {1 {integer value too large to represent}} format %d 7810179016327718216 } 1819043144 test format-17.2 {testing %ld with wide} {64bitInts} { format %ld 7810179016327718216 } 7810179016327718216 test format-17.3 {testing %ld with non-wide} {64bitInts} { format %ld 42 } 42 test format-17.4 {testing %l with non-integer} { format %lf 1 } 1.000000 test format-17.5 {type conversions with wides} { set a 0xAAAAAAAA ;# NB: Careful to make separate objects here! set b 0xAAAAAAA; append b A set result [expr {$a == $b}] format %x $a lappend result [expr {$a == $b}] } {1 1} test format-18.1 {do not demote existing numeric values} { set a 0xaaaaaaaa # Ensure $a and $b are separate objects set b 0xaaaa append b aaaa set result [expr {$a == $b}] format %08lx $b lappend result [expr {$a == $b}] set b 0xaaaa append b aaaa lappend result [expr {$a == $b}] format %08x $b lappend result [expr {$a == $b}] } {1 1 1 1} test format-18.2 {do not demote existing numeric values} {wideIntExpressions} { set a [expr {0xaaaaaaaaaa + 1}] set b 0xaaaaaaaaab list [format %08x $a] [expr {$a == $b}] } {aaaaaaab 1} test format-19.1 { regression test - tcl-core message by Brian Griffin on 26 0ctober 2004 } -body { set x 0x8fedc654 list [expr { ~ $x }] [format %08x [expr { ~$x }]] } -match regexp -result {-2414724693 f*701239ab} # cleanup catch {unset a} catch {unset b} catch {unset c} catch {unset d} ::tcltest::cleanupTests return

︙
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	- +	# Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 by Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # # RCS: @(#) $Id: http.test,v 1.33 2003/02/11 20:41:38 kennykb Exp $ # RCS: @(#) $Id: http.test,v 1.33.2.6 2006/10/06 19:00:53 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } if {[catch {package require http 2} version]} {
︙
43 44 45 46 47 48 49 50 51 52 53 54 55 56 57	43 44 45 46 47 48 49 50 51 52 53 54 55 56 57	- +	set port 8010 set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null" catch {unset data} # Ensure httpd file exists set origFile [file join $::tcltest::testsDirectory httpd] set origFile [file join [pwd] [file dirname [info script]] httpd] set httpdFile [file join [temporaryDirectory] httpd_[pid]] if {![file exists $httpdFile]} { makeFile "" $httpdFile file delete $httpdFile file copy $origFile $httpdFile set removeHttpd 1 }
︙
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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204	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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200	- - + - - - - + + + - + - - - + + + + + + + + - - - - + + - - - - - + + + + + + - - + - - - - -	unset port return } else { set port [lindex [fconfigure $listen -sockname] 2] } } test http-1.1 {http::config} { http::config } [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -useragent "Tcl http client package $version"] } [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "Tcl http client package $version"] test http-1.2 {http::config} { http::config -proxyfilter } http::ProxyRequired test http-1.3 {http::config} { catch {http::config -junk} } 1 test http-1.4 {http::config} { set savedconf [http::config] http::config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite" http::config -proxyhost nowhere.come -proxyport 8080 \ -proxyfilter myFilter -useragent "Tcl Test Suite" \ -urlencoding iso8859-1 set x [http::config] eval http::config $savedconf set x } {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}} } {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}} test http-1.5 {http::config} { list [catch {http::config -proxyhost {} -junk 8080} msg] $msg } {1 {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -useragent}} } {1 {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent}} test http-1.6 {http::config} { set enc [list [http::config -urlencoding]] http::config -urlencoding iso8859-1 lappend enc [http::config -urlencoding] http::config -urlencoding [lindex $enc 0] set enc } {utf-8 iso8859-1} test http-2.1 {http::reset} { catch {http::reset http#1} } 0 test http-3.1 {http::geturl} { list [catch {http::geturl -bogus flag} msg] $msg } {1 {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -progress, -query, -queryblocksize, -querychannel, -queryprogress, -validate, -timeout, -type}} test http-3.2 {http::geturl} { catch {http::geturl http:junk} err set err } {Unsupported URL: http:junk} set url [info hostname]:$port set badurl [info hostname]:6666 set url //[info hostname]:$port set badurl //[info hostname]:6666 test http-3.3 {http::geturl} { set token [http::geturl $url] http::data $token } "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>GET /</h2> </body></html>" set tail /a/b/c set url [info hostname]:$port/a/b/c set binurl [info hostname]:$port/binary set posturl [info hostname]:$port/post set badposturl [info hostname]:$port/droppost set url //[info hostname]:$port/a/b/c set fullurl http://user:pass@[info hostname]:$port/a/b/c set binurl //[info hostname]:$port/binary set posturl //[info hostname]:$port/post set badposturl //[info hostname]:$port/droppost set badcharurl //%user@[info hostname]:$port/a/^b/c test http-3.4 {http::geturl} { set token [http::geturl $url] http::data $token } "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>GET $tail</h2> </body></html>" proc selfproxy {host} { global port return [list [info hostname] $port] } test http-3.5 {http::geturl} { http::config -proxyfilter selfproxy set token [http::geturl $url] http::config -proxyfilter http::ProxyRequired http::data $token } "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>GET http://$url</h2> <h2>GET http:$url</h2> </body></html>" test http-3.6 {http::geturl} { http::config -proxyfilter bogus set token [http::geturl $url] http::config -proxyfilter http::ProxyRequired http::data $token } "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>GET $tail</h2> </body></html>" test http-3.7 {http::geturl} { set token [http::geturl $url -headers {Pragma no-cache}] http::data $token } "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>GET $tail</h2> </body></html>" test http-3.8 {http::geturl} { set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 2000] http::data $token } "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>POST $tail</h2> <h2>Query</h2> <dl> <dt>Name<dd>Value <dt>Foo<dd>Bar </dl> </body></html>" test http-3.9 {http::geturl} { set token [http::geturl $url -validate 1] http::code $token } "HTTP/1.0 200 OK" test http-3.10 {http::geturl queryprogress} { set query foo=bar set sep "" set i 0 # Create about 120K of query data while {$i < 14} { incr i
︙
212 213 214 215 216 217 218 219 220 221 222 223 224 225 226	208 209 210 211 212 213 214 215 216 217 218 219 220 221	-	} set postProgress {} set t [http::geturl $posturl -query $query \ -queryprogress postProgress -queryblocksize 16384] http::wait $t list [http::status $t] [string length $query] $postProgress [http::data $t] } {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}} test http-3.11 {http::geturl querychannel with -command} { set query foo=bar set sep "" set i 0 # Create about 120K of query data while {$i < 14} { incr i
︙
248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269	243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261	- - - - + + + - - - + + -	http::wait $t close $fp lappend testRes [http::status $t] $postResult removeFile outdata set testRes } {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}} # On Linux platforms when the client and server are on the same # host, the client is unable to read the server's response one # it hits the write error. The status is "eof" # On Linux platforms when the client and server are on the same host, the # client is unable to read the server's response one it hits the write error. # The status is "eof". # On Windows, the http::wait procedure gets a # "connection reset by peer" error while reading the reply # On Windows, the http::wait procedure gets a "connection reset by peer" error # while reading the reply. test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} { set query foo=bar set sep "" set i 0 # Create about 120K of query data while {$i < 14} { incr i
︙
293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503	285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551	- - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - + - - + - - - - + + - - - + - - - - + + - - - - + + - - - - + - - + + - - - - + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + +	puts $errorInfo error $err } removeFile outdata list [http::status $t] [http::code $t] } {ok {HTTP/1.0 200 Data follows}} test http-3.13 {http::geturl socket leak test} { set chanCount [llength [file channels]] for {set i 0} {$i < 3} {incr i} { catch {http::geturl $badurl -timeout 5000} catch {http::geturl $badurl -timeout 5000} } # No extra channels should be taken expr {[llength [file channels]] == $chanCount} } 1 test http-3.14 "http::geturl $fullurl" { set token [http::geturl $fullurl -validate 1] http::code $token } "HTTP/1.0 200 OK" test http-3.15 {http::geturl parse failures} -body { http::geturl "{invalid}:url" } -returnCodes error -result {Unsupported URL: {invalid}:url} test http-3.16 {http::geturl parse failures} -body { http::geturl http:relative/url } -returnCodes error -result {Unsupported URL: http:relative/url} test http-3.17 {http::geturl parse failures} -body { http::geturl /absolute/url } -returnCodes error -result {Missing host part: /absolute/url} test http-3.18 {http::geturl parse failures} -body { http::geturl http://somewhere:123456789/ } -returnCodes error -result {Invalid port number: 123456789} test http-3.19 {http::geturl parse failures} -body { set ::http::strict 1 http::geturl http://{user}@somewhere } -returnCodes error -result {Illegal characters in URL user} test http-3.20 {http::geturl parse failures} -body { set ::http::strict 1 http::geturl http://%user@somewhere } -returnCodes error -result {Illegal encoding character usage "%us" in URL user} test http-3.21 {http::geturl parse failures} -body { set ::http::strict 1 http::geturl http://somewhere/{path} } -returnCodes error -result {Illegal characters in URL path} test http-3.22 {http::geturl parse failures} -body { set ::http::strict 1 http::geturl http://somewhere/%path } -returnCodes error -result {Illegal encoding character usage "%pa" in URL path} test http-3.23 {http::geturl parse failures} -body { set ::http::strict 1 http::geturl http://somewhere/path?{query} } -returnCodes error -result {Illegal characters in URL path} test http-3.24 {http::geturl parse failures} -body { set ::http::strict 1 http::geturl http://somewhere/path?%query } -returnCodes error -result {Illegal encoding character usage "%qu" in URL path} test http-3.25 {http::geturl parse failures} -body { set ::http::strict 0 set token [http::geturl $badcharurl] http::cleanup $token } -returnCodes ok -result {} test http-4.1 {http::Event} { set token [http::geturl $url] upvar #0 $token data array set meta $data(meta) expr ($data(totalsize) == $meta(Content-Length)) } 1 test http-4.2 {http::Event} { set token [http::geturl $url] upvar #0 $token data array set meta $data(meta) string compare $data(type) [string trim $meta(Content-Type)] } 0 test http-4.3 {http::Event} { set token [http::geturl $url] http::code $token } {HTTP/1.0 200 Data follows} test http-4.4 {http::Event} { set testfile [makeFile "" testfile] set out [open $testfile w] set token [http::geturl $url -channel $out] close $out set in [open $testfile] set x [read $in] close $in removeFile $testfile set x } "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>GET $tail</h2> </body></html>" test http-4.5 {http::Event} { set testfile [makeFile "" testfile] set out [open $testfile w] set token [http::geturl $url -channel $out] close $out upvar #0 $token data removeFile $testfile expr $data(currentsize) == $data(totalsize) } 1 test http-4.6 {http::Event} { set testfile [makeFile "" testfile] set out [open $testfile w] set token [http::geturl $binurl -channel $out] close $out set in [open $testfile] fconfigure $in -translation binary set x [read $in] close $in removeFile $testfile set x } "$bindata$binurl" } "$bindata[string trimleft $binurl /]" proc myProgress {token total current} { global progress httpLog if {[info exists httpLog] && $httpLog} { puts "progress $total $current" } set progress [list $total $current] } if 0 { # This test hangs on Windows95 because the client never gets EOF set httpLog 1 test http-4.6 {http::Event} { test http-4.6.1 {http::Event} knownBug { set token [http::geturl $url -blocksize 50 -progress myProgress] set progress } {111 111} } test http-4.7 {http::Event} { set token [http::geturl $url -progress myProgress] set progress } {111 111} test http-4.8 {http::Event} { set token [http::geturl $url] http::status $token } {ok} test http-4.9 {http::Event} { set token [http::geturl $url -progress myProgress] http::code $token } {HTTP/1.0 200 Data follows} test http-4.10 {http::Event} { set token [http::geturl $url -progress myProgress] http::size $token } {111} # Timeout cases # Short timeout to working server (the test server) # This lets us try a reset during the connection # Short timeout to working server (the test server). This lets us try a # reset during the connection. test http-4.11 {http::Event} { set token [http::geturl $url -timeout 1 -command {#}] http::reset $token http::status $token } {reset} # Longer timeout with reset # Longer timeout with reset. test http-4.12 {http::Event} { set token [http::geturl $url/?timeout=10 -command {#}] http::reset $token http::status $token } {reset} # Medium timeout to working server that waits even longer # The timeout hits while waiting for a reply # Medium timeout to working server that waits even longer. The timeout # hits while waiting for a reply. test http-4.13 {http::Event} { set token [http::geturl $url?timeout=30 -timeout 10 -command {#}] http::wait $token http::status $token } {timeout} # Longer timeout to good host, bad port, gets an error # after the connection "completes" but the socket is bad # Longer timeout to good host, bad port, gets an error after the # connection "completes" but the socket is bad. test http-4.14 {http::Event} { set code [catch { set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command {#}] if {[string length $token] == 0} { error "bogus return from http::geturl" } http::wait $token http::status $token } err] # error code varies among platforms. list $code [regexp {(connect failed|couldn't open socket)} $err] } {1 1} # Bogus host test http-4.15 {http::Event} { # This test may fail if you use a proxy server. That is to be # expected and is not a problem with Tcl. set code [catch { set token [http::geturl not_a_host.tcl.tk -timeout 1000 -command {#}] set token [http::geturl //not_a_host.tcl.tk -timeout 1000 -command {#}] http::wait $token http::status $token } err] # error code varies among platforms. list $code [string match "couldn't open socket*" $err] } {1 1} test http-5.1 {http::formatQuery} { http::formatQuery name1 value1 name2 "value two" } {name1=value1&name2=value+two} } {name1=value1&name2=value%20two} # test http-5.2 obsoleted by 5.4 and 5.5 with http 2.5 test http-5.2 {http::formatQuery} { http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2 } {name1=%7ebwelch&name2=%a1%a2%a2} test http-5.3 {http::formatQuery} { http::formatQuery lines "line1\nline2\nline3" } {lines=line1%0d%0aline2%0d%0aline3} test http-5.4 {http::formatQuery} { http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2 } {name1=~bwelch&name2=%c2%a1%c2%a2%c2%a2} test http-5.5 {http::formatQuery} { set enc [http::config -urlencoding] http::config -urlencoding iso8859-1 set res [http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2] http::config -urlencoding $enc set res } {name1=~bwelch&name2=%a1%a2%a2} test http-6.1 {http::ProxyRequired} { http::config -proxyhost [info hostname] -proxyport $port set token [http::geturl $url] http::wait $token http::config -proxyhost {} -proxyport {} upvar #0 $token data set data(body) } "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> <h2>GET http://$url</h2> <h2>GET http:$url</h2> </body></html>" test http-7.1 {http::mapReply} { http::mapReply "abc\$\[\]\"\\()\}\{" } {abc%24%5b%5d%22%5c%28%29%7d%7b} test http-7.2 {http::mapReply} { # RFC 2718 specifies that we pass urlencoding on utf-8 chars by default, # so make sure this gets converted to utf-8 then urlencoded. http::mapReply "\u2208" } {%e2%88%88} test http-7.3 {http::formatQuery} { set enc [http::config -urlencoding] # this would be reverting to http <=2.4 behavior http::config -urlencoding "" set res [list [catch {http::mapReply "\u2208"} msg] $msg] http::config -urlencoding $enc set res } [list 1 "can't read \"formMap(\u2208)\": no such element in array"] test http-7.4 {http::formatQuery} { set enc [http::config -urlencoding] # this would be reverting to http <=2.4 behavior w/o errors # (unknown chars become '?') http::config -urlencoding "iso8859-1" set res [http::mapReply "\u2208"] http::config -urlencoding $enc set res } {%3f} # cleanup catch {unset url} catch {unset badurl} catch {unset port} catch {unset data} if {[info exists httpthread]} { testthread send -async $httpthread { testthread exit } } else { close $listen } if {[info exists removeHttpd]} { removeFile $httpdFile } rename bgerror {} ::tcltest::cleanupTests

︙
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	- +	# Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 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. # # RCS: @(#) $Id: if-old.test,v 1.5 2000/04/10 17:18:59 ericm Exp $ # RCS: @(#) $Id: if-old.test,v 1.5.24.1 2003/03/27 13:11:12 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } test if-old-1.1 {taking proper branch} {
︙
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	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	- + - + - + - +	set a } {} test if-old-1.5 {taking proper branch} { set a {} if 0 {set a 1} else {} set a } {} test if-old-1.5 {taking proper branch} { test if-old-1.6 {taking proper branch} { set a {} if 0 {set a 1} elseif 1 {set a 2} elseif 1 {set a 3} else {set a 4} set a } {2} test if-old-1.6 {taking proper branch} { test if-old-1.7 {taking proper branch} { set a {} if 0 {set a 1} elseif 0 {set a 2} elseif 1 {set a 3} else {set a 4} set a } {3} test if-old-1.7 {taking proper branch} { test if-old-1.8 {taking proper branch} { set a {} if 0 {set a 1} elseif 0 {set a 2} elseif 0 {set a 3} else {set a 4} set a } {4} test if-old-1.8 {taking proper branch, multiline test expr} { test if-old-1.9 {taking proper branch, multiline test expr} { set a {} if {($tcl_platform(platform) != "foobar1") && \ ($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4} set a } {3}
︙
158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176	158 159 160 161 162 163 164	- - - - - - - - - - - -	test if-old-4.11 {error conditions} { list [catch {if 0 then foo elseif 0 bar else {[error "error in else clause"]}} msg] $msg } {1 {error in else clause}} # cleanup ::tcltest::cleanupTests return

︙
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	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	- + - +	# Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 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. # # RCS: @(#) $Id: incr-old.test,v 1.6 2003/02/06 22:44:58 mdejong Exp $ # RCS: @(#) $Id: incr-old.test,v 1.6.2.1 2003/03/27 13:11:13 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } catch {unset x} test incr-old-1.1 {basic incr operation} { set x 23 list [incr x] $x } {24 24} test incr-old-1.2 {basic incr operation} { set x 106 list [incr x -5] $x } {101 101} test incr-old-1.3 {basic incr operation} { set x " -106" list [incr x 1] $x } {-105 -105} test incr-old-1.3 {basic incr operation} { test incr-old-1.4 {basic incr operation} { set x " +106" list [incr x 1] $x } {107 107} test incr-old-2.1 {incr errors} { list [catch incr msg] $msg } {1 {wrong # args: should be "incr varName ?increment?"}}
︙
90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108	90 91 92 93 94 95 96	- - - - - - - - - - - -	set x {20 x} list [catch {incr x 1} msg] $msg } {1 {expected integer but got "20 x"}} # cleanup ::tcltest::cleanupTests return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	- +	# This file is a Tcl script to test out the the procedures in file # tkIndexObj.c, which implement indexed table lookups. The tests here # are organized in the standard fashion for Tcl tests. # # Copyright (c) 1997 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. # # RCS: @(#) $Id: indexObj.test,v 1.7 2000/11/24 11:27:38 dkf Exp $ # RCS: @(#) $Id: indexObj.test,v 1.7.18.4 2006/04/06 18:57:30 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } if {[info commands testindexobj] == {}} {
︙
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	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	+ + + + + + + + + + + + + + + + + + + + + +	} {5} test indexObj-1.6 {forced exact match} { testindexobj 1 0 xy abc def xalb xy alm } {3} test indexObj-1.7 {forced exact match} { testindexobj 1 0 x abc def xalb xyz alm x } {5} test indexObj-1.8 {exact match of empty values} { testindexobj 1 1 {} a aa aaa {} b bb bbb } 3 test indexObj-1.9 {exact match of empty values} { testindexobj 1 0 {} a aa aaa {} b bb bbb } 3 test indexObj-2.1 {no match} { list [catch {testindexobj 1 1 dddd abc def xalb xyz alm x} msg] $msg } {1 {bad token "dddd": must be abc, def, xalb, xyz, alm, or x}} test indexObj-2.2 {no match} { list [catch {testindexobj 1 1 dddd abc} msg] $msg } {1 {bad token "dddd": must be abc}} test indexObj-2.3 {no match: no abbreviations} { list [catch {testindexobj 1 0 xy abc def xalb xyz alm} msg] $msg } {1 {bad token "xy": must be abc, def, xalb, xyz, or alm}} test indexObj-2.4 {ambiguous value} { list [catch {testindexobj 1 1 d dumb daughter a c} msg] $msg } {1 {ambiguous token "d": must be dumb, daughter, a, or c}} test indexObj-2.5 {omit error message} { list [catch {testindexobj 0 1 d x} msg] $msg } {1 {}} test indexObj-2.6 {TCL_EXACT => no "ambiguous" error message} { list [catch {testindexobj 1 0 d dumb daughter a c} msg] $msg } {1 {bad token "d": must be dumb, daughter, a, or c}} test indexObj-2.7 {exact match of empty values} { list [catch {testindexobj 1 1 {} a b c} msg] $msg } {1 {ambiguous token "": must be a, b, or c}} test indexObj-2.8 {exact match of empty values: singleton case} { list [catch {testindexobj 1 0 {} a} msg] $msg } {1 {bad token "": must be a}} test indexObj-2.9 {non-exact match of empty values: singleton case} { # NOTE this is a special case. Although the empty string is a # unique prefix, we have an established history of rejecting # empty lookup keys, requiring any unique prefix match to have # at least one character. list [catch {testindexobj 1 1 {} a} msg] $msg } {1 {bad token "": must be a}} test indexObj-3.1 {cache result to skip next lookup} { testindexobj check 42 } {42} test indexObj-4.1 {free old internal representation} { set x {a b}
︙
107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125	129 130 131 132 133 134 135	- - - - - - - - - - - -	testgetindexfromobjstruct $x 1 testgetindexfromobjstruct $x 1 } "wrong # args: should be \"testgetindexfromobjstruct c 1\"" # cleanup ::tcltest::cleanupTests return

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	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	+ + - + - + + + +	# -*- tcl -*- # Commands covered: info # # 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-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 2006 ActiveState # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: info.test,v 1.24 2002/07/01 07:52:03 dgp Exp $ # RCS: @(#) $Id: info.test,v 1.24.2.5 2006/11/28 22:20:02 andreas_kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest package require tcltest 2 namespace import -force ::tcltest::* } # Set up namespaces needed to test operation of "info args", "info body", # "info default", and "info procs" with imported procedures. catch {namespace delete test_ns_info1 test_ns_info2} namespace eval test_ns_info1 { namespace export * proc p {x} {return "x=$x"} proc q {{y 27} {z {}}} {return "y=$y"} } testConstraint tip280 [info exists tcl_platform(tip,280)] testConstraint !tip280 [expr {![info exists tcl_platform(tip,280)]}] test info-1.1 {info args option} { proc t1 {a bbb c} {return foo} info args t1 } {a bbb c} test info-1.2 {info args option} { proc t1 {{a default1} {bbb default2} {c default3} args} {return foo}
︙
158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181	163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186	- + - + - + - +	test info-5.1 {info complete option} { list [catch {info complete} msg] $msg } {1 {wrong # args: should be "info complete command"}} test info-5.2 {info complete option} { info complete abc } 1 test info-5.2 {info complete option} { test info-5.3 {info complete option} { info complete "\{abcd " } 0 test info-5.3 {info complete option} { test info-5.4 {info complete option} { info complete {# Comment should be complete command} } 1 test info-5.4 {info complete option} { test info-5.5 {info complete option} { info complete {[a [b] } } 0 test info-5.5 {info complete option} { test info-5.6 {info complete option} { info complete {[a [b]} } 0 test info-6.1 {info default option} { proc t1 {a b {c d} {e "long default value"}} {} info default t1 a value } 0
︙
287 288 289 290 291 292 293 294 295 296 297 298 299 300	292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322	+ + + + + + + + + + + + + + + + +	set _xxx1 1 set _xxx2 2 lsort [info g _xxx*] } {_xxx1 _xxx2} test info-8.3 {info globals option} { list [catch {info globals 1 2} msg] $msg } {1 {wrong # args: should be "info globals ?pattern?"}} test info-8.4 {info globals option: may have leading namespace qualifiers} { set x 0 list [info globals x] [info globals :x] [info globals ::x] [info globals :::x] [info globals ::::x] } {x {} x x x} test info-8.5 {info globals option: only return existing global variables} { -setup { catch {unset ::NO_SUCH_VAR} proc evalInProc script {eval $script} } -body { evalInProc {global NO_SUCH_VAR; info globals NO_SUCH_VAR} } -cleanup { rename evalInProc {} } -result {} } test info-9.1 {info level option} { info level } 0 test info-9.2 {info level option} { proc t1 {a b} { set x [info le]
︙
600 601 602 603 604 605 606 607 608 609 610 611 612 613	622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643	+ + + + + + + +	test info-19.5 {info vars with temporary variables} { proc t1 {} { foreach a {b c} {} info vars } t1 } {a} test info-19.6 {info vars: Bug 1072654} -setup { namespace eval :: unset -nocomplain foo catch {namespace delete x} } -body { namespace eval x info vars foo } -cleanup { namespace delete x } -result {} # Check whether the extra testing functions are defined... if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} { set functions {abs acos asin atan atan2 ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh wide} } else { set functions {T1 T2 T3 abs acos asin atan atan2 ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh wide} }
︙
622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645	652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081	- + + + + - + + + + - + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	test info-20.5 {info functions option} { list [catch {info functions raise an error} msg] $msg } {1 {wrong # args: should be "info functions ?pattern?"}} test info-21.1 {miscellaneous error conditions} { list [catch {info} msg] $msg } {1 {wrong # args: should be "info option ?arg arg ...?"}} test info-21.2 {miscellaneous error conditions} { test info-21.2 {miscellaneous error conditions} !tip280 { list [catch {info gorp} msg] $msg } {1 {bad option "gorp": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}} test info-21.2-280 {miscellaneous error conditions} tip280 { list [catch {info gorp} msg] $msg } {1 {bad option "gorp": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}} test info-21.3 {miscellaneous error conditions} { test info-21.3 {miscellaneous error conditions} !tip280 { list [catch {info c} msg] $msg } {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}} test info-21.3-280 {miscellaneous error conditions} tip280 { list [catch {info c} msg] $msg } {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}} test info-21.4 {miscellaneous error conditions} { test info-21.4 {miscellaneous error conditions} !tip280 { list [catch {info l} msg] $msg } {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}} test info-21.4-280 {miscellaneous error conditions} tip280 { list [catch {info l} msg] $msg } {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}} test info-21.5 {miscellaneous error conditions} { test info-21.5 {miscellaneous error conditions} !tip280 { list [catch {info s} msg] $msg } {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}} test info-21.5-280 {miscellaneous error conditions} tip280 { list [catch {info s} msg] $msg } {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}} ## # ### ### ### ######### ######### ######### ## info frame ## Helper # For the more complex results we cut the file name down to remove # path dependencies, and we use only part of the first line of the # reported command. The latter is required because otherwise the whole # test case may appear in some results, but the result is part of the # testcase. An infinite string would be required to describe that. The # cutting-down breaks this. proc reduce {frame} { set pos [lsearch -exact $frame cmd] incr pos set cmd [lindex $frame $pos] if {[regexp \n $cmd]} { set first [string range [lindex [split $cmd \n] 0] 0 end-11] set frame [lreplace $frame $pos $pos $first] } set pos [lsearch -exact $frame file] if {$pos >=0} { incr pos set tail [file tail [lindex $frame $pos]] set frame [lreplace $frame $pos $pos $tail] } set frame } ## Helper # Generate a stacktrace from the current location to top. This code # not only depends on the exact location of things, but also on the # implementation of tcltest. Any changes and these tests will have to # be updated. proc etrace {} { set res {} set level [info frame] while {$level} { lappend res [list $level [reduce [info frame $level]]] incr level -1 } return $res } ## test info-22.0 {info frame, levels} tip280 { info frame } 7 test info-22.1 {info frame, bad level relative} tip280 { # catch is another level!, i.e. we have 8, not 7 catch {info frame -8} msg set msg } {bad level "-8"} test info-22.2 {info frame, bad level absolute} tip280 { # catch is another level!, i.e. we have 8, not 7 catch {info frame 9} msg set msg } {bad level "9"} test info-22.3 {info frame, current, relative} tip280 { info frame 0 } {type eval line 2 cmd {info frame 0}} test info-22.4 {info frame, current, relative, nested} tip280 { set res [info frame 0] } {type eval line 2 cmd {info frame 0}} test info-22.5 {info frame, current, absolute} tip280 { reduce [info frame 7] } {type eval line 2 cmd {info frame 7}} test info-22.6 {info frame, global, relative} tip280 { reduce [info frame -6] } {type source line 759 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relativ} test info-22.7 {info frame, global, absolute} tip280 { reduce [info frame 1] } {type source line 763 file info.test cmd test\ info-22.7\ \{info\ frame,\ global,\ absolut} test info-22.8 {info frame, basic trace} tip280 { join [etrace] \n } {8 {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0} 7 {type eval line 2 cmd etrace} 6 {type source line 2277 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::RunTest} 5 {type eval line 1 cmd {::tcltest::RunTest }} 4 {type source line 1619 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::Eval} 3 {type eval line 1 cmd ::tcltest::Eval\ \{::tcltest::RunTest\ } 2 {type source line 1966 file tcltest.tcl cmd {uplevel 1 [list [namespace origin Eval] $command 1]} proc ::tcltest::test} 1 {type source line 767 file info.test cmd test\ info-22.8\ \{info\ frame,\ basic\ trac}} ## The line 1966 is off by 5 from the true value of 1971. This is a knownBug, see testcase 30.0 test info-23.0 {eval'd info frame} tip280 { eval {info frame} } 8 test info-23.1 {eval'd info frame, semi-dynamic} tip280 { eval info frame } 8 test info-23.2 {eval'd info frame, dynamic} tip280 { set script {info frame} eval $script } 8 test info-23.3 {eval'd info frame, literal} tip280 { eval { info frame 0 } } {type eval line 2 cmd {info frame 0}} test info-23.4 {eval'd info frame, semi-dynamic} tip280 { eval info frame 0 } {type eval line 1 cmd {info frame 0}} test info-23.5 {eval'd info frame, dynamic} tip280 { set script {info frame 0} eval $script } {type eval line 1 cmd {info frame 0}} test info-23.6 {eval'd info frame, trace} tip280 { set script {etrace} join [eval $script] \n } {9 {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0} 8 {type eval line 1 cmd etrace} 7 {type eval line 3 cmd {eval $script}} 6 {type source line 2277 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::RunTest} 5 {type eval line 1 cmd {::tcltest::RunTest }} 4 {type source line 1619 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::Eval} 3 {type eval line 1 cmd ::tcltest::Eval\ \{::tcltest::RunTest\ } 2 {type source line 1966 file tcltest.tcl cmd {uplevel 1 [list [namespace origin Eval] $command 1]} proc ::tcltest::test} 1 {type source line 806 file info.test cmd test\ info-23.6\ \{eval'd\ info\ frame,\ trac}} ## The line 1966 is off by 5 from the true value of 1971. This is a knownBug, see testcase 30.0 # ------------------------------------------------------------------------- # Procedures defined in scripts which are arguments to control # structures (like 'namespace eval', 'interp eval', 'if', 'while', # 'switch', 'catch', 'for', 'foreach', etc.) have no absolute # location. The command implementations execute such scripts through # Tcl_EvalObjEx. Flag 0 causes it to use the bytecode compiler. This # causes the connection to the context to be lost. Currently only # procedure bodies are able to remember their context. # ------------------------------------------------------------------------- namespace eval foo { proc bar {} {info frame 0} } test info-24.0 {info frame, interaction, namespace eval} tip280 { reduce [foo::bar] } {type source line 832 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo # ------------------------------------------------------------------------- set flag 1 if {$flag} { namespace eval foo {} proc ::foo::bar {} {info frame 0} } test info-24.1 {info frame, interaction, if} tip280 { reduce [foo::bar] } {type source line 846 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo # ------------------------------------------------------------------------- set flag 1 while {$flag} { namespace eval foo {} proc ::foo::bar {} {info frame 0} set flag 0 } test info-24.2 {info frame, interaction, while} tip280 { reduce [foo::bar] } {type source line 860 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo # ------------------------------------------------------------------------- catch { namespace eval foo {} proc ::foo::bar {} {info frame 0} } test info-24.3 {info frame, interaction, catch} tip280 { reduce [foo::bar] } {type source line 874 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo # ------------------------------------------------------------------------- foreach var val { namespace eval foo {} proc ::foo::bar {} {info frame 0} break } test info-24.4 {info frame, interaction, foreach} tip280 { reduce [foo::bar] } {type source line 887 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo # ------------------------------------------------------------------------- for {} {1} {} { namespace eval foo {} proc ::foo::bar {} {info frame 0} break } test info-24.5 {info frame, interaction, for} tip280 { reduce [foo::bar] } {type source line 901 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo # ------------------------------------------------------------------------- eval { proc bar {} {info frame 0} } test info-25.0 {info frame, proc in eval} tip280 { reduce [bar] } {type source line 914 file info.test cmd {info frame 0} proc ::bar level 0} proc bar {} {info frame 0} test info-25.1 {info frame, regular proc} tip280 { reduce [bar] } {type source line 921 file info.test cmd {info frame 0} proc ::bar level 0} rename bar {} test info-30.0 {bs+nl in literal words} {tip280 knownBug} { if {1} { set res \ [reduce [info frame 0]] } set res # This is reporting line 3 instead of the correct 4 because the # bs+nl combination is subst by the parser before the 'if' # command, and the the bcc sees the word. To fix record the # offsets of all bs+nl sequences in literal words, then use the # information in the bcc to bump line numbers when parsing over # the location. Also affected: testcases 22.8 and 23.6. } {type eval line 4 cmd {info frame 0} proc ::tcltest::RunTest} # ------------------------------------------------------------------------- # See 24.0 - 24.5 for similar situations, using literal scripts. set body {set flag 0 set a c set res [info frame 0]} ;# line 3! test info-31.0 {ns eval, script in variable} tip280 { namespace eval foo $body set res } {type eval line 3 cmd {info frame 0} level 0} catch {namespace delete foo} test info-31.1 {if, script in variable} tip280 { if 1 $body set res } {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} test info-31.1a {if, script in variable} tip280 { if 1 then $body set res } {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} test info-31.2 {while, script in variable} tip280 { set flag 1 while {$flag} $body set res } {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} # .3 - proc - scoping prevent return of result ... test info-31.4 {foreach, script in variable} tip280 { foreach var val $body set res } {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} test info-31.5 {for, script in variable} tip280 { set flag 1 for {} {$flag} {} $body set res } {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} test info-31.6 {eval, script in variable} tip280 { eval $body set res } {type eval line 3 cmd {info frame 0}} # ------------------------------------------------------------------------- namespace eval foo {} set x foo switch -exact -- $x { foo { proc ::foo::bar {} {info frame 0} } } test info-24.6.0 {info frame, interaction, switch, list body} tip280 { reduce [foo::bar] } {type source line 1001 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo unset x # ------------------------------------------------------------------------- namespace eval foo {} set x foo switch -exact -- $x foo { proc ::foo::bar {} {info frame 0} } test info-24.6.1 {info frame, interaction, switch, multi-body} tip280 { reduce [foo::bar] } {type source line 1017 file info.test cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo unset x # ------------------------------------------------------------------------- namespace eval foo {} set x foo switch -exact -- $x [list foo { proc ::foo::bar {} {info frame 0} }] test info-24.6.2 {info frame, interaction, switch, list body, dynamic} tip280 { reduce [foo::bar] } {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo unset x # ------------------------------------------------------------------------- set body { foo { proc ::foo::bar {} {info frame 0} } } namespace eval foo {} set x foo switch -exact -- $x $body test info-31.7 {info frame, interaction, switch, dynamic} tip280 { reduce [foo::bar] } {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo unset x # ------------------------------------------------------------------------- set body { proc ::foo::bar {} {info frame 0} } namespace eval foo {} eval $body test info-32.0 {info frame, dynamic procedure} tip280 { reduce [foo::bar] } {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0} namespace delete foo # ------------------------------------------------------------------------- # cleanup catch {namespace delete test_ns_info1 test_ns_info2} ::tcltest::cleanupTests return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	# Functionality covered: this file contains a collection of tests for the # auto loading and namespaces. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1997 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. # # RCS: @(#) $Id: init.test,v 1.9 2002/06/05 01:12:38 dgp Exp $ # RCS: @(#) $Id: init.test,v 1.9.2.2 2004/10/26 20:14:36 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } # Clear out any namespaces called test_ns_*
︙
63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80	63 64 65 66 67 68 69 70 71 72 73 74 75 76	- - - -	set testInterp [interp create] interp eval $testInterp [list set argv $argv] interp eval $testInterp [list package require tcltest] interp eval $testInterp [list namespace import -force ::tcltest::*] interp eval $testInterp { if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest } auto_reset catch {rename parray {}} test init-2.0 {load parray - stage 1} { set ret [catch {parray} error] rename parray {} ; # remove it, for the next test - that should not fail. list $ret $error
︙
125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184	121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180	+ + - + - - - + + - - - - + + + - - + - + + - +	test init-2.7 {oad setLogCmd from safe:: - stage 2} { namespace eval safe setLogCmd rename ::safe::setLogCmd {} ; # should not fail } {} test init-2.8 {load tcl::HistAdd} -setup { auto_reset auto_reset package require http 2.0 catch {rename ::http::geturl {}} catch {rename ::tcl::HistAdd {}} } -body { test init-2.8 {load http::geturl (package)} { # 3 ':' on purpose set ret [catch {http:::geturl} error] # removing it, for the next test. should not fail. rename ::http::geturl {} ; list [catch {tcl:::HistAdd} error] $error } -cleanup { rename ::tcl::HistAdd {} ; list $ret $error } {1 {wrong # args: should be "http:::geturl url args"}} } -result {1 {wrong # args: should be "tcl:::HistAdd command ?exec?"}} test init-3.0 {random stuff in the auto_index, should still work} { set auto_index(foo:::bar::blah) { namespace eval foo {namespace eval bar {proc blah {} {return 1}}} } foo:::bar::blah } 1 # Tests that compare the error stack trace generated when autoloading # with that generated when no autoloading is necessary. Ideally they # should be the same. set count 0 foreach arg { foreach arg [subst -nocommands -novariables { c {argument which spans multiple lines} {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack} {argument which spans multiple lines and is long enough to be truncated and " <- includes a false lead in the prune point search and must be longer still to force truncation} {contrived example: rare circumstance where the point at which to prune the error stack cannot be uniquely determined. foo bar foo "} {contrived example: rare circumstance where the point at which to prune the error stack cannot be uniquely determined. foo bar "} {argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library} } { }] { test init-4.$count.0 {::errorInfo produced by [unknown]} { auto_reset catch {parray a b $arg} set first $::errorInfo catch {parray a b $arg} set second $::errorInfo
︙
196 197 198 199 200 201 202 203 204 205 206 207 208 209	192 193 194 195 196 197 198 199 200 201 202 203 204 205 206	+	set second $::errorInfo string equal $first $second } 1 incr count } cleanupTests } ;# End of [interp eval $testInterp] # cleanup interp delete $testInterp ::tcltest::cleanupTests return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	- + - +	# This file tests the multiple interpreter facility of Tcl # # 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) 1995-1996 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. # # RCS: @(#) $Id: interp.test,v 1.19 2003/02/05 20:05:47 mdejong Exp $ # RCS: @(#) $Id: interp.test,v 1.19.2.6 2004/10/28 00:01:07 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest package require tcltest 2.1 namespace import -force ::tcltest::* } # The set of hidden commands is platform dependent: if {"$tcl_platform(platform)" == "macintosh"} { set hidden_cmds {beep cd echo encoding exit fconfigure file glob load ls open pwd socket source}
︙
114 115 116 117 118 119 120 121 122 123 124 125 126 127	114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130	+ + +	regexp "interp(\[0-9]+)" $x dummy thenum interp delete $x proc interp$thenum {} {} set x [interp create -safe] regexp "interp(\[0-9]+)" $x dummy anothernum expr $anothernum - $thenum } 1 test interp-2.13 {correct default when no $path arg is given} -body { interp create -- } -match regexp -result {interp[0-9]+} foreach i [interp slaves] { interp delete $i } # Part 2: Testing "interp slaves" and "interp exists" test interp-3.1 {testing interp exists and interp slaves} {
︙
292 293 294 295 296 297 298 299 300 301 302 303 304 305	295 296 297 298 299 300 301 302 303 304 305 306 307 308 309	+	proc nonexistent-command-in-master {} {return i_exist!} a eval zop } i_exist! test interp-9.3 {testing aliases for hidden commands} { catch {interp create a} a eval {proc p {} {return ENTER_A}} interp alias {} p a p set res {} lappend res [list [catch p msg] $msg] interp hide a p lappend res [list [catch p msg] $msg] rename p {} interp delete a set res } {{0 ENTER_A} {1 {invalid command name "p"}}}
︙
752 753 754 755 756 757 758 759 760 761 762 763 764 765	756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779	+ + + + + + + + + +	} } interp alias {a b} dela {} dela proc dela {} {interp delete a} list [catch {a eval foo} msg] $msg } {1 {attempt to call eval in deleted interpreter}} } test interp-18.9 {eval in deleted interp, bug 495830} {knownBug} { interp create tst interp alias tst suicide {} interp delete tst list [catch {tst eval {suicide; set a 5}} msg] $msg } {1 {attempt to call eval in deleted interpreter}} test interp-18.10 {eval in deleted interp, bug 495830} { interp create tst interp alias tst suicide {} interp delete tst list [catch {tst eval {set set set; suicide; $set a 5}} msg] $msg } {1 {attempt to call eval in deleted interpreter}} # Test alias deletion test interp-19.1 {alias deletion} { catch {interp delete a} interp create a interp alias a foo a bar
︙
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	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	- + - + - +	a eval { namespace eval foo {} proc foo::x {} {} } set l [list [catch {interp hide a foo::x} msg] $msg] interp delete a set l } {1 {cannot use namespace qualifiers as hidden commandtoken (rename)}} } {1 {cannot use namespace qualifiers in hidden command token (rename)}} test interp-20.46 {interp hide vs namespaces} { catch {interp delete a} interp create a a eval { namespace eval foo {} proc foo::x {} {} } set l [list [catch {interp hide a foo::x x} msg] $msg] interp delete a set l } {1 {can only hide global namespace commands (use rename then hide)}} test interp-20.47 {interp hide vs namespaces} { catch {interp delete a} interp create a a eval { proc x {} {} } set l [list [catch {interp hide a x foo::x} msg] $msg] interp delete a set l } {1 {cannot use namespace qualifiers as hidden commandtoken (rename)}} } {1 {cannot use namespace qualifiers in hidden command token (rename)}} test interp-20.48 {interp hide vs namespaces} { catch {interp delete a} interp create a a eval { namespace eval foo {} proc foo::x {} {} } set l [list [catch {interp hide a foo::x bar::x} msg] $msg] interp delete a set l } {1 {cannot use namespace qualifiers as hidden commandtoken (rename)}} } {1 {cannot use namespace qualifiers in hidden command token (rename)}} test interp-21.1 {interp hidden} { interp hidden {} } "" test interp-21.2 {interp hidden} { interp hidden } ""
︙
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 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948	+ + + + + + + + + +	cd .. file delete cwd_test interp delete $i cd [workingDirectory] expr {[string equal $parent $child] ? 1 : "\{$parent\} != \{$child\}"} } 1 test interp-33.1 {refCounting for target words of alias [Bug 730244]} { # This test will panic if Bug 730244 is not fixed. set i [interp create] proc testHelper args {rename testHelper {}; return $args} # Note: interp names are simple words by default trace add execution testHelper enter "interp alias $i alias {} ;#" interp alias $i alias {} testHelper this $i eval alias } this # cleanup foreach i [interp slaves] { interp delete $i } ::tcltest::cleanupTests return

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	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	+ - + + + + - - -	# -*- tcl -*- # Functionality covered: operation of all IO commands, and all procedures # defined in generic/tclIO.c. # # 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-1994 The Regents of the University of California. # Copyright (c) 1994-1997 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. # # RCS: @(#) $Id: io.test,v 1.40 2003/02/25 22:03:38 andreas_kupries Exp $ # RCS: @(#) $Id: io.test,v 1.40.2.12 2007/02/12 19:25:42 andreas_kupries Exp $ if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." return } namespace eval ::tcl::test::io { namespace import ::tcltest::cleanupTests namespace import ::tcltest::interpreter namespace import ::tcltest::makeFile namespace import ::tcltest::removeFile namespace import ::tcltest::test namespace import ::tcltest::testConstraint namespace import ::tcltest::viewFile testConstraint testchannel [llength [info commands testchannel]] testConstraint exec [llength [info commands exec]] testConstraint openpipe 1 testConstraint fileevent [llength [info commands fileevent]] testConstraint fcopy [llength [info commands fcopy]] # You need a *very* special environment to do some tests. In # particular, many file systems do not support large-files... testConstraint largefileSupport 0 removeFile test1 removeFile pipe # set up a long data file for some of the following tests set path(longfile) [makeFile {} longfile] set f [open $path(longfile) w] fconfigure $f -eofchar {} -translation lf for { set i 0 } { $i < 100 } { incr i} { puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef
︙
111 112 113 114 115 116 117 118 119 120 121 122 123 124	112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	set f [open $path(test2) w] fconfigure $f -encoding iso2022-jp puts -nonewline $f [format %s%c [string repeat " " 4] 12399] close $f contents $path(test2) } " \x1b\$B\$O\x1b(B" test io-1.9 {Tcl_WriteChars: WriteChars} { # When closing a channel with an encoding that appends # escape bytes, check for the case where the escape # bytes overflow the current IO buffer. The bytes # should be moved into a new buffer. set data "1234567890 [format %c 12399]" set sizes [list] # With default buffer size set f [open $path(test2) w] fconfigure $f -encoding iso2022-jp puts -nonewline $f $data close $f lappend sizes [file size $path(test2)] # With buffer size equal to the length # of the data, the escape bytes would # go into the next buffer. set f [open $path(test2) w] fconfigure $f -encoding iso2022-jp -buffersize 16 puts -nonewline $f $data close $f lappend sizes [file size $path(test2)] # With buffer size that is large enough # to hold 1 byte of escaped data, but # not all 3. This should not write # the escape bytes to the first buffer # and then again to the second buffer. set f [open $path(test2) w] fconfigure $f -encoding iso2022-jp -buffersize 17 puts -nonewline $f $data close $f lappend sizes [file size $path(test2)] # With buffer size that can hold 2 out of # 3 bytes of escaped data. set f [open $path(test2) w] fconfigure $f -encoding iso2022-jp -buffersize 18 puts -nonewline $f $data close $f lappend sizes [file size $path(test2)] # With buffer size that can hold all the # data and escape bytes. set f [open $path(test2) w] fconfigure $f -encoding iso2022-jp -buffersize 19 puts -nonewline $f $data close $f lappend sizes [file size $path(test2)] set sizes } {19 19 19 19 19} test io-2.1 {WriteBytes} { # loop until all bytes are written set f [open $path(test1) w] fconfigure $f -encoding binary -buffersize 16 -translation crlf puts $f "abcdefghijklmnopqrstuvwxyz"
︙
403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420	464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481	- + - +	puts $f hi close $f set f [open $path(test1)] set x [list [gets $f line] $line] close $f set x } [list 256 $a] test io-6.7 {Tcl_GetsObj: error in input} {stdio} { test io-6.7 {Tcl_GetsObj: error in input} {stdio openpipe} { # if (FilterInputBytes(chanPtr, &gs) != 0) set f [open "|[list [interpreter] cat]" w+] set f [open "|[list [interpreter] $path(cat)]" w+] puts -nonewline $f "hi\nwould" flush $f gets $f fconfigure $f -blocking 0 set x [gets $f line] close $f set x
︙
665 666 667 668 669 670 671 672 673 674 675 676 677 678 679	726 727 728 729 730 731 732 733 734 735 736 737 738 739 740	- +	close $f set f [open $path(test1)] fconfigure $f -translation crlf -buffersize 16 set x [list [gets $f line] $line [testchannel inputbuffered $f]] close $f set x } [list 15 "123456789012345" 15] test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel} { test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel openpipe fileevent} { # (FilterInputBytes() != 0) set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {crlf lf} -buffering none puts -nonewline $f "bbbbbbbbbbbbbb\r\n123456789012345\r" fconfigure $f -buffersize 16 set x [gets $f]
︙
804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869	865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930	- + - + - + - +	set f [open $path(test1)] fconfigure $f -translation auto set x [list [gets $f line] $line [gets $f line] $line] lappend x [gets $f line] $line [gets $f line] $line [gets $f line] $line close $f set x } [list 4 "abcd" 4 "efgh" 4 "ijkl" 4 "mnop" -1 ""] test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel} { test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent} { # if (chanPtr->flags & INPUT_SAW_CR) set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto lf} -buffering none puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 set x [list [gets $f]] fconfigure $f -blocking 0 lappend x [gets $f line] $line [testchannel queuedcr $f] fconfigure $f -blocking 1 puts -nonewline $f "\nabcd\refg\x1a" lappend x [gets $f line] $line [testchannel queuedcr $f] lappend x [gets $f line] $line close $f set x } [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"] test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel} { test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel openpipe fileevent} { # not (*eol == '\n') set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto lf} -buffering none puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 set x [list [gets $f]] fconfigure $f -blocking 0 lappend x [gets $f line] $line [testchannel queuedcr $f] fconfigure $f -blocking 1 puts -nonewline $f "abcd\refg\x1a" lappend x [gets $f line] $line [testchannel queuedcr $f] lappend x [gets $f line] $line close $f set x } [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"] test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel} { test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel openpipe fileevent} { # Tcl_ExternalToUtf() set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto lf} -buffering none fconfigure $f -encoding unicode puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 gets $f fconfigure $f -blocking 0 set x [list [gets $f line] $line [testchannel queuedcr $f]] fconfigure $f -blocking 1 puts -nonewline $f "\nabcd\refg" lappend x [gets $f line] $line [testchannel queuedcr $f] close $f set x } [list 15 "123456789abcdef" 1 4 "abcd" 0] test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel} { test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel openpipe fileevent} { # memmove() set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto lf} -buffering none puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 gets $f
︙
980 981 982 983 984 985 986 987 988 989 990 991 992 993 994	1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055	- +	close $f set f [open $path(test1)] fconfigure $f -encoding iso2022-jp set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line] close $f set x } [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"] test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio} { test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio openpipe fileevent} { update set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -buffering none puts -nonewline $f "foobar" fconfigure $f -blocking 0 variable x {} after 500 [namespace code { lappend x timeout }]
︙
1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054	1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115	- +	fconfigure $f -encoding shiftjis set x [list [gets $f line] $line] lappend x [tell $f] [testchannel inputbuffered $f] [eof $f] lappend x [gets $f line] $line close $f set x } [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""] test io-7.4 {FilterInputBytes: recover from split up character} {stdio} { test io-7.4 {FilterInputBytes: recover from split up character} {stdio openpipe fileevent} { set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -encoding binary -buffering none puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82" fconfigure $f -encoding shiftjis -blocking 0 fileevent $f read [namespace code "ready $f"] variable x {} proc ready {f} {
︙
1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109	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	- + - +	fconfigure $f -encoding ascii -translation auto -buffersize 16 # here gets $f set x [testchannel inputbuffered $f] close $f set x } "7" test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel} { test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel openpipe fileevent} { # not (bufPtr->nextPtr == NULL) set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation lf -encoding ascii -buffering none puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz" variable x {} fileevent $f read [namespace code "ready $f"] proc ready {f} { variable x lappend x [gets $f line] $line [testchannel inputbuffered $f] } fconfigure $f -encoding unicode -buffersize 16 -blocking 0 vwait [namespace which -variable x] fconfigure $f -translation auto -encoding ascii -blocking 1 # here vwait [namespace which -variable x] close $f set x } [list -1 "" 42 15 "123456789012345" 25] test io-8.3 {PeekAhead: no cached data available} {stdio testchannel} { test io-8.3 {PeekAhead: no cached data available} {stdio testchannel openpipe fileevent} { # (bytesLeft == 0) set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto binary} puts -nonewline $f "abcdefghijklmno\r" flush $f set x [list [gets $f line] $line [testchannel queuedcr $f]]
︙
1128 1129 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	1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227	- + - + - +	# that cached data is available in buffer w/o having to call driver. set x [gets $f] close $f set x } $a unset a test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel} { test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} { # (bufPtr->nextAdded < bufPtr->length) set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto binary} puts -nonewline $f "abcdefghijklmno\r" flush $f # here set x [list [gets $f line] $line [testchannel queuedcr $f]] close $f set x } {15 abcdefghijklmno 1} test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel} { test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} { # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto binary} -buffersize 16 puts -nonewline $f "abcdefghijklmno\r" flush $f # here set x [list [gets $f line] $line [testchannel queuedcr $f]] close $f set x } {15 abcdefghijklmno 1} test io-8.7 {PeekAhead: cleanup} {stdio testchannel} { test io-8.7 {PeekAhead: cleanup} {stdio testchannel openpipe fileevent} { # Make sure bytes are removed from buffer. set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto binary} -buffering none puts -nonewline $f "abcdefghijklmno\r" # here set x [list [gets $f line] $line [testchannel queuedcr $f]]
︙
1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332	1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393	- +	set f [open $path(test1)] fconfigure $f -buffersize 16 # here set x [read $f] close $f set x } {abcdefghijklmnopqrstuvwxyz} test io-12.4 {ReadChars: split-up char} {stdio testchannel} { test io-12.4 {ReadChars: split-up char} {stdio testchannel openpipe fileevent} { # (srcRead == 0) set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -encoding binary -buffering none -buffersize 16 puts -nonewline $f "123456789012345\x96" fconfigure $f -encoding shiftjis -blocking 0
︙
1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357	1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418	- +	puts -nonewline $f "\x7b" after 500 ;# Give the cat process time to catch up fconfigure $f -encoding shiftjis -blocking 0 vwait [namespace which -variable x] close $f set x } [list "123456789012345" 1 "\u672c" 0] test io-12.5 {ReadChars: fileevents on partial characters} {stdio} { test io-12.5 {ReadChars: fileevents on partial characters} {stdio openpipe fileevent} { set path(test1) [makeFile { fconfigure stdout -encoding binary -buffering none gets stdin; puts -nonewline "\xe7" gets stdin; puts -nonewline "\x89" gets stdin; puts -nonewline "\xa6" } test1] set f [open "|[list [interpreter] $path(test1)]" r+]
︙
1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452	1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513	- +	close $f set f [open $path(test1)] fconfigure $f -translation crlf set x [read $f] close $f set x } "abcd\ndef\nfgh" test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel} { test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel openpipe fileevent} { # (chanPtr->flags & INPUT_SAW_CR) # This test may fail on slower machines. set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -blocking 0 -buffering none -translation {auto lf} fileevent $f read [namespace code "ready $f"]
︙
1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478	1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539	- +	puts -nonewline $f "\n01234" after 500 [namespace code {set y ok}] vwait [namespace which -variable y] close $f set x } [list "abcdefghj\n" 1 "01234" 0] test io-13.7 {TranslateInputEOL: auto mode: naked \r} {testchannel} { test io-13.7 {TranslateInputEOL: auto mode: naked \r} {testchannel openpipe} { # (src >= srcMax) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "abcd\r" close $f set f [open $path(test1)]
︙
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	1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696	- + - + - - - - + + + + + - + - + - - - - + + + + + - +	lappend l [x eval {fconfigure stderr -buffering}] interp delete x set l } {line line none} set path(test3) [makeFile {} test3] test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec} { test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec openpipe} { set f [open $path(test1) w] puts $f [format { puts -nonewline $f { close stdin close stdout close stderr set f [open "%s" r] set f2 [open "%s" w] set f3 [open "%s" w] puts stdout [gets stdin] set f [} puts $f [list open $path(test1) r]] puts $f "set f2 \[[list open $path(test2) w]]" puts $f "set f3 \[[list open $path(test3) w]]" puts $f { puts stdout [gets stdin] puts stdout out puts stderr err close $f close $f2 close $f3 } $path(test1) $path(test2) $path(test3)] } close $f set result [exec [interpreter] $path(test1)] set f [open $path(test2) r] set f2 [open $path(test3) r] lappend result [read $f] [read $f2] close $f close $f2 set result } {{ out } {err }} # This test relies on the fact that the smallest available fd is used first. test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec unixOnly} { set f [open $path(test1) w] puts $f [format { close stdin puts -nonewline $f { close stdin close stdout close stderr set f [open "%s" r] set f2 [open "%s" w] set f3 [open "%s" w] puts stdout [gets stdin] set f [} puts $f [list open $path(test1) r]] puts $f "set f2 \[[list open $path(test2) w]]" puts $f "set f3 \[[list open $path(test3) w]]" puts $f { puts stdout [gets stdin] puts stdout $f2 puts stderr $f3 close $f close $f2 close $f3 } $path(test1) $path(test2) $path(test3)] } close $f set result [exec [interpreter] $path(test1)] set f [open $path(test2) r] set f2 [open $path(test3) r] lappend result [read $f] [read $f2] close $f close $f2
︙
1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715	1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788	- - - + + + - + - + + + - + + + - + - - - + + + + + + + + +	set result [list $msg1 $msg2 $msg3] interp delete z set result } {{} {} {can not find channel named "stderr"}} set path(script) [makeFile {} script] test io-14.8 {reuse of stdio special channels} {stdio} { removeFile script removeFile test1 test io-14.8 {reuse of stdio special channels} {stdio openpipe} { file delete $path(script) file delete $path(test1) set f [open $path(script) w] puts $f [format { puts -nonewline $f { close stderr set f [open "%s" w] set f [} puts $f [list open $path(test1) w]] puts -nonewline $f { puts stderr hello close $f set f [open "%s" r] set f [} puts $f [list open $path(test1) r]] puts $f { puts [gets $f] } $path(test1) $path(test1)] } close $f set f [open "|[list [interpreter] $path(script)]" r] set c [gets $f] close $f set c } hello test io-14.9 {reuse of stdio special channels} {stdio} { removeFile script removeFile test1 test io-14.9 {reuse of stdio special channels} {stdio openpipe fileevent} { file delete $path(script) file delete $path(test1) set f [open $path(script) w] puts $f { array set path [lindex $argv 0] set f [open $path(test1) w] puts $f hello close $f close stderr set f [open "|[list [info nameofexecutable] $path(cat) $path(test1)]" r] puts [gets $f] } close $f set f [open "|[list [interpreter] $path(script) [array get path]]" r] set c [gets $f] close $f # Added delay to give Windows time to stop the spawned process and clean # up its grip on the file test1. Added delete as proper test cleanup. # The failing tests were 18.1 and 18.2 as first re-users of file "test1". after 10000 file delete $path(script) file delete $path(test1) set c } hello test io-15.1 {Tcl_CreateCloseHandler} { } {} test io-16.1 {Tcl_DeleteCloseHandler} {
︙
1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805	1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878	- + - + - +	lappend l [expr [testchannel refcount stderr] - $l1] interp delete x lappend l [expr [testchannel refcount stderr] - $l1] set l } {0 1 0} test io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} { removeFile test1 file delete $path(test1) set l "" set f [open $path(test1) w] lappend l [lindex [testchannel info $f] 15] close $f if {[catch {lindex [testchannel info $f] 15} msg]} { lappend l $msg } else { lappend l "very broken: $f found after being closed" } string compare [string tolower $l] \ [list 1 [format "can not find channel named \"%s\"" $f]] } 0 test io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} { removeFile test1 file delete $path(test1) set l "" set f [open $path(test1) w] lappend l [lindex [testchannel info $f] 15] interp create x interp share "" $f x lappend l [lindex [testchannel info $f] 15] x eval close $f lappend l [lindex [testchannel info $f] 15] interp delete x lappend l [lindex [testchannel info $f] 15] close $f if {[catch {lindex [testchannel info $f] 15} msg]} { lappend l $msg } else { lappend l "very broken: $f found after being closed" } string compare [string tolower $l] \ [list 1 2 1 1 [format "can not find channel named \"%s\"" $f]] } 0 test io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} { removeFile test1 file delete $path(test1) set l "" set f [open $path(test1) w] lappend l [lindex [testchannel info $f] 15] interp create x interp share "" $f x lappend l [lindex [testchannel info $f] 15] interp delete x
︙
1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838	1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911	- + - +	[list 1 2 1 [format "can not find channel named \"%s\"" $f]] } 0 test io-19.1 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} { eof stdin } 0 test io-19.2 {testing Tcl_GetChannel, user opened handle} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] set x [eof $f] close $f set x } 0 test io-19.3 {Tcl_GetChannel, channel not found} { list [catch {eof file34} msg] $msg } {1 {can not find channel named "file34"}} test io-19.4 {Tcl_CreateChannel, insertion into channel table} {testchannel} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] set l "" lappend l [eof $f] close $f if {[catch {lindex [testchannel info $f] 15} msg]} { lappend l $msg } else {
︙
1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 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	1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 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 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122	- + - + - + + + - + - + - + - + - + - + - + - + - + - + - + - - - + + + + - + - - +	set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]] close $f set x } {{{} {}} {auto cr}} set path(stdout) [makeFile {} stdout] test io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio} { test io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio openpipe} { set f [open $path(script) w] puts $f [format { puts -nonewline $f { close stdout set f1 [open "%s" w] set f1 [} puts $f [list open $path(stdout) w]] puts $f { fconfigure $f1 -buffersize 777 puts stderr [fconfigure stdout -buffersize] } $path(stdout)] } close $f set f [open "|[list [interpreter] $path(script)]"] catch {close $f} msg set msg } {777} test io-21.1 {CloseChannelsOnExit} { } {} # Test management of attributes associated with a channel, such as # its default translation, its name and type, etc. The functions # tested in this group are Tcl_GetChannelName, # Tcl_GetChannelType and Tcl_GetChannelFile. Tcl_GetChannelInstanceData # not tested because files do not use the instance data. test io-22.1 {Tcl_GetChannelMode} { # Not used anywhere in Tcl. } {} test io-23.1 {Tcl_GetChannelName} {testchannel} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] set n [testchannel name $f] close $f string compare $n $f } 0 test io-24.1 {Tcl_GetChannelType} {testchannel} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] set t [testchannel type $f] close $f string compare $t file } 0 test io-25.1 {Tcl_GetChannelHandle, input} {testchannel} { set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} puts $f "1234567890\n098765432" close $f set f [open $path(test1) r] gets $f set l "" lappend l [testchannel inputbuffered $f] lappend l [tell $f] close $f set l } {10 11} test io-25.2 {Tcl_GetChannelHandle, output} {testchannel} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello set l "" lappend l [testchannel outputbuffered $f] lappend l [tell $f] flush $f lappend l [testchannel outputbuffered $f] lappend l [tell $f] close $f removeFile test1 file delete $path(test1) set l } {6 6 0 6} test io-26.1 {Tcl_GetChannelInstanceData} {stdio} { test io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} { # "pid" command uses Tcl_GetChannelInstanceData # Don't care what pid is (but must be a number), just want to exercise it. set f [open "|[list [interpreter] << exit]"] expr [pid $f] close $f } {} # Test flushing. The functions tested here are FlushChannel. test io-27.1 {FlushChannel, no output buffered} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] flush $f set s [file size $path(test1)] close $f set s } 0 test io-27.2 {FlushChannel, some output buffered} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set l "" puts $f hello lappend l [file size $path(test1)] flush $f lappend l [file size $path(test1)] close $f lappend l [file size $path(test1)] set l } {0 6 6} test io-27.3 {FlushChannel, implicit flush on close} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set l "" puts $f hello lappend l [file size $path(test1)] close $f lappend l [file size $path(test1)] set l } {0 6} test io-27.4 {FlushChannel, implicit flush when buffer fills} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} fconfigure $f -buffersize 60 set l "" lappend l [file size $path(test1)] for {set i 0} {$i < 12} {incr i} { puts $f hello } lappend l [file size $path(test1)] flush $f lappend l [file size $path(test1)] close $f set l } {0 60 72} test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \ {unixOrPc} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffersize 60 -eofchar {} set l "" lappend l [file size $path(test1)] for {set i 0} {$i < 12} {incr i} { puts $f hello } lappend l [file size $path(test1)] close $f lappend l [file size $path(test1)] set l } {0 60 72} set path(pipe) [makeFile {} pipe] set path(output) [makeFile {} output] test io-27.6 {FlushChannel, async flushing, async close} \ {stdio asyncPipeClose } { removeFile pipe removeFile output {stdio asyncPipeClose openpipe} { file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f "set f \[[list open $path(output) w]]" puts $f [format { puts $f { set f [open "%s" w] fconfigure $f -translation lf -buffering none -eofchar {} while {![eof stdin]} { after 20 puts -nonewline $f [read stdin 1024] } close $f } $path(output)] } close $f set x 01234567890123456789012345678901 for {set i 0} {$i < 11} {incr i} { set x "$x$x" } set f [open $path(output) w] close $f
︙
2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105	2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180	- + - + - - - + + +	set result ok } } ok # Tests closing a channel. The functions tested are CloseChannel and Tcl_Close. test io-28.1 {CloseChannel called when all references are dropped} {testchannel} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] interp create x interp share "" $f x set l "" lappend l [testchannel refcount $f] x eval close $f interp delete x lappend l [testchannel refcount $f] close $f set l } {2 1} test io-28.2 {CloseChannel called when all references are dropped} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] interp create x interp share "" $f x puts -nonewline $f abc close $f x eval puts $f def x eval close $f interp delete x set f [open $path(test1) r] set l [gets $f] close $f set l } abcdef test io-28.3 {CloseChannel, not called before output queue is empty} \ {stdio asyncPipeClose nonPortable} { removeFile pipe removeFile output {stdio asyncPipeClose nonPortable openpipe} { file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f { # Need to not have eof char appended on close, because the other # side of the pipe already closed, so that writing would cause an # error "invalid file".
︙
2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 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	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 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330	- + - - + + - + - + - + - + - + - + - +	if {$counter == 1000} { set result probably_broken } else { set result ok } } ok test io-28.4 {Tcl_Close} {testchannel} { removeFile test1 file delete $path(test1) set l "" lappend l [lsort [testchannel open]] set f [open $path(test1) w] lappend l [lsort [testchannel open]] close $f lappend l [lsort [testchannel open]] set x [list $consoleFileNames \ [lsort [eval list $consoleFileNames $f]] \ $consoleFileNames] string compare $l $x } 0 test io-28.5 {Tcl_Close vs standard handles} {stdio unixOnly testchannel} { removeFile script test io-28.5 {Tcl_Close vs standard handles} {stdio unixOnly testchannel openpipe} { file delete $path(script) set f [open $path(script) w] puts $f { close stdin puts [testchannel open] } close $f set f [open "|[list [interpreter] $path(script)]" r] set l [gets $f] close $f set l } {file1 file2} test io-29.1 {Tcl_WriteChars, channel not writable} { list [catch {puts stdin hello} msg] $msg } {1 {channel "stdin" wasn't opened for writing}} test io-29.2 {Tcl_WriteChars, empty string} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -eofchar {} puts -nonewline $f "" close $f file size $path(test1) } 0 test io-29.3 {Tcl_WriteChars, nonempty string} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -eofchar {} puts -nonewline $f hello close $f file size $path(test1) } 5 test io-29.4 {Tcl_WriteChars, buffering in full buffering mode} {testchannel} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffering full -eofchar {} puts $f hello set l "" lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] flush $f lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] close $f set l } {6 0 0 6} test io-29.5 {Tcl_WriteChars, buffering in line buffering mode} {testchannel} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffering line -eofchar {} puts -nonewline $f hello set l "" lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] close $f set l } {5 0 0 11} test io-29.6 {Tcl_WriteChars, buffering in no buffering mode} {testchannel} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffering none -eofchar {} puts -nonewline $f hello set l "" lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] close $f set l } {0 5 0 11} test io-29.7 {Tcl_Flush, full buffering} {testchannel} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffering full -eofchar {} puts -nonewline $f hello set l "" lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] flush $f lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] close $f set l } {5 0 11 0 0 11} test io-29.8 {Tcl_Flush, full buffering} {testchannel} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffering line puts -nonewline $f hello set l "" lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] flush $f
︙
2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328	2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403	- + - + - - - + + + + - + - - + - - - + + +	close $f set l } {5 0 0 5 0 11 0 11} test io-29.9 {Tcl_Flush, channel not writable} { list [catch {flush stdin} msg] $msg } {1 {channel "stdin" wasn't opened for writing}} test io-29.10 {Tcl_WriteChars, looping and buffering} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} set f2 [open $path(longfile) r] for {set x 0} {$x < 10} {incr x} { puts $f1 [gets $f2] } close $f2 close $f1 file size $path(test1) } 387 test io-29.11 {Tcl_WriteChars, no newline, implicit flush} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -eofchar {} set f2 [open $path(longfile) r] for {set x 0} {$x < 10} {incr x} { puts -nonewline $f1 [gets $f2] } close $f1 close $f2 file size $path(test1) } 377 test io-29.12 {Tcl_WriteChars on a pipe} {stdio} { removeFile test1 removeFile pipe test io-29.12 {Tcl_WriteChars on a pipe} {stdio openpipe} { file delete $path(test1) file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 "set f1 \[[list open $path(longfile) r]]" puts $f1 [format { puts $f1 { set f1 [open "%s" r] for {set x 0} {$x < 10} {incr x} { puts [gets $f1] } } $path(longfile)] } close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r] set f2 [open $path(longfile) r] set y ok for {set x 0} {$x < 10} {incr x} { set l1 [gets $f1] set l2 [gets $f2] if {"$l1" != "$l2"} { set y broken } } close $f1 close $f2 set y } ok test io-29.13 {Tcl_WriteChars to a pipe, line buffered} {stdio} { removeFile test1 removeFile pipe test io-29.13 {Tcl_WriteChars to a pipe, line buffered} {stdio openpipe} { file delete $path(test1) file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 { puts [gets stdin] puts [gets stdin] } close $f1 set y ok
︙
2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 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 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466	2417 2418 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 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541	- + - + - + - + - + - + - + - - + + - - + +	set y broken } close $f1 close $f2 set y } ok test io-29.14 {Tcl_WriteChars, buffering and implicit flush at close} { removeFile test3 file delete $path(test3) set f [open $path(test3) w] puts -nonewline $f "Text1" puts -nonewline $f " Text 2" puts $f " Text 3" close $f set f [open $path(test3) r] set x [gets $f] close $f set x } {Text1 Text 2 Text 3} test io-29.15 {Tcl_Flush, channel not open for writing} { removeFile test1 file delete $path(test1) set fd [open $path(test1) w] close $fd set fd [open $path(test1) r] set x [list [catch {flush $fd} msg] $msg] close $fd string compare $x \ [list 1 "channel \"$fd\" wasn't opened for writing"] } 0 test io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio} { test io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio openpipe} { set fd [open "|[list [interpreter] cat longfile]" r] set x [list [catch {flush $fd} msg] $msg] catch {close $fd} string compare $x \ [list 1 "channel \"$fd\" wasn't opened for writing"] } 0 test io-29.17 {Tcl_WriteChars buffers, then Tcl_Flush flushes} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf puts $f1 hello puts $f1 hello puts $f1 hello flush $f1 set x [file size $path(test1)] close $f1 set x } 18 test io-29.18 {Tcl_WriteChars and Tcl_Flush intermixed} { removeFile test1 file delete $path(test1) set x "" set f1 [open $path(test1) w] fconfigure $f1 -translation lf puts $f1 hello puts $f1 hello puts $f1 hello flush $f1 lappend x [file size $path(test1)] puts $f1 hello flush $f1 lappend x [file size $path(test1)] puts $f1 hello flush $f1 lappend x [file size $path(test1)] close $f1 set x } {18 24 30} test io-29.19 {Explicit and implicit flushes} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} set x "" puts $f1 hello puts $f1 hello puts $f1 hello flush $f1 lappend x [file size $path(test1)] puts $f1 hello flush $f1 lappend x [file size $path(test1)] puts $f1 hello close $f1 lappend x [file size $path(test1)] set x } {18 24 30} test io-29.20 {Implicit flush when buffer is full} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} set line "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" for {set x 0} {$x < 100} {incr x} { puts $f1 $line } set z "" lappend z [file size $path(test1)] for {set x 0} {$x < 100} {incr x} { puts $f1 $line } lappend z [file size $path(test1)] close $f1 lappend z [file size $path(test1)] set z } {4096 12288 12600} test io-29.21 {Tcl_Flush to pipe} {stdio} { removeFile pipe test io-29.21 {Tcl_Flush to pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {set x [read stdin 6]} puts $f1 {set cnt [string length $x]} puts $f1 {puts "read $cnt characters"} close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] puts $f1 hello flush $f1 set x [gets $f1] catch {close $f1} set x } "read 6 characters" test io-29.22 {Tcl_Flush called at other end of pipe} {stdio} { removeFile pipe test io-29.22 {Tcl_Flush called at other end of pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 { fconfigure stdout -buffering full puts hello puts hello flush stdout gets stdin
︙
2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489	2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564	- - + +	lappend x [gets $f1] puts $f1 hello flush $f1 lappend x [gets $f1] close $f1 set x } {hello hello bye} test io-29.23 {Tcl_Flush and line buffering at end of pipe} {stdio} { removeFile pipe test io-29.23 {Tcl_Flush and line buffering at end of pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 { puts hello puts hello gets stdin puts bye }
︙
2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544	2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619	- - + + - + - - + +	flush $f set f2 [open $path(test3)] lappend x [read -nonewline $f2] close $f2 close $f set x } "{} {Line 1\nLine 2}" test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio} { removeFile test3 test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio openpipe fileevent} { file delete $path(test3) set f [open "|[list [interpreter] $path(cat) | [interpreter] $path(cat) > $path(test3)]" w] puts $f "Line 1" puts $f "Line 2" close $f after 100 set f [open $path(test3) r] set x [read $f] close $f set x } "Line 1\nLine 2\n" test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs} { test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs openpipe} { set f [open "|[list cat -u]" r+] puts $f "Line1" flush $f set x [gets $f] close $f set x } {Line1} test io-29.27 {Tcl_Flush on closed pipeline} {stdio} { removeFile pipe test io-29.27 {Tcl_Flush on closed pipeline} {stdio openpipe} { file delete $path(pipe) set f [open $path(pipe) w] puts $f {exit} close $f set f [open "|[list [interpreter] $path(pipe)]" r+] gets $f puts $f output after 50
︙
2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601	2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 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	- + - + - + - - - + + + - +	set x {this was supposed to fail and did not} } } regsub {".*":} $x {"":} x string tolower $x } {1 {error flushing "": broken pipe} {posix epipe {broken pipe}}} test io-29.28 {Tcl_WriteChars, lf mode} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} puts $f hello\nthere\nand\nhere flush $f set s [file size $path(test1)] close $f set s } 21 test io-29.29 {Tcl_WriteChars, cr mode} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} puts $f hello\nthere\nand\nhere close $f file size $path(test1) } 21 test io-29.30 {Tcl_WriteChars, crlf mode} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar {} puts $f hello\nthere\nand\nhere close $f file size $path(test1) } 25 test io-29.31 {Tcl_WriteChars, background flush} {stdio} { removeFile pipe removeFile output test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} { file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f [format {set f [open "%s" w]} $path(output)] puts $f "set f \[[list open $path(output) w]]" puts $f {fconfigure $f -translation lf} set x [list while {![eof stdin]}] set x "$x {" puts $f $x puts $f { puts -nonewline $f [read stdin 4096]} puts $f { flush $f} puts $f "}"
︙
2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638	2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713	- - - + + + - +	if {$counter == 1000} { set result "file size only [file size $path(output)]" } else { set result ok } } ok test io-29.32 {Tcl_WriteChars, background flush to slow reader} \ {stdio asyncPipeClose} { catch {removeFile pipe} catch {removeFile output} {stdio asyncPipeClose openpipe} { file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f [format {set f [open {%s} w]} $path(output)] puts $f "set f \[[list open $path(output) w]]" puts $f {fconfigure $f -translation lf} set x [list while {![eof stdin]}] set x "$x \{" puts $f $x puts $f { after 20} puts $f { puts -nonewline $f [read stdin 1024]} puts $f { flush $f}
︙
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	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	- + - - + - + - - + +	set result "file size only [file size $path(output)]" } else { set result ok } } ok test io-29.33 {Tcl_Flush, implicit flush on exit} {exec} { set f [open $path(script) w] puts $f [format { puts $f "set f \[[list open $path(test1) w]]" set f [open "%s" w] fconfigure $f -translation lf puts $f {fconfigure $f -translation lf puts $f hello puts $f bye puts $f strange } $path(test1)] } close $f exec [interpreter] $path(script) set f [open $path(test1) r] set r [read $f] close $f set r } "hello\nbye\nstrange\n" test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac} { set c 0 test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac fileevent} { variable c 0 variable x running set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz proc writelots {s l} { for {set i 0} {$i < 2000} {incr i} { puts $s $l } }
︙
2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724	2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798	- +	fconfigure $cs -blocking off writelots $cs $l close $cs close $ss vwait [namespace which -variable x] set c } 2000 test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotMac} { test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotMac fileevent} { # On Mac, this test screws up sockets such that subsequent tests using port 2828 # either cause errors or panic(). catch {interp delete x} catch {interp delete y} interp create x interp create y
︙
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 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 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 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 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 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048	2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 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 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 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 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 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 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122	- + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - +	interp delete x interp delete y } "" # Test end of line translations. Procedures tested are Tcl_Write, Tcl_Read. test io-30.1 {Tcl_Write lf, Tcl_Read lf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation lf set x [read $f] close $f set x } "hello\nthere\nand\nhere\n" test io-30.2 {Tcl_Write lf, Tcl_Read cr} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation cr set x [read $f] close $f set x } "hello\nthere\nand\nhere\n" test io-30.3 {Tcl_Write lf, Tcl_Read crlf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation crlf set x [read $f] close $f set x } "hello\nthere\nand\nhere\n" test io-30.4 {Tcl_Write cr, Tcl_Read cr} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation cr set x [read $f] close $f set x } "hello\nthere\nand\nhere\n" test io-30.5 {Tcl_Write cr, Tcl_Read lf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation lf set x [read $f] close $f set x } "hello\rthere\rand\rhere\r" test io-30.6 {Tcl_Write cr, Tcl_Read crlf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation crlf set x [read $f] close $f set x } "hello\rthere\rand\rhere\r" test io-30.7 {Tcl_Write crlf, Tcl_Read crlf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation crlf set x [read $f] close $f set x } "hello\nthere\nand\nhere\n" test io-30.8 {Tcl_Write crlf, Tcl_Read lf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation lf set x [read $f] close $f set x } "hello\r\nthere\r\nand\r\nhere\r\n" test io-30.9 {Tcl_Write crlf, Tcl_Read cr} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation cr set x [read $f] close $f set x } "hello\n\nthere\n\nand\n\nhere\n\n" test io-30.10 {Tcl_Write lf, Tcl_Read auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] set c [read $f] set x [fconfigure $f -translation] close $f list $c $x } {{hello there and here } auto} test io-30.11 {Tcl_Write cr, Tcl_Read auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] set c [read $f] set x [fconfigure $f -translation] close $f list $c $x } {{hello there and here } auto} test io-30.12 {Tcl_Write crlf, Tcl_Read auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] set c [read $f] set x [fconfigure $f -translation] close $f list $c $x } {{hello there and here } auto} test io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set line "123456789ABCDE" ;# 14 char plus crlf puts -nonewline $f x ;# shift crlf across block boundary for {set i 0} {$i < 700} {incr i} { puts $f $line } close $f set f [open $path(test1) r] fconfigure $f -translation auto set c [read $f] close $f string length $c } [expr 700*15+1] test io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set line "123456789ABCDE" ;# 14 char plus crlf puts -nonewline $f x ;# shift crlf across block boundary for {set i 0} {$i < 700} {incr i} { puts $f $line } close $f set f [open $path(test1) r] fconfigure $f -translation crlf set c [read $f] close $f string length $c } [expr 700*15+1] test io-30.15 {Tcl_Write mixed, Tcl_Read auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\rhere close $f set f [open $path(test1) r] fconfigure $f -translation auto set c [read $f] close $f set c } {hello there and here } test io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f hello\nthere\nand\rhere\n\x1a close $f set f [open $path(test1) r] fconfigure $f -eofchar \x1a -translation auto set c [read $f] close $f set c } {hello there and here } test io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {pcOnly} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -eofchar \x1a -translation lf puts $f hello\nthere\nand\rhere close $f set f [open $path(test1) r] fconfigure $f -eofchar \x1a -translation auto set c [read $f] close $f set c } {hello there and here } test io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "abc\ndef\n%cghi\nqrs" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -eofchar \x1a -translation auto set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1 {} 1} test io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "abc\ndef\n%cghi\nqrs" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -eofchar \x1a -translation auto set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1 {} 1} test io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set s [format "abc\ndef\n%cghi\nqrs" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation lf -eofchar {}
︙
3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 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 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 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 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585	3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 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 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 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 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659	- + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - +	lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } "abc def 0 \x1aghi 0 qrs 0 {} 1" test io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set s [format "abc\ndef\n%cghi\nqrs" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation cr -eofchar {} set l "" set x [gets $f] lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs\n"] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {0 1 {} 1} test io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set s [format "abc\ndef\n%cghi\nqrs" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar {} set l "" set x [gets $f] lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs\n"] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {0 1 {} 1} test io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1a set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} test io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation lf -eofchar \x1a set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} test io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1a set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} test io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation cr -eofchar \x1a set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} test io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1a set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} test io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set c [format abc\ndef\n%cqrs\ntuv 26] puts $f $c close $f set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1a set c [string length [read $f]] set e [eof $f] close $f list $c $e } {8 1} # Test end of line translations. Functions tested are Tcl_Write and Tcl_Gets. test io-31.1 {Tcl_Write lf, Tcl_Gets auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] set l "" lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] close $f set l } {hello 6 auto there 12 auto} test io-31.2 {Tcl_Write cr, Tcl_Gets auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] set l "" lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] close $f set l } {hello 6 auto there 12 auto} test io-31.3 {Tcl_Write crlf, Tcl_Gets auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] set l "" lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] close $f set l } {hello 7 auto there 14 auto} test io-31.4 {Tcl_Write lf, Tcl_Gets lf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation lf set l "" lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] close $f set l } {hello 6 lf there 12 lf} test io-31.5 {Tcl_Write lf, Tcl_Gets cr} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation cr set l "" lappend l [string length [gets $f]] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] close $f set l } {21 21 cr 1 {} 21 cr 1} test io-31.6 {Tcl_Write lf, Tcl_Gets crlf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation crlf set l "" lappend l [string length [gets $f]] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] close $f set l } {21 21 crlf 1 {} 21 crlf 1} test io-31.7 {Tcl_Write cr, Tcl_Gets cr} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation cr set l "" lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] close $f set l } {hello 6 cr 0 there 12 cr 0} test io-31.8 {Tcl_Write cr, Tcl_Gets lf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation lf set l "" lappend l [string length [gets $f]] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] close $f set l } {21 21 lf 1 {} 21 lf 1} test io-31.9 {Tcl_Write cr, Tcl_Gets crlf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation crlf set l "" lappend l [string length [gets $f]] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] close $f set l } {21 21 crlf 1 {} 21 crlf 1} test io-31.10 {Tcl_Write crlf, Tcl_Gets crlf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation crlf set l "" lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] close $f set l } {hello 7 crlf 0 there 14 crlf 0} test io-31.11 {Tcl_Write crlf, Tcl_Gets cr} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation cr set l "" lappend l [gets $f] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] lappend l [string length [gets $f]] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] close $f set l } {hello 6 cr 0 6 13 cr 0} test io-31.12 {Tcl_Write crlf, Tcl_Gets lf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf puts $f hello\nthere\nand\nhere close $f set f [open $path(test1) r] fconfigure $f -translation lf set l "" lappend l [string length [gets $f]] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] lappend l [string length [gets $f]] lappend l [tell $f] lappend l [fconfigure $f -translation] lappend l [eof $f] close $f set l } {6 7 lf 0 6 14 lf 0} test io-31.13 {binary mode is synonym of lf mode} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation binary set x [fconfigure $f -translation] close $f set x } lf # # Test io-9.14 has been removed because "auto" output translation mode is # not supoprted. # test io-31.14 {Tcl_Write mixed, Tcl_Gets auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\rand\r\nhere close $f set f [open $path(test1) r] fconfigure $f -translation auto set l "" lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {hello there and here 0 {} 1} test io-31.15 {Tcl_Write mixed, Tcl_Gets auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f hello\nthere\rand\r\nhere\r close $f set f [open $path(test1) r] fconfigure $f -translation auto set l "" lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {hello there and here 0 {} 1} test io-31.16 {Tcl_Write mixed, Tcl_Gets auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f hello\nthere\rand\r\nhere\n close $f set f [open $path(test1) r] set l "" lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {hello there and here 0 {} 1} test io-31.17 {Tcl_Write mixed, Tcl_Gets auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f hello\nthere\rand\r\nhere\r\n close $f set f [open $path(test1) r] fconfigure $f -translation auto set l "" lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {hello there and here 0 {} 1} test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "hello\nthere\nand\rhere\n\%c" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -eofchar \x1a -translation auto set l "" lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {hello there and here 0 {} 1} test io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -eofchar \x1a -translation lf puts $f hello\nthere\nand\rhere close $f set f [open $path(test1) r] fconfigure $f -eofchar \x1a -translation auto set l "" lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {hello there and here 0 {} 1} test io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -eofchar \x1a fconfigure $f -translation auto set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -eofchar \x1a -translation auto set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation lf -eofchar {}
︙
3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607	3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681	- +	lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } "abc def 0 \x1aqrs 0 tuv 0 {} 1" test io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation cr -eofchar {}
︙
3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629	3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703	- +	lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } "abc def 0 \x1aqrs 0 tuv 0 {} 1" test io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar {}
︙
3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778	3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852	- + - + - + - + - + - + - + - +	lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } "abc def 0 \x1aqrs 0 tuv 0 {} 1" test io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1a set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation lf -eofchar \x1a set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1a set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation cr -eofchar \x1a set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1a set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar {} set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1a set l "" lappend l [gets $f] lappend l [gets $f] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set line "123456789ABCDE" ;# 14 char plus crlf puts -nonewline $f x ;# shift crlf across block boundary for {set i 0} {$i < 700} {incr i} { puts $f $line } close $f set f [open $path(test1) r] fconfigure $f -translation crlf set c "" while {[gets $f line] >= 0} { append c $line\n } close $f string length $c } [expr 700*15+1] test io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set line "123456789ABCDE" ;# 14 char plus crlf puts -nonewline $f x ;# shift crlf across block boundary for {set i 0} {$i < 700} {incr i} { puts $f $line }
︙
3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975	3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049	- - + + - - + + - + - + - + - + - + - +	set x ok set z [file size $path(longfile)] if {$z != $l} { set x broken } set x } ok test io-32.10 {Tcl_Read from a pipe} {stdio} { removeFile pipe test io-32.10 {Tcl_Read from a pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {puts [gets stdin]} close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] puts $f1 hello flush $f1 set x [read $f1] close $f1 set x } "hello\n" test io-32.11 {Tcl_Read from a pipe} {stdio} { removeFile pipe test io-32.11 {Tcl_Read from a pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {puts [gets stdin]} puts $f1 {puts [gets stdin]} close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] puts $f1 hello flush $f1 set x "" lappend x [read $f1 6] puts $f1 hello flush $f1 lappend x [read $f1] close $f1 set x } {{hello } {hello }} test io-32.12 {Tcl_Read, -nonewline} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] puts $f1 hello puts $f1 bye close $f1 set f1 [open $path(test1) r] set c [read -nonewline $f1] close $f1 set c } {hello bye} test io-32.13 {Tcl_Read, -nonewline} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] puts $f1 hello puts $f1 bye close $f1 set f1 [open $path(test1) r] set c [read -nonewline $f1] close $f1 list [string length $c] $c } {9 {hello bye}} test io-32.14 {Tcl_Read, reading in small chunks} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] puts $f "Two lines: this one" puts $f "and this one" close $f set f [open $path(test1)] set x [list [read $f 1] [read $f 2] [read $f]] close $f set x } {T wo { lines: this one and this one }} test io-32.15 {Tcl_Read, asking for more input than available} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] puts $f "Two lines: this one" puts $f "and this one" close $f set f [open $path(test1)] set x [read $f 100] close $f set x } {Two lines: this one and this one } test io-32.16 {Tcl_Read, read to end of file with -nonewline} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] puts $f "Two lines: this one" puts $f "and this one" close $f set f [open $path(test1)] set x [read -nonewline $f] close $f set x } {Two lines: this one and this one} # Test Tcl_Gets. test io-33.1 {Tcl_Gets, reading what was written} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] set y "first line" puts $f1 $y close $f1 set f1 [open $path(test1) r] set x [gets $f1] set z ok
︙
3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037	4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111	- - + + - + - +	set z ok if {$l != $l} { set z broken } close $f1 set z } ok test io-33.3 {Tcl_Gets from pipe} {stdio} { removeFile pipe test io-33.3 {Tcl_Gets from pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {puts [gets stdin]} close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] puts $f1 hello flush $f1 set x [gets $f1] close $f1 set z ok if {"$x" != "hello"} { set z broken } set z } ok test io-33.4 {Tcl_Gets with long line} { removeFile test3 file delete $path(test3) set f [open $path(test3) w] puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" close $f set f [open $path(test3)] set x [gets $f] close $f set x } {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ} test io-33.5 {Tcl_Gets with long line} { set f [open $path(test3)] set x [gets $f y] close $f list $x $y } {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ} test io-33.6 {Tcl_Gets and end of file} { removeFile test3 file delete $path(test3) set f [open $path(test3) w] puts -nonewline $f "Test1\nTest2" close $f set f [open $path(test3)] set x {} set y {} lappend x [gets $f y] $y
︙
4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205	4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279	- + - + - + - + - + - + - + - +	set f1 [open $path(longfile) r] seek $f1 0 current set c [tell $f1] close $f1 set c } 0 test io-34.2 {Tcl_Seek to offset from start} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 10 start set c [tell $f1] close $f1 set c } 10 test io-34.3 {Tcl_Seek to end of file} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 0 end set c [tell $f1] close $f1 set c } 54 test io-34.4 {Tcl_Seek to offset from end of file} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 -10 end set c [tell $f1] close $f1 set c } 44 test io-34.5 {Tcl_Seek to offset from current position} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 10 current seek $f1 10 current set c [tell $f1] close $f1 set c } 20 test io-34.6 {Tcl_Seek to offset from end of file} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 -10 end set c [tell $f1] set r [read $f1] close $f1 list $c $r } {44 {rstuvwxyz }} test io-34.7 {Tcl_Seek to offset from end of file, then to current position} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 -10 end set c1 [tell $f1] set r1 [read $f1 5] seek $f1 0 current set c2 [tell $f1] close $f1 list $c1 $r1 $c2 } {44 rstuv 49} test io-34.8 {Tcl_Seek on pipes: not supported} {stdio} { test io-34.8 {Tcl_Seek on pipes: not supported} {stdio openpipe} { set f1 [open "|[list [interpreter]]" r+] set x [list [catch {seek $f1 0 current} msg] $msg] close $f1 regsub {".*":} $x {"":} x string tolower $x } {1 {error during seek on "": invalid argument}} test io-34.9 {Tcl_Seek, testing buffered input flushing} { removeFile test3 file delete $path(test3) set f [open $path(test3) w] fconfigure $f -eofchar {} puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" close $f set f [open $path(test3) RDWR] set x [read $f 1] seek $f 3
︙
4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323	4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397	- + - + - + - + - + - +	set y [gets $f] close $f list $x [viewFile test3] $y } {14 {xyz 123 xyzzy} zzy} test io-34.13 {Tcl_Tell at start of file} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] set p [tell $f1] close $f1 set p } 0 test io-34.14 {Tcl_Tell after seek to end of file} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 0 end set c1 [tell $f1] close $f1 set c1 } 54 test io-34.15 {Tcl_Tell combined with seeking} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 10 start set c1 [tell $f1] seek $f1 10 current set c2 [tell $f1] close $f1 list $c1 $c2 } {10 20} test io-34.16 {Tcl_tell on pipe: always -1} {stdio} { test io-34.16 {Tcl_tell on pipe: always -1} {stdio openpipe} { set f1 [open "|[list [interpreter]]" r+] set c [tell $f1] close $f1 set c } -1 test io-34.17 {Tcl_Tell on pipe: always -1} {stdio} { test io-34.17 {Tcl_Tell on pipe: always -1} {stdio openpipe} { set f1 [open "|[list [interpreter]]" r+] puts $f1 {puts hello} flush $f1 set c [tell $f1] gets $f1 close $f1 set c } -1 test io-34.18 {Tcl_Tell combined with seeking and reading} { removeFile test2 file delete $path(test2) set f [open $path(test2) w] fconfigure $f -translation lf -eofchar {} puts -nonewline $f "line1\nline2\nline3\nline4\nline5\n" close $f set f [open $path(test2)] fconfigure $f -translation lf set x [tell $f]
︙
4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369	4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443	- +	lappend l [tell $f] seek $f 407 end lappend l [tell $f] close $f set l } {29 39 40 447} test io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} { removeFile test3 file delete $path(test3) set f [open $path(test3) w] fconfigure $f -encoding binary set l "" lappend l [tell $f] puts -nonewline $f abcdef lappend l [tell $f] flush $f
︙
4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431	4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505	- + - - + + - - + +	lappend l [file size $f] set l } {0 6 6 4294967296 4294967302 4294967302 0} # Test Tcl_Eof test io-35.1 {Tcl_Eof} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] puts $f hello puts $f hello close $f set f [open $path(test1)] set x [eof $f] lappend x [eof $f] gets $f lappend x [eof $f] gets $f lappend x [eof $f] gets $f lappend x [eof $f] lappend x [eof $f] close $f set x } {0 0 0 0 1 1} test io-35.2 {Tcl_Eof with pipe} {stdio} { removeFile pipe test io-35.2 {Tcl_Eof with pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {gets stdin} puts $f1 {puts hello} close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] puts $f1 hello set x [eof $f1] flush $f1 lappend x [eof $f1] gets $f1 lappend x [eof $f1] gets $f1 lappend x [eof $f1] close $f1 set x } {0 0 0 1} test io-35.3 {Tcl_Eof with pipe} {stdio} { removeFile pipe test io-35.3 {Tcl_Eof with pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {gets stdin} puts $f1 {puts hello} close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] puts $f1 hello set x [eof $f1]
︙
4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747	4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821	- + - - + + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - +	lappend x [eof $f1] gets $f1 lappend x [eof $f1] close $f1 set x } {0 0 0 1 1 1} test io-35.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] close $f set f [open $path(test1) r] fconfigure $f -blocking off set l "" lappend l [gets $f] lappend l [eof $f] close $f set l } {{} 1} test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio} { removeFile pipe test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio openpipe} { file delete $path(pipe) set f [open $path(pipe) w] puts $f { exit } close $f set f [open "|[list [interpreter] $path(pipe)]" r] set l "" lappend l [gets $f] lappend l [eof $f] close $f set l } {{} 1} test io-35.6 {Tcl_Eof, eof char, lf write, auto read} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar \x1a puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {9 8 1} test io-35.7 {Tcl_Eof, eof char, lf write, lf read} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar \x1a puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation lf -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {9 8 1} test io-35.8 {Tcl_Eof, eof char, cr write, auto read} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar \x1a puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {9 8 1} test io-35.9 {Tcl_Eof, eof char, cr write, cr read} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar \x1a puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation cr -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {9 8 1} test io-35.10 {Tcl_Eof, eof char, crlf write, auto read} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar \x1a puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {11 8 1} test io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar \x1a puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f list $s $l $e } {11 8 1} test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {17 8 1} test io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation lf -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {17 8 1} test io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {17 8 1} test io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation cr -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {17 8 1} test io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {21 8 1} test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf -eofchar {} set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {21 8 1} # Test Tcl_InputBlocked test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio} { test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio openpipe} { set f1 [open "|[list [interpreter]]" r+] puts $f1 {puts hello_from_pipe} flush $f1 gets $f1 fconfigure $f1 -blocking off -buffering full puts $f1 {puts hello} set x "" lappend x [gets $f1] lappend x [fblocked $f1] flush $f1 after 200 lappend x [gets $f1] lappend x [fblocked $f1] lappend x [gets $f1] lappend x [fblocked $f1] close $f1 set x } {{} 1 hello 0 {} 1} test io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio} { test io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio openpipe} { set f1 [open "|[list [interpreter]]" r+] fconfigure $f1 -buffering line puts $f1 {puts hello_from_pipe} set x "" lappend x [gets $f1] lappend x [fblocked $f1] puts $f1 {exit} lappend x [gets $f1] lappend x [fblocked $f1] lappend x [eof $f1] close $f1 set x } {hello_from_pipe 0 {} 0 1} test io-36.3 {Tcl_InputBlocked vs files, short read} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] puts $f abcdefghijklmnop close $f set f [open $path(test1) r] set l "" lappend l [fblocked $f] lappend l [read $f 3] lappend l [fblocked $f] lappend l [read -nonewline $f] lappend l [fblocked $f] lappend l [eof $f] close $f set l } {0 abc 0 defghijklmnop 0 1} test io-36.4 {Tcl_InputBlocked vs files, event driven read} { test io-36.4 {Tcl_InputBlocked vs files, event driven read} {fileevent} { proc in {f} { variable l variable x lappend l [read $f 3] if {[eof $f]} {lappend l eof; close $f; set x done} } removeFile test1 file delete $path(test1) set f [open $path(test1) w] puts $f abcdefghijklmnop close $f set f [open $path(test1) r] set l "" fileevent $f readable [namespace code [list in $f]] variable x vwait [namespace which -variable x] set l } {abc def ghi jkl mno {p } eof} test io-36.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] puts $f abcdefghijklmnop close $f set f [open $path(test1) r] fconfigure $f -blocking off set l "" lappend l [fblocked $f] lappend l [read $f 3] lappend l [fblocked $f] lappend l [read -nonewline $f] lappend l [fblocked $f] lappend l [eof $f] close $f set l } {0 abc 0 defghijklmnop 0 1} test io-36.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles} { test io-36.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles fileevent} { proc in {f} { variable l variable x lappend l [read $f 3] if {[eof $f]} {lappend l eof; close $f; set x done} } removeFile test1 file delete $path(test1) set f [open $path(test1) w] puts $f abcdefghijklmnop close $f set f [open $path(test1) r] fconfigure $f -blocking off set l "" fileevent $f readable [namespace code [list in $f]]
︙
4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940	4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014	- + - + - + - + - + - + - + - + - + - + - - + +	lappend l [fconfigure $f -buffersize] fconfigure $f -buffersize 100000 lappend l [fconfigure $f -buffersize] fconfigure $f -buffersize 10000000 lappend l [fconfigure $f -buffersize] close $f set l } {4096 10000 4096 4096 4096 100000 4096} } {4096 10000 1 1 1 100000 100000} test io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} { # This test crashes the interp if Bug #427196 is not fixed set chan [open [info script] r] fconfigure $chan -buffersize 10 set var [read $chan 2] fconfigure $chan -buffersize 32 append var [read $chan] close $chan } {} # Test Tcl_SetChannelOption, Tcl_GetChannelOption test io-39.1 {Tcl_GetChannelOption} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] set x [fconfigure $f1 -blocking] close $f1 set x } 1 # # Test 17.2 was removed. # test io-39.2 {Tcl_GetChannelOption} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] set x [fconfigure $f1 -buffering] close $f1 set x } full test io-39.3 {Tcl_GetChannelOption} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -buffering line set x [fconfigure $f1 -buffering] close $f1 set x } line test io-39.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] set l "" lappend l [fconfigure $f1 -buffering] fconfigure $f1 -buffering line lappend l [fconfigure $f1 -buffering] fconfigure $f1 -buffering none lappend l [fconfigure $f1 -buffering] fconfigure $f1 -buffering line lappend l [fconfigure $f1 -buffering] fconfigure $f1 -buffering full lappend l [fconfigure $f1 -buffering] close $f1 set l } {full line none line full} test io-39.5 {Tcl_GetChannelOption, invariance} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] set l "" lappend l [fconfigure $f1 -buffering] lappend l [list [catch {fconfigure $f1 -buffering green} msg] $msg] lappend l [fconfigure $f1 -buffering] close $f1 set l } {full {1 {bad value for -buffering: must be one of full, line, or none}} full} test io-39.6 {Tcl_SetChannelOption, multiple options} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -buffering line puts $f1 hello puts $f1 bye set x [file size $path(test1)] close $f1 set x } 10 test io-39.7 {Tcl_SetChannelOption, buffering, translation} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf puts $f1 hello puts $f1 bye set x "" fconfigure $f1 -buffering line lappend x [file size $path(test1)] puts $f1 really_bye lappend x [file size $path(test1)] close $f1 set x } {0 21} test io-39.8 {Tcl_SetChannelOption, different buffering options} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] set l "" fconfigure $f1 -translation lf -buffering none -eofchar {} puts -nonewline $f1 hello lappend l [file size $path(test1)] puts -nonewline $f1 hello lappend l [file size $path(test1)] fconfigure $f1 -buffering full puts -nonewline $f1 hello lappend l [file size $path(test1)] fconfigure $f1 -buffering none lappend l [file size $path(test1)] puts -nonewline $f1 hello lappend l [file size $path(test1)] close $f1 lappend l [file size $path(test1)] set l } {5 10 10 10 20 20} test io-39.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] close $f1 set f1 [open $path(test1) r] set x "" lappend x [fconfigure $f1 -blocking] fconfigure $f1 -blocking off lappend x [fconfigure $f1 -blocking] lappend x [gets $f1] lappend x [read $f1 1000] lappend x [fblocked $f1] lappend x [eof $f1] close $f1 set x } {1 0 {} {} 0 1} test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio} { removeFile pipe test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 { gets stdin after 100 puts hi gets stdin }
︙
4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 5028 5029 5030	5036 5037 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104	- + - + - + - + - + - + - +	lappend x [eof $f1] lappend x [gets $f1] lappend x [eof $f1] close $f1 set x } {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1} test io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -buffersize -10 set x [fconfigure $f -buffersize] close $f set x } 4096 test io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -buffersize 10000000 set x [fconfigure $f -buffersize] close $f set x } 4096 test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -buffersize 40000 set x [fconfigure $f -buffersize] close $f set x } 40000 test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -encoding {} puts -nonewline $f \xe7\x89\xa6 close $f set f [open $path(test1) r] fconfigure $f -encoding utf-8 set x [read $f] close $f set x } \u7266 test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -encoding binary puts -nonewline $f \xe7\x89\xa6 close $f set f [open $path(test1) r] fconfigure $f -encoding utf-8 set x [read $f] close $f set x } \u7266 test io-39.16 {Tcl_SetChannelOption: -encoding, errors} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] set result [list [catch {fconfigure $f -encoding foobar} msg] $msg] close $f set result } {1 {unknown encoding "foobar"}} test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio} { test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio openpipe fileevent} { set f [open "|[list [interpreter] $path(cat)]" r+] fconfigure $f -encoding binary puts -nonewline $f "\xe7" flush $f fconfigure $f -encoding utf-8 -blocking 0 variable x {} fileevent $f readable [namespace code { lappend x [read $f] }]
︙
5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104 5105 5106 5107 5108 5109 5110 5111 5112 5113 5114 5115 5116 5117 5118 5119 5120	5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194	- + - +	set modes [fconfigure $s2 -translation] close $s1 close $s2 set modes } {auto crlf} test io-39.22 {Tcl_SetChannelOption, invariance} {unixOnly} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w+] set l "" lappend l [fconfigure $f1 -eofchar] fconfigure $f1 -eofchar {ON GO} lappend l [fconfigure $f1 -eofchar] fconfigure $f1 -eofchar D lappend l [fconfigure $f1 -eofchar] close $f1 set l } {{{} {}} {O G} {D D}} test io-39.22a {Tcl_SetChannelOption, invariance} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w+] set l [list] fconfigure $f1 -eofchar {ON GO} lappend l [fconfigure $f1 -eofchar] fconfigure $f1 -eofchar D lappend l [fconfigure $f1 -eofchar] lappend l [list [catch {fconfigure $f1 -eofchar {1 2 3}} msg] $msg]
︙
5138 5139 5140 5141 5142 5143 5144 5145 5146 5147 5148 5149 5150 5151 5152 5153 5154 5155 5156 5157 5158 5159 5160 5161 5162 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 5211 5212 5213 5214 5215 5216 5217 5218 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248 5249 5250 5251 5252 5253 5254 5255 5256 5257 5258 5259 5260 5261 5262 5263 5264 5265 5266 5267 5268 5269 5270 5271 5272 5273 5274 5275 5276 5277 5278 5279 5280 5281 5282 5283 5284 5285 5286 5287 5288 5289 5290 5291 5292 5293 5294 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 5338 5339 5340 5341 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 5359 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 5426 5427 5428 5429 5430 5431 5432 5433 5434 5435 5436 5437 5438 5439 5440 5441 5442 5443 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 5456 5457 5458 5459 5460 5461 5462 5463 5464 5465 5466 5467 5468 5469 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 5483 5484 5485 5486 5487 5488 5489 5490 5491 5492 5493 5494 5495 5496 5497 5498 5499 5500 5501 5502 5503 5504 5505 5506 5507 5508 5509 5510 5511 5512 5513	5212 5213 5214 5215 5216 5217 5218 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248 5249 5250 5251 5252 5253 5254 5255 5256 5257 5258 5259 5260 5261 5262 5263 5264 5265 5266 5267 5268 5269 5270 5271 5272 5273 5274 5275 5276 5277 5278 5279 5280 5281 5282 5283 5284 5285 5286 5287 5288 5289 5290 5291 5292 5293 5294 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 5338 5339 5340 5341 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 5359 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 5426 5427 5428 5429 5430 5431 5432 5433 5434 5435 5436 5437 5438 5439 5440 5441 5442 5443 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 5456 5457 5458 5459 5460 5461 5462 5463 5464 5465 5466 5467 5468 5469 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 5483 5484 5485 5486 5487 5488 5489 5490 5491 5492 5493 5494 5495 5496 5497 5498 5499 5500 5501 5502 5503 5504 5505 5506 5507 5508 5509 5510 5511 5512 5513 5514 5515 5516 5517 5518 5519 5520 5521 5522 5523 5524 5525 5526 5527 5528 5529 5530 5531 5532 5533 5534 5535 5536 5537 5538 5539 5540 5541 5542 5543 5544 5545 5546 5547 5548 5549 5550 5551 5552 5553 5554 5555 5556 5557 5558 5559 5560 5561 5562 5563 5564 5565 5566 5567 5568 5569 5570 5571 5572 5573 5574 5575 5576 5577 5578 5579 5580 5581 5582 5583 5584 5585 5586 5587 5588 5589 5590 5591 5592 5593 5594 5595 5596 5597	- + - + - + - + - + - - + + - + - - - - + - + - + - + - - - + + + - - - - - - + + + + - - - + - - - + + + - - - + - + - - - - - + + + + + - - + - + - + - + - + - + - + - + - + - - - - - - - - + - + + + + + + + - + - + + + + + + + - - + + + + + + + + - - + + + + + + + + - - + + + + + + + + - - + + - - - - + - + - +	fconfigure $sock -eofchar D -translation lf lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation] close $sock set l } {{{}} auto} test io-40.1 {POSIX open access modes: RDWR} { removeFile test3 file delete $path(test3) set f [open $path(test3) w] puts $f xyzzy close $f set f [open $path(test3) RDWR] puts -nonewline $f "ab" seek $f 0 current set x [gets $f] close $f set f [open $path(test3) r] lappend x [gets $f] close $f set x } {zzy abzzy} test io-40.2 {POSIX open access modes: CREAT} {unixOnly} { removeFile test3 file delete $path(test3) set f [open $path(test3) {WRONLY CREAT} 0600] file stat $path(test3) stats set x [format "0%o" [expr $stats(mode)&0777]] puts $f "line 1" close $f set f [open $path(test3) r] lappend x [gets $f] close $f set x } {0600 {line 1}} # some tests can only be run is umask is 2 # if "umask" cannot be run, the tests will be skipped. catch {testConstraint umask2 [expr {[exec umask] == 2}]} test io-40.3 {POSIX open access modes: CREAT} {unixOnly umask2} { # This test only works if your umask is 2, like ouster's. removeFile test3 file delete $path(test3) set f [open $path(test3) {WRONLY CREAT}] close $f file stat test3 stats format "0%o" [expr $stats(mode)&0777] } 0664 test io-40.4 {POSIX open access modes: CREAT} { removeFile test3 file delete $path(test3) set f [open $path(test3) w] fconfigure $f -eofchar {} puts $f xyzzy close $f set f [open $path(test3) {WRONLY CREAT}] fconfigure $f -eofchar {} puts -nonewline $f "ab" close $f set f [open $path(test3) r] set x [gets $f] close $f set x } abzzy test io-40.5 {POSIX open access modes: APPEND} { removeFile test3 file delete $path(test3) set f [open $path(test3) w] fconfigure $f -translation lf -eofchar {} puts $f xyzzy close $f set f [open $path(test3) {WRONLY APPEND}] fconfigure $f -translation lf puts $f "new line" seek $f 0 puts $f "abc" close $f set f [open $path(test3) r] fconfigure $f -translation lf set x "" seek $f 6 current lappend x [gets $f] lappend x [gets $f] close $f set x } {{new line} abc} test io-40.6 {POSIX open access modes: EXCL} { removeFile test3 test io-40.6 {POSIX open access modes: EXCL} -match regexp -body { file delete $path(test3) set f [open $path(test3) w] puts $f xyzzy close $f set msg [list [catch {open $path(test3) {WRONLY CREAT EXCL}} msg] $msg] open $path(test3) {WRONLY CREAT EXCL} regsub " already " $msg " " msg regsub [file join {} $path(test3)] $msg "test3" msg string tolower $msg } {1 {couldn't open "test3": file exists}} } -returnCodes error -result {(?i)couldn't open ".*test3": file (already )?exists} test io-40.7 {POSIX open access modes: EXCL} { removeFile test3 file delete $path(test3) set f [open $path(test3) {WRONLY CREAT EXCL}] fconfigure $f -eofchar {} puts $f "A test line" close $f viewFile test3 } {A test line} test io-40.8 {POSIX open access modes: TRUNC} { removeFile test3 file delete $path(test3) set f [open $path(test3) w] puts $f xyzzy close $f set f [open $path(test3) {WRONLY TRUNC}] puts $f abc close $f set f [open $path(test3) r] set x [gets $f] close $f set x } abc test io-40.9 {POSIX open access modes: NONBLOCK} {nonPortable macOrUnix} { removeFile test3 file delete $path(test3) set f [open $path(test3) {WRONLY NONBLOCK CREAT}] puts $f "NONBLOCK test" close $f set f [open $path(test3) r] set x [gets $f] close $f set x } {NONBLOCK test} test io-40.10 {POSIX open access modes: RDONLY} { set f [open $path(test1) w] puts $f "two lines: this one" puts $f "and this" close $f set f [open $path(test1) RDONLY] set x [list [gets $f] [catch {puts $f Test} msg] $msg] close $f string compare [string tolower $x] \ [list {two lines: this one} 1 \ [format "channel \"%s\" wasn't opened for writing" $f]] } 0 test io-40.11 {POSIX open access modes: RDONLY} { removeFile test3 set msg [list [catch {open $path(test3) RDONLY} msg] $msg] test io-40.11 {POSIX open access modes: RDONLY} -match regexp -body { file delete $path(test3) open $path(test3) RDONLY regsub [file join {} $path(test3)] $msg "test3" msg string tolower $msg } {1 {couldn't open "test3": no such file or directory}} test io-40.12 {POSIX open access modes: WRONLY} { removeFile test3 set msg [list [catch {open $path(test3) WRONLY} msg] $msg] } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} test io-40.12 {POSIX open access modes: WRONLY} -match regexp -body { file delete $path(test3) open $path(test3) WRONLY regsub [file join {} $path(test3)] $msg "test3" msg string tolower $msg } {1 {couldn't open "test3": no such file or directory}} } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} test io-40.13 {POSIX open access modes: WRONLY} { makeFile xyzzy test3 set f [open $path(test3) WRONLY] fconfigure $f -eofchar {} puts -nonewline $f "ab" seek $f 0 current set x [list [catch {gets $f} msg] $msg] close $f lappend x [viewFile test3] string compare [string tolower $x] \ [list 1 "channel \"$f\" wasn't opened for reading" abzzy] } 0 test io-40.14 {POSIX open access modes: RDWR} { removeFile test3 set msg [list [catch {open $path(test3) RDWR} msg] $msg] test io-40.14 {POSIX open access modes: RDWR} -match regexp -body { file delete $path(test3) open $path(test3) RDWR regsub [file join {} $path(test3)] $msg "test3" msg string tolower $msg } {1 {couldn't open "test3": no such file or directory}} } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} test io-40.15 {POSIX open access modes: RDWR} { makeFile xyzzy test3 set f [open $path(test3) RDWR] puts -nonewline $f "ab" seek $f 0 current set x [gets $f] close $f lappend x [viewFile test3] } {zzy abzzy} if {![file exists ~/_test_] && [file writable ~]} { test io-40.16 {tilde substitution in open} { test io-40.16 {tilde substitution in open} -setup { set f [open ~/_test_ w] puts $f "Some text" close $f set x [file exists [file join $env(HOME) _test_]] removeFile [file join $env(HOME) _test_] makeFile {Some text} _test_ ~ } -body { file exists [file join $env(HOME) _test_] } -cleanup { removeFile _test_ ~ set x } 1 } -result 1 } test io-40.17 {tilde substitution in open} { set home $env(HOME) unset env(HOME) set x [list [catch {open ~/foo} msg] $msg] set env(HOME) $home set x } {1 {couldn't find HOME environment variable to expand path}} test io-41.1 {Tcl_FileeventCmd: errors} { test io-41.1 {Tcl_FileeventCmd: errors} {fileevent} { list [catch {fileevent foo} msg] $msg } {1 {wrong # args: should be "fileevent channelId event ?script?"}} test io-41.2 {Tcl_FileeventCmd: errors} { test io-41.2 {Tcl_FileeventCmd: errors} {fileevent} { list [catch {fileevent foo bar baz q} msg] $msg } {1 {wrong # args: should be "fileevent channelId event ?script?"}} test io-41.3 {Tcl_FileeventCmd: errors} { test io-41.3 {Tcl_FileeventCmd: errors} {fileevent} { list [catch {fileevent gorp readable} msg] $msg } {1 {can not find channel named "gorp"}} test io-41.4 {Tcl_FileeventCmd: errors} { test io-41.4 {Tcl_FileeventCmd: errors} {fileevent} { list [catch {fileevent gorp writable} msg] $msg } {1 {can not find channel named "gorp"}} test io-41.5 {Tcl_FileeventCmd: errors} { test io-41.5 {Tcl_FileeventCmd: errors} {fileevent} { list [catch {fileevent gorp who-knows} msg] $msg } {1 {bad event name "who-knows": must be readable or writable}} # # Test fileevent on a file # set path(foo) [makeFile {} foo] set f [open $path(foo) w+] test io-42.1 {Tcl_FileeventCmd: creating, deleting, querying} { test io-42.1 {Tcl_FileeventCmd: creating, deleting, querying} {fileevent} { list [fileevent $f readable] [fileevent $f writable] } {{} {}} test io-42.2 {Tcl_FileeventCmd: replacing} { test io-42.2 {Tcl_FileeventCmd: replacing} {fileevent} { set result {} fileevent $f r "first script" lappend result [fileevent $f readable] fileevent $f r "new script" lappend result [fileevent $f readable] fileevent $f r "yet another" lappend result [fileevent $f readable] fileevent $f r "" lappend result [fileevent $f readable] } {{first script} {new script} {yet another} {}} test io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} { test io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent} { set result {} fileevent $f r "first scr\0ipt" lappend result [string length [fileevent $f readable]] fileevent $f r "new scr\0ipt" lappend result [string length [fileevent $f readable]] fileevent $f r "yet ano\0ther" lappend result [string length [fileevent $f readable]] fileevent $f r "" lappend result [fileevent $f readable] } {13 11 12 {}} # # Test fileevent on a pipe # catch {set f2 [open "|[list cat -u]" r+]} catch {set f3 [open "|[list cat -u]" r+]} test io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs} { test io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs fileevent} { set result {} fileevent $f readable "script 1" lappend result [fileevent $f readable] [fileevent $f writable] fileevent $f writable "write script" lappend result [fileevent $f readable] [fileevent $f writable] fileevent $f readable {} lappend result [fileevent $f readable] [fileevent $f writable] fileevent $f writable {} lappend result [fileevent $f readable] [fileevent $f writable] } {{script 1} {} {script 1} {write script} {} {write script} {} {}} test io-43.2 {Tcl_FileeventCmd: deleting when many present} {stdio unixExecs} { test io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] } -constraints {stdio unixExecs fileevent openpipe} -body { set result {} lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r] fileevent $f r "read f" fileevent $f2 r "read f2" fileevent $f3 r "read f3" lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r] fileevent $f2 r {} lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r] fileevent $f3 r {} lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r] fileevent $f r {} lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r] } -cleanup { catch {close $f2} catch {close $f3} } {{} {} {} {read f} {read f2} {read f3} {read f} {} {read f3} {read f} {} {} {} {} {}} } -result {{} {} {} {read f} {read f2} {read f3} {read f} {} {read f3} {read f} {} {} {} {} {}} test io-44.1 {FileEventProc procedure: normal read event} {stdio unixExecs} { test io-44.1 {FileEventProc procedure: normal read event} -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] } -constraints {stdio unixExecs fileevent openpipe} -body { fileevent $f2 readable [namespace code { set x [gets $f2]; fileevent $f2 readable {} }] puts $f2 text; flush $f2 variable x initial vwait [namespace which -variable x] set x } -cleanup { catch {close $f2} catch {close $f3} } {text} test io-44.2 {FileEventProc procedure: error in read event} {stdio unixExecs} { } -result {text} test io-44.2 {FileEventProc procedure: error in read event} -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] } -constraints {stdio unixExecs fileevent openpipe} -body { proc ::bgerror args "set [namespace which -variable x] \$args" fileevent $f2 readable {error bogus} puts $f2 text; flush $f2 variable x initial vwait [namespace which -variable x] rename ::bgerror {} list $x [fileevent $f2 readable] } -cleanup { catch {close $f2} catch {close $f3} } {bogus {}} test io-44.3 {FileEventProc procedure: normal write event} {stdio unixExecs} { } -result {bogus {}} test io-44.3 {FileEventProc procedure: normal write event} -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] } -constraints {stdio unixExecs fileevent openpipe} -body { fileevent $f2 writable [namespace code { lappend x "triggered" incr count -1 if {$count <= 0} { fileevent $f2 writable {} } }] variable x initial set count 3 vwait [namespace which -variable x] vwait [namespace which -variable x] vwait [namespace which -variable x] set x } -cleanup { catch {close $f2} catch {close $f3} } {initial triggered triggered triggered} test io-44.4 {FileEventProc procedure: eror in write event} {stdio unixExecs} { } -result {initial triggered triggered triggered} test io-44.4 {FileEventProc procedure: eror in write event} -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] } -constraints {stdio unixExecs fileevent openpipe} -body { proc ::bgerror args "set [namespace which -variable x] \$args" fileevent $f2 writable {error bad-write} variable x initial vwait [namespace which -variable x] rename ::bgerror {} list $x [fileevent $f2 writable] } -cleanup { catch {close $f2} catch {close $f3} } {bad-write {}} test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs} { } -result {bad-write {}} test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} { set f4 [open "|[list [interpreter] $path(cat) << foo]" r] fileevent $f4 readable [namespace code { if {[gets $f4 line] < 0} { lappend x eof fileevent $f4 readable {} } else { lappend x $line } }] variable x initial vwait [namespace which -variable x] vwait [namespace which -variable x] close $f4 set x } {initial foo eof} catch {close $f2} catch {close $f3} close $f makeFile "foo bar" foo test io-45.1 {DeleteFileEvent, cleanup on close} { test io-45.1 {DeleteFileEvent, cleanup on close} {fileevent} { set f [open $path(foo) r] fileevent $f readable [namespace code { lappend x "binding triggered: \"[gets $f]\"" fileevent $f readable {} }] close $f set x initial after 100 [namespace code { set y done }] variable y vwait [namespace which -variable y] set x } {initial} test io-45.2 {DeleteFileEvent, cleanup on close} { test io-45.2 {DeleteFileEvent, cleanup on close} {fileevent} { set f [open $path(foo) r] set f2 [open $path(foo) r] fileevent $f readable [namespace code { lappend x "f triggered: \"[gets $f]\"" fileevent $f readable {} }] fileevent $f2 readable [namespace code { lappend x "f2 triggered: \"[gets $f2]\"" fileevent $f2 readable {} }] close $f variable x initial vwait [namespace which -variable x] close $f2 set x } {initial {f2 triggered: "foo bar"}} test io-45.3 {DeleteFileEvent, cleanup on close} { test io-45.3 {DeleteFileEvent, cleanup on close} {fileevent} { set f [open $path(foo) r] set f2 [open $path(foo) r] set f3 [open $path(foo) r] fileevent $f readable {f script} fileevent $f2 readable {f2 script} fileevent $f3 readable {f3 script} set x {}
︙
5524 5525 5526 5527 5528 5529 5530 5531 5532 5533 5534 5535 5536 5537 5538 5539 5540 5541 5542 5543 5544 5545 5546 5547	5608 5609 5610 5611 5612 5613 5614 5615 5616 5617 5618 5619 5620 5621 5622 5623 5624 5625 5626 5627 5628 5629 5630 5631 5632	- + - - + + + - +	[catch {fileevent $f2 readable}] \ [catch {fileevent $f3 readable}] } {0 {f script} 1 0 {f3 script} 0 {f script} 1 1 1 1 1} # Execute these tests only if the "testfevent" command is present. testConstraint testfevent [llength [info commands testfevent]] test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent} { test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent} { testfevent create testfevent cmd [format { set f [open {%s} r] set script "set f \[[list open $path(foo) r]]\n" append script { set x "no event" fileevent $f readable [namespace code { set x "f triggered: [gets $f]" fileevent $f readable {} }] } } $path(foo)] testfevent cmd $script after 1 ;# We must delay because Windows takes a little time to notice update testfevent cmd {close $f} list [testfevent cmd {set x}] [testfevent cmd {info commands after}] } {{f triggered: foo bar} after} test io-46.2 {Tcl event loop vs multiple interpreters} testfevent { testfevent create
︙
5562 5563 5564 5565 5566 5567 5568 5569 5570 5571 5572 5573 5574 5575 5576 5577 5578 5579 5580 5581 5582 5583 5584 5585 5586 5587 5588 5589 5590 5591 5592 5593 5594 5595 5596 5597 5598 5599 5600 5601 5602 5603 5604 5605 5606 5607 5608 5609 5610 5611 5612 5613 5614 5615 5616 5617 5618 5619 5620 5621 5622 5623 5624 5625 5626 5627 5628 5629 5630 5631 5632 5633 5634 5635 5636 5637 5638 5639 5640 5641 5642 5643 5644 5645 5646 5647 5648 5649 5650 5651 5652 5653 5654 5655 5656 5657 5658 5659 5660 5661 5662 5663 5664 5665 5666 5667 5668 5669 5670 5671 5672 5673 5674 5675 5676 5677 5678 5679 5680 5681 5682	5647 5648 5649 5650 5651 5652 5653 5654 5655 5656 5657 5658 5659 5660 5661 5662 5663 5664 5665 5666 5667 5668 5669 5670 5671 5672 5673 5674 5675 5676 5677 5678 5679 5680 5681 5682 5683 5684 5685 5686 5687 5688 5689 5690 5691 5692 5693 5694 5695 5696 5697 5698 5699 5700 5701 5702 5703 5704 5705 5706 5707 5708 5709 5710 5711 5712 5713 5714 5715 5716 5717 5718 5719 5720 5721 5722 5723 5724 5725 5726 5727 5728 5729 5730 5731 5732 5733 5734 5735 5736 5737 5738 5739 5740 5741 5742 5743 5744 5745 5746 5747 5748 5749 5750 5751 5752 5753 5754 5755 5756 5757 5758 5759 5760 5761 5762 5763 5764 5765 5766 5767	- + - + - + - + - + - + - +	update idletasks lappend result $x update lappend result $x } } {0 0 {0 timer}} test io-47.1 {fileevent vs multiple interpreters} testfevent { test io-47.1 {fileevent vs multiple interpreters} {testfevent fileevent} { set f [open $path(foo) r] set f2 [open $path(foo) r] set f3 [open $path(foo) r] fileevent $f readable {script 1} testfevent create testfevent share $f2 testfevent cmd "fileevent $f2 readable {script 2}" fileevent $f3 readable {sript 3} set x {} lappend x [fileevent $f2 readable] testfevent delete lappend x [fileevent $f readable] [fileevent $f2 readable] \ [fileevent $f3 readable] close $f close $f2 close $f3 set x } {{} {script 1} {} {sript 3}} test io-47.2 {deleting fileevent on interpreter delete} testfevent { test io-47.2 {deleting fileevent on interpreter delete} {testfevent fileevent} { set f [open $path(foo) r] set f2 [open $path(foo) r] set f3 [open $path(foo) r] set f4 [open $path(foo) r] fileevent $f readable {script 1} testfevent create testfevent share $f2 testfevent share $f3 testfevent cmd "fileevent $f2 readable {script 2} fileevent $f3 readable {script 3}" fileevent $f4 readable {script 4} testfevent delete set x [list [fileevent $f readable] [fileevent $f2 readable] \ [fileevent $f3 readable] [fileevent $f4 readable]] close $f close $f2 close $f3 close $f4 set x } {{script 1} {} {} {script 4}} test io-47.3 {deleting fileevent on interpreter delete} testfevent { test io-47.3 {deleting fileevent on interpreter delete} {testfevent fileevent} { set f [open $path(foo) r] set f2 [open $path(foo) r] set f3 [open $path(foo) r] set f4 [open $path(foo) r] testfevent create testfevent share $f3 testfevent share $f4 fileevent $f readable {script 1} fileevent $f2 readable {script 2} testfevent cmd "fileevent $f3 readable {script 3} fileevent $f4 readable {script 4}" testfevent delete set x [list [fileevent $f readable] [fileevent $f2 readable] \ [fileevent $f3 readable] [fileevent $f4 readable]] close $f close $f2 close $f3 close $f4 set x } {{script 1} {script 2} {} {}} test io-47.4 {file events on shared files and multiple interpreters} testfevent { test io-47.4 {file events on shared files and multiple interpreters} {testfevent fileevent} { set f [open $path(foo) r] set f2 [open $path(foo) r] testfevent create testfevent share $f testfevent cmd "fileevent $f readable {script 1}" fileevent $f readable {script 2} fileevent $f2 readable {script 3} set x [list [fileevent $f2 readable] \ [testfevent cmd "fileevent $f readable"] \ [fileevent $f readable]] testfevent delete close $f close $f2 set x } {{script 3} {script 1} {script 2}} test io-47.5 {file events on shared files, deleting file events} testfevent { test io-47.5 {file events on shared files, deleting file events} {testfevent fileevent} { set f [open $path(foo) r] testfevent create testfevent share $f testfevent cmd "fileevent $f readable {script 1}" fileevent $f readable {script 2} testfevent cmd "fileevent $f readable {}" set x [list [testfevent cmd "fileevent $f readable"] \ [fileevent $f readable]] testfevent delete close $f set x } {{} {script 2}} test io-47.6 {file events on shared files, deleting file events} testfevent { test io-47.6 {file events on shared files, deleting file events} {testfevent fileevent} { set f [open $path(foo) r] testfevent create testfevent share $f testfevent cmd "fileevent $f readable {script 1}" fileevent $f readable {script 2} fileevent $f readable {} set x [list [testfevent cmd "fileevent $f readable"] \ [fileevent $f readable]] testfevent delete close $f set x } {{script 1} {}} set path(bar) [makeFile {} bar] test io-48.1 {testing readability conditions} { test io-48.1 {testing readability conditions} {fileevent} { set f [open $path(bar) w] puts $f abcdefg puts $f abcdefg puts $f abcdefg puts $f abcdefg puts $f abcdefg close $f
︙
5694 5695 5696 5697 5698 5699 5700 5701 5702 5703 5704 5705 5706 5707 5708	5779 5780 5781 5782 5783 5784 5785 5786 5787 5788 5789 5790 5791 5792 5793	- +	} } set l "" variable x not_done vwait [namespace which -variable x] list $x $l } {done {called called called called called called called}} test io-48.2 {testing readability conditions} {nonBlockFiles} { test io-48.2 {testing readability conditions} {nonBlockFiles fileevent} { set f [open $path(bar) w] puts $f abcdefg puts $f abcdefg puts $f abcdefg puts $f abcdefg puts $f abcdefg close $f
︙
5724 5725 5726 5727 5728 5729 5730 5731 5732 5733 5734 5735 5736 5737 5738	5809 5810 5811 5812 5813 5814 5815 5816 5817 5818 5819 5820 5821 5822 5823	- +	variable x not_done vwait [namespace which -variable x] list $x $l } {done {called called called called called called called}} set path(my_script) [makeFile {} my_script] test io-48.3 {testing readability conditions} {stdio unixOnly nonBlockFiles} { test io-48.3 {testing readability conditions} {stdio unixOnly nonBlockFiles openpipe fileevent} { set f [open $path(bar) w] puts $f abcdefg puts $f abcdefg puts $f abcdefg puts $f abcdefg puts $f abcdefg close $f
︙
5761 5762 5763 5764 5765 5766 5767 5768 5769 5770 5771 5772 5773 5774 5775 5776 5777 5778 5779 5780 5781 5782 5783 5784 5785 5786 5787	5846 5847 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 5859 5860 5861 5862 5863 5864 5865 5866 5867 5868 5869 5870 5871 5872	- - + + - - + + - +	lappend l [fblocked $f] gets $f lappend l [fblocked $f] } } set l "" variable x not_done puts $f [format {source {%s}} $path(my_script)] puts $f [format {set f [open {%s} r]} $path(bar)] puts $f [list source $path(my_script)] puts $f "set f \[[list open $path(bar) r]]" puts $f {copy_slowly $f} puts $f {exit} vwait [namespace which -variable x] close $f list $x $l } {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}} test io-48.4 {lf write, testing readability, ^Z termination, auto read mode} { removeFile test1 test io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set c [format "abc\ndef\n%c" 26] variable c [format "abc\ndef\n%c" 26] puts -nonewline $f $c close $f proc consume {f} { variable l variable c variable x if {[eof $f]} {
︙
5797 5798 5799 5800 5801 5802 5803 5804 5805 5806 5807 5808 5809 5810 5811 5812	5882 5883 5884 5885 5886 5887 5888 5889 5890 5891 5892 5893 5894 5895 5896 5897	- - + +	set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1a fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} { removeFile test1 test io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set c [format "abc\ndef\n%cfoo\nbar\n" 26] puts -nonewline $f $c close $f proc consume {f} { variable l
︙
5825 5826 5827 5828 5829 5830 5831 5832 5833 5834 5835 5836 5837 5838 5839 5840	5910 5911 5912 5913 5914 5915 5916 5917 5918 5919 5920 5921 5922 5923 5924 5925	- - + +	set f [open $path(test1) r] fconfigure $f -eofchar \x1a -translation auto fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.6 {cr write, testing readability, ^Z termination, auto read mode} { removeFile test1 test io-48.6 {cr write, testing readability, ^Z termination, auto read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set c [format "abc\ndef\n%c" 26] puts -nonewline $f $c close $f proc consume {f} { variable l
︙
5853 5854 5855 5856 5857 5858 5859 5860 5861 5862 5863 5864 5865 5866 5867 5868	5938 5939 5940 5941 5942 5943 5944 5945 5946 5947 5948 5949 5950 5951 5952 5953	- - + +	set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1a fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} { removeFile test1 test io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set c [format "abc\ndef\n%cfoo\nbar\n" 26] puts -nonewline $f $c close $f proc consume {f} { variable l
︙
5881 5882 5883 5884 5885 5886 5887 5888 5889 5890 5891 5892 5893 5894 5895 5896	5966 5967 5968 5969 5970 5971 5972 5973 5974 5975 5976 5977 5978 5979 5980 5981	- - + +	set f [open $path(test1) r] fconfigure $f -eofchar \x1a -translation auto fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} { removeFile test1 test io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set c [format "abc\ndef\n%c" 26] puts -nonewline $f $c close $f proc consume {f} { variable l
︙
5909 5910 5911 5912 5913 5914 5915 5916 5917 5918 5919 5920 5921 5922 5923 5924	5994 5995 5996 5997 5998 5999 6000 6001 6002 6003 6004 6005 6006 6007 6008 6009	- - + +	set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1a fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} { removeFile test1 test io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set c [format "abc\ndef\n%cfoo\nbar\n" 26] puts -nonewline $f $c close $f proc consume {f} { variable l
︙
5937 5938 5939 5940 5941 5942 5943 5944 5945 5946 5947 5948 5949 5950 5951 5952	6022 6023 6024 6025 6026 6027 6028 6029 6030 6031 6032 6033 6034 6035 6036 6037	- - + +	set f [open $path(test1) r] fconfigure $f -eofchar \x1a -translation auto fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} { removeFile test1 test io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set c [format "abc\ndef\n%cfoo\nbar\n" 26] puts -nonewline $f $c close $f proc consume {f} { variable l
︙
5965 5966 5967 5968 5969 5970 5971 5972 5973 5974 5975 5976 5977 5978 5979 5980	6050 6051 6052 6053 6054 6055 6056 6057 6058 6059 6060 6061 6062 6063 6064 6065	- - + +	set f [open $path(test1) r] fconfigure $f -eofchar \x1a -translation lf fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.11 {lf write, testing readability, ^Z termination, lf read mode} { removeFile test1 test io-48.11 {lf write, testing readability, ^Z termination, lf read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set c [format "abc\ndef\n%c" 26] puts -nonewline $f $c close $f proc consume {f} { variable l
︙
5993 5994 5995 5996 5997 5998 5999 6000 6001 6002 6003 6004 6005 6006 6007 6008	6078 6079 6080 6081 6082 6083 6084 6085 6086 6087 6088 6089 6090 6091 6092 6093	- - + +	set f [open $path(test1) r] fconfigure $f -translation lf -eofchar \x1a fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} { removeFile test1 test io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set c [format "abc\ndef\n%cfoo\nbar\n" 26] puts -nonewline $f $c close $f proc consume {f} { variable l
︙
6021 6022 6023 6024 6025 6026 6027 6028 6029 6030 6031 6032 6033 6034 6035 6036	6106 6107 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 6118 6119 6120 6121	- - + +	set f [open $path(test1) r] fconfigure $f -eofchar \x1a -translation cr fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.13 {cr write, testing readability, ^Z termination, cr read mode} { removeFile test1 test io-48.13 {cr write, testing readability, ^Z termination, cr read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set c [format "abc\ndef\n%c" 26] puts -nonewline $f $c close $f proc consume {f} { variable c
︙
6049 6050 6051 6052 6053 6054 6055 6056 6057 6058 6059 6060 6061 6062 6063 6064	6134 6135 6136 6137 6138 6139 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149	- - + +	set f [open $path(test1) r] fconfigure $f -translation cr -eofchar \x1a fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} { removeFile test1 test io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set c [format "abc\ndef\n%cfoo\nbar\n" 26] puts -nonewline $f $c close $f proc consume {f} { variable c
︙
6077 6078 6079 6080 6081 6082 6083 6084 6085 6086 6087 6088 6089 6090 6091 6092	6162 6163 6164 6165 6166 6167 6168 6169 6170 6171 6172 6173 6174 6175 6176 6177	- - + +	set f [open $path(test1) r] fconfigure $f -eofchar \x1a -translation crlf fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} { removeFile test1 test io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set c [format "abc\ndef\n%c" 26] puts -nonewline $f $c close $f proc consume {f} { variable c
︙
6107 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 6118 6119 6120 6121	6192 6193 6194 6195 6196 6197 6198 6199 6200 6201 6202 6203 6204 6205 6206	- +	fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] list $c $l } {3 {abc def {}}} test io-49.1 {testing crlf reading, leftover cr disgorgment} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "a\rb\rc\r\n" close $f set f [open $path(test1) r] set l "" lappend l [file size $path(test1)]
︙
6136 6137 6138 6139 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150	6221 6222 6223 6224 6225 6226 6227 6228 6229 6230 6231 6232 6233 6234 6235	- +	lappend l [read $f 1] lappend l [eof $f] close $f set l } "7 a 1 [list \r] 2 b 3 [list \r] 4 c 5 { } 7 0 {} 1" test io-49.2 {testing crlf reading, leftover cr disgorgment} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "a\rb\rc\r\n" close $f set f [open $path(test1) r] set l "" lappend l [file size $path(test1)]
︙
6159 6160 6161 6162 6163 6164 6165 6166 6167 6168 6169 6170 6171 6172 6173 6174 6175 6176 6177 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 6215 6216 6217 6218 6219 6220 6221 6222 6223 6224 6225 6226 6227 6228 6229 6230 6231 6232 6233 6234 6235 6236 6237 6238 6239 6240 6241 6242 6243 6244 6245 6246 6247 6248 6249 6250 6251 6252 6253 6254 6255 6256 6257 6258 6259 6260 6261 6262 6263 6264 6265 6266 6267 6268 6269	6244 6245 6246 6247 6248 6249 6250 6251 6252 6253 6254 6255 6256 6257 6258 6259 6260 6261 6262 6263 6264 6265 6266 6267 6268 6269 6270 6271 6272 6273 6274 6275 6276 6277 6278 6279 6280 6281 6282 6283 6284 6285 6286 6287 6288 6289 6290 6291 6292 6293 6294 6295 6296 6297 6298 6299 6300 6301 6302 6303 6304 6305 6306 6307 6308 6309 6310 6311 6312 6313 6314 6315 6316 6317 6318 6319 6320 6321 6322 6323 6324 6325 6326 6327 6328 6329 6330 6331 6332 6333 6334 6335 6336 6337 6338 6339 6340 6341 6342 6343 6344 6345 6346 6347 6348 6349 6350 6351 6352 6353 6354	- + - + - + - + - + - +	lappend l [read $f 2] lappend l [tell $f] lappend l [eof $f] close $f set l } "7 [list a\r] 2 [list b\r] 4 [list c\n] 7 0 {} 7 1" test io-49.3 {testing crlf reading, leftover cr disgorgment} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "a\rb\rc\r\n" close $f set f [open $path(test1) r] set l "" lappend l [file size $path(test1)] fconfigure $f -translation crlf lappend l [read $f 3] lappend l [tell $f] lappend l [read $f 3] lappend l [tell $f] lappend l [eof $f] lappend l [read $f 3] lappend l [tell $f] lappend l [eof $f] close $f set l } "7 [list a\rb] 3 [list \rc\n] 7 0 {} 7 1" test io-49.4 {testing crlf reading, leftover cr disgorgment} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "a\rb\rc\r\n" close $f set f [open $path(test1) r] set l "" lappend l [file size $path(test1)] fconfigure $f -translation crlf lappend l [read $f 3] lappend l [tell $f] lappend l [gets $f] lappend l [tell $f] lappend l [eof $f] lappend l [gets $f] lappend l [tell $f] lappend l [eof $f] close $f set l } "7 [list a\rb] 3 [list \rc] 7 0 {} 7 1" test io-49.5 {testing crlf reading, leftover cr disgorgment} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "a\rb\rc\r\n" close $f set f [open $path(test1) r] set l "" lappend l [file size $path(test1)] fconfigure $f -translation crlf lappend l [set x [gets $f]] lappend l [tell $f] lappend l [gets $f] lappend l [tell $f] lappend l [eof $f] close $f set l } [list 7 a\rb\rc 7 {} 7 1] testConstraint testchannelevent [llength [info commands testchannelevent]] test io-50.1 {testing handler deletion} {testchannelevent} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] close $f set f [open $path(test1) r] testchannelevent $f add readable [namespace code [list delhandler $f]] proc delhandler {f} { variable z set z called testchannelevent $f delete 0 } set z not_called update close $f set z } called test io-50.2 {testing handler deletion with multiple handlers} {testchannelevent} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] close $f set f [open $path(test1) r] testchannelevent $f add readable [namespace code [list delhandler $f 1]] testchannelevent $f add readable [namespace code [list delhandler $f 0]] proc delhandler {f i} { variable z lappend z "called delhandler $f $i" testchannelevent $f delete 0 } set z "" update close $f string compare [string tolower $z] \ [list [list called delhandler $f 0] [list called delhandler $f 1]] } 0 test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] close $f set f [open $path(test1) r] testchannelevent $f add readable [namespace code [list notcalled $f 1]] testchannelevent $f add readable [namespace code [list delhandler $f 0]] set z "" proc notcalled {f i} {
︙
6281 6282 6283 6284 6285 6286 6287 6288 6289 6290 6291 6292 6293 6294 6295	6366 6367 6368 6369 6370 6371 6372 6373 6374 6375 6376 6377 6378 6379 6380	- +	update close $f string compare [string tolower $z] \ [list [list delhandler $f 0 called] \ [list delhandler $f 0 deleted myself]] } 0 test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] close $f set f [open $path(test1) r] testchannelevent $f add readable [namespace code [list delrecursive $f]] proc delrecursive {f} { variable z variable u
︙
6306 6307 6308 6309 6310 6311 6312 6313 6314 6315 6316 6317 6318 6319 6320	6391 6392 6393 6394 6395 6396 6397 6398 6399 6400 6401 6402 6403 6404 6405	- +	set z "" update close $f string compare [string tolower $z] \ {{delrecursive calling recursive} {delrecursive deleting recursive}} } 0 test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] close $f set f [open $path(test1) r] testchannelevent $f add readable [namespace code [list notcalled $f]] testchannelevent $f add readable [namespace code [list del $f]] proc notcalled {f} { variable z
︙
6340 6341 6342 6343 6344 6345 6346 6347 6348 6349 6350 6351 6352 6353 6354	6425 6426 6427 6428 6429 6430 6431 6432 6433 6434 6435 6436 6437 6438 6439	- +	update close $f string compare [string tolower $z] \ [list {del calling recursive} {del deleted notcalled} \ {del deleted myself} {del after update}] } 0 test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] close $f set f [open $path(test1) r] testchannelevent $f add readable [namespace code [list second $f]] testchannelevent $f add readable [namespace code [list first $f]] proc first {f} { variable u
︙
6422 6423 6424 6425 6426 6427 6428 6429 6430 6431 6432 6433 6434 6435 6436 6437 6438 6439 6440 6441 6442 6443 6444 6445 6446 6447 6448 6449 6450 6451 6452 6453 6454 6455 6456 6457 6458 6459 6460 6461 6462 6463 6464 6465 6466 6467 6468 6469 6470 6471 6472 6473 6474 6475 6476 6477 6478 6479 6480 6481 6482 6483 6484 6485 6486 6487 6488 6489 6490 6491 6492 6493 6494 6495 6496 6497 6498 6499 6500 6501 6502 6503 6504 6505 6506 6507 6508 6509 6510 6511 6512 6513 6514 6515 6516 6517 6518 6519 6520 6521 6522 6523 6524 6525 6526 6527 6528 6529 6530 6531 6532 6533 6534 6535 6536 6537 6538 6539 6540	6507 6508 6509 6510 6511 6512 6513 6514 6515 6516 6517 6518 6519 6520 6521 6522 6523 6524 6525 6526 6527 6528 6529 6530 6531 6532 6533 6534 6535 6536 6537 6538 6539 6540 6541 6542 6543 6544 6545 6546 6547 6548 6549 6550 6551 6552 6553 6554 6555 6556 6557 6558 6559 6560 6561 6562 6563 6564 6565 6566 6567 6568 6569 6570 6571 6572 6573 6574 6575 6576 6577 6578 6579 6580 6581 6582 6583 6584 6585 6586 6587 6588 6589 6590 6591 6592 6593 6594 6595 6596 6597 6598 6599 6600 6601 6602 6603 6604 6605 6606 6607 6608 6609 6610 6611 6612 6613 6614 6615 6616 6617 6618 6619 6620 6621 6622 6623 6624 6625	- - + + - - + + - - + + - - + + - - + + - - + + - - + + - - - + + +	vwait [namespace which -variable wait] lappend result [gets $cs] close $cs close $ss set result } {sock1 sock2 sock3 sock4} test io-52.1 {TclCopyChannel} { removeFile test1 test io-52.1 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fcopy $f1 $f2 -command { # } catch { fcopy $f1 $f2 } msg close $f1 close $f2 string compare $msg "channel \"$f1\" is busy" } {0} test io-52.2 {TclCopyChannel} { removeFile test1 test io-52.2 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] set f3 [open $thisScript] fcopy $f1 $f2 -command { # } catch { fcopy $f3 $f2 } msg close $f1 close $f2 close $f3 string compare $msg "channel \"$f2\" is busy" } {0} test io-52.3 {TclCopyChannel} { removeFile test1 test io-52.3 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation cr -blocking 0 set s0 [fcopy $f1 $f2] set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 close $f2 set s1 [file size $thisScript] set s2 [file size $path(test1)] if {("$s1" == "$s2") && ($s0 == $s1)} { lappend result ok } set result } {0 0 ok} test io-52.4 {TclCopyChannel} { removeFile test1 test io-52.4 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation cr -blocking 0 fcopy $f1 $f2 -size 40 set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 close $f2 lappend result [file size $path(test1)] } {0 0 40} test io-52.5 {TclCopyChannel} { removeFile test1 test io-52.5 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation lf -blocking 0 fcopy $f1 $f2 -size -1 set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 close $f2 set s1 [file size $thisScript] set s2 [file size $path(test1)] if {"$s1" == "$s2"} { lappend result ok } set result } {0 0 ok} test io-52.6 {TclCopyChannel} { removeFile test1 test io-52.6 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation lf -blocking 0 set s0 [fcopy $f1 $f2 -size [expr [file size $thisScript] + 5]] set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 close $f2 set s1 [file size $thisScript] set s2 [file size $path(test1)] if {("$s1" == "$s2") && ($s0 == $s1)} { lappend result ok } set result } {0 0 ok} test io-52.7 {TclCopyChannel} { removeFile test1 test io-52.7 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation lf -blocking 0 fcopy $f1 $f2 set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] set s1 [file size $thisScript] set s2 [file size $path(test1)] close $f1 close $f2 if {"$s1" == "$s2"} { lappend result ok } set result } {0 0 ok} test io-52.8 {TclCopyChannel} {stdio} { removeFile test1 removeFile pipe test io-52.8 {TclCopyChannel} {stdio openpipe fcopy} { file delete $path(test1) file delete $path(pipe) set f1 [open $path(pipe) w] fconfigure $f1 -translation lf puts $f1 " puts ready gets stdin set f1 \[open [list $thisScript] r\] fconfigure \$f1 -translation lf
︙
6562 6563 6564 6565 6566 6567 6568 6569 6570 6571 6572 6573 6574 6575 6576	6647 6648 6649 6650 6651 6652 6653 6654 6655 6656 6657 6658 6659 6660 6661	- +	# Create kyrillic file, use lf translation to avoid os eol issues set out [open $path(kyrillic.txt) w] fconfigure $out -encoding koi8-r -translation lf puts $out "\u0410\u0410" close $out test io-52.9 {TclCopyChannel & encodings} { test io-52.9 {TclCopyChannel & encodings} {fcopy} { # Copy kyrillic to UTF-8, using fcopy. set in [open $path(kyrillic.txt) r] set out [open $path(utf8-fcopy.txt) w] fconfigure $in -encoding koi8-r -translation lf fconfigure $out -encoding utf-8 -translation lf
︙
6593 6594 6595 6596 6597 6598 6599 6600 6601 6602 6603 6604 6605 6606 6607 6608 6609 6610 6611 6612 6613 6614 6615 6616 6617 6618 6619 6620 6621 6622 6623 6624 6625 6626 6627 6628 6629 6630 6631 6632 6633 6634 6635 6636 6637 6638 6639 6640 6641 6642 6643 6644 6645 6646 6647 6648 6649 6650 6651 6652 6653 6654 6655 6656 6657 6658 6659 6660 6661 6662 6663 6664 6665 6666 6667 6668 6669 6670 6671 6672 6673 6674 6675 6676 6677 6678 6679 6680 6681 6682 6683 6684 6685 6686 6687 6688 6689 6690 6691 6692 6693 6694 6695 6696 6697 6698 6699 6700 6701 6702 6703 6704 6705 6706 6707 6708 6709 6710 6711 6712	6678 6679 6680 6681 6682 6683 6684 6685 6686 6687 6688 6689 6690 6691 6692 6693 6694 6695 6696 6697 6698 6699 6700 6701 6702 6703 6704 6705 6706 6707 6708 6709 6710 6711 6712 6713 6714 6715 6716 6717 6718 6719 6720 6721 6722 6723 6724 6725 6726 6727 6728 6729 6730 6731 6732 6733 6734 6735 6736 6737 6738 6739 6740 6741 6742 6743 6744 6745 6746 6747 6748 6749 6750 6751 6752 6753 6754 6755 6756 6757 6758 6759 6760 6761 6762 6763 6764 6765 6766 6767 6768 6769 6770 6771 6772 6773 6774 6775 6776 6777 6778 6779 6780 6781 6782 6783 6784 6785 6786 6787 6788 6789 6790 6791 6792 6793 6794 6795 6796 6797 6798	- + - + - - - + + - - + + - - - + + + - + - + + + - + - + - - + +	close $out list [file size $path(kyrillic.txt)] \ [file size $path(utf8-fcopy.txt)] \ [file size $path(utf8-rp.txt)] } {3 5 5} test io-52.10 {TclCopyChannel & encodings} { test io-52.10 {TclCopyChannel & encodings} {fcopy} { # encoding to binary (=> implies that the # internal utf-8 is written) set in [open $path(kyrillic.txt) r] set out [open $path(utf8-fcopy.txt) w] fconfigure $in -encoding koi8-r -translation lf # -translation binary is also -encoding binary fconfigure $out -translation binary fcopy $in $out close $in close $out file size $path(utf8-fcopy.txt) } 5 test io-52.11 {TclCopyChannel & encodings} { test io-52.11 {TclCopyChannel & encodings} {fcopy} { # binary to encoding => the input has to be # in utf-8 to make sense to the encoder set in [open $path(utf8-fcopy.txt) r] set out [open $path(kyrillic.txt) w] # -translation binary is also -encoding binary fconfigure $in -translation binary fconfigure $out -encoding koi8-r -translation lf fcopy $in $out close $in close $out file size $path(kyrillic.txt) } 3 test io-53.1 {CopyData} { removeFile test1 test io-53.1 {CopyData} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation cr -blocking 0 fcopy $f1 $f2 -size 0 set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 close $f2 lappend result [file size $path(test1)] } {0 0 0} test io-53.2 {CopyData} { removeFile test1 test io-53.2 {CopyData} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation cr -blocking 0 fcopy $f1 $f2 -command [namespace code {set s0}] set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] variable s0 vwait [namespace which -variable s0] close $f1 close $f2 set s1 [file size $thisScript] set s2 [file size $path(test1)] if {("$s1" == "$s2") && ($s0 == $s1)} { lappend result ok } set result } {0 0 ok} test io-53.3 {CopyData: background read underflow} {stdio unixOnly} { removeFile test1 removeFile pipe test io-53.3 {CopyData: background read underflow} {stdio unixOnly openpipe fcopy} { file delete $path(test1) file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 [format { puts -nonewline $f1 { puts ready flush stdout ;# Don't assume line buffered! fcopy stdin stdout -command { set x } vwait x set f [open "%s" w] set f [} puts $f1 [list open $path(test1) w]] puts $f1 { fconfigure $f -translation lf puts $f "done" close $f } $path(test1)] } close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] set result [gets $f1] puts $f1 line1 flush $f1 lappend result [gets $f1] puts $f1 line2 flush $f1 lappend result [gets $f1] close $f1 after 500 set f [open $path(test1)] lappend result [read $f] close $f set result } "ready line1 line2 {done\n}" test io-53.4 {CopyData: background write overflow} {stdio unixOnly} { test io-53.4 {CopyData: background write overflow} {stdio unixOnly openpipe fileevent fcopy} { set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n variable x for {set x 0} {$x < 12} {incr x} { append big $big } removeFile test1 removeFile pipe file delete $path(test1) file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 { puts ready fcopy stdin stdout -command { set x } vwait x set f [open $path(test1) w] fconfigure $f -translation lf
︙
6742 6743 6744 6745 6746 6747 6748 6749 6750 6751 6752 6753 6754 6755 6756 6757 6758 6759 6760 6761 6762 6763 6764 6765 6766 6767 6768 6769 6770 6771 6772 6773 6774 6775	6828 6829 6830 6831 6832 6833 6834 6835 6836 6837 6838 6839 6840 6841 6842 6843 6844 6845 6846 6847 6848 6849 6850 6851 6852 6853 6854 6855 6856 6857 6858 6859 6860 6861	- + - + - - + +	if {[string length $error]} { set fcopyTestDone 1 } else { set fcopyTestDone 0 } } test io-53.5 {CopyData: error during fcopy} {socket} { test io-53.5 {CopyData: error during fcopy} {socket fcopy} { variable fcopyTestDone set listen [socket -server [namespace code FcopyTestAccept] 0] set in [open $thisScript] ;# 126 K set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]] catch {unset fcopyTestDone} close $listen ;# This means the socket open never really succeeds fcopy $in $out -command [namespace code FcopyTestDone] variable fcopyTestDone if ![info exists fcopyTestDone] { vwait [namespace which -variable fcopyTestDone] ;# The error occurs here in the b.g. } close $in close $out set fcopyTestDone ;# 1 for error condition } 1 test io-53.6 {CopyData: error during fcopy} {stdio} { test io-53.6 {CopyData: error during fcopy} {stdio openpipe fcopy} { variable fcopyTestDone removeFile pipe removeFile test1 file delete $path(pipe) file delete $path(test1) catch {unset fcopyTestDone} set f1 [open $path(pipe) w] puts $f1 "exit 1" close $f1 set in [open "|[list [interpreter] $path(pipe)]" r+] set out [open $path(test1) w] fcopy $in $out -command [namespace code FcopyTestDone]
︙
6795 6796 6797 6798 6799 6800 6801 6802 6803 6804 6805 6806 6807 6808 6809 6810 6811 6812	6881 6882 6883 6884 6885 6886 6887 6888 6889 6890 6891 6892 6893 6894 6895 6896 6897	- + - + -	after 100 [list fcopy $in $out -size 1000 \ -command [namespace code [list doFcopy $in $out]] ] } } test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio} { test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio openpipe fcopy} { variable fcopyTestDone removeFile pipe file delete $path(pipe) removeFile test1 catch {unset fcopyTestDone} set fcopyTestCount 0 set f1 [open $path(pipe) w] puts $f1 { # Write 10 bytes / 10 msec proc Write {count} { puts -nonewline "1234567890"
︙
6831 6832 6833 6834 6835 6836 6837 6838 6839 6840 6841 6842 6843 6844 6845	6916 6917 6918 6919 6920 6921 6922 6923 6924 6925 6926 6927 6928 6929 6930	- +	} catch {close $in} close $out # -1=error 0=script error N=number of bytes expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1 } {3450} test io-54.1 {Recursive channel events} {socket} { test io-54.1 {Recursive channel events} {socket fileevent} { # This test checks to see if file events are delivered during recursive # event loops when there is buffered data on the channel. proc accept {s a p} { variable as fconfigure $s -translation lf puts $s "line 1\nline2\nline3"
︙
6885 6886 6887 6888 6889 6890 6891 6892 6893 6894 6895 6896 6897 6898 6899	6970 6971 6972 6973 6974 6975 6976 6977 6978 6979 6980 6981 6982 6983 6984	- +	vwait [namespace which -variable x] after cancel $a close $as close $ss close $cs list $result $x } {{{line 1} 1 2} 2} test io-54.2 {Testing for busy-wait in recursive channel events} {socket} { test io-54.2 {Testing for busy-wait in recursive channel events} {socket fileevent} { set accept {} set after {} variable s [socket -server [namespace code accept] 0] proc accept {s a p} { variable counter variable accept
︙
6947 6948 6949 6950 6951 6952 6953 6954 6955 6956 6957 6958 6959 6960 6961	7032 7033 7034 7035 7036 7037 7038 7039 7040 7041 7042 7043 7044 7045 7046	- +	after cancel $after if {$accept != {}} {close $accept} set counter } 1 set path(fooBar) [makeFile {} fooBar] test io-55.1 {ChannelEventScriptInvoker: deletion} { test io-55.1 {ChannelEventScriptInvoker: deletion} {fileevent} { variable x proc eventScript {fd} { variable x close $fd error "planned error" set x whoops }
︙
6984 6985 6986 6987 6988 6989 6990 6991 6992 6993 6994 6995 6996 6997 6998	7069 7070 7071 7072 7073 7074 7075 7076 7077 7078 7079 7080 7081 7082 7083	- +	after idle [namespace code {set y done}] variable y vwait [namespace which -variable y] close $f lappend result $y } {2 done} test io-57.1 {buffered data and file events, gets} { test io-57.1 {buffered data and file events, gets} {fileevent} { proc accept {sock args} { variable s2 set s2 $sock } set server [socket -server [namespace code accept] 0] set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]] variable s2
︙
7007 7008 7009 7010 7011 7012 7013 7014 7015 7016 7017 7018 7019 7020 7021	7092 7093 7094 7095 7096 7097 7098 7099 7100 7101 7102 7103 7104 7105 7106	- +	lappend result [gets $s2] vwait [namespace which -variable result] close $s close $s2 close $server set result } {12 readable 34567890 timer} test io-57.2 {buffered data and file events, read} { test io-57.2 {buffered data and file events, read} {fileevent} { proc accept {sock args} { variable s2 set s2 $sock } set server [socket -server [namespace code accept] 0] set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]] variable s2
︙
7031 7032 7033 7034 7035 7036 7037 7038 7039 7040 7041 7042 7043 7044 7045	7116 7117 7118 7119 7120 7121 7122 7123 7124 7125 7126 7127 7128 7129 7130	- +	vwait [namespace which -variable result] close $s close $s2 close $server set result } {1 readable 234567890 timer} test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc} { test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc openpipe fileevent} { set out [open $path(script) w] puts $out { puts "normal message from pipe" puts stderr "error message from pipe" exit 1 } proc readit {pipe} {
︙
7074 7075 7076 7077 7078 7079 7080 7081 7082 7083 7084 7085 7086 7087 7088	7159 7160 7161 7162 7163 7164 7165 7166 7167 7168 7169 7170 7171 7172 7173	- +	set f [open $path(longfile) r] set result [testchannel mthread $f] close $f string equal $result [testmainthread] } {1} test io-60.1 {writing illegal utf sequences} { test io-60.1 {writing illegal utf sequences} {openpipe fileevent} { # This test will hang in older revisions of the core. set out [open $path(script) w] puts $out { puts [encoding convertfrom identity \xe2] exit 1 }
︙
7105 7106 7107 7108 7109 7110 7111 7112 7113 7114 7115 7116 7117 7118 7119 7120 7121 7122 7123	7190 7191 7192 7193 7194 7195 7196 7197 7198 7199 7200 7201 7202 7203 7204 7205 7206 7207 7208 7209 7210 7211 7212 7213 7214 7215 7216 7217 7218 7219 7220 7221 7222 7223 7224 7225 7226 7227 7228 7229 7230 7231 7232	- - + + + + + + + + + + + + + + + + + + + + + + + + + + - +	vwait [namespace which -variable x] # cut of the remainder of the error stack, especially the filename set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]] list $x $result } {1 {gets {} catch {error writing "stdout": invalid argument}}} test io-61.1 {Reset eof state after changing the eof char} -setup { set datafile [makeFile {} eofchar] set f [open $datafile w] fconfigure $f -translation binary puts -nonewline $f [string repeat "Ho hum\n" 11] puts $f = set line [string repeat "Ge gla " 4] puts -nonewline $f [string repeat [string trimright $line]\n 834] close $f } -body { set f [open $datafile r] fconfigure $f -eofchar = set res {} lappend res [read $f; tell $f] fconfigure $f -eofchar {} lappend res [read $f 1] lappend res [read $f; tell $f] # Any seek zaps the internals into a good state. #seek $f 0 start #seek $f 0 current #lappend res [read $f; tell $f] close $f set res } -cleanup { removeFile eofchar } -result {77 = 23431} # cleanup foreach file [list fooBar longfile script output test1 pipe my_script foo \ bar test2 test3 cat stdout] { bar test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { removeFile $file } cleanupTests } namespace delete ::tcl::test::io return

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	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	+ - + - + -	# -*- tcl -*- # Commands covered: open, close, gets, read, puts, seek, tell, eof, flush, # fblocked, fconfigure, open, channel, fcopy # # 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-1994 The Regents of the University of California. # Copyright (c) 1994-1996 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. # # RCS: @(#) $Id: ioCmd.test,v 1.16 2003/02/19 16:43:30 das Exp $ # RCS: @(#) $Id: ioCmd.test,v 1.16.2.3 2006/03/16 18:23:24 andreas_kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } removeFile test1 testConstraint fcopy [llength [info commands fcopy]] removeFile pipe test iocmd-1.1 {puts command} { list [catch {puts} msg] $msg } {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}} test iocmd-1.2 {puts command} { list [catch {puts a b c d e f g} msg] $msg } {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}}
︙
118 119 120 121 122 123 124 125 126 127 128 129 130 131 132	118 119 120 121 122 123 124 125 126 127 128 129 130 131 132	- +	test iocmd-4.6 {read command} { list [catch {read stdout} msg] $msg } {1 {channel "stdout" wasn't opened for reading}} test iocmd-4.7 {read command} { list [catch {read -nonewline stdout} msg] $msg } {1 {channel "stdout" wasn't opened for reading}} test iocmd-4.8 {read command with incorrect combination of arguments} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] puts $f "Two lines: this one" puts $f "and this one" close $f set f [open $path(test1)] set x [list [catch {read -nonewline $f 20 z} msg] $msg $errorCode] close $f
︙
194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240	194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240	- + - + - + - +	test iocmd-8.2 {fconfigure command} { list [catch {fconfigure a b c d e f} msg] $msg } {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName value?..."}} test iocmd-8.3 {fconfigure command} { list [catch {fconfigure a b} msg] $msg } {1 {can not find channel named "a"}} test iocmd-8.4 {fconfigure command} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] set x [list [catch {fconfigure $f1 froboz} msg] $msg] close $f1 set x } {1 {bad option "froboz": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}} test iocmd-8.5 {fconfigure command} { list [catch {fconfigure stdin -buffering froboz} msg] $msg } {1 {bad value for -buffering: must be one of full, line, or none}} test iocmd-8.6 {fconfigure command} { list [catch {fconfigure stdin -translation froboz} msg] $msg } {1 {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform}} test iocmd-8.7 {fconfigure command} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} -encoding unicode set x [fconfigure $f1] close $f1 set x } {-blocking 1 -buffering full -buffersize 4096 -encoding unicode -eofchar {} -translation lf} test iocmd-8.8 {fconfigure command} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf -buffering line -buffersize 3030 \ -eofchar {} -encoding unicode set x "" lappend x [fconfigure $f1 -buffering] lappend x [fconfigure $f1] close $f1 set x } {line {-blocking 1 -buffering line -buffersize 3030 -encoding unicode -eofchar {} -translation lf}} test iocmd-8.9 {fconfigure command} { removeFile test1 file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation binary -buffering none -buffersize 4040 \ -eofchar {} -encoding binary set x [fconfigure $f1] close $f1 set x } {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -translation lf}
︙
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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452	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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447	- + - + - - - + + + - - - - - - + + + + - - - + - + - - - + + + - - - + +	test iocmd-10.5 {fblocked command} { fblocked stdin } 0 set path(test4) [makeFile {} test4] set path(test5) [makeFile {} test5] removeFile test5 file delete $path(test5) test iocmd-11.1 {I/O to command pipelines} {unixOrPc unixExecs} { set f [open $path(test4) w] close $f list [catch {open "| cat < $path(test4) > $path(test5)" w} msg] $msg $errorCode } {1 {can't write input to command: standard input was redirected} NONE} test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} { list [catch {open "| echo > $path(test5)" r} msg] $msg $errorCode } {1 {can't read output from command: standard output was redirected} NONE} test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} { list [catch {open "| echo > $path(test5)" r+} msg] $msg $errorCode } {1 {can't read output from command: standard output was redirected} NONE} test iocmd-12.1 {POSIX open access modes: RDONLY} { removeFile test1 file delete $path(test1) set f [open $path(test1) w] puts $f "Two lines: this one" puts $f "and this one" close $f set f [open $path(test1) RDONLY] set x [list [gets $f] [catch {puts $f Test} msg] $msg] close $f string compare $x \ "{Two lines: this one} 1 [list [format "channel \"%s\" wasn't opened for writing" $f]]" } 0 test iocmd-12.2 {POSIX open access modes: RDONLY} { removeFile test3 set msg [list [catch {open $path(test3) RDONLY} msg] $msg] test iocmd-12.2 {POSIX open access modes: RDONLY} -match regexp -body { file delete $path(test3) open $path(test3) RDONLY regsub [file join {} $path(test3)] $msg "test3" msg string tolower $msg } {1 {couldn't open "test3": no such file or directory}} test iocmd-12.3 {POSIX open access modes: WRONLY} { removeFile test3 set msg [list [catch {open $path(test3) WRONLY} msg] $msg] } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} test iocmd-12.3 {POSIX open access modes: WRONLY} -match regexp -body { file delete $path(test3) open $path(test3) WRONLY regsub [file join {} $path(test3)] $msg "test3" msg string tolower $msg } {1 {couldn't open "test3": no such file or directory}} } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} # # Test 13.4 relies on assigning the same channel name twice. # test iocmd-12.4 {POSIX open access modes: WRONLY} {unixOnly} { removeFile test3 file delete $path(test3) set f [open $path(test3) w] fconfigure $f -eofchar {} puts $f xyzzy close $f set f [open $path(test3) WRONLY] fconfigure $f -eofchar {} puts -nonewline $f "ab" seek $f 0 current set x [list [catch {gets $f} msg] $msg] close $f set f [open $path(test3) r] fconfigure $f -eofchar {} lappend x [gets $f] close $f set y [list 1 [format "channel \"%s\" wasn't opened for reading" $f] abzzy] string compare $x $y } 0 test iocmd-12.5 {POSIX open access modes: RDWR} { removeFile test3 set msg [list [catch {open $path(test3) RDWR} msg] $msg] test iocmd-12.5 {POSIX open access modes: RDWR} -match regexp -body { file delete $path(test3) open $path(test3) RDWR regsub [file join {} $path(test3)] $msg "test3" msg string tolower $msg } {1 {couldn't open "test3": no such file or directory}} } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} test iocmd-12.6 {POSIX open access modes: errors} { concat [catch {open $path(test3) "FOO \{BAR BAZ"} msg] $msg\n$errorInfo } "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 RDONLY, WRONLY, RDWR, APPEND, CREAT EXCL, NOCTTY, NONBLOCK, or TRUNC}} 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, WRONLY, or RDWR}} close [open $path(test3) w] 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?"}}
︙
460 461 462 463 464 465 466 467 468 469 470 471 472 473	455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	list [catch {open $path(test1) r+1} msg] $msg } {1 {illegal access mode "r+1"}} test iocmd-13.6 {errors in open command} { set msg [list [catch {open _non_existent_} msg] $msg $errorCode] regsub [file join {} _non_existent_] $msg "_non_existent_" msg string tolower $msg } {1 {couldn't open "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}} test iocmd-13.7.1 {open for append, a mode} -setup { set log [makeFile {} out] set chans {} } -body { foreach i { 0 1 2 3 4 5 6 7 8 9 } { puts [set ch [open $log a]] $i lappend chans $ch } foreach ch $chans {catch {close $ch}} lsort [split [string trim [viewFile out]] \n] } -cleanup { removeFile out # Ensure that channels are gone, even if body failed to do so foreach ch $chans {catch {close $ch}} } -result {0 1 2 3 4 5 6 7 8 9} test iocmd-13.7.2 {open for append, O_APPEND} -setup { set log [makeFile {} out] set chans {} } -body { foreach i { 0 1 2 3 4 5 6 7 8 9 } { puts [set ch [open $log {WRONLY CREAT APPEND}]] $i lappend chans $ch } foreach ch $chans {catch {close $ch}} lsort [split [string trim [viewFile out]] \n] } -cleanup { removeFile out # Ensure that channels are gone, even if body failed to do so foreach ch $chans {catch {close $ch}} } -result {0 1 2 3 4 5 6 7 8 9} test iocmd-14.1 {file id parsing errors} { list [catch {eof gorp} msg] $msg $errorCode } {1 {can not find channel named "gorp"} NONE} test iocmd-14.2 {file id parsing errors} { list [catch {eof filex} msg] $msg } {1 {can not find channel named "filex"}}
︙
497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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	528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594	- + - + - + - + - + - + - + - + - + - + - + - + - + - - + + - +	close $f set expect "1 {can not find channel named \"$f\"}" test iocmd-14.10 {file id parsing errors} { list [catch {eof $f} msg] $msg } $expect test iocmd-15.1 {Tcl_FcopyObjCmd} { test iocmd-15.1 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy} msg] $msg } {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}} test iocmd-15.2 {Tcl_FcopyObjCmd} { test iocmd-15.2 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy 1} msg] $msg } {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}} test iocmd-15.3 {Tcl_FcopyObjCmd} { test iocmd-15.3 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy 1 2 3 4 5 6 7} msg] $msg } {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}} test iocmd-15.4 {Tcl_FcopyObjCmd} { test iocmd-15.4 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy 1 2 3} msg] $msg } {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}} test iocmd-15.5 {Tcl_FcopyObjCmd} { test iocmd-15.5 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy 1 2 3 4 5} msg] $msg } {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}} set path(test2) [makeFile {} test2] set f [open $path(test1) w] close $f set rfile [open $path(test1) r] set wfile [open $path(test2) w] test iocmd-15.6 {Tcl_FcopyObjCmd} { test iocmd-15.6 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy foo $wfile} msg] $msg } {1 {can not find channel named "foo"}} test iocmd-15.7 {Tcl_FcopyObjCmd} { test iocmd-15.7 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy $rfile foo} msg] $msg } {1 {can not find channel named "foo"}} test iocmd-15.8 {Tcl_FcopyObjCmd} { test iocmd-15.8 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy $wfile $wfile} msg] $msg } "1 {channel \"$wfile\" wasn't opened for reading}" test iocmd-15.9 {Tcl_FcopyObjCmd} { test iocmd-15.9 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy $rfile $rfile} msg] $msg } "1 {channel \"$rfile\" wasn't opened for writing}" test iocmd-15.10 {Tcl_FcopyObjCmd} { test iocmd-15.10 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy $rfile $wfile foo bar} msg] $msg } {1 {bad switch "foo": must be -size or -command}} test iocmd-15.11 {Tcl_FcopyObjCmd} { test iocmd-15.11 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy $rfile $wfile -size foo} msg] $msg } {1 {expected integer but got "foo"}} test iocmd-15.12 {Tcl_FcopyObjCmd} { test iocmd-15.12 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy $rfile $wfile -command bar -size foo} msg] $msg } {1 {expected integer but got "foo"}} close $rfile close $wfile # cleanup foreach file [list test1 test2 test3 test4] { catch {::tcltest::removeFile $file} removeFile $file } # delay long enough for background processes to finish after 500 foreach file [list test5 pipe output] { catch {::tcltest::removeFile $file} foreach file [list test5] { removeFile $file } ::tcltest::cleanupTests cleanupTests return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	- +	# This file (ioUtil.test) tests the hookable TclStat(), TclAccess(), # and Tcl_OpenFileChannel, routines in the file generic/tclIOUtils.c. # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # 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. # # RCS: @(#) $Id: ioUtil.test,v 1.13 2002/07/18 09:40:24 vincentdarley Exp $ # RCS: @(#) $Id: ioUtil.test,v 1.13.2.1 2003/04/14 15:45:57 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::testConstraint testopenfilechannelproc \
︙
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130	109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130	- + - +	catch {teststatproc delete TestStatProc3} err11 list $err9 $err10 $err11 } {{"TestStatProc1": could not be deleteed} {"TestStatProc2": could not be deleteed} {"TestStatProc3": could not be deleteed}} eval $unsetScript test ioUtil-1.1 {TclAccess: Check that none of the test procs are there.} { test ioUtil-1.9 {TclAccess: Check that none of the test procs are there.} { catch {file exists testAccess1%.fil} err1 catch {file exists testAccess2%.fil} err2 catch {file exists testAccess3%.fil} err3 list $err1 $err2 $err3 } {0 0 0} test ioUtil-1.2 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} {testaccessproc} { test ioUtil-1.10 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} {testaccessproc} { catch {testaccessproc insert TclpAccess} err1 testaccessproc insert TestAccessProc1 testaccessproc insert TestAccessProc2 testaccessproc insert TestAccessProc3 set err1 } {bad arg "insert": must be TestAccessProc1, TestAccessProc2, or TestAccessProc3}
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	# -*- tcl -*- # Commands covered: transform, and stacking in general # # This file contains a collection of tests for Giot # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # Copyright (c) 2000 Ajuba Solutions. # Copyright (c) 2000 Andreas Kupries. # All rights reserved. # # RCS: @(#) $Id: iogt.test,v 1.7 2002/07/04 15:46:55 andreas_kupries Exp $ # RCS: @(#) $Id: iogt.test,v 1.7.2.1 2005/04/14 07:10:57 davygrvy Exp $ if {[catch {package require tcltest 2.1}]} { puts stderr "Skipping tests in [info script]. tcltest 2.1 required." return } namespace eval ::tcl::test::iogt {
︙
494 495 496 497 498 499 500 501 502 503 504 505 506 507 508	494 495 496 497 498 499 500 501 502 503 504 505 506 507 508	- +	set fout [open $path(dummyout) w] set ain [list] ; set aout [list] audit_ops ain -attach $fin audit_ops aout -attach $fout fconfigure $fin -buffersize 10 fconfigure $fout -buffersize 5 fconfigure $fout -buffersize 10 fcopy $fin $fout close $fin close $fout set res "[join $ain \n]\n--------\n[join $aout \n]"
︙
544 545 546 547 548 549 550 551 552 553 554 555 556 557 558	544 545 546 547 548 549 550 551 552 553 554 555 556 557 558	- +	set fout [open $path(dummyout) w] set ain [list] ; set aout [list] audit_flow ain -attach $fin audit_flow aout -attach $fout fconfigure $fin -buffersize 10 fconfigure $fout -buffersize 5 fconfigure $fout -buffersize 10 fcopy $fin $fout close $fin close $fout set res "[join $ain \n]\n--------\n[join $aout \n]"
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	# Commands covered: list # # 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. # # RCS: @(#) $Id: list.test,v 1.5 2000/04/10 17:19:01 ericm Exp $ # RCS: @(#) $Id: list.test,v 1.5.24.1 2003/03/27 13:11:15 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } # First, a bunch of individual tests
︙
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	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	- - - - + + - + - - + - - + - - - - - - - - - - - - - - - + + + + + + + + + + + + + +	test list-1.22 {basic tests} {list "{ab}\\"} \\{ab\\}\\\\ test list-1.23 {basic tests} {list \{} "\\{" test list-1.24 {basic tests} {list} {} # For the next round of tests create a list and then pick it apart # with "index" to make sure that we get back exactly what went in. test list-2.1 {placeholder} { } {} set num 1 proc lcheck {a b c} { set num 0 proc lcheck {testid a b c} { global num d set d [list $a $b $c] ; test list-2.$num {what goes in must come out} {lindex $d 0} $a test ${testid}-0 {what goes in must come out} {lindex $d 0} $a set num [expr $num+1] ; test list-2.$num {what goes in must come out} {lindex $d 1} $b test ${testid}-1 {what goes in must come out} {lindex $d 1} $b set num [expr $num+1] ; test list-2.$num {what goes in must come out} {lindex $d 2} $c test ${testid}-2 {what goes in must come out} {lindex $d 2} $c set num [expr $num+1] } lcheck a b c lcheck "a b" c\td e\nf lcheck {{a b}} {} { } lcheck \$ \$ab ab\$ lcheck \; \;ab ab\; lcheck \[ \[ab ab\[ lcheck \\ \\ab ab\\ lcheck {"} {"ab} {ab"} lcheck {a b} { ab} {ab } lcheck a{ a{b \{ab lcheck a} a}b }ab lcheck a\\} {a \}b} {a \{c} lcheck xyz \\ 1\\\n2 lcheck "{ab}\\" "{ab}xy" abc lcheck list-2.1 a b c lcheck list-2.2 "a b" c\td e\nf lcheck list-2.3 {{a b}} {} { } lcheck list-2.4 \$ \$ab ab\$ lcheck list-2.5 \; \;ab ab\; lcheck list-2.6 \[ \[ab ab\[ lcheck list-2.7 \\ \\ab ab\\ lcheck list-2.8 {"} {"ab} {ab"} ;#" Stupid emacs highlighting! lcheck list-2.9 {a b} { ab} {ab } lcheck list-2.10 a{ a{b \{ab lcheck list-2.11 a} a}b }ab lcheck list-2.12 a\\} {a \}b} {a \{c} lcheck list-2.13 xyz \\ 1\\\n2 lcheck list-2.14 "{ab}\\" "{ab}xy" abc concat {} # Check that tclListObj.c's SetListFromAny handles possible overlarge # string rep lengths in the source object. proc slowsort list {
︙
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127	104 105 106 107 108 109 110	- - - - - - - - - - - -	test list-3.1 {SetListFromAny and lrange/concat results} { slowsort {fred julie alex carol bill annie} } {alex annie bill carol fred julie} # cleanup ::tcltest::cleanupTests return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	# Commands covered: load # # 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) 1995 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. # # RCS: @(#) $Id: load.test,v 1.11 2003/02/01 23:37:29 kennykb Exp $ # RCS: @(#) $Id: load.test,v 1.11.2.1 2004/09/14 17:02:56 das Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } # Figure out what extension is used for shared libraries on this
︙
74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90	74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91	- + + - +	interp create -safe child test load-2.2 {loading into a safe interpreter, with package name conversion} \ [list $dll $loaded] { load [file join $testDir pkgb$ext] pKgB child list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \ [catch {pkgb_sub 12 10} msg2] $msg2 } {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}} test load-2.3 {loading with no _Init procedure} [list $dll $loaded] { test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \ -body { list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg } {1 {couldn't find procedure Foo_Init}} } -match glob -result {1 {*couldn't find procedure Foo_Init}} test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] { list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg } {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}} test load-3.1 {error in _Init procedure, same interpreter} \ [list $dll $loaded] { list [catch {load [file join $testDir pkge$ext] pkge} msg] \
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	# Commands covered: lsearch # # 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. # # RCS: @(#) $Id: lsearch.test,v 1.10 2003/02/27 16:02:00 dkf Exp $ # RCS: @(#) $Id: lsearch.test,v 1.10.2.3 2005/12/09 14:39:25 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } set x {abcd bbcd 123 234 345}
︙
289 290 291 292 293 294 295 296 297 298 299 300 301 302	289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314	+ + + + + + + + + + + +	} set res } [concat -1 -1 [lrange $increasingIntegers 2 end]] test lsearch-10.7 {offset searching with an empty list} { # Stop bug #694232 from reocurring lsearch -start 0 {} x } -1 test lsearch-10.8 {offset searching past the end of the list} { # Stop [Bug 1374778] from reoccurring lsearch -start 10 {a b c} c } -1 test lsearch-10.9 {offset searching past the end of the list} { # Stop [Bug 1374778] from reoccurring lsearch -start 10 -all {a b c} c } {} test lsearch-10.10 {offset searching past the end of the list} { # Stop [Bug 1374778] from reoccurring lsearch -start 10 -inline {a b c} c } {} test lsearch-11.1 {negated searches} { lsearch -not {a a a b a a a} a } 3 test lsearch-11.2 {negated searches} { lsearch -not {a a a a a a a} a } -1
︙
311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 355 356 357 358 359 360 361 362 363 364	323 324 325 326 327 328 329 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 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	- + - + - + - + - + - + - + - + - + - + + + + +	test lsearch-13.1 {search for all matches} { lsearch -all {a b a c a d} 1 } {} test lsearch-13.2 {search for all matches} { lsearch -all {a b a c a d} a } {0 2 4} test lsearch-13.1 {combinations: -all and -inline} { test lsearch-14.1 {combinations: -all and -inline} { lsearch -all -inline -glob {a1 b2 a3 c4 a5 d6} a* } {a1 a3 a5} test lsearch-13.2 {combinations: -all, -inline and -not} { test lsearch-14.2 {combinations: -all, -inline and -not} { lsearch -all -inline -not -glob {a1 b2 a3 c4 a5 d6} a* } {b2 c4 d6} test lsearch-13.3 {combinations: -all and -not} { test lsearch-14.3 {combinations: -all and -not} { lsearch -all -not -glob {a1 b2 a3 c4 a5 d6} a* } {1 3 5} test lsearch-13.4 {combinations: -inline and -not} { test lsearch-14.4 {combinations: -inline and -not} { lsearch -inline -not -glob {a1 b2 a3 c4 a5 d6} a* } {b2} test lsearch-13.5 {combinations: -start, -all and -inline} { test lsearch-14.5 {combinations: -start, -all and -inline} { lsearch -start 2 -all -inline -glob {a1 b2 a3 c4 a5 d6} a* } {a3 a5} test lsearch-13.6 {combinations: -start, -all, -inline and -not} { test lsearch-14.6 {combinations: -start, -all, -inline and -not} { lsearch -start 2 -all -inline -not -glob {a1 b2 a3 c4 a5 d6} a* } {c4 d6} test lsearch-13.7 {combinations: -start, -all and -not} { test lsearch-14.7 {combinations: -start, -all and -not} { lsearch -start 2 -all -not -glob {a1 b2 a3 c4 a5 d6} a* } {3 5} test lsearch-13.8 {combinations: -start, -inline and -not} { test lsearch-14.8 {combinations: -start, -inline and -not} { lsearch -start 2 -inline -not -glob {a1 b2 a3 c4 a5 d6} a* } {c4} test lsearch-14.1 {make sure no shimmering occurs} { test lsearch-15.1 {make sure no shimmering occurs} { set x [expr int(sin(0))] lsearch -start $x $x $x } 0 test lsearch-15.1 {lsearch -regexp shared object} { test lsearch-16.1 {lsearch -regexp shared object} { set str a lsearch -regexp $str $str } 0 # Bug 1366683 test lsearch-16.2 {lsearch -regexp allows internal backrefs} { lsearch -regexp {a aa b} {(.)\1} } 1 # cleanup catch {unset res} catch {unset increasingIntegers} catch {unset decreasingIntegers} catch {unset increasingDoubles} catch {unset decreasingDoubles} catch {unset increasingStrings} catch {unset decreasingStrings} catch {unset increasingDictionary} catch {unset decreasingDictionary} ::tcltest::cleanupTests return

1 2 3 4 5 6 7 8 9 10	1 2 3 4 5 6 7 8 9 10	- +	# This file contains a collection of tests for generic/tclMain.c. # # RCS: @(#) $Id: main.test,v 1.13 2003/02/16 01:36:32 msofer Exp $ # RCS: @(#) $Id: main.test,v 1.13.2.4 2006/09/04 21:36:55 dgp Exp $ if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." return } namespace eval ::tcl::test::main {
︙
484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507	484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528	- + - + + + + + + + + + + + + + + + + + + + + + +	rename exit _exit proc exit code { puts "In exit" _exit $code } } rc] } -body { exec [interpreter] << {puts "In script"} \ exec [interpreter] << {} \ -appinitprocsetrcfile $rc >& result set f [open result] read $f } -cleanup { close $f file delete result removeFile rc } -result "application-specific initialization failed:\ \nIn script\nExit MainLoop\nIn exit\neven 0\n" \nExit MainLoop\nIn exit\neven 0\n" test Tcl_Main-4.5 { Tcl_Main: Bug 1481986 } -constraints { exec Tcltest } -setup { set rc [makeFile { testsetmainloop after 0 {puts "Event callback"} } rc] } -body { set f [open "|[list [interpreter] -appinitprocsetrcfile $rc]" w+] after 1000 type $f {puts {Interactive output} exit } read $f } -cleanup { catch {close $f} removeFile rc } -result "Event callback\nInteractive output\n" # Tests Tcl_Main-5.*: interactive operations test Tcl_Main-5.1 { Tcl_Main: tcl_interactive must be boolean } -constraints { exec
︙
835 836 837 838 839 840 841 842 843 844 845 846 847 848	856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886	+ + + + + + + + + + + + + + + + +	close stdin} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n% " test Tcl_Main-6.7 { [unknown]: interactive auto-completion. } -constraints { exec } -body { exec [interpreter] << { proc foo\{ x {} set ::auto_noexec xxx set tcl_interactive 1 foo y} >& result set f [open result] read $f } -cleanup { close $f file delete result } -result "1\n% % " # Tests Tcl_Main-7.*: exiting test Tcl_Main-7.1 { Tcl_Main: [exit] defined as no-op -> still have exithandlers } -constraints { exec Tcltest
︙

︙
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30	8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30	- + - - + +	# # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # Note that after running these tests, entries will be left behind in the # message catalogs for locales foo, foo_BAR, and foo_BAR_baz. # # RCS: @(#) $Id: msgcat.test,v 1.11 2002/06/17 05:37:39 dgp Exp $ # RCS: @(#) $Id: msgcat.test,v 1.11.2.4 2006/09/11 16:15:12 andreas_kupries Exp $ package require Tcl 8.2 if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." return } if {[catch {package require msgcat 1.3}]} { puts stderr "Skipping tests in [info script]. No msgcat 1.3 found to test." if {[catch {package require msgcat 1.3.4}]} { puts stderr "Skipping tests in [info script]. No msgcat 1.3.4 found to test." return } namespace eval ::msgcat::test { namespace import ::msgcat::* namespace import ::tcltest::test namespace import ::tcltest::cleanupTests
︙
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68	50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72	+ + + - - - - - + + + + + +	variable count 0 variable body variable result variable setVars foreach setVars [PowerSet $envVars] { set result [string tolower [lindex $setVars 0]] if {[string length $result] == 0} { if {[info exists ::tcl::mac::locale]} { set result [string tolower $::tcl::mac::locale] } else { set result c } test msgcat-0.$count { locale initialization from environment variables } -setup { set result c } } test msgcat-0.$count [list \ locale initialization from environment variables $setVars \ ] -setup { variable var foreach var $envVars { catch {variable $var $::env($var)} catch {unset ::env($var)} } foreach var $setVars { set ::env($var) $var
︙
161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185	165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205	+ + + + + + + + + + + + + + + + - +	mclocale en_US_funky } -cleanup { mclocale $locale } -body { mcpreferences } -result {en_us_funky en_us en} test msgcat-1.12 {mclocale set, reject evil input} -setup { variable locale [mclocale] } -cleanup { mclocale $locale } -body { mclocale /path/to/evil/code } -returnCodes error -match glob -result {invalid newLocale value *} test msgcat-1.13 {mclocale set, reject evil input} -setup { variable locale [mclocale] } -cleanup { mclocale $locale } -body { mclocale looks/ok/../../../../but/is/path/to/evil/code } -returnCodes error -match glob -result {invalid newLocale value *} # Tests msgcat-2.*: [mcset], [mcmset], namespace partitioning test msgcat-2.1 {mcset, global scope} { namespace eval :: ::msgcat::mcset foo_BAR text1 text2 } {text2} test msgcat-2.2 {mcset, global scope, default} { namespace eval :: ::msgcat::mcset foo_BAR text3 } {text3} test msgcat-2.2 {mcset, namespace overlap} { test msgcat-2.2.1 {mcset, namespace overlap} { namespace eval baz {::msgcat::mcset foo_BAR con1 con1baz} } {con1baz} test msgcat-2.3 {mcset, namespace overlap} -setup { namespace eval bar {::msgcat::mcset foo_BAR con1 con1bar} namespace eval baz {::msgcat::mcset foo_BAR con1 con1baz} variable locale [mclocale]
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	# Functionality covered: this file contains a collection of tests for the # procedures in tclNamesp.c that implement Tcl's basic support for # namespaces. Other namespace-related tests appear in variable.test. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: namespace.test,v 1.21 2002/06/22 04:19:47 dgp Exp $ # RCS: @(#) $Id: namespace.test,v 1.21.2.10 2006/10/04 17:59:06 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } # Clear out any namespaces called test_ns_*
︙
129 130 131 132 133 134 135 136 137 138 139 140 141 142	129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	namespace eval test_ns_2 { proc p {} { return [namespace current] } } list [test_ns_2::p] [namespace delete test_ns_2] } {::test_ns_2 {}} test namespace-7.3 {recursive Tcl_DeleteNamespace, active call frames in ns} { # [Bug 1355942] namespace eval test_ns_2 { set x 1 trace add variable x unset "namespace delete [namespace current];#" namespace delete [namespace current] } } {} test namespace-7.4 {recursive Tcl_DeleteNamespace, active call frames in ns} { # [Bug 1355942] namespace eval test_ns_2 { proc x {} {} trace add command x delete "namespace delete [namespace current];#" namespace delete [namespace current] } } {} test namespace-7.5 {recursive Tcl_DeleteNamespace, no active call frames in ns} { # [Bug 1355942] namespace eval test_ns_2 { set x 1 trace add variable x unset "namespace delete [namespace current];#" } namespace delete test_ns_2 } {} test namespace-7.6 {recursive Tcl_DeleteNamespace, no active call frames in ns} { # [Bug 1355942] namespace eval test_ns_2 { proc x {} {} trace add command x delete "namespace delete [namespace current];#" } namespace delete test_ns_2 } {} test namespace-8.1 {TclTeardownNamespace, delete global namespace} { catch {interp delete test_interp} interp create test_interp interp eval test_interp { namespace eval test_ns_1 { namespace export p
︙
189 190 191 192 193 194 195 196 197 198 199 200 201 202	221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259	+ + + + + + + + + + + + + + + + + + + + + + + + +	namespace import ::test_ns_export::* proc p {} {return foo} } list [lsort [info commands test_ns_import::*]] \ [namespace delete test_ns_export] \ [info commands test_ns_import::*] } [list [lsort {::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2}] {} ::test_ns_import::p] test namespace-8.5 {TclTeardownNamespace: preserve errorInfo; errorCode values} { interp create slave slave eval {trace add execution error leave {namespace delete :: ;#}} catch {slave eval error foo bar baz} interp delete slave set ::errorInfo } {bar invoked from within "slave eval error foo bar baz"} test namespace-8.6 {TclTeardownNamespace: preserve errorInfo; errorCode values} { interp create slave slave eval {trace add variable errorCode write {namespace delete :: ;#}} catch {slave eval error foo bar baz} interp delete slave set ::errorInfo } {bar invoked from within "slave eval error foo bar baz"} test namespace-8.7 {TclTeardownNamespace: preserve errorInfo; errorCode values} { interp create slave slave eval {trace add execution error leave {namespace delete :: ;#}} catch {slave eval error foo bar baz} interp delete slave set ::errorCode } baz test namespace-9.1 {Tcl_Import, empty import pattern} { catch {eval namespace delete [namespace children :: test_ns_*]} list [catch {namespace eval test_ns_import {namespace import {}}} msg] $msg } {1 {empty import pattern}} test namespace-9.2 {Tcl_Import, unknown namespace in import pattern} { list [catch {namespace eval test_ns_import {namespace import fred::x}} msg] $msg
︙
215 216 217 218 219 220 221 222 223 224 225 226 227 228 229	272 273 274 275 276 277 278 279 280 281 282 283 284 285 286	- +	namespace import ::test_ns_export::* proc p {} {return [cmd1 123]} } test_ns_import::p } {cmd1: 123} test namespace-9.5 {Tcl_Import, can't redefine cmd unless allowOverwrite!=0} { list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg } {1 {can't import command "cmd1": already exists}} } {0 {}} test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} { namespace eval test_ns_import { namespace import -force ::test_ns_export::* cmd1 555 } } {cmd1: 555} test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
︙
240 241 242 243 244 245 246 247 248 249 250 251 252 253	297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	[proc test_ns_export::cmd1 {args} {return "new1: $args"}] \ [namespace origin test_ns_import::cmd1] \ [namespace origin test_ns_export::cmd1] \ [test_ns_import::cmd1 g h i] \ [test_ns_export::cmd1 j k l] } {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}} test namespace-9.8 {Tcl_Import: Bug 1017299} -setup { namespace eval one { namespace export cmd proc cmd {} {} } namespace eval two { namespace export cmd proc other args {} } namespace eval two \ [list namespace import [namespace current]::one::cmd] namespace eval three \ [list namespace import [namespace current]::two::cmd] namespace eval three { rename cmd other namespace export other } } -body { namespace eval two [list namespace import -force \ [namespace current]::three::other] namespace origin two::other } -cleanup { namespace delete one two three } -match glob -result *::one::cmd test namespace-9.9 {Tcl_Import: Bug 1017299} -setup { namespace eval one { namespace export cmd proc cmd {} {} } namespace eval two namespace export cmd namespace eval two \ [list namespace import [namespace current]::one::cmd] namespace eval three namespace export cmd namespace eval three \ [list namespace import [namespace current]::two::cmd] } -body { namespace eval two [list namespace import -force \ [namespace current]::three::cmd] namespace origin two::cmd } -cleanup { namespace delete one two three } -returnCodes error -match glob -result {import pattern * would create a loop*} test namespace-10.1 {Tcl_ForgetImport, check for valid namespaces} { catch {eval namespace delete [namespace children :: test_ns_*]} list [catch {namespace forget xyzzy::*} msg] $msg } {1 {unknown namespace in namespace forget pattern "xyzzy::*"}} test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} { namespace eval test_ns_export { namespace export cmd1
︙
265 266 267 268 269 270 271 272 273 274 275 276 277 278	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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	set l {} lappend l [lsort [info commands ::test_ns_import::*]] namespace forget ::test_ns_export::cmd1 lappend l [info commands ::test_ns_import::*] lappend l [catch {cmd1 777} msg] $msg } } [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}] test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup { namespace eval origin { namespace export cmd proc cmd {} {} } namespace eval unrelated { proc cmd {} {} } namespace eval my \ [list namespace import [namespace current]::origin::cmd] } -body { namespace eval my \ [list namespace forget [namespace current]::unrelated::cmd] my::cmd } -cleanup { namespace delete origin unrelated my } test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup { namespace eval origin { namespace export cmd proc cmd {} {} } namespace eval my \ [list namespace import [namespace current]::origin::cmd] namespace eval my rename cmd newname } -body { namespace eval my \ [list namespace forget [namespace current]::origin::cmd] my::newname } -cleanup { namespace delete origin my } -returnCodes error -match glob -result * test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup { namespace eval origin { namespace export cmd proc cmd {} {} } namespace eval my \ [list namespace import [namespace current]::origin::cmd] namespace eval your {} namespace eval my \ [list rename cmd [namespace current]::your::newname] } -body { namespace eval your namespace forget newname your::newname } -cleanup { namespace delete origin my your } -returnCodes error -match glob -result * test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup { namespace eval origin { namespace export cmd proc cmd {} {} } namespace eval link namespace export cmd namespace eval link \ [list namespace import [namespace current]::origin::cmd] namespace eval link2 namespace export cmd namespace eval link2 \ [list namespace import [namespace current]::link::cmd] namespace eval my \ [list namespace import [namespace current]::link2::cmd] } -body { namespace eval my \ [list namespace forget [namespace current]::origin::cmd] my::cmd } -cleanup { namespace delete origin link link2 my } -returnCodes error -match glob -result * test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup { namespace eval origin { namespace export cmd proc cmd {} {} } namespace eval link namespace export cmd namespace eval link \ [list namespace import [namespace current]::origin::cmd] namespace eval link2 namespace export cmd namespace eval link2 \ [list namespace import [namespace current]::link::cmd] namespace eval my \ [list namespace import [namespace current]::link2::cmd] } -body { namespace eval my \ [list namespace forget [namespace current]::link::cmd] my::cmd } -cleanup { namespace delete origin link link2 my } test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup { namespace eval origin { namespace export cmd proc cmd {} {} } namespace eval link namespace export cmd namespace eval link \ [list namespace import [namespace current]::origin::cmd] namespace eval link2 namespace export cmd namespace eval link2 \ [list namespace import [namespace current]::link::cmd] namespace eval my \ [list namespace import [namespace current]::link2::cmd] } -body { namespace eval my \ [list namespace forget [namespace current]::link2::cmd] my::cmd } -cleanup { namespace delete origin link link2 my } -returnCodes error -match glob -result * test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} { catch {eval namespace delete [namespace children :: test_ns_*]} namespace eval test_ns_export { namespace export cmd1 proc cmd1 {args} {return "cmd1: $args"} }
︙
774 775 776 777 778 779 780 781 782 783 784 785 786 787 788	989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018	+ + + + + + + + + + + + + + +	list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $errorInfo } {1 {invalid command name "xxxx"} {invalid command name "xxxx" while executing "xxxx" (in namespace eval "::test_ns_1" script line 1) invoked from within "namespace eval test_ns_1 {xxxx}"}} test namespace-25.7 {NamespaceEvalCmd, error in eval'd script} { list [catch {namespace eval test_ns_1 {error foo bar baz}} msg] $msg $errorInfo } {1 foo {bar (in namespace eval "::test_ns_1" script line 1) invoked from within "namespace eval test_ns_1 {error foo bar baz}"}} test namespace-25.8 {NamespaceEvalCmd, error in eval'd script} knownBug { list [catch {namespace eval test_ns_1 error foo bar baz} msg] $msg $errorInfo } {1 foo {bar (in namespace eval "::test_ns_1" script line 1) invoked from within "namespace eval test_ns_1 error foo bar baz"}} catch {unset v} test namespace-25.9 {NamespaceEvalCmd, 545325} { namespace eval test_ns_1 info level 0 } {namespace eval test_ns_1 info level 0} test namespace-26.1 {NamespaceExportCmd, no args and new ns} { catch {eval namespace delete [namespace children :: test_ns_*]} namespace export } {} test namespace-26.2 {NamespaceExportCmd, just -clear arg} { namespace export -clear
︙
889 890 891 892 893 894 895 896 897 898 899 900 901 902	1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136	+ + + +	} namespace inscope test_ns_1 cmd } {::test_ns_1::cmd: v=747, args=} test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} { list [namespace inscope test_ns_1 cmd x y z] \ [namespace eval test_ns_1 [concat cmd [list x y z]]] } {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}} test namespace-29.6 {NamespaceInscopeCmd, 1400572} knownBug { namespace inscope test_ns_1 {info level 0} } {namespace inscope test_ns_1 {info level 0}} test namespace-30.1 {NamespaceOriginCmd, bad args} { catch {eval namespace delete [namespace children :: test_ns_*]} list [catch {namespace origin} msg] $msg } {1 {wrong # args: should be "namespace origin name"}} test namespace-30.2 {NamespaceOriginCmd, bad args} { list [catch {namespace origin x y} msg] $msg
︙

︙
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26	9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26	- + - +	# generates output for errors. No output means no errors were found. # # Copyright (c) 2003 by Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: notify.test,v 1.2 2003/02/17 17:23:57 kennykb Exp $ # RCS: @(#) $Id: notify.test,v 1.2.2.1 2003/10/06 13:55:38 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest package require tcltest 2 namespace import -force ::tcltest::* } testConstraint testevent [llength [info commands testevent]] test notify-1.1 {Tcl_QueueEvent and delivery of a single event} \ -constraints {testevent} \
︙

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	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	- + + + + + + + + + + + + + + + + + + + + + + + + + + + +	# Functionality covered: this file contains a collection of tests for the # procedures in tclObj.c that implement Tcl's basic type support and the # type managers for the types boolean, double, and integer. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1995-1996 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. # # RCS: @(#) $Id: obj.test,v 1.7 2002/04/26 08:43:38 dkf Exp $ # RCS: @(#) $Id: obj.test,v 1.7.2.1 2004/09/10 21:52:37 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } if {[info commands testobj] == {}} { puts "This application hasn't been compiled with the \"testobj\"" puts "command, so I can't test the Tcl type and object support." ::tcltest::cleanupTests return } # Procedure to determine the integer range of the machine proc int_range {} { for { set MIN_INT 1 } { $MIN_INT > 0 } {} { set MIN_INT [expr { $MIN_INT << 1 }] } set MAX_INT [expr { ~ $MIN_INT }] return [list $MIN_INT $MAX_INT] } # Procedure to determine the range of wide integers on the machine. proc wide_range {} { for { set MIN_WIDE [expr { wide(1) }] } { $MIN_WIDE > wide(0) } {} { set MIN_WIDE [expr { $MIN_WIDE << 1 }] } set MAX_WIDE [expr { ~ $MIN_WIDE }] return [list $MIN_WIDE $MAX_WIDE] } foreach { MIN_INT MAX_INT } [int_range] break foreach { MIN_WIDE MAX_WIDE } [wide_range] break ::tcltest::testConstraint 32bit \ [expr { $MAX_INT == 0x7fffffff }] ::tcltest::testConstraint wideBiggerThanInt \ [expr { $MAX_WIDE > wide($MAX_INT) }] test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} { set r 1 foreach {t} { {array search} boolean bytearray
︙
592 593 594 595 596 597 598 599 600 601 602 603 604	619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	test obj-31.6 {regenerate string rep of "end--bigInteger"} {nonPortable} { testobj freeallvars teststringobj set 1 end--0x80000000 testobj convert 1 end-offset testobj invalidateStringRep 1 } end--2147483648 test obj-32.1 {integer overflow on input} {32bit wideBiggerThanInt} { set x 0x8000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 2147483648} test obj-32.2 {integer overflow on input} {32bit wideBiggerThanInt} { set x 0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 4294967295} test obj-32.3 {integer overflow on input} {32bit wideBiggerThanInt} { set x 0x10000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {0 4294967296} test obj-32.4 {integer overflow on input} {32bit wideBiggerThanInt} { set x -0x8000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 -2147483648} test obj-32.5 {integer overflow on input} {32bit wideBiggerThanInt} { set x -0x8000; append x 0001 list [string is integer $x] [expr { wide($x) }] } {1 -2147483649} test obj-32.6 {integer overflow on input} {32bit wideBiggerThanInt} { set x -0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 -4294967295} test obj-32.7 {integer overflow on input} {32bit wideBiggerThanInt} { set x -0x10000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {0 -4294967296} testobj freeallvars # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- + - +	# This file contains a collection of tests for the procedures in the # file tclParse.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 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. # # RCS: @(#) $Id: parse.test,v 1.11 2003/02/16 01:36:32 msofer Exp $ # RCS: @(#) $Id: parse.test,v 1.11.2.5 2006/03/07 05:30:24 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest package require tcltest 2 namespace import -force ::tcltest::* } if {[info commands testparser] == {}} { puts "This application hasn't been compiled with the \"testparser\"" puts "command, so I can't test the Tcl parser." ::tcltest::cleanupTests
︙
214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287	214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343	+ + - + - + - + - + - + - + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	list [catch {testparser {[a]} 2} msg] $msg } {1 {missing close-bracket}} test parse-7.1 {Tcl_FreeParse and ExpandTokenArray procedures} { testparser {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 0 } {- {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 16 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 {}} testConstraint testevalobjv [llength [info commands testevalobjv]] testConstraint testevalex [llength [info commands testevalex]] test parse-8.1 {Tcl_EvalObjv procedure} { test parse-8.1 {Tcl_EvalObjv procedure} testevalobjv { testevalobjv 0 concat this is a test } {this is a test} test parse-8.2 {Tcl_EvalObjv procedure, unknown commands} { test parse-8.2 {Tcl_EvalObjv procedure, unknown commands} testevalobjv { rename unknown unknown.old set x [catch {testevalobjv 10 asdf poiu} msg] rename unknown.old unknown list $x $msg } {1 {invalid command name "asdf"}} test parse-8.3 {Tcl_EvalObjv procedure, unknown commands} { test parse-8.3 {Tcl_EvalObjv procedure, unknown commands} testevalobjv { rename unknown unknown.old proc unknown args { return "unknown $args" } set x [catch {testevalobjv 0 asdf poiu} msg] rename unknown {} rename unknown.old unknown list $x $msg } {0 {unknown asdf poiu}} test parse-8.4 {Tcl_EvalObjv procedure, unknown commands} { test parse-8.4 {Tcl_EvalObjv procedure, unknown commands} testevalobjv { rename unknown unknown.old proc unknown args { error "I don't like that command" } set x [catch {testevalobjv 0 asdf poiu} msg] rename unknown {} rename unknown.old unknown list $x $msg } {1 {I don't like that command}} test parse-8.5 {Tcl_EvalObjv procedure, command traces} { test parse-8.5 {Tcl_EvalObjv procedure, command traces} testevalobjv { testevalobjv 0 set x 123 testcmdtrace tracetest {testevalobjv 0 set x $x} } {{testevalobjv 0 set x $x} {testevalobjv 0 set x 123} {set x 123} {set x 123}} test parse-8.7 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL flag} { test parse-8.7 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL flag} testevalobjv { proc x {} { set y 23 set z [testevalobjv 1 set y] return [list $z $y] } catch {unset y} set y 16 x } {16 23} test parse-8.8 {Tcl_EvalObjv procedure, async handlers} { test parse-8.8 {Tcl_EvalObjv procedure, async handlers} testevalobjv { proc async1 {result code} { global aresult acode set aresult $result set acode $code return "new result" } set handler1 [testasync create async1] set aresult xxx set acode yyy set x [list [catch [list testevalobjv 0 testasync mark $handler1 original 0] msg] $msg $acode $aresult] testasync delete set x } {0 {new result} 0 original} test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} { test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} testevalobjv { list [catch {testevalobjv 0 error message} msg] $msg } {1 message} test parse-8.10 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL} testevalobjv { rename ::unknown unknown.save proc ::unknown args {lappend ::info [info level]} catch {rename ::noSuchCommand {}} set ::info {} namespace eval test_ns_1 { testevalobjv 1 noSuchCommand uplevel #0 noSuchCommand } namespace delete test_ns_1 rename ::unknown {} rename unknown.save ::unknown set ::info } {1 1} test parse-8.11 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} testevalobjv { rename ::unknown unknown.save proc ::unknown args {lappend ::info [info level]; uplevel 1 foo} proc ::foo args {lappend ::info global} catch {rename ::noSuchCommand {}} set ::slave [interp create] $::slave alias bar noSuchCommand set ::info {} namespace eval test_ns_1 { proc foo args {lappend ::info namespace} $::slave eval bar testevalobjv 1 [list $::slave eval bar] uplevel #0 [list $::slave eval bar] } namespace delete test_ns_1 rename ::foo {} rename ::unknown {} rename unknown.save ::unknown set ::info } [subst {[set level 2; incr level [info level]] global 1 global 1 global}] test parse-8.12 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} { set ::auto_index(noSuchCommand) { proc noSuchCommand {} {lappend ::info global} } set ::auto_index(::[string trimleft [namespace current]::test_ns_1::noSuchCommand :]) [list \ proc [namespace current]::test_ns_1::noSuchCommand {} { lappend ::info ns }] catch {rename ::noSuchCommand {}} set ::slave [interp create] $::slave alias bar noSuchCommand set ::info {} namespace eval test_ns_1 { $::slave eval bar } namespace delete test_ns_1 interp delete $::slave catch {rename ::noSuchCommand {}} set ::info } global test parse-9.1 {Tcl_LogCommandInfo, line numbers} { catch {unset x} list [catch {testevalex {for {} 1 {} { # asdf
︙
727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750	783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852	- + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	} 0 test parse-15.57 {CommandComplete procedure} { info complete "# Comment should be complete command" } 1 test parse-15.58 {CommandComplete procedure, memory leaks} { info complete "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22" } 1 test parse-15.58 {CommandComplete procedure} { test parse-15.59 {CommandComplete procedure} { # Test for Tcl Bug 684744 info complete [encoding convertfrom identity "\x00;if 1 \{"] } 0 test parse-16.1 {Tcl_EvalEx, check termOffset is set correctly for non TCL_OK cases, bug 2535} { subst {[eval {return foo}]bar} } foobar test parse-17.1 {Correct return codes from errors during substitution} { catch {eval {w[continue]}} } 4 test parse-19.1 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints { testevalex } -setup { interp create i load {} Tcltest i i eval {proc {} args {}} interp recursionlimit i 3 } -body { i eval {testevalex {[]}} } -cleanup { interp delete i } test parse-19.2 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints { testevalex } -setup { interp create i load {} Tcltest i i eval {proc {} args {}} interp recursionlimit i 3 } -body { i eval {testevalex {[[]]}} } -cleanup { interp delete i } -returnCodes error -match glob -result {too many nested*} test parse-19.3 {Bug 1115904: recursion limit in Tcl_EvalEx} -setup { interp create i i eval {proc {} args {}} interp recursionlimit i 3 } -body { i eval {subst {[]}} } -cleanup { interp delete i } test parse-19.4 {Bug 1115904: recursion limit in Tcl_EvalEx} -setup { interp create i i eval {proc {} args {}} interp recursionlimit i 3 } -body { i eval {subst {[[]]}} } -cleanup { interp delete i } -returnCodes error -match glob -result {too many nested*} # cleanup catch {unset a} ::tcltest::cleanupTests return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- + - +	# This file contains a collection of tests for the procedures in the # file tclParseExpr.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 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. # # RCS: @(#) $Id: parseExpr.test,v 1.10 2003/02/16 01:36:32 msofer Exp $ # RCS: @(#) $Id: parseExpr.test,v 1.10.2.1 2003/10/06 13:55:39 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest package require tcltest 2 namespace import -force ::tcltest::* } # Note that the Tcl expression parser (tclParseExpr.c) does not check # the semantic validity of the expressions it parses. It does not check, # for example, that a math function actually exists, or that the operands # of "<<" are integers.
︙

︙
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	- +	# Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 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. # # RCS: @(#) $Id: parseOld.test,v 1.11 2002/06/25 01:13:38 dgp Exp $ # RCS: @(#) $Id: parseOld.test,v 1.11.2.1 2003/03/27 13:49:22 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } tcltest::testConstraint testwordend \
︙
317 318 319 320 321 322 323 324 325 326 327 328 329 330	317 318 319 320 321 322 323 324 325 326 327 328 329 330 331	+	set msg } {missing close-brace} test parseOld-10.3 {syntax errors} {catch {set a "bcd} msg} 1 test parseOld-10.4 {syntax errors} { catch {set a "bcd} msg set msg } {missing "} #" Emacs formatting >:^( test parseOld-10.5 {syntax errors} {catch {set a "bcd"xy} msg} 1 test parseOld-10.6 {syntax errors} { catch {set a "bcd"xy} msg set msg } {extra characters after close-quote} test parseOld-10.7 {syntax errors} {catch "set a {bcd}xy" msg} 1 test parseOld-10.8 {syntax errors} {
︙
415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430	416 417 418 419 420 421 422 423 424 425 426 427 428 429 430	- - +	set a [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ] llength $a } 62 set i 0 foreach j [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ] { set test [string index 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ $i] set test $test$test$test$test set i [expr $i+1] test parseOld-11.10 {long values} { test parseOld-11.10-[incr i] {long values} { set j } $test } test parseOld-11.11 {test buffer overflow in backslashes in braces} { expr {"a" == {xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101}} } 0
︙
464 465 466 467 468 469 470 471 472 473 474 475 476 477	464 465 466 467 468 469 470 471 472 473 474 475 476 477 478	+	} {} test parseOld-14.3 {TclWordEnd procedure} {testwordend} { testwordend " \\\n " } { } test parseOld-14.4 {TclWordEnd procedure} {testwordend} { testwordend {"abc"} } {"} #" Emacs formatting >:^( test parseOld-14.5 {TclWordEnd procedure} {testwordend} { testwordend {{xyz}} } \} test parseOld-14.6 {TclWordEnd procedure} {testwordend} { testwordend {{a{}b{}\}} xyz} } "\} xyz" test parseOld-14.7 {TclWordEnd procedure} {testwordend} {
︙
509 510 511 512 513 514 515 516 517 518 519 520 521 522	510 511 512 513 514 515 516 517 518 519 520 521 522 523 524	+	} {c} test parseOld-14.18 {TclWordEnd procedure} {testwordend} { testwordend \[a\000\] } {]} test parseOld-14.19 {TclWordEnd procedure} {testwordend} { testwordend \"a\000\" } {"} #" Emacs formatting >:^( test parseOld-14.20 {TclWordEnd procedure} {testwordend} { testwordend a{\000}b } {b} test parseOld-14.21 {TclWordEnd procedure} {testwordend} { testwordend " \000b" } {b}
︙
538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556	540 541 542 543 544 545 546	- - - - - - - - - - - -	info complete "xyz \[abc" } {0} # cleanup set argv $savedArgv ::tcltest::cleanupTests return

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	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	- + - + - - - - - + + + + + - + + - - + + + + + - + + + -	# Commands covered: pid # # 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-1995 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. # # RCS: @(#) $Id: pid.test,v 1.8 2003/02/25 22:03:45 andreas_kupries Exp $ # RCS: @(#) $Id: pid.test,v 1.8.2.2 2004/02/25 23:38:17 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest package require tcltest 2 namespace import -force ::tcltest::* } # If pid is not defined just return with no error # Some platforms may not have the pid command implemented if {[info commands pid] == ""} { puts "pid is not implemented for this machine" ::tcltest::cleanupTests return } catch {removeFile test1} set path(test1) [makeFile {} test1] test pid-1.1 {pid command} { regexp {(^[0-9]+$)|(^0x[0-9a-fA-F]+$)} [pid] } 1 test pid-1.2 {pid command} {unixOrPc unixExecs} { set f [open [format {| echo foo | cat {>%s}} $path(test1)] w] test pid-1.2 {pid command} -constraints {unixOrPc unixExecs} -setup { set path(test1) [makeFile {} test1] file delete $path(test1) } -body { set f [open |[list echo foo | cat >$path(test1)] w] set pids [pid $f] close $f catch {removeFile test1} list [llength $pids] [regexp {^[0-9]+$} [lindex $pids 0]] \ [regexp {^[0-9]+$} [lindex $pids 1]] \ [expr {[lindex $pids 0] == [lindex $pids 1]}] } -cleanup { removeFile test1 } {2 1 1 0} test pid-1.3 {pid command} { } -result {2 1 1 0} test pid-1.3 {pid command} -setup { set path(test1) [makeFile {} test1] file delete $path(test1) } -body { set f [open $path(test1) w] set pids [pid $f] close $f set pids } {} } -cleanup { removeFile test1 } -result {} test pid-1.4 {pid command} { list [catch {pid a b} msg] $msg } {1 {wrong # args: should be "pid ?channelId?"}} test pid-1.5 {pid command} { list [catch {pid gorp} msg] $msg } {1 {can not find channel named "gorp"}} # cleanup catch {::tcltest::removeFile test1} ::tcltest::cleanupTests return
︙

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	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	- + - + - + + + +	# Commands covered: pkg # # 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) 1995-1996 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. # # RCS: @(#) $Id: pkg.test,v 1.9 2001/08/06 19:13:29 dgp Exp $ # RCS: @(#) $Id: pkg.test,v 1.9.12.10 2007/02/22 20:25:29 andreas_kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest package require tcltest 2 namespace import -force ::tcltest::* } # Do all this in a slave interp to avoid garbaging the # package list set i [interp create] interp eval $i [list set argv $argv] interp eval $i [list package require tcltest] interp eval $i [list package require tcltest 2] interp eval $i [list namespace import -force ::tcltest::*] interp eval $i { eval package forget [package names] set oldPkgUnknown [package unknown] package unknown {} set oldPath $auto_path set auto_path "" testConstraint tip268 [info exists tcl_platform(tip,268)] testConstraint !tip268 [expr {![info exists tcl_platform(tip,268)]}] test pkg-1.1 {Tcl_PkgProvide procedure} { package forget t package provide t 2.3 } {} test pkg-1.2 {Tcl_PkgProvide procedure} { package forget t package provide t 2.3
︙
51 52 53 54 55 56 57 58 59 60 61 62 63 64	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	+ + + + + + + + + + + + + + + + +	list [catch {package provide t 3.3} msg] $msg } {1 {conflicting versions provided for package "t": 2.3, then 3.3}} test pkg-1.5 {Tcl_PkgProvide procedure} { package forget t package provide t 2.3 package provide t 2.3 } {} test pkg-1.6 {Tcl_PkgProvide procedure} tip268 { package forget t package provide t 2.3a1 } {} set n 0 foreach v { 2.3k1 2a3a2 2ab3 2.a4 2.b4 2b.4 2a.4 2ba4 2a4b1 2b4a1 2b3b2 } { test pkg-1.7.$n {Tcl_PkgProvide procedure} tip268 { package forget t list [catch {package provide t $v} msg] $msg } [list 1 "expected version number but got \"$v\""] incr n } test pkg-2.1 {Tcl_PkgRequire procedure, picking best version} { package forget t foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i; package provide t $i" } set x xxx
︙
113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235	133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331	- + + + + + + + + + + + - + - + - + - + - + - + - + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + +	package forget t package unknown {} foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i" } list [catch {package require t 4.1} msg] $msg } {1 {can't find package t 4.1}} test pkg-2.8 {Tcl_PkgRequire procedure, can't find suitable version} { test pkg-2.8 {Tcl_PkgRequire procedure, can't find suitable version} !tip268 { package forget t package unknown {} foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i" } list [catch {package require -exact t 1.3} msg] $msg } {1 {can't find package t 1.3}} test pkg-2.8-268 {Tcl_PkgRequire procedure, can't find suitable version} tip268 { package forget t package unknown {} foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i" } list [catch {package require -exact t 1.3} msg] $msg } {1 {can't find package t 1.3}} } {1 {can't find package t 1.3-1.4}} test pkg-2.9 {Tcl_PkgRequire procedure, can't find suitable version} { package forget t package unknown {} list [catch {package require t} msg] $msg } {1 {can't find package t}} test pkg-2.10 {Tcl_PkgRequire procedure, error in ifneeded script} { test pkg-2.10 {Tcl_PkgRequire procedure, error in ifneeded script} -body { package forget t package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"} list [catch {package require t 2.1} msg] $msg $errorInfo } {1 {ifneeded test} {ifneeded test } -match glob -result {1 {ifneeded test} {ifneeded test while executing "error "ifneeded test"" ("package ifneeded" script) ("package ifneeded*" script) invoked from within "package require t 2.1"}} test pkg-2.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} { test pkg-2.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} -body { package forget t package ifneeded t 2.1 "set x invoked" set x xxx list [catch {package require t 2.1} msg] $msg $x } {1 {can't find package t 2.1} invoked} } -match glob -result {1 * invoked} test pkg-2.12 {Tcl_PkgRequire procedure, self-deleting script} { package forget t package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2" set x xxx package require t 1.2 set x } {1.2} test pkg-2.13 {Tcl_PkgRequire procedure, "package unknown" support} { test pkg-2.13-!268 {Tcl_PkgRequire procedure, "package unknown" support} !tip268 { proc pkgUnknown args { global x set x $args package provide [lindex $args 0] [lindex $args 1] } package forget t foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i" } package unknown pkgUnknown set x xxx package require -exact t 1.5 package unknown {} set x } {t 1.5 -exact} test pkg-2.13-268 {Tcl_PkgRequire procedure, "package unknown" support} tip268 { proc pkgUnknown args { # args = name requirement # requirement = v-v (for exact version) global x set x $args package provide [lindex $args 0] [lindex [split [lindex $args 1] -] 0] } package forget t foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i" } package unknown pkgUnknown set x xxx package require -exact t 1.5 package unknown {} set x } {t 1.5-1.6} test pkg-2.14 {Tcl_PkgRequire procedure, "package unknown" support} { proc pkgUnknown args { package ifneeded t 1.2 "set x loaded; package provide t 1.2" } package forget t package unknown pkgUnknown set x xxx set result [list [package require t] $x] package unknown {} set result } {1.2 loaded} test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} { test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} !tip268 { proc pkgUnknown args { global x set x $args package provide [lindex $args 0] 2.0 } package forget {a b} package unknown pkgUnknown set x xxx package require {a b} package unknown {} set x } {{a b} {}} test pkg-2.15-268 {Tcl_PkgRequire procedure, "package unknown" support} tip268 { proc pkgUnknown args { global x set x $args package provide [lindex $args 0] 2.0 } package forget {a b} package unknown pkgUnknown set x xxx package require {a b} package unknown {} set x } {{a b} 0-} test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} { test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} !tip268 { proc pkgUnknown args { error "testing package unknown" } package forget t package unknown pkgUnknown set result [list [catch {package require t} msg] $msg $errorInfo] package unknown {} set result } {1 {testing package unknown} {testing package unknown while executing "error "testing package unknown"" (procedure "pkgUnknown" line 2) invoked from within "pkgUnknown t {}" ("package unknown" script) invoked from within "package require t"}} test pkg-2.16-268 {Tcl_PkgRequire procedure, "package unknown" error} tip268 { proc pkgUnknown args { error "testing package unknown" } package forget t package unknown pkgUnknown set result [list [catch {package require t} msg] $msg $errorInfo] package unknown {} set result } {1 {testing package unknown} {testing package unknown while executing "error "testing package unknown"" (procedure "pkgUnknown" line 2) invoked from within "pkgUnknown t 0-" ("package unknown" script) invoked from within "package require t"}} test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} { test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} !tip268 { proc pkgUnknown args { global x set x $args } package forget t foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i" } package unknown pkgUnknown set x xxx set result [list [catch {package require -exact t 1.5} msg] $msg $x] package unknown {} set result } {1 {can't find package t 1.5} {t 1.5 -exact}} test pkg-2.17-268 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} tip268 { proc pkgUnknown args { global x set x $args } package forget t foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i" } package unknown pkgUnknown set x xxx set result [list [catch {package require -exact t 1.5} msg] $msg $x] package unknown {} set result } {1 {can't find package t 1.5-1.6} {t 1.5-1.6}} test pkg-2.18 {Tcl_PkgRequire procedure, version checks} { package forget t package provide t 2.3 package require t } {2.3} test pkg-2.19 {Tcl_PkgRequire procedure, version checks} { package forget t
︙
252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270	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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609	- + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	list [catch {package require t 1.2} msg] $msg } {1 {version conflict for package "t": have 2.3, need 1.2}} test pkg-2.23 {Tcl_PkgRequire procedure, version checks} { package forget t package provide t 2.3 package require -exact t 2.3 } {2.3} test pkg-2.24 {Tcl_PkgRequire procedure, version checks} { test pkg-2.24 {Tcl_PkgRequire procedure, version checks} !tip268 { package forget t package provide t 2.3 list [catch {package require -exact t 2.2} msg] $msg } {1 {version conflict for package "t": have 2.3, need 2.2}} test pkg-2.24-268 {Tcl_PkgRequire procedure, version checks} tip268 { package forget t package provide t 2.3 list [catch {package require -exact t 2.2} msg] $msg } {1 {version conflict for package "t": have 2.3, need 2.2-2.3}} test pkg-2.25 {Tcl_PkgRequire procedure, error in ifneeded script} -body { package forget t package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test" EI} list [catch {package require t 2.1} msg] $msg $errorInfo } -match glob -result {1 {ifneeded test} {EI ("package ifneeded*" script) invoked from within "package require t 2.1"}} -constraints knownBug test pkg-2.26 {Tcl_PkgRequire procedure, error in ifneeded script} -body { package forget t package ifneeded t 2.1 {package provide t 2.1; foreach x 1 {error "ifneeded test" EI}} list [catch {package require t 2.1} msg] $msg $errorInfo } -match glob -result {1 {ifneeded test} {EI ("foreach" body line 1) invoked from within "foreach x 1 {error "ifneeded test" EI}" ("package ifneeded*" script) invoked from within "package require t 2.1"}} test pkg-2.27 {Tcl_PkgRequire: circular dependency} -setup { package forget foo } -body { package ifneeded foo 1 {package require foo 1} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob -result {circular package dependency:*} test pkg-2.28 {Tcl_PkgRequire: circular dependency} -setup { package forget foo } -body { package ifneeded foo 1 {package require foo 2} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob -result {circular package dependency:*} test pkg-2.29 {Tcl_PkgRequire: circular dependency} -setup { package forget foo package forget bar } -body { package ifneeded foo 1 {package require bar 1; package provide foo 1} package ifneeded bar 1 {package require foo 1; package provide bar 1} package require foo 1 } -cleanup { package forget foo package forget bar } -returnCodes error -match glob -result {circular package dependency:*} test pkg-2.30 {Tcl_PkgRequire: circular dependency} -setup { package forget foo package forget bar } -body { package ifneeded foo 1 {package require bar 1; package provide foo 1} package ifneeded foo 2 {package provide foo 2} package ifneeded bar 1 {package require foo 2; package provide bar 1} package require foo 1 } -cleanup { package forget foo package forget bar } -returnCodes error -match glob -result {circular package dependency:*} test pkg-2.31 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {package provide foo 1; error foo} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob -result foo test pkg-2.32 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {package provide foo 1; error foo} catch {package require foo 1} package provide foo } -cleanup { package forget foo } -result {} test pkg-2.33 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {package provide foo 2} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob -result {attempt to provide package * failed:*} test pkg-2.34 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {package provide foo 1.1} package require foo 1 } -cleanup { package forget foo } -result 1.1 test pkg-2.34.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1.1 {package provide foo 1} package require foo 1 } -cleanup { package forget foo } -result 1 test pkg-2.34.2 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1.1 {package provide foo 1} package require foo 1.1 } -cleanup { package forget foo } -returnCodes error -match glob -result {attempt to provide package * failed:*} test pkg-2.35 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob -result {attempt to provide package * failed:*} test pkg-2.35.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {break} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob \ -result {attempt to provide package * failed: bad return code:*} test pkg-2.36 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {continue} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob \ -result {attempt to provide package * failed: bad return code:*} test pkg-2.37 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {return} package require foo 1 } -cleanup { package forget foo } -returnCodes error -match glob \ -result {attempt to provide package * failed: bad return code:*} test pkg-2.38 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo } -body { package ifneeded foo 1 {proc x {} {return -code 10}; x} package require foo 1 } -cleanup { rename x {} package forget foo } -returnCodes error -match glob \ -result {attempt to provide package * failed: bad return code:*} test pkg-2.39 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo set saveUnknown [package unknown] package unknown {package provide foo 2 ;#} } -body { package require foo 1 } -cleanup { package forget foo package unknown $saveUnknown } -returnCodes error -match glob -result * test pkg-2.40 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo set saveUnknown [package unknown] package unknown {break ;#} } -body { package require foo 1 } -cleanup { package forget foo package unknown $saveUnknown } -returnCodes error -match glob -result {bad return code:*} test pkg-2.41 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo set saveUnknown [package unknown] package unknown {continue ;#} } -body { package require foo 1 } -cleanup { package forget foo package unknown $saveUnknown } -returnCodes error -match glob -result {bad return code:*} test pkg-2.42 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo set saveUnknown [package unknown] package unknown {return ;#} } -body { package require foo 1 } -cleanup { package forget foo package unknown $saveUnknown } -returnCodes error -match glob -result {bad return code:*} test pkg-2.43 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo set saveUnknown [package unknown] proc x args {return -code 10} package unknown x } -body { package require foo 1 } -cleanup { rename x {} package forget foo package unknown $saveUnknown } -returnCodes error -match glob -result {bad return code:*} test pkg-2.50 {Tcl_PkgRequire procedure, picking best stable version} tip268 { package forget t foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} { package ifneeded t $i "set x $i; package provide t $i" } set x xxx package require t set x } {3.4} test pkg-2.51 {Tcl_PkgRequire procedure, picking best stable version} tip268 { package forget t foreach i {1.2b1 1.2 1.3a2 1.3} { package ifneeded t $i "set x $i; package provide t $i" } set x xxx package require t set x } {1.3} test pkg-2.52 {Tcl_PkgRequire procedure, picking best stable version} tip268 { package forget t foreach i {1.2b1 1.2 1.3 1.3a2} { package ifneeded t $i "set x $i; package provide t $i" } set x xxx package require t set x } {1.3} test pkg-3.1 {Tcl_PackageCmd procedure} { list [catch {package} msg] $msg } {1 {wrong # args: should be "package option ?arg arg ...?"}} test pkg-3.2 {Tcl_PackageCmd procedure, "forget" option} { foreach i [package names] { package forget $i
︙
381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418	720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771	- + + + + - + - + + + + + + - + - + + + + - + + + +	package provide t 2.3 package provide t } {2.3} test pkg-3.21 {Tcl_PackageCmd procedure, "provide" option} { package forget t list [catch {package provide t a.b} msg] $msg } {1 {expected version number but got "a.b"}} test pkg-3.22 {Tcl_PackageCmd procedure, "require" option} { test pkg-3.22 {Tcl_PackageCmd procedure, "require" option} !tip268 { list [catch {package require} msg] $msg } {1 {wrong # args: should be "package require ?-exact? package ?version?"}} test pkg-3.22-268 {Tcl_PackageCmd procedure, "require" option} tip268 { list [catch {package require} msg] $msg } {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}} test pkg-3.23 {Tcl_PackageCmd procedure, "require" option} { test pkg-3.23 {Tcl_PackageCmd procedure, "require" option} !tip268 { list [catch {package require a b c} msg] $msg } {1 {wrong # args: should be "package require ?-exact? package ?version?"}} test pkg-3.24 {Tcl_PackageCmd procedure, "require" option} { test pkg-3.24 {Tcl_PackageCmd procedure, "require" option} !tip268 { list [catch {package require -exact a b c} msg] $msg } {1 {wrong # args: should be "package require ?-exact? package ?version?"}} test pkg-3.24-268 {Tcl_PackageCmd procedure, "require" option} tip268 { list [catch {package require -exact a b c} msg] $msg # Exact syntax: -exact name version # name ?requirement...? } {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}} test pkg-3.25 {Tcl_PackageCmd procedure, "require" option} { test pkg-3.25 {Tcl_PackageCmd procedure, "require" option} !tip268 { list [catch {package require -bs a b} msg] $msg } {1 {wrong # args: should be "package require ?-exact? package ?version?"}} test pkg-3.26 {Tcl_PackageCmd procedure, "require" option} { list [catch {package require x a.b} msg] $msg } {1 {expected version number but got "a.b"}} test pkg-3.27 {Tcl_PackageCmd procedure, "require" option} { list [catch {package require -exact x a.b} msg] $msg } {1 {expected version number but got "a.b"}} test pkg-3.28 {Tcl_PackageCmd procedure, "require" option} { test pkg-3.28 {Tcl_PackageCmd procedure, "require" option} !tip268 { list [catch {package require -exact x} msg] $msg } {1 {wrong # args: should be "package require ?-exact? package ?version?"}} test pkg-3.28-268 {Tcl_PackageCmd procedure, "require" option} tip268 { list [catch {package require -exact x} msg] $msg } {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}} test pkg-3.29 {Tcl_PackageCmd procedure, "require" option} { test pkg-3.29 {Tcl_PackageCmd procedure, "require" option} !tip268 { list [catch {package require -exact} msg] $msg } {1 {wrong # args: should be "package require ?-exact? package ?version?"}} test pkg-3.29-268 {Tcl_PackageCmd procedure, "require" option} tip268 { list [catch {package require -exact} msg] $msg } {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}} test pkg-3.30 {Tcl_PackageCmd procedure, "require" option} { package forget t package provide t 2.3 package require t 2.1 } {2.3} test pkg-3.31 {Tcl_PackageCmd procedure, "require" option} { package forget t
︙
470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533	823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904	- + + + + - + - + + + + + + + + + + + + + + + + - + - - + +	} {} test pkg-3.46 {Tcl_PackageCmd procedure, "versions" option} { package forget t package ifneeded t 2.3 x package ifneeded t 2.4 y package versions t } {2.3 2.4} test pkg-3.47 {Tcl_PackageCmd procedure, "vsatisfies" option} { test pkg-3.47 {Tcl_PackageCmd procedure, "vsatisfies" option} !tip268 { list [catch {package vsatisfies a} msg] $msg } {1 {wrong # args: should be "package vsatisfies version1 version2"}} test pkg-3.47-268 {Tcl_PackageCmd procedure, "vsatisfies" option} tip268 { list [catch {package vsatisfies a} msg] $msg } {1 {wrong # args: should be "package vsatisfies version requirement requirement..."}} test pkg-3.48 {Tcl_PackageCmd procedure, "vsatisfies" option} { test pkg-3.48 {Tcl_PackageCmd procedure, "vsatisfies" option} !tip268 { list [catch {package vsatisfies a b c} msg] $msg } {1 {wrong # args: should be "package vsatisfies version1 version2"}} test pkg-3.49 {Tcl_PackageCmd procedure, "vsatisfies" option} { list [catch {package vsatisfies x.y 3.4} msg] $msg } {1 {expected version number but got "x.y"}} test pkg-3.50 {Tcl_PackageCmd procedure, "vsatisfies" option} { list [catch {package vcompare 2.1 a.b} msg] $msg } {1 {expected version number but got "a.b"}} test pkg-3.51 {Tcl_PackageCmd procedure, "vsatisfies" option} { package vs 2.3 2.1 } {1} test pkg-3.52 {Tcl_PackageCmd procedure, "vsatisfies" option} { package vs 2.3 1.2 } {0} test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} { test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} !tip268 { list [catch {package foo} msg] $msg } {1 {bad option "foo": must be forget, ifneeded, names, present, provide, require, unknown, vcompare, versions, or vsatisfies}} test pkg-3.53-268 {Tcl_PackageCmd procedure, "versions" option} tip268 { list [catch {package foo} msg] $msg } {1 {bad option "foo": must be forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies}} test pkg-3.54 {Tcl_PackageCmd procedure, "vsatisfies" option} tip268 { list [catch {package vsatisfies 2.1 2.1-3.2-4.5} msg] $msg } {1 {expected versionMin-versionMax but got "2.1-3.2-4.5"}} test pkg-3.55 {Tcl_PackageCmd procedure, "vsatisfies" option} tip268 { list [catch {package vsatisfies 2.1 3.2-x.y} msg] $msg } {1 {expected version number but got "x.y"}} test pkg-3.56 {Tcl_PackageCmd procedure, "vsatisfies" option} tip268 { list [catch {package vsatisfies 2.1 x.y-3.2} msg] $msg } {1 {expected version number but got "x.y"}} # No tests for FindPackage; can't think up anything detectable # errors. test pkg-4.1 {TclFreePackageInfo procedure} { interp create foo foo eval { package ifneeded t 2.3 x package ifneeded t 2.4 y package ifneeded x 3.1 z package provide q 4.3 package unknown "will this get freed?" } interp delete foo } {} test pkg-4.2 {TclFreePackageInfo procedure} { test pkg-4.2 {TclFreePackageInfo procedure} -body { interp create foo foo eval { package ifneeded t 2.3 x package ifneeded t 2.4 y package ifneeded x 3.1 z package provide q 4.3 } foo alias z kill proc kill {} { interp delete foo } list [catch {foo eval package require x 3.1} msg] $msg } {1 {can't find package x 3.1}} foo eval package require x 3.1 } -returnCodes error -match glob -result * test pkg-5.1 {CheckVersion procedure} { list [catch {package vcompare 1 2.1} msg] $msg } {0 -1} test pkg-5.2 {CheckVersion procedure} { list [catch {package vcompare .1 2.1} msg] $msg } {1 {expected version number but got ".1"}}
︙
636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665	1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - -	} {1 {expected version number but got "a.b"}} test pkg-7.17 {Tcl_PackageCmd procedure, "present" option} { list [catch {package present -exact x} msg] $msg } {1 {wrong # args: should be "package present ?-exact? package ?version?"}} test pkg-7.18 {Tcl_PackageCmd procedure, "present" option} { list [catch {package present -exact} msg] $msg } {1 {wrong # args: should be "package present ?-exact? package ?version?"}} # Note: It is correct that the result of the very first test, # i.e. "5.0 5.0a0" is 1, i.e. that version 5.0a0 satisfies a 5.0 # requirement. # The requirement "5.0" internally translates first to "5.0-6", and # then to its final form of "5.0a0-6a0". These translations are # explicitly specified by the TIP (Search for "padded/extended # internally with 'a0'"). This was done intentionally for exactly the # tested case, that an alpha package can satisfy a requirement for the # regular package. An example would be a package FOO requiring Tcl 8.X # for its operation. It can be used with Tcl 8.Xa0. Without our # translation that would not be possible. set n 0 foreach {r p vs vc} { 5.0 5.0a0 1 1 5.0a0 5.0 1 -1 8.5a0 8.5a5 1 -1 8.5a0 8.5b1 1 -1 8.5a0 8.5.1 1 -1 8.5a0 8.6a0 1 -1 8.5a0 8.6b0 1 -1 8.5a0 8.6.0 1 -1 8.5a6 8.5a5 0 1 8.5a6 8.5b1 1 -1 8.5a6 8.5.1 1 -1 8.5a6 8.6a0 1 -1 8.5a6 8.6b0 1 -1 8.5a6 8.6.0 1 -1 8.5b0 8.5a5 0 1 8.5b0 8.5b1 1 -1 8.5b0 8.5.1 1 -1 8.5b0 8.6a0 1 -1 8.5b0 8.6b0 1 -1 8.5b0 8.6.0 1 -1 8.5b2 8.5a5 0 1 8.5b2 8.5b1 0 1 8.5b2 8.5.1 1 -1 8.5b2 8.6a0 1 -1 8.5b2 8.6b0 1 -1 8.5b2 8.6.0 1 -1 8.5 8.5a5 1 1 8.5 8.5b1 1 1 8.5 8.5.1 1 -1 8.5 8.6a0 1 -1 8.5 8.6b0 1 -1 8.5 8.6.0 1 -1 8.5.0 8.5a5 0 1 8.5.0 8.5b1 0 1 8.5.0 8.5.1 1 -1 8.5.0 8.6a0 1 -1 8.5.0 8.6b0 1 -1 8.5.0 8.6.0 1 -1 } { test package-vsatisfies-1.$n {package vsatisfies} tip268 { package vsatisfies $p $r } $vs test package-vcompare-1.$n {package vcompare} tip268 { package vcompare $r $p } $vc incr n } set n 0 foreach {required provided satisfied} { 8.5a0- 8.5a5 1 8.5a0- 8.5b1 1 8.5a0- 8.5.1 1 8.5a0- 8.6a0 1 8.5a0- 8.6b0 1 8.5a0- 8.6.0 1 8.5a6- 8.5a5 0 8.5a6- 8.5b1 1 8.5a6- 8.5.1 1 8.5a6- 8.6a0 1 8.5a6- 8.6b0 1 8.5a6- 8.6.0 1 8.5b0- 8.5a5 0 8.5b0- 8.5b1 1 8.5b0- 8.5.1 1 8.5b0- 8.6a0 1 8.5b0- 8.6b0 1 8.5b0- 8.6.0 1 8.5b2- 8.5a5 0 8.5b2- 8.5b1 0 8.5b2- 8.5.1 1 8.5b2- 8.6a0 1 8.5b2- 8.6b0 1 8.5b2- 8.6.0 1 8.5- 8.5a5 1 8.5- 8.5b1 1 8.5- 8.5.1 1 8.5- 8.6a0 1 8.5- 8.6b0 1 8.5- 8.6.0 1 8.5.0- 8.5a5 0 8.5.0- 8.5b1 0 8.5.0- 8.5.1 1 8.5.0- 8.6a0 1 8.5.0- 8.6b0 1 8.5.0- 8.6.0 1 8.5a0-7 8.5a5 0 8.5a0-7 8.5b1 0 8.5a0-7 8.5.1 0 8.5a0-7 8.6a0 0 8.5a0-7 8.6b0 0 8.5a0-7 8.6.0 0 8.5a6-7 8.5a5 0 8.5a6-7 8.5b1 0 8.5a6-7 8.5.1 0 8.5a6-7 8.6a0 0 8.5a6-7 8.6b0 0 8.5a6-7 8.6.0 0 8.5b0-7 8.5a5 0 8.5b0-7 8.5b1 0 8.5b0-7 8.5.1 0 8.5b0-7 8.6a0 0 8.5b0-7 8.6b0 0 8.5b0-7 8.6.0 0 8.5b2-7 8.5a5 0 8.5b2-7 8.5b1 0 8.5b2-7 8.5.1 0 8.5b2-7 8.6a0 0 8.5b2-7 8.6b0 0 8.5b2-7 8.6.0 0 8.5-7 8.5a5 0 8.5-7 8.5b1 0 8.5-7 8.5.1 0 8.5-7 8.6a0 0 8.5-7 8.6b0 0 8.5-7 8.6.0 0 8.5.0-7 8.5a5 0 8.5.0-7 8.5b1 0 8.5.0-7 8.5.1 0 8.5.0-7 8.6a0 0 8.5.0-7 8.6b0 0 8.5.0-7 8.6.0 0 8.5a0-8.6.1 8.5a5 1 8.5a0-8.6.1 8.5b1 1 8.5a0-8.6.1 8.5.1 1 8.5a0-8.6.1 8.6a0 1 8.5a0-8.6.1 8.6b0 1 8.5a0-8.6.1 8.6.0 1 8.5a6-8.6.1 8.5a5 0 8.5a6-8.6.1 8.5b1 1 8.5a6-8.6.1 8.5.1 1 8.5a6-8.6.1 8.6a0 1 8.5a6-8.6.1 8.6b0 1 8.5a6-8.6.1 8.6.0 1 8.5b0-8.6.1 8.5a5 0 8.5b0-8.6.1 8.5b1 1 8.5b0-8.6.1 8.5.1 1 8.5b0-8.6.1 8.6a0 1 8.5b0-8.6.1 8.6b0 1 8.5b0-8.6.1 8.6.0 1 8.5b2-8.6.1 8.5a5 0 8.5b2-8.6.1 8.5b1 0 8.5b2-8.6.1 8.5.1 1 8.5b2-8.6.1 8.6a0 1 8.5b2-8.6.1 8.6b0 1 8.5b2-8.6.1 8.6.0 1 8.5-8.6.1 8.5a5 1 8.5-8.6.1 8.5b1 1 8.5-8.6.1 8.5.1 1 8.5-8.6.1 8.6a0 1 8.5-8.6.1 8.6b0 1 8.5-8.6.1 8.6.0 1 8.5.0-8.6.1 8.5a5 0 8.5.0-8.6.1 8.5b1 0 8.5.0-8.6.1 8.5.1 1 8.5.0-8.6.1 8.6a0 1 8.5.0-8.6.1 8.6b0 1 8.5.0-8.6.1 8.6.0 1 8.5a0-8.5a0 8.5a0 1 8.5a0-8.5a0 8.5b1 0 8.5a0-8.5a0 8.4 0 8.5b0-8.5b0 8.5a5 0 8.5b0-8.5b0 8.5b0 1 8.5b0-8.5b0 8.5.1 0 8.5-8.5 8.5a5 0 8.5-8.5 8.5b1 0 8.5-8.5 8.5 1 8.5-8.5 8.5.1 0 8.5.0-8.5.0 8.5a5 0 8.5.0-8.5.0 8.5b1 0 8.5.0-8.5.0 8.5.0 1 8.5.0-8.5.0 8.5.1 0 8.5.0-8.5.0 8.6a0 0 8.5.0-8.5.0 8.6b0 0 8.5.0-8.5.0 8.6.0 0 8.2 9 0 8.2- 9 1 8.2-8.5 9 0 8.2-9.1 9 1 8.5-8.5 8.5b1 0 8.5a0-8.5 8.5b1 0 8.5a0-8.5.1 8.5b1 1 8.5-8.5 8.5 1 8.5.0-8.5.0 8.5 1 8.5a0-8.5.0 8.5 0 } { test package-vsatisfies-2.$n "package vsatisfies $provided $required" tip268 { package vsatisfies $provided $required } $satisfied incr n } test package-vsatisfies-3.0 "package vsatisfies multiple" tip268 { # yes no package vsatisfies 8.4 8.4 7.3 } 1 test package-vsatisfies-3.1 "package vsatisfies multiple" tip268 { # no yes package vsatisfies 8.4 7.3 8.4 } 1 test package-vsatisfies-3.2 "package vsatisfies multiple" tip268 { # yes yes package vsatisfies 8.4.2 8.4 8.4.1 } 1 test package-vsatisfies-3.3 "package vsatisfies multiple" tip268 { # no no package vsatisfies 8.4 7.3 6.1 } 0 proc prefer {args} { set ip [interp create] lappend res [$ip eval {package prefer}] foreach mode $args { lappend res [$ip eval [list package prefer $mode]] } interp delete $ip return $res } test package-prefer-1.0 {default} tip268 { prefer } stable test package-prefer-1.1 {default} tip268 { set ::env(TCL_PKG_PREFER_LATEST) stable ; # value not relevant! set res [prefer] unset ::env(TCL_PKG_PREFER_LATEST) set res } latest test package-prefer-2.0 {wrong\#args} tip268 { catch {package prefer foo bar} msg set msg } {wrong # args: should be "package prefer ?latest|stable?"} test package-prefer-2.1 {bogus argument} tip268 { catch {package prefer foo} msg set msg } {bad preference "foo": must be latest or stable} test package-prefer-3.0 {set, keep} tip268 { package prefer stable } stable test package-prefer-3.1 {set stable, keep} tip268 { prefer stable } {stable stable} test package-prefer-3.2 {set latest, change} tip268 { prefer latest } {stable latest} test package-prefer-3.3 {set latest, keep} tip268 { prefer latest latest } {stable latest latest} test package-prefer-3.4 {set stable, rejected} tip268 { prefer latest stable } {stable latest latest} rename prefer {} set auto_path $oldPath package unknown $oldPkgUnknown concat cleanupTests } # cleanup interp delete $i ::tcltest::cleanupTests return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	- +	# This file contains tests for the pkg_mkIndex command. # Note that the tests are limited to Tcl scripts only, there are no shared # libraries against which to test. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # # RCS: @(#) $Id: pkgMkIndex.test,v 1.23 2002/07/06 18:19:46 dgp Exp $ # RCS: @(#) $Id: pkgMkIndex.test,v 1.23.2.1 2003/07/24 08:23:39 rmax Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } set fullPkgPath [makeDirectory pkg]
︙
280 281 282 283 284 285 286 287 288 289 290 291 292 293	280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301	+ + + + + + + +	test pkgMkIndex-2.2 {simple package - use -direct} { pkgtest::runIndex -direct $fullPkgPath simple.tcl } "0 {{simple:1.0 {[list source [file join $fullPkgPath simple.tcl]]}}}" test pkgMkIndex-2.3 {simple package - direct loading is default} { pkgtest::runIndex $fullPkgPath simple.tcl } "0 {{simple:1.0 {[list source [file join $fullPkgPath simple.tcl]]}}}" test pkgMkIndex-2.4 {simple package - use -verbose} -body { pkgtest::runIndex -verbose $fullPkgPath simple.tcl } -result "0 {{simple:1.0 {[list source [file join $fullPkgPath simple.tcl]]}}}" \ -errorOutput {successful sourcing of simple.tcl packages provided were {simple 1.0} processed simple.tcl } removeFile [file join pkg simple.tcl] makeFile { # Contains global symbols, used to check that they don't have a leading :: package provide global 1.0 proc global_lower { stg } {
︙

︙
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	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	+ + + + + + + + + + + + + + + + + + + + + +	# RCS: @(#) if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } testConstraint testWinCPUID [llength [info commands testwincpuid]] test platform-1.1 {TclpSetVariables: tcl_platform} { interp create i i eval {catch {unset tcl_platform(debug)}} i eval {catch {unset tcl_platform(threaded)}} i eval {catch {unset tcl_platform(tip,268)}} i eval {catch {unset tcl_platform(tip,280)}} set result [i eval {lsort [array names tcl_platform]}] interp delete i set result } {byteOrder machine os osVersion platform user wordSize} # Test assumes twos-complement arithmetic, which is true of virtually # everything these days. Note that this does *not* use wide(), and # this is intentional since that could make Tcl's numbers wider than # the machine-integer on some platforms... test platform-2.1 {tcl_platform(wordSize) indicates size of native word} { set result [expr {1 << (8 * $tcl_platform(wordSize) - 1)}] # Result must be the largest bit in a machine word, which this checks # without assuming how wide the word really is list [expr {$result < 0}] [expr {$result ^ ($result - 1)}] } {1 -1} # On Windows, test that the CPU ID works test platform-3.1 {CPU ID on Windows } \ -constraints testWinCPUID \ -body { set cpudata [testwincpuid 0] binary format iii \ [lindex $cpudata 1] \ [lindex $cpudata 3] \ [lindex $cpudata 2] } \ -match regexp \ -result {^(?:AuthenticAMD|CentaurHauls|CyrixInstead|GenuineIntel)$} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End:

︙
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	- +	# Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 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. # # RCS: @(#) $Id: proc-old.test,v 1.9 2002/04/15 17:45:06 msofer Exp $ # RCS: @(#) $Id: proc-old.test,v 1.9.2.1 2003/03/27 21:46:32 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } catch {rename t1 ""}
︙
477 478 479 480 481 482 483 484 485 486 487 488 489 490 491	477 478 479 480 481 482 483 484 485 486 487 488 489 490 491	- +	} set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode] regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg normalizeMsg $msg } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory while executing "tproc2"} none} test proc-old-7.14 {return with special completion code} { test proc-old-7.15 {return with special completion code} { list [catch {return -badOption foo message} msg] $msg } {1 {bad option "-badOption": must be -code, -errorcode, or -errorinfo}} test proc-old-8.1 {unset and undefined local arrays} { proc t1 {} { foreach v {xxx, yyy} { catch {unset $v}
︙

︙
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	- +	# # Copyright (c) 1997 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. # # RCS: @(#) $Id: proc.test,v 1.11 2002/12/11 21:29:52 dgp Exp $ # RCS: @(#) $Id: proc.test,v 1.11.2.1 2004/05/02 21:07:16 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } catch {eval namespace delete [namespace children :: test_ns_*]}
︙
161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178	161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184	+ + + + + +	list [p] [namespace which p] } } {{p in ::} ::p} test proc-3.5 {TclObjInterpProc, any old result is reset before appending error msg about missing arguments} { proc p {x} {info commands 3m} list [catch {p} msg] $msg } {1 {wrong # args: should be "p x"}} test proc-3.6 {TclObjInterpProc, proper quoting of proc name, Bug 942757} { proc {a b c} {x} {info commands 3m} list [catch {{a b c}} msg] $msg } {1 {wrong # args: should be "{a b c} x"}} catch {eval namespace delete [namespace children :: test_ns_*]} catch {rename p ""} catch {rename {} ""} catch {rename {a b c} {}} catch {unset msg} if {[catch {package require procbodytest}]} { puts "This application couldn't load the \"procbodytest\" package, so I" puts "can't test creation of procs whose bodies have type \"procbody\"." ::tcltest::cleanupTests return
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	# reg.test -- # # 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. # (Don't panic if you are seeing this as part of the reg distribution # and aren't using Tcl -- reg's own regression tester also knows how # to read this file, ignoring the Tcl-isms.) # # Copyright (c) 1998, 1999 Henry Spencer. All rights reserved. # # RCS: @(#) $Id: reg.test,v 1.16 2002/07/29 12:28:35 dkf Exp $ # RCS: @(#) $Id: reg.test,v 1.16.2.3 2004/11/27 05:44:13 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } # All tests require the testregexp command, return if this
︙
134 135 136 137 138 139 140 141 142 143 144 145 146 147 148	134 135 136 137 138 139 140 141 142 143 144 145 146 147 148	- +	set prefix reg-$major set description "reg $desc" set testbypassed 0 } # build test number (internal) proc tno {testid} { return [lindex $testid 0] return [join $testid .] } # build description, with possible modifiers (internal) proc desc {testid} { global description set d $description
︙
990 991 992 993 994 995 996 997 998 999 1000	990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	# Tests resulting from bugs reported by users test reg-31.1 {[[:xdigit:]] behaves correctly when followed by [[:space:]]} { set str {2:::DebugWin32} set re {([[:xdigit:]])([[:space:]]*)} list [regexp $re $str match xdigit spaces] $match $xdigit $spaces # Code used to produce {1 2:::DebugWin32 2 :::DebugWin32} !!! } {1 2 2 {}} test reg-32.1 {canmatch functionality -- at end} testregexp { set pat {blah} set line "asd asd" # can match at the final d, if '%' follows set res [testregexp -xflags -- c $pat $line resvar] lappend res $resvar } {0 7} test reg-32.2 {canmatch functionality -- at end} testregexp { set pat {s%$} set line "asd asd" # can only match after the end of the string set res [testregexp -xflags -- c $pat $line resvar] lappend res $resvar } {0 7} test reg-32.3 {canmatch functionality -- not last char} testregexp { set pat {[^d]%$} set line "asd asd" # can only match after the end of the string set res [testregexp -xflags -- c $pat $line resvar] lappend res $resvar } {0 7} test reg-32.3.1 {canmatch functionality -- no match} testregexp { set pat {\Zx} set line "asd asd" # can match the last char, if followed by x set res [testregexp -xflags -- c $pat $line resvar] lappend res $resvar } {0 -1} test reg-32.4 {canmatch functionality -- last char} {knownBug} { set pat {.x} set line "asd asd" # can match the last char, if followed by x set res [testregexp -xflags -- c $pat $line resvar] lappend res $resvar } {0 6} test reg-32.4.1 {canmatch functionality -- last char} {knownBug} { set pat {.x$} set line "asd asd" # can match the last char, if followed by x set res [testregexp -xflags -- c $pat $line resvar] lappend res $resvar } {0 6} test reg-32.5 {canmatch functionality -- last char} {knownBug} { set pat {.[^d]x$} set line "asd asd" # can match the last char, if followed by not-d and x. set res [testregexp -xflags -- c $pat $line resvar] lappend res $resvar } {0 6} test reg-32.6 {canmatch functionality -- last char} {knownBug} { set pat {[^a]%[^\r\n]*$} set line "asd asd" # can match at the final d, if '%' follows set res [testregexp -xflags -- c $pat $line resvar] lappend res $resvar } {0 6} test reg-32.7 {canmatch functionality -- last char} {knownBug} { set pat {[^a]%$} set line "asd asd" # can match at the final d, if '%' follows set res [testregexp -xflags -- c $pat $line resvar] lappend res $resvar } {0 6} test reg-32.8 {canmatch functionality -- last char} {knownBug} { set pat {[^x]%$} set line "asd asd" # can match at the final d, if '%' follows set res [testregexp -xflags -- c $pat $line resvar] lappend res $resvar } {0 6} test reg-32.9 {canmatch functionality -- more complex case} {knownBug} { set pat {((\B\B|\Bh+line)[ \t]*|[^\B]%[^\r\n]*)$} set line "asd asd" # can match at the final d, if '%' follows set res [testregexp -xflags -- c $pat $line resvar] lappend res $resvar } {0 6} # Tests reg-33.*: Checks for bug fixes test reg-33.1 {Bug 230589} { regexp {[ ]*(^|[^%])%V} "*%V2" m s } 1 test reg-33.2 {Bug 504785} { regexp -inline {([^_.]*)([^.]*)\.(..)(.).*} bbcos_001_c01.q1la } {bbcos_001_c01.q1la bbcos _001_c01 q1 l} test reg-33.3 {Bug 505048} { regexp {\A\s*[^<]*\s*<([^>]+)>} a<a> } 1 test reg-33.4 {Bug 505048} { regexp {\A\s*([^b]*)b} ab } 1 test reg-33.5 {Bug 505048} { regexp {\A\s*[^b]*(b)} ab } 1 test reg-33.6 {Bug 505048} { regexp {\A(\s*)[^b]*(b)} ab } 1 test reg-33.7 {Bug 505048} { regexp {\A\s*[^b]*b} ab } 1 test reg-33.8 {Bug 505048} { regexp -inline {\A\s*[^b]*b} ab } ab test reg-33.9 {Bug 505048} { regexp -indices -inline {\A\s*[^b]*b} ab } {{0 1}} test reg-33.10 {Bug 840258} { regsub {(^|\n)+\.*b} \n.b {} tmp } 1 test reg-33.11 {Bug 840258} { regsub {(^|[\n\r]+)\.*\?<.*?(\n|\r)+} \ "TQ\r\n.?<5000267>Test already stopped\r\n" {} tmp } 1 # cleanup ::tcltest::cleanupTests return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	- + - +	# Commands covered: regexp, regsub # # 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) 1998 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. # # RCS: @(#) $Id: regexp.test,v 1.22 2002/07/10 11:56:44 dgp Exp $ # RCS: @(#) $Id: regexp.test,v 1.22.2.3 2003/10/14 18:22:10 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest package require tcltest 2 namespace import -force ::tcltest::* } catch {unset foo} test regexp-1.1 {basic regexp operation} { regexp ab*c abbbc } 1
︙
430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448	430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452	- + - - - + + + + + + +	regexp .*e f set x . append x *a regexp -nocase $x bbba } 1 testConstraint exec [llength [info commands exec]] test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} { test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} -constraints { exec } { exec [interpreter] [makeFile {puts [regexp {} foo]} junk.tcl] } 1 } -setup { set junk [makeFile {puts [regexp {} foo]} junk.tcl] } -body { exec [interpreter] $junk } -cleanup { removeFile junk.tcl } -result 1 test regexp-15.1 {regexp -start} { catch {unset x} list [regexp -start -10 {\d} 1abc2de3 x] $x } {1 1} test regexp-15.2 {regexp -start} { catch {unset x}
︙
567 568 569 570 571 572 573 574 575 576 577	571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	set c abcdefghijklmnopqurstuvwxyz0123456789 regsub $a $c $b d list $d [string length $d] [string bytelength $d] } [list abcdefghijklmnopqurstuvwxyz0123456789 37 37] test regexp-20.2 {regsub shared object shimmering with -about} { eval regexp -about abc } {0 {}} test regexp-21.1 {regsub works with empty string} { regsub -- ^ {} foo } {foo} test regexp-21.2 {regsub works with empty string} { regsub -- \$ {} foo } {foo} test regexp-21.3 {regsub works with empty string offset} { regsub -start 0 -- ^ {} foo } {foo} test regexp-21.4 {regsub works with empty string offset} { regsub -start 0 -- \$ {} foo } {foo} test regexp-21.5 {regsub works with empty string offset} { regsub -start 3 -- \$ {123} foo } {123foo} test regexp-21.6 {regexp works with empty string} { regexp -- ^ {} } {1} test regexp-21.7 {regexp works with empty string} { regexp -start 0 -- ^ {} } {1} test regexp-21.8 {regexp works with empty string offset} { regexp -start 3 -- ^ {123} } {0} test regexp-21.9 {regexp works with empty string offset} { regexp -start 3 -- \$ {123} } {1} test regexp-21.10 {multiple matches handle newlines} { regsub -all -lineanchor -- {^#[^\n]*\n} "#one\n#two\n#three\n" foo\n } "foo\nfoo\nfoo\n" test regexp-21.11 {multiple matches handle newlines} { regsub -all -line -- ^ "a\nb\nc" \# } "\#a\n\#b\n\#c" test regexp-21.12 {multiple matches handle newlines} { regsub -all -line -- ^ "\n\n" \# } "\#\n\#\n\#" test regexp-21.13 {multiple matches handle newlines} { regexp -all -inline -indices -line -- ^ "a\nb\nc" } {{0 -1} {2 1} {4 3}} # cleanup ::tcltest::cleanupTests return

︙
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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802	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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806	- + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - - - + + + + + + + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - +	# # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id$ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest package require tcltest 2 namespace import -force ::tcltest::* } # Procedure to evaluate a script within a proc, to test compilation # functionality proc evalInProc { script } { proc testProc {} $script set status [catch { testProc } result] rename testProc {} return $result #return [list $status $result] } catch {unset foo} test regexp-1.1 {basic regexp operation} { test regexpComp-1.1 {basic regexp operation} { evalInProc { regexp ab*c abbbc } } 1 test regexp-1.2 {basic regexp operation} { test regexpComp-1.2 {basic regexp operation} { evalInProc { regexp ab*c ac } } 1 test regexp-1.3 {basic regexp operation} { test regexpComp-1.3 {basic regexp operation} { evalInProc { regexp ab*c ab } } 0 test regexp-1.4 {basic regexp operation} { test regexpComp-1.4 {basic regexp operation} { evalInProc { regexp -- -gorp abc-gorpxxx } } 1 test regexp-1.5 {basic regexp operation} { test regexpComp-1.5 {basic regexp operation} { evalInProc { regexp {^([^ ]*)[ ]*([^ ]*)} "" a } } 1 test regexp-1.6 {basic regexp operation} { test regexpComp-1.6 {basic regexp operation} { list [catch {regexp {} abc} msg] $msg } {0 1} test regexp-1.7 {regexp utf compliance} { test regexpComp-1.7 {regexp utf compliance} { # if not UTF-8 aware, result is "0 1" evalInProc { set foo "\u4e4eb q" regexp "\u4e4eb q" "a\u4e4eb qw\u5e4e\x4e wq" bar list [string compare $foo $bar] [regexp 4 $bar] } } {0 0} test regexp-2.1 {getting substrings back from regexp} { test regexpComp-2.1 {getting substrings back from regexp} { evalInProc { set foo {} list [regexp ab*c abbbbc foo] $foo } } {1 abbbbc} test regexp-2.2 {getting substrings back from regexp} { test regexpComp-2.2 {getting substrings back from regexp} { evalInProc { set foo {} set f2 {} list [regexp a(b*)c abbbbc foo f2] $foo $f2 } } {1 abbbbc bbbb} test regexp-2.3 {getting substrings back from regexp} { test regexpComp-2.3 {getting substrings back from regexp} { evalInProc { set foo {} set f2 {} list [regexp a(b*)(c) abbbbc foo f2] $foo $f2 } } {1 abbbbc bbbb} test regexp-2.4 {getting substrings back from regexp} { test regexpComp-2.4 {getting substrings back from regexp} { evalInProc { set foo {} set f2 {} set f3 {} list [regexp a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3 } } {1 abbbbc bbbb c} test regexp-2.5 {getting substrings back from regexp} { test regexpComp-2.5 {getting substrings back from regexp} { evalInProc { set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {}; set f6 {}; set f7 {}; set f8 {}; set f9 {}; set fa {}; set fb {}; list [regexp (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*)(a*)(b*) \ 12223345556789999aabbb \ foo f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb] $foo $f1 $f2 $f3 $f4 $f5 \ $f6 $f7 $f8 $f9 $fa $fb } } {1 12223345556789999aabbb 1 222 33 4 555 6 7 8 9999 aa bbb} test regexp-2.6 {getting substrings back from regexp} { test regexpComp-2.6 {getting substrings back from regexp} { evalInProc { set foo 2; set f2 2; set f3 2; set f4 2 list [regexp (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4 } } {1 a a {} {}} test regexp-2.7 {getting substrings back from regexp} { test regexpComp-2.7 {getting substrings back from regexp} { evalInProc { set foo 1; set f2 1; set f3 1; set f4 1 list [regexp (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4 } } {1 ac a {} c} test regexp-2.8 {getting substrings back from regexp} { test regexpComp-2.8 {getting substrings back from regexp} { evalInProc { set match {} list [regexp {^a*b} aaaab match] $match } } {1 aaaab} test regexp-3.1 {-indices option to regexp} { test regexpComp-3.1 {-indices option to regexp} { evalInProc { set foo {} list [regexp -indices ab*c abbbbc foo] $foo } } {1 {0 5}} test regexp-3.2 {-indices option to regexp} { test regexpComp-3.2 {-indices option to regexp} { evalInProc { set foo {} set f2 {} list [regexp -indices a(b*)c abbbbc foo f2] $foo $f2 } } {1 {0 5} {1 4}} test regexp-3.3 {-indices option to regexp} { test regexpComp-3.3 {-indices option to regexp} { evalInProc { set foo {} set f2 {} list [regexp -indices a(b*)(c) abbbbc foo f2] $foo $f2 } } {1 {0 5} {1 4}} test regexp-3.4 {-indices option to regexp} { test regexpComp-3.4 {-indices option to regexp} { evalInProc { set foo {} set f2 {} set f3 {} list [regexp -indices a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3 } } {1 {0 5} {1 4} {5 5}} test regexp-3.5 {-indices option to regexp} { test regexpComp-3.5 {-indices option to regexp} { evalInProc { set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {}; set f6 {}; set f7 {}; set f8 {}; set f9 {} list [regexp -indices (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*) \ 12223345556789999 \ foo f1 f2 f3 f4 f5 f6 f7 f8 f9] $foo $f1 $f2 $f3 $f4 $f5 \ $f6 $f7 $f8 $f9 } } {1 {0 16} {0 0} {1 3} {4 5} {6 6} {7 9} {10 10} {11 11} {12 12} {13 16}} test regexp-3.6 {getting substrings back from regexp} { test regexpComp-3.6 {getting substrings back from regexp} { evalInProc { set foo 2; set f2 2; set f3 2; set f4 2 list [regexp -indices (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4 } } {1 {1 1} {1 1} {-1 -1} {-1 -1}} test regexp-3.7 {getting substrings back from regexp} { test regexpComp-3.7 {getting substrings back from regexp} { evalInProc { set foo 1; set f2 1; set f3 1; set f4 1 list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4 } } {1 {1 2} {1 1} {-1 -1} {2 2}} test regexp-4.1 {-nocase option to regexp} { test regexpComp-4.1 {-nocase option to regexp} { evalInProc { regexp -nocase foo abcFOo } } 1 test regexp-4.2 {-nocase option to regexp} { test regexpComp-4.2 {-nocase option to regexp} { evalInProc { set f1 22 set f2 33 set f3 44 list [regexp -nocase {a(b*)([xy]*)z} aBbbxYXxxZ22 f1 f2 f3] $f1 $f2 $f3 } } {1 aBbbxYXxxZ Bbb xYXxx} test regexp-4.3 {-nocase option to regexp} { test regexpComp-4.3 {-nocase option to regexp} { evalInProc { regexp -nocase FOo abcFOo } } 1 set ::x abcdefghijklmnopqrstuvwxyz1234567890 set ::x $x$x$x$x$x$x$x$x$x$x$x$x test regexp-4.4 {case conversion in regexp} { test regexpComp-4.4 {case conversion in regexp} { evalInProc { list [regexp -nocase $::x $::x foo] $foo } } "1 $x" catch {unset ::x} test regexp-5.1 {exercise cache of compiled expressions} { test regexpComp-5.1 {exercise cache of compiled expressions} { evalInProc { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f regexp .*a bbba } } 1 test regexp-5.2 {exercise cache of compiled expressions} { test regexpComp-5.2 {exercise cache of compiled expressions} { evalInProc { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f regexp .*b xxxb } } 1 test regexp-5.3 {exercise cache of compiled expressions} { test regexpComp-5.3 {exercise cache of compiled expressions} { evalInProc { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f regexp .*c yyyc } } 1 test regexp-5.4 {exercise cache of compiled expressions} { test regexpComp-5.4 {exercise cache of compiled expressions} { evalInProc { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f regexp .*d 1d } } 1 test regexp-5.5 {exercise cache of compiled expressions} { test regexpComp-5.5 {exercise cache of compiled expressions} { evalInProc { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f regexp .*e xe } } 1 test regexp-6.1 {regexp errors} { test regexpComp-6.1 {regexp errors} { evalInProc { list [catch {regexp a} msg] $msg } } {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}} test regexp-6.2 {regexp errors} { test regexpComp-6.2 {regexp errors} { evalInProc { list [catch {regexp -nocase a} msg] $msg } } {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}} test regexp-6.3 {regexp errors} { test regexpComp-6.3 {regexp errors} { evalInProc { list [catch {regexp -gorp a} msg] $msg } } {1 {bad switch "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}} test regexp-6.4 {regexp errors} { test regexpComp-6.4 {regexp errors} { evalInProc { list [catch {regexp a( b} msg] $msg } } {1 {couldn't compile regular expression pattern: parentheses () not balanced}} test regexp-6.5 {regexp errors} { test regexpComp-6.5 {regexp errors} { evalInProc { list [catch {regexp a( b} msg] $msg } } {1 {couldn't compile regular expression pattern: parentheses () not balanced}} test regexp-6.6 {regexp errors} { test regexpComp-6.6 {regexp errors} { evalInProc { list [catch {regexp a a f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1} msg] $msg } } {0 1} test regexp-6.7 {regexp errors} { test regexpComp-6.7 {regexp errors} { evalInProc { list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg } } {0 0} test regexp-6.8 {regexp errors} { test regexpComp-6.8 {regexp errors} { evalInProc { catch {unset f1} set f1 44 list [catch {regexp abc abc f1(f2)} msg] $msg } } {1 {couldn't set variable "f1(f2)"}} test regexp-6.9 {regexp errors, -start bad int check} { test regexpComp-6.9 {regexp errors, -start bad int check} { evalInProc { list [catch {regexp -start bogus {^$} {}} msg] $msg } } {1 {expected integer but got "bogus"}} test regexp-7.1 {basic regsub operation} { test regexpComp-7.1 {basic regsub operation} { evalInProc { list [regsub aa+ xaxaaaxaa 111&222 foo] $foo } } {1 xax111aaa222xaa} test regexp-7.2 {basic regsub operation} { test regexpComp-7.2 {basic regsub operation} { evalInProc { list [regsub aa+ aaaxaa &111 foo] $foo } } {1 aaa111xaa} test regexp-7.3 {basic regsub operation} { test regexpComp-7.3 {basic regsub operation} { evalInProc { list [regsub aa+ xaxaaa 111& foo] $foo } } {1 xax111aaa} test regexp-7.4 {basic regsub operation} { test regexpComp-7.4 {basic regsub operation} { evalInProc { list [regsub aa+ aaa 11&2&333 foo] $foo } } {1 11aaa2aaa333} test regexp-7.5 {basic regsub operation} { test regexpComp-7.5 {basic regsub operation} { evalInProc { list [regsub aa+ xaxaaaxaa &2&333 foo] $foo } } {1 xaxaaa2aaa333xaa} test regexp-7.6 {basic regsub operation} { test regexpComp-7.6 {basic regsub operation} { evalInProc { list [regsub aa+ xaxaaaxaa 1&22& foo] $foo } } {1 xax1aaa22aaaxaa} test regexp-7.7 {basic regsub operation} { test regexpComp-7.7 {basic regsub operation} { evalInProc { list [regsub a(a+) xaxaaaxaa {1\122\1} foo] $foo } } {1 xax1aa22aaxaa} test regexp-7.8 {basic regsub operation} { test regexpComp-7.8 {basic regsub operation} { evalInProc { list [regsub a(a+) xaxaaaxaa {1\\\122\1} foo] $foo } } "1 {xax1\\aa22aaxaa}" test regexp-7.9 {basic regsub operation} { test regexpComp-7.9 {basic regsub operation} { evalInProc { list [regsub a(a+) xaxaaaxaa {1\\122\1} foo] $foo } } "1 {xax1\\122aaxaa}" test regexp-7.10 {basic regsub operation} { test regexpComp-7.10 {basic regsub operation} { evalInProc { list [regsub a(a+) xaxaaaxaa {1\\&\1} foo] $foo } } "1 {xax1\\aaaaaxaa}" test regexp-7.11 {basic regsub operation} { test regexpComp-7.11 {basic regsub operation} { evalInProc { list [regsub a(a+) xaxaaaxaa {1\&\1} foo] $foo } } {1 xax1&aaxaa} test regexp-7.12 {basic regsub operation} { test regexpComp-7.12 {basic regsub operation} { evalInProc { list [regsub a(a+) xaxaaaxaa {\1\1\1\1&&} foo] $foo } } {1 xaxaaaaaaaaaaaaaaxaa} test regexp-7.13 {basic regsub operation} { test regexpComp-7.13 {basic regsub operation} { evalInProc { set foo xxx list [regsub abc xyz 111 foo] $foo } } {0 xyz} test regexp-7.14 {basic regsub operation} { test regexpComp-7.14 {basic regsub operation} { evalInProc { set foo xxx list [regsub ^ xyz "111 " foo] $foo } } {1 {111 xyz}} test regexp-7.15 {basic regsub operation} { test regexpComp-7.15 {basic regsub operation} { evalInProc { set foo xxx list [regsub -- -foo abc-foodef "111 " foo] $foo } } {1 {abc111 def}} test regexp-7.16 {basic regsub operation} { test regexpComp-7.16 {basic regsub operation} { evalInProc { set foo xxx list [regsub x "" y foo] $foo } } {0 {}} test regexp-7.17 {regsub utf compliance} { test regexpComp-7.17 {regsub utf compliance} { evalInProc { # if not UTF-8 aware, result is "0 1" set foo "xyz555ijka\u4e4ebpqr" regsub a\u4e4eb xyza\u4e4ebijka\u4e4ebpqr 555 bar list [string compare $foo $bar] [regexp 4 $bar] } } {0 0} test regexp-8.1 {case conversion in regsub} { test regexpComp-8.1 {case conversion in regsub} { evalInProc { list [regsub -nocase a(a+) xaAAaAAay & foo] $foo } } {1 xaAAaAAay} test regexp-8.2 {case conversion in regsub} { test regexpComp-8.2 {case conversion in regsub} { evalInProc { list [regsub -nocase a(a+) xaAAaAAay & foo] $foo } } {1 xaAAaAAay} test regexp-8.3 {case conversion in regsub} { test regexpComp-8.3 {case conversion in regsub} { evalInProc { set foo 123 list [regsub a(a+) xaAAaAAay & foo] $foo } } {0 xaAAaAAay} test regexp-8.4 {case conversion in regsub} { test regexpComp-8.4 {case conversion in regsub} { evalInProc { set foo 123 list [regsub -nocase a CaDE b foo] $foo } } {1 CbDE} test regexp-8.5 {case conversion in regsub} { test regexpComp-8.5 {case conversion in regsub} { evalInProc { set foo 123 list [regsub -nocase XYZ CxYzD b foo] $foo } } {1 CbD} test regexp-8.6 {case conversion in regsub} { test regexpComp-8.6 {case conversion in regsub} { evalInProc { set x abcdefghijklmnopqrstuvwxyz1234567890 set x $x$x$x$x$x$x$x$x$x$x$x$x set foo 123 list [regsub -nocase $x $x b foo] $foo } } {1 b} test regexp-9.1 {-all option to regsub} { test regexpComp-9.1 {-all option to regsub} { evalInProc { set foo 86 list [regsub -all x+ axxxbxxcxdx |&| foo] $foo } } {4 a|xxx|b|xx|c|x|d|x|} test regexp-9.2 {-all option to regsub} { test regexpComp-9.2 {-all option to regsub} { evalInProc { set foo 86 list [regsub -nocase -all x+ aXxXbxxcXdx |&| foo] $foo } } {4 a|XxX|b|xx|c|X|d|x|} test regexp-9.3 {-all option to regsub} { test regexpComp-9.3 {-all option to regsub} { evalInProc { set foo 86 list [regsub x+ axxxbxxcxdx |&| foo] $foo } } {1 a|xxx|bxxcxdx} test regexp-9.4 {-all option to regsub} { test regexpComp-9.4 {-all option to regsub} { evalInProc { set foo 86 list [regsub -all bc axxxbxxcxdx |&| foo] $foo } } {0 axxxbxxcxdx} test regexp-9.5 {-all option to regsub} { test regexpComp-9.5 {-all option to regsub} { evalInProc { set foo xxx list [regsub -all node "node node more" yy foo] $foo } } {2 {yy yy more}} test regexp-9.6 {-all option to regsub} { test regexpComp-9.6 {-all option to regsub} { evalInProc { set foo xxx list [regsub -all ^ xxx 123 foo] $foo } } {1 123xxx} test regexp-10.1 {expanded syntax in regsub} { test regexpComp-10.1 {expanded syntax in regsub} { evalInProc { set foo xxx list [regsub -expanded ". \#comment\n . \#comment2" abc def foo] $foo } } {1 defc} test regexp-10.2 {newline sensitivity in regsub} { test regexpComp-10.2 {newline sensitivity in regsub} { evalInProc { set foo xxx list [regsub -line {^a.*b$} "dabc\naxyb\n" 123 foo] $foo } } "1 {dabc\n123\n}" test regexp-10.3 {newline sensitivity in regsub} { test regexpComp-10.3 {newline sensitivity in regsub} { evalInProc { set foo xxx list [regsub -line {^a.*b$} "dabc\naxyb\nxb" 123 foo] $foo } } "1 {dabc\n123\nxb}" test regexp-10.4 {partial newline sensitivity in regsub} { test regexpComp-10.4 {partial newline sensitivity in regsub} { evalInProc { set foo xxx list [regsub -lineanchor {^a.*b$} "da\naxyb\nxb" 123 foo] $foo } } "1 {da\n123}" test regexp-10.5 {inverse partial newline sensitivity in regsub} { test regexpComp-10.5 {inverse partial newline sensitivity in regsub} { evalInProc { set foo xxx list [regsub -linestop {a.*b} "da\nbaxyb\nxb" 123 foo] $foo } } "1 {da\nb123\nxb}" test regexp-11.1 {regsub errors} { test regexpComp-11.1 {regsub errors} { evalInProc { list [catch {regsub a b} msg] $msg } } {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}} test regexp-11.2 {regsub errors} { test regexpComp-11.2 {regsub errors} { evalInProc { list [catch {regsub -nocase a b} msg] $msg } } {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}} test regexp-11.3 {regsub errors} { test regexpComp-11.3 {regsub errors} { evalInProc { list [catch {regsub -nocase -all a b} msg] $msg } } {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}} test regexp-11.4 {regsub errors} { test regexpComp-11.4 {regsub errors} { evalInProc { list [catch {regsub a b c d e f} msg] $msg } } {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}} test regexp-11.5 {regsub errors} { test regexpComp-11.5 {regsub errors} { evalInProc { list [catch {regsub -gorp a b c} msg] $msg } } {1 {bad switch "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}} test regexp-11.6 {regsub errors} { test regexpComp-11.6 {regsub errors} { evalInProc { list [catch {regsub -nocase a( b c d} msg] $msg } } {1 {couldn't compile regular expression pattern: parentheses () not balanced}} test regexp-11.7 {regsub errors} { test regexpComp-11.7 {regsub errors} { evalInProc { catch {unset f1} set f1 44 list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg } } {1 {couldn't set variable "f1(f2)"}} test regexp-11.8 {regsub errors, -start bad int check} { test regexpComp-11.8 {regsub errors, -start bad int check} { evalInProc { list [catch {regsub -start bogus pattern string rep var} msg] $msg } } {1 {expected integer but got "bogus"}} # This test crashes on the Mac unless you increase the Stack Space to about 1 # Meg. This is probably bigger than most users want... # 8.2.3 regexp reduced stack space requirements, but this should be # tested again test regexp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} { test regexpComp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} { evalInProc { list [regexp (.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) abcdefghijklmnopqrstuvwxyz all a b c d e f g h i j k l m n o p q r s t u v w x y z] $all $a $b $c $d $e $f $g $h $i $j $k $l $m $n $o $p $q $r $s $t $u $v $w $x $y $z } } {1 abcdefghijklmnopqrstuvwxyz a b c d e f g h i j k l m n o p q r s t u v w x y z} test regexp-13.1 {regsub of a very large string} { test regexpComp-13.1 {regsub of a very large string} { # This test is designed to stress the memory subsystem in order # to catch Bug #933. It only fails if the Tcl memory allocator # is in use. set line {BEGIN_TABLE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; END_TABLE} set filedata [string repeat $line 200] for {set i 1} {$i<10} {incr i} { regsub -all "BEGIN_TABLE " $filedata "" newfiledata } set x done } {done} test regexp-14.1 {CompileRegexp: regexp cache} { test regexpComp-14.1 {CompileRegexp: regexp cache} { evalInProc { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f set x . append x *a regexp $x bbba } } 1 test regexp-14.2 {CompileRegexp: regexp cache, different flags} { test regexpComp-14.2 {CompileRegexp: regexp cache, different flags} { evalInProc { regexp .*a b regexp .*b c regexp .*c d regexp .*d e regexp .*e f set x . append x *a regexp -nocase $x bbba } } 1 testConstraint exec [llength [info commands exec]] test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} { test regexpComp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} -constraints { exec } { exec [interpreter] [makeFile {puts [regexp {} foo]} junk.tcl] } 1 } -setup { set junk [makeFile {puts [regexp {} foo]} junk.tcl] } -body { exec [interpreter] $junk } -cleanup { removeFile junk.tcl } -result 1 test regexp-15.1 {regexp -start} { test regexpComp-15.1 {regexp -start} { catch {unset x} list [regexp -start -10 {\d} 1abc2de3 x] $x } {1 1} test regexp-15.2 {regexp -start} { test regexpComp-15.2 {regexp -start} { catch {unset x} list [regexp -start 2 {\d} 1abc2de3 x] $x } {1 2} test regexp-15.3 {regexp -start} { test regexpComp-15.3 {regexp -start} { catch {unset x} list [regexp -start 4 {\d} 1abc2de3 x] $x } {1 2} test regexp-15.4 {regexp -start} { test regexpComp-15.4 {regexp -start} { catch {unset x} list [regexp -start 5 {\d} 1abc2de3 x] $x } {1 3} test regexp-15.5 {regexp -start, over end of string} { test regexpComp-15.5 {regexp -start, over end of string} { catch {unset x} list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x] } {0 0} test regexp-15.6 {regexp -start, loss of ^$ behavior} { test regexpComp-15.6 {regexp -start, loss of ^$ behavior} { list [regexp -start 2 {^$} {}] } {0} test regexp-16.1 {regsub -start} { test regexpComp-16.1 {regsub -start} { catch {unset x} list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x } {4 a1b/2c/3d/4e/5} test regexp-16.2 {regsub -start} { test regexpComp-16.2 {regsub -start} { catch {unset x} list [regsub -all -start -25 {z} hello {/&} x] $x } {0 hello} test regexp-16.3 {regsub -start} { test regexpComp-16.3 {regsub -start} { catch {unset x} list [regsub -all -start 3 {z} hello {/&} x] $x } {0 hello} test regexp-16.4 {regsub -start, \A behavior} { test regexpComp-16.4 {regsub -start, \A behavior} { set out {} lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x } {5 /a/b/c/d/e 3 ab/c/d/e} test regexp-17.1 {regexp -inline} { test regexpComp-17.1 {regexp -inline} { regexp -inline b ababa } {b} test regexp-17.2 {regexp -inline} { test regexpComp-17.2 {regexp -inline} { regexp -inline (b) ababa } {b b} test regexp-17.3 {regexp -inline -indices} { test regexpComp-17.3 {regexp -inline -indices} { regexp -inline -indices (b) ababa } {{1 1} {1 1}} test regexp-17.4 {regexp -inline} { test regexpComp-17.4 {regexp -inline} { regexp -inline {\w(\d+)\w} " hello 23 there456def " } {e456d 456} test regexp-17.5 {regexp -inline no matches} { test regexpComp-17.5 {regexp -inline no matches} { regexp -inline {\w(\d+)\w} "" } {} test regexp-17.6 {regexp -inline no matches} { test regexpComp-17.6 {regexp -inline no matches} { regexp -inline hello goodbye } {} test regexp-17.7 {regexp -inline, no matchvars allowed} { test regexpComp-17.7 {regexp -inline, no matchvars allowed} { list [catch {regexp -inline b abc match} msg] $msg } {1 {regexp match variables not allowed when using -inline}} test regexp-18.1 {regexp -all} { test regexpComp-18.1 {regexp -all} { regexp -all b bbbbb } {5} test regexp-18.2 {regexp -all} { test regexpComp-18.2 {regexp -all} { regexp -all b abababbabaaaaaaaaaab } {6} test regexp-18.3 {regexp -all -inline} { test regexpComp-18.3 {regexp -all -inline} { regexp -all -inline b abababbabaaaaaaaaaab } {b b b b b b} test regexp-18.4 {regexp -all -inline} { test regexpComp-18.4 {regexp -all -inline} { regexp -all -inline {\w(\w)} abcdefg } {ab b cd d ef f} test regexp-18.5 {regexp -all -inline} { test regexpComp-18.5 {regexp -all -inline} { regexp -all -inline {\w(\w)$} abcdefg } {fg g} test regexp-18.6 {regexp -all -inline} { test regexpComp-18.6 {regexp -all -inline} { regexp -all -inline {\d+} 10:20:30:40 } {10 20 30 40} test regexp-18.7 {regexp -all -inline} { test regexpComp-18.7 {regexp -all -inline} { list [catch {regexp -all -inline b abc match} msg] $msg } {1 {regexp match variables not allowed when using -inline}} test regexp-18.8 {regexp -all} { test regexpComp-18.8 {regexp -all} { # This should not cause an infinite loop regexp -all -inline {a*} a } {a} test regexp-18.9 {regexp -all} { test regexpComp-18.9 {regexp -all} { # Yes, the expected result is {a {}}. Here's why: # Start at index 0; a* matches the "a" there then stops. # Go to index 1; a* matches the lambda (or {}) there then stops. Recall # that a* matches zero or more "a"'s; thus it matches the string "b", as # there are zero or more "a"'s there. # Go to index 2; this is past the end of the string, so stop. regexp -all -inline {a*} ab } {a {}} test regexp-18.10 {regexp -all} { test regexpComp-18.10 {regexp -all} { # Yes, the expected result is {a {} a}. Here's why: # Start at index 0; a* matches the "a" there then stops. # Go to index 1; a* matches the lambda (or {}) there then stops. Recall # that a* matches zero or more "a"'s; thus it matches the string "b", as # there are zero or more "a"'s there. # Go to index 2; a* matches the "a" there then stops. # Go to index 3; this is past the end of the string, so stop. regexp -all -inline {a*} aba } {a {} a} test regexp-18.11 {regexp -all} { test regexpComp-18.11 {regexp -all} { evalInProc { regexp -all -inline {^a} aaaa } } {a} test regexp-18.12 {regexp -all -inline -indices} { test regexpComp-18.12 {regexp -all -inline -indices} { evalInProc { regexp -all -inline -indices a(b(c)d|e(f)g)h abcdhaefgh } } {{0 4} {1 3} {2 2} {-1 -1} {5 9} {6 8} {-1 -1} {7 7}} test regexp-19.1 {regsub null replacement} { test regexpComp-19.1 {regsub null replacement} { evalInProc { regsub -all {@} {@hel@lo@} "\0a\0" result list $result [string length $result] } } "\0a\0hel\0a\0lo\0a\0 14" test regexp-20.1 {regsub shared object shimmering} { test regexpComp-20.1 {regsub shared object shimmering} { evalInProc { # Bug #461322 set a abcdefghijklmnopqurstuvwxyz set b $a set c abcdefghijklmnopqurstuvwxyz0123456789 regsub $a $c $b d list $d [string length $d] [string bytelength $d] } } [list abcdefghijklmnopqurstuvwxyz0123456789 37 37] test regexp-20.2 {regsub shared object shimmering with -about} { test regexpComp-20.2 {regsub shared object shimmering with -about} { evalInProc { eval regexp -about abc } } {0 {}} test regexp-21.1 {regexp command compiling tests} { test regexpComp-21.1 {regexp command compiling tests} { evalInProc { regexp foo bar } } 0 test regexp-21.2 {regexp command compiling tests} { test regexpComp-21.2 {regexp command compiling tests} { evalInProc { regexp {^foo$} dogfood } } 0 test regexp-21.3 {regexp command compiling tests} { test regexpComp-21.3 {regexp command compiling tests} { evalInProc { set a foo regexp {^foo$} $a } } 1 test regexp-21.4 {regexp command compiling tests} { test regexpComp-21.4 {regexp command compiling tests} { evalInProc { regexp foo dogfood } } 1 test regexp-21.5 {regexp command compiling tests} { test regexpComp-21.5 {regexp command compiling tests} { evalInProc { regexp -nocase FOO dogfod } } 0 test regexp-21.6 {regexp command compiling tests} { test regexpComp-21.6 {regexp command compiling tests} { evalInProc { regexp -n foo dogfoOd } } 1 test regexp-21.7 {regexp command compiling tests} { test regexpComp-21.7 {regexp command compiling tests} { evalInProc { regexp -no -- FoO dogfood } } 1 test regexp-21.8 {regexp command compiling tests} { test regexpComp-21.8 {regexp command compiling tests} { evalInProc { regexp -- foo dogfod } } 0 test regexp-21.9 {regexp command compiling tests} { test regexpComp-21.9 {regexp command compiling tests} { evalInProc { list [catch {regexp -- -nocase foo dogfod} msg] $msg } } {0 0} test regexp-21.10 {regexp command compiling tests} { test regexpComp-21.10 {regexp command compiling tests} { evalInProc { list [regsub -all "" foo bar str] $str } } {3 barfbarobaro} test regexp-21.11 {regexp command compiling tests} { test regexpComp-21.11 {regexp command compiling tests} { evalInProc { list [regsub -all "" "" bar str] $str } } {0 {}} set i 0 foreach {str exp result} {
︙
810 811 812 813 814 815 816 817 818 819 820 821 822 823	814 815 816 817 818 819 820 821 822 823 824 825 826 827	- +	anything ^.*a$ 0 anything ^.*a.*$ 1 anything ^.*.*$ 1 anything ^.*..*$ 1 anything ^.*b$ 0 anything ^a.*$ 1 } { test regexp-22.[incr i] {regexp command compiling tests} \ test regexpComp-22.[incr i] {regexp command compiling tests} \ [subst {evalInProc {set a "$str"; regexp {$exp} \$a}}] $result } # cleanup ::tcltest::cleanupTests return

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	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	- + - + - - + + - - - + - -	# registry.test -- # # This file contains a collection of tests for the registry command. # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # In order for these tests to run, the registry package must be on the # auto_path or the registry package must have been loaded already. # # Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved. # Copyright (c) 1998-1999 by Scriptics Corporation. # # RCS: @(#) $Id: registry.test,v 1.12 2002/10/18 23:58:18 hobbs Exp $ # RCS: @(#) $Id: registry.test,v 1.12.2.3 2007/03/17 22:41:05 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest package require tcltest 2 namespace import -force ::tcltest::* } if {$tcl_platform(platform) == "windows"} { if [catch { set lib [lindex [glob -directory [file join [pwd] [file dirname \ [info nameofexecutable]]] tclreg*.dll] 0] load $lib registry }] { puts "Unable to find the registry package. Skipping registry tests." return } } # determine the current locale set old [testlocale all] if {![string compare [testlocale all ""] "English_United States.1252"]} { testConstraint english [expr {[llength [info commands testlocale]] && [string equal [testlocale all ""] "English_United States.1252"] # error messages from registry package are already localized. set ::tcltest::testConstraints(english) 1 } }] testlocale all $old unset old set hostname [info hostname] test registry-1.1 {argument parsing for registry command} {pcOnly} { list [catch {registry} msg] $msg } {1 {wrong # args: should be "registry option ?arg arg ...?"}} test registry-1.2 {argument parsing for registry command} {pcOnly} {
︙
247 248 249 250 251 252 253 254 255 256 257 258 259 260	243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270	+ + + + + + + + + + + + + +	registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz\u30b7bar registry set HKEY_CLASSES_ROOT\\TclFoobar\\blat registry set HKEY_CLASSES_ROOT\\TclFoobar\\foo set result [lsort [registry keys HKEY_CLASSES_ROOT\\TclFoobar b*]] registry delete HKEY_CLASSES_ROOT\\TclFoobar set result } "baz\u30b7bar blat" test registry-4.9 {GetKeyNames: very long key [Bug 1682211]} \ -constraints {pcOnly} \ -setup { registry set HKEY_CLASSES_ROOT\\TclFoobar\\a registry set HKEY_CLASSES_ROOT\\TclFoobar\\b[string repeat x 254] registry set HKEY_CLASSES_ROOT\\TclFoobar\\c } \ -body { lsort [registry keys HKEY_CLASSES_ROOT\\TclFoobar] } \ -cleanup { registry delete HKEY_CLASSES_ROOT\\TclFoobar } \ -result [list a b[string repeat x 254] c] test registry-5.1 {GetType} {pcOnly english} { registry delete HKEY_CLASSES_ROOT\\TclFoobar list [catch {registry type HKEY_CLASSES_ROOT\\TclFoobar val1} msg] $msg } {1 {unable to open key: The system cannot find the file specified.}} test registry-5.2 {GetType} {pcOnly english} { registry set HKEY_CLASSES_ROOT\\TclFoobar
︙
598 599 600 601 602 603 604	608 609 610 611 612 613 614 615 616 617 618 619 620	+ + + + + +	list [catch {registry b {}} msg] $msg } {0 {1 0}} # cleanup unset hostname ::tcltest::cleanupTests return # Local Variables: # mode: tcl # tcl-indent-level: 4 # fill-column: 78 # End:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	# Commands covered: resource # # 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) 1996-1997 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. # # RCS: @(#) $Id: resource.test,v 1.7 2000/04/10 17:19:03 ericm Exp $ # RCS: @(#) $Id: resource.test,v 1.7.24.1 2003/10/06 14:30:06 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } test resource-1.1 {resource tests} {macOnly} {
︙
269 270 271 272 273 274 275 276 277 278 279 280 281 282 283	269 270 271 272 273 274 275 276 277 278 279 280 281 282 283	- +	testWriteTextResource -rsrc fileRsrcName -rsrcid 128 -file rsrc2.file {Some stuff} set id [resource open rsrc2.file w] set result [catch {resource delete -id 128 -file $id _bad_type_} mssg] resource close $id file delete rsrc2.file lappend result $mssg } {1 {expected Macintosh OS type but got "_bad_type_"}} test resource-8.5 {resource delete tests} {macOnly} { test resource-8.5.1 {resource delete tests} {macOnly} { catch {file delete rsrc2.file} set id [resource open rsrc2.file w] set result [catch {resource delete -id 128 -file $id TEXT} mssg] resource close $id file delete rsrc2.file lappend result $mssg } {1 {resource not found}}
︙

︙
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	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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133	+ + + - + - + - + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	test result-3.1 {Tcl_DiscardInterpResult} {testsaveresult} { list [catch {testsaveresult append {cd _foobar} 1} msg] $msg } {1 {couldn't change working directory to "_foobar": no such file or directory}} test result-3.2 {Tcl_DiscardInterpResult} {testsaveresult} { testsaveresult free {set x 42} 1 } {42} ::tcltest::testConstraint testsetobjerrorcode \ [expr {[info commands testsetobjerrorcode] != {}}] test result-4.1 {Tcl_SetObjErrorCode - one arg} {testsaveresult} { test result-4.1 {Tcl_SetObjErrorCode - one arg} {testsetobjerrorcode} { catch {testsetobjerrorcode 1} list [set errorCode] } {1} test result-4.2 {Tcl_SetObjErrorCode - two args} {testsaveresult} { test result-4.2 {Tcl_SetObjErrorCode - two args} {testsetobjerrorcode} { catch {testsetobjerrorcode 1 2} list [set errorCode] } {{1 2}} test result-4.3 {Tcl_SetObjErrorCode - three args} {testsaveresult} { test result-4.3 {Tcl_SetObjErrorCode - three args} {testsetobjerrorcode} { catch {testsetobjerrorcode 1 2 3} list [set errorCode] } {{1 2 3}} test result-4.4 {Tcl_SetObjErrorCode - four args} {testsaveresult} { test result-4.4 {Tcl_SetObjErrorCode - four args} {testsetobjerrorcode} { catch {testsetobjerrorcode 1 2 3 4} list [set errorCode] } {{1 2 3 4}} test result-4.5 {Tcl_SetObjErrorCode - five args} {testsaveresult} { test result-4.5 {Tcl_SetObjErrorCode - five args} {testsetobjerrorcode} { catch {testsetobjerrorcode 1 2 3 4 5} list [set errorCode] } {{1 2 3 4 5}} ::tcltest::testConstraint testseterrorcode \ [expr {[info commands testseterrorcode] != {}}] test result-5.1 {Tcl_SetErrorCode - one arg} testseterrorcode { catch {testseterrorcode 1} set errorCode } 1 test result-5.2 {Tcl_SetErrorCode - one arg, list quoting} testseterrorcode { catch {testseterrorcode {a b}} set errorCode } {{a b}} test result-5.3 {Tcl_SetErrorCode - one arg, list quoting} testseterrorcode { catch {testseterrorcode \{} llength $errorCode } 1 test result-5.4 {Tcl_SetErrorCode - two args, list quoting} testseterrorcode { catch {testseterrorcode {a b} c} set errorCode } {{a b} c} test result-6.2 {Bug 1649062} -setup { proc foo {} { if {[catch { return -code error -errorinfo custom -errorcode CUSTOM foo } err]} { return [list $err $::errorCode $::errorInfo] } } set ::errorInfo {} set ::errorCode {} } -body { foo } -cleanup { rename foo {} } -result {foo {} {}} # cleanup ::tcltest::cleanupTests return
︙

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	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	- + + + +	# safe.test -- # # This file contains a collection of tests for safe Tcl, packages loading, # and using safe interpreters. Sourcing this file into tcl runs the tests # and generates output for errors. No output means no errors were found. # # Copyright (c) 1995-1996 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. # # RCS: @(#) $Id: safe.test,v 1.13 2002/05/10 18:47:11 dgp Exp $ # RCS: @(#) $Id: safe.test,v 1.13.2.3 2006/11/28 22:20:03 andreas_kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } foreach i [interp slaves] { interp delete $i } set saveAutoPath $::auto_path set ::auto_path [info library] # Force actual loading of the safe package # because we use un exported (and thus un-autoindexed) APIs # in this test result arguments: catch {safe::interpConfigure} proc equiv {x} {return $x}
︙
179 180 181 182 183 184 185 186 187 188 189 190 191 192	182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203	+ + + + + + + +	if {$tcl_platform(platform) == "windows" && \ [lsearch $r "debug"] != -1} { set r [lreplace $r 1 1] } set threaded [lsearch $r "threaded"] if {$threaded != -1} { set r [lreplace $r $threaded $threaded] } set tip [lsearch $r "tip,268"] if {$tip != -1} { set r [lreplace $r $tip $tip] } set tip [lsearch $r "tip,280"] if {$tip != -1} { set r [lreplace $r $tip $tip] } set r } {byteOrder platform wordSize} # more test should be added to check that hostname, nameofexecutable, # aren't leaking infos, but they still do...
︙
515 516 517 518 519 520 521 522 523 524	526 527 528 529 530 531 532 533 534 535 536	+	list \ [catch {interp eval $i encoding convertto} msg] \ $msg \ [safe::interpDelete $i]; } {1 {wrong # args: should be "encoding convertto ?encoding? data"} {}} set ::auto_path $saveAutoPath # cleanup ::tcltest::cleanupTests return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	# Commands covered: scan # # 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-1994 The Regents of the University of California. # Copyright (c) 1994-1997 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. # # RCS: @(#) $Id: scan.test,v 1.14 2002/06/22 04:19:47 dgp Exp $ # RCS: @(#) $Id: scan.test,v 1.14.2.1 2004/08/19 21:12:04 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::testConstraint 64bitInts [expr {0x80000000 > 0}]
︙
413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432	413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435	- + + + +	# input (-16) some return MAX_INT. # test scan-5.11 {integer scanning} {nonPortable} { set a {}; set b {}; list [scan "4294967280 4294967280" "%u %d" a b] $a \ [expr {$b == -16 || $b == 0x7fffffff}] } {2 4294967280 1} test scan-5.12 {integer scanning} {64bitInts} { set a {}; set b {}; set c {} list [scan "7810179016327718216,6c63546f6c6c6548,661432506755433062510" \ %ld,%lx,%lo a b c] $a $b $c } {3 7810179016327718216 7810179016327718216 7810179016327718216} test scan-5.13 {integer scanning and overflow} { # This test used to fail on some 64-bit systems. [Bug 1011860] scan {300000000 3000000000 30000000000} {%ld %ld %ld} } {300000000 3000000000 30000000000} test scan-6.1 {floating-point scanning} { set a {}; set b {}; set c {}; set d {} list [scan "2.1 -3.0e8 .99962 a" "%f%g%e%f" a b c d] $a $b $c $d } {3 2.1 -300000000.0 0.99962 {}} test scan-6.2 {floating-point scanning} { set a {}; set b {}; set c {}; set d {}
︙

︙
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	- +	# Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 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. # # RCS: @(#) $Id: set-old.test,v 1.16 2003/02/05 20:05:51 mdejong Exp $ # RCS: @(#) $Id: set-old.test,v 1.16.2.1 2003/03/27 21:46:32 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } proc ignore args {}
︙
426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615	426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615	- + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + + + + + + + + - + - - - - - - - - + - + - + - + - + - + - +	list [catch {foo 1} msg] $msg } {0 {}} test set-old-8.22 {array command, names option} { catch {unset a} set a(22) 3 list [catch {array names a 4 5} msg] $msg } {1 {bad option "4": must be -exact, -glob, or -regexp}} test set-old-8.19 {array command, names option} { test set-old-8.23 {array command, names option} { catch {unset a} array names a } {} test set-old-8.23 {array command, names option} { test set-old-8.24 {array command, names option} { catch {unset a} set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx list [catch {lsort [array names a]} msg] $msg } {0 {22 Textual_name {name with spaces}}} test set-old-8.24 {array command, names option} { test set-old-8.25 {array command, names option} { catch {unset a} set a(22) 3; set a(33) 44; trace var a(xxx) w ignore list [catch {lsort [array names a]} msg] $msg } {0 {22 33}} test set-old-8.25 {array command, names option} { test set-old-8.26 {array command, names option} { catch {unset a} set a(22) 3; set a(33) 44; trace var a(xxx) w ignore set a(xxx) value list [catch {lsort [array names a]} msg] $msg } {0 {22 33 xxx}} test set-old-8.26 {array command, names option} { test set-old-8.27 {array command, names option} { catch {unset a} set a(axy) 3 set a(bxy) 44 set a(no) yes set a(xxx) value list [lsort [array names a *xy]] [lsort [array names a]] } {{axy bxy} {axy bxy no xxx}} test set-old-8.27 {array command, names option, array doesn't exist yet but has compiler-allocated procedure slot} { test set-old-8.28 {array command, names option, array doesn't exist yet but has compiler-allocated procedure slot} { proc foo {x} { if {$x==1} { return [array names a] } set a(x) 123 } list [catch {foo 1} msg] $msg } {0 {}} test set-old-8.28 {array command, nextelement option} { test set-old-8.29 {array command, nextelement option} { list [catch {array nextelement a} msg] $msg } {1 {wrong # args: should be "array nextelement arrayName searchId"}} test set-old-8.29 {array command, nextelement option} { test set-old-8.30 {array command, nextelement option} { catch {unset a} list [catch {array nextelement a b} msg] $msg } {1 {"a" isn't an array}} test set-old-8.30 {array command, nextelement option, array doesn't exist yet but has compiler-allocated procedure slot} { test set-old-8.31 {array command, nextelement option, array doesn't exist yet but has compiler-allocated procedure slot} { proc foo {x} { if {$x==1} { return [array nextelement a b] } set a(x) 123 } list [catch {foo 1} msg] $msg } {1 {"a" isn't an array}} test set-old-8.31 {array command, set option} { test set-old-8.32 {array command, set option} { list [catch {array set a} msg] $msg } {1 {wrong # args: should be "array set arrayName list"}} test set-old-8.32 {array command, set option} { test set-old-8.33 {array command, set option} { list [catch {array set a 1 2} msg] $msg } {1 {wrong # args: should be "array set arrayName list"}} test set-old-8.33 {array command, set option} { test set-old-8.34 {array command, set option} { list [catch {array set a "a \{ c"} msg] $msg } {1 {unmatched open brace in list}} test set-old-8.34 {array command, set option} { test set-old-8.35 {array command, set option} { catch {unset a} set a 44 list [catch {array set a {a b c d}} msg] $msg } {1 {can't set "a(a)": variable isn't array}} test set-old-8.35 {array command, set option} { test set-old-8.36 {array command, set option} { catch {unset a} set a(xx) yy array set a {b c d e} lsort [array get a] } {b c d e xx yy} test set-old-8.36 {array command, set option, array doesn't exist yet but has compiler-allocated procedure slot} { test set-old-8.37 {array command, set option, array doesn't exist yet but has compiler-allocated procedure slot} { proc foo {x} { if {$x==1} { return [array set a {x 0}] } set a(x) } list [catch {foo 1} msg] $msg } {0 {}} test set-old-8.37 {array command, set option} { test set-old-8.38 {array command, set option} { catch {unset aVaRnAmE} array set aVaRnAmE {} list [info exists aVaRnAmE] [catch {set aVaRnAmE} msg] $msg } {1 1 {can't read "aVaRnAmE": variable is array}} test set-old-8.37.1 {array command, set scalar} { test set-old-8.38.1 {array command, set scalar} { catch {unset aVaRnAmE} set aVaRnAmE 1 list [catch {array set aVaRnAmE {}} msg] $msg } {1 {can't array set "aVaRnAmE": variable isn't array}} test set-old-8.37.2 {array command, set alias} { test set-old-8.38.2 {array command, set alias} { catch {unset aVaRnAmE} upvar 0 aVaRnAmE anAliAs array set anAliAs {} list [array exists aVaRnAmE] [catch {set anAliAs} msg] $msg } {1 1 {can't read "anAliAs": variable is array}} test set-old-8.37.3 {array command, set element alias} { test set-old-8.38.3 {array command, set element alias} { catch {unset aVaRnAmE} list [catch {upvar 0 aVaRnAmE(elem) elemAliAs}] \ [catch {array set elemAliAs {}} msg] $msg } {0 1 {can't array set "elemAliAs": variable isn't array}} test set-old-8.37.4 {array command, empty set with populated array} { test set-old-8.38.4 {array command, empty set with populated array} { catch {unset aVaRnAmE} array set aVaRnAmE [list e1 v1 e2 v2] array set aVaRnAmE {} array set aVaRnAmE [list e3 v3] list [lsort [array names aVaRnAmE]] [catch {set aVaRnAmE(e2)} msg] $msg } {{e1 e2 e3} 0 v2} test set-old-8.37.5 {array command, set with non-existent namespace} { test set-old-8.38.5 {array command, set with non-existent namespace} { list [catch {array set bogusnamespace::var {}} msg] $msg } {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}} test set-old-8.37.6 {array command, set with non-existent namespace} { test set-old-8.38.6 {array command, set with non-existent namespace} { list [catch {array set bogusnamespace::var {a b}} msg] $msg } {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}} test set-old-8.37.7 {array command, set with non-existent namespace} { test set-old-8.38.7 {array command, set with non-existent namespace} { list [catch {array set bogusnamespace::var(0) {a b}} msg] $msg } {1 {can't set "bogusnamespace::var(0)": variable isn't array}} test set-old-8.38 {array command, size option} { test set-old-8.39 {array command, size option} { catch {unset a} array size a } {0} test set-old-8.40 {array command, size option} { list [catch {array size a 4} msg] $msg } {1 {wrong # args: should be "array size arrayName"}} test set-old-8.41 {array command, size option} { catch {unset a} array size a } {0} test set-old-8.39 {array command, size option} { test set-old-8.42 {array command, size option} { list [catch {array size a 4} msg] $msg } {1 {wrong # args: should be "array size arrayName"}} test set-old-8.40 {array command, size option} { catch {unset a} array size a } {0} test set-old-8.41 {array command, size option} { catch {unset a} set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx list [catch {array size a} msg] $msg } {0 3} test set-old-8.42 {array command, size option} { test set-old-8.43 {array command, size option} { catch {unset a} set a(22) 3; set a(xx) 44; set a(y) xxx unset a(22) a(y) a(xx) list [catch {array size a} msg] $msg } {0 0} test set-old-8.43 {array command, size option} { test set-old-8.44 {array command, size option} { catch {unset a} set a(22) 3; trace var a(33) rwu ignore list [catch {array size a} msg] $msg } {0 1} test set-old-8.44 {array command, size option, array doesn't exist yet but has compiler-allocated procedure slot} { test set-old-8.45 {array command, size option, array doesn't exist yet but has compiler-allocated procedure slot} { proc foo {x} { if {$x==1} { return [array size a] } set a(x) 123 } list [catch {foo 1} msg] $msg } {0 0} test set-old-8.45 {array command, startsearch option} { test set-old-8.46 {array command, startsearch option} { list [catch {array startsearch a b} msg] $msg } {1 {wrong # args: should be "array startsearch arrayName"}} test set-old-8.46 {array command, startsearch option} { test set-old-8.47 {array command, startsearch option} { catch {unset a} list [catch {array startsearch a} msg] $msg } {1 {"a" isn't an array}} test set-old-8.47 {array command, startsearch option, array doesn't exist yet but has compiler-allocated procedure slot} { test set-old-8.48 {array command, startsearch option, array doesn't exist yet but has compiler-allocated procedure slot} { catch {rename p ""} proc p {x} { if {$x==1} { return [array startsearch a] } set a(x) 123 } list [catch {p 1} msg] $msg } {1 {"a" isn't an array}} test set-old-8.48 {array command, statistics option} { test set-old-8.49 {array command, statistics option} { catch {unset a} set a(abc) 1 set a(def) 2 set a(ghi) 3 set a(jkl) 4 set a(mno) 5 set a(pqr) 6
︙
626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680	626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680	- + - + - + - + - + - + - +	number of buckets with 5 entries: 0 number of buckets with 6 entries: 0 number of buckets with 7 entries: 0 number of buckets with 8 entries: 0 number of buckets with 9 entries: 0 number of buckets with 10 or more entries: 0 average search distance for entry: 1.7" test set-old-8.49 {array command, array names -exact on glob pattern} { test set-old-8.50 {array command, array names -exact on glob pattern} { catch {unset a} set a(1*2) 1 list [catch {array names a -exact 1*2} msg] $msg } {0 1*2} test set-old-8.48 {array command, array names -glob on glob pattern} { test set-old-8.51 {array command, array names -glob on glob pattern} { catch {unset a} set a(1*2) 1 set a(12) 1 set a(11) 1 list [catch {lsort [array names a -glob 1*2]} msg] $msg } {0 {1*2 12}} test set-old-8.49 {array command, array names -regexp on regexp pattern} { test set-old-8.52 {array command, array names -regexp on regexp pattern} { catch {unset a} set a(1*2) 1 set a(12) 1 set a(11) 1 list [catch {lsort [array names a -regexp ^1]} msg] $msg } {0 {1*2 11 12}} test set-old-8.50 {array command, array names -regexp} { test set-old-8.53 {array command, array names -regexp} { catch {unset a} set a(-glob) 1 set a(-regexp) 1 set a(-exact) 1 list [catch {array names a -regexp} msg] $msg } {0 -regexp} test set-old-8.51 {array command, array names -exact} { test set-old-8.54 {array command, array names -exact} { catch {unset a} set a(-glob) 1 set a(-regexp) 1 set a(-exact) 1 list [catch {array names a -exact} msg] $msg } {0 -exact} test set-old-8.52 {array command, array names -glob} { test set-old-8.55 {array command, array names -glob} { catch {unset a} set a(-glob) 1 set a(-regexp) 1 set a(-exact) 1 list [catch {array names a -glob} msg] $msg } {0 -glob} test set-old-8.53 {array command, array statistics on a non-array} { test set-old-8.56 {array command, array statistics on a non-array} { catch {unset a} list [catch {array statistics a} msg] $msg } [list 1 "\"a\" isn't an array"] test set-old-9.1 {ids for array enumeration} { catch {unset a} set a(a) 1
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	# Commands tested in this file: socket. # # 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) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: socket.test,v 1.26 2002/07/10 11:56:45 dgp Exp $ # RCS: @(#) $Id: socket.test,v 1.26.2.6 2006/03/16 00:35:59 andreas_kupries Exp $ # Running socket tests with a remote server: # ------------------------------------------ # # Some tests in socket.test depend on the existence of a remote server to # which they connect. The remote server must be an instance of tcltest and it # must run the script found in the file "remote.tcl" in this directory. You
︙
238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256	238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262	+ + + + + + - +	list [catch {socket -server callback 2520 --} msg] $msg } {1 {wrong # args: should be either: socket ?-myaddr addr? ?-myport myport? ?-async? host port socket -server command ?-myaddr addr? port}} test socket-1.12 {arg parsing for socket command} {socket} { list [catch {socket foo badport} msg] $msg } {1 {expected integer but got "badport"}} test socket-1.13 {arg parsing for socket command} {socket} { list [catch {socket -async -server} msg] $msg } {1 {cannot set -async option for server sockets}} test socket-1.14 {arg parsing for socket command} {socket} { list [catch {socket -server foo -async} msg] $msg } {1 {cannot set -async option for server sockets}} set path(script) [makeFile {} script] test socket-2.1 {tcp connection} {socket stdio} { removeFile script file delete $path(script) set f [open $path(script) w] puts $f { set timer [after 10000 "set x timed_out"] set f [socket -server accept 0] proc accept {file addr port} { global x set x done
︙
280 281 282 283 284 285 286 287 288 289 290 291 292 293 294	286 287 288 289 290 291 292 293 294 295 296 297 298 299 300	- +	if [info exists port] { incr port } else { set port [expr 2048 + [pid]%1024] } test socket-2.2 {tcp connection with client port specified} {socket stdio} { removeFile script file delete $path(script) set f [open $path(script) w] puts $f { set timer [after 10000 "set x timeout"] set f [socket -server accept 0] proc accept {file addr port} { global x puts "[gets $file] $port"
︙
316 317 318 319 320 321 322 323 324 325 326 327 328 329 330	322 323 324 325 326 327 328 329 330 331 332 333 334 335 336	- +	lappend x [gets $f] close $sock } close $f set x } [list ready "hello $port"] test socket-2.3 {tcp connection with client interface specified} {socket stdio} { removeFile script file delete $path(script) set f [open $path(script) w] puts $f { set timer [after 2000 "set x done"] set f [socket -server accept 2830] proc accept {file addr port} { global x puts "[gets $file] $addr"
︙
347 348 349 350 351 352 353 354 355 356 357 358 359 360 361	353 354 355 356 357 358 359 360 361 362 363 364 365 366 367	- +	lappend x [gets $f] close $sock } close $f set x } {ready {hello 127.0.0.1}} test socket-2.4 {tcp connection with server interface specified} {socket stdio} { removeFile script file delete $path(script) set f [open $path(script) w] puts $f { set timer [after 2000 "set x done"] set f [socket -server accept -myaddr 127.0.0.1 0] proc accept {file addr port} { global x puts "[gets $file]"
︙
380 381 382 383 384 385 386 387 388 389 390 391 392 393 394	386 387 388 389 390 391 392 393 394 395 396 397 398 399 400	- +	lappend x [gets $f] close $sock } close $f set x } {ready hello} test socket-2.5 {tcp connection with redundant server port} {socket stdio} { removeFile script file delete $path(script) set f [open $path(script) w] puts $f { set timer [after 10000 "set x timeout"] set f [socket -server accept 0] proc accept {file addr port} { global x puts "[gets $file]"
︙
423 424 425 426 427 428 429 430 431 432 433 434 435 436 437	429 430 431 432 433 434 435 436 437 438 439 440 441 442 443	- +	set status broken } close $sock } set status } ok test socket-2.7 {echo server, one line} {socket stdio} { removeFile script file delete $path(script) set f [open $path(script) w] puts $f { set timer [after 10000 "set x timeout"] set f [socket -server accept 0] proc accept {s a p} { fileevent $s readable [list echo $s] fconfigure $s -translation lf -buffering line
︙
463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478	469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485	+ - - + +	after 1000 set x [gets $s] close $s set y [gets $f] close $f list $x $y } {{hello abcdefghijklmnop} done} removeFile script test socket-2.8 {echo server, loop 50 times, single connection} {socket stdio} { makeFile { test socket-2.8 {echo server, loop 50 times, single connection} -constraints {socket stdio} -setup { set path(script) [makeFile { set f [socket -server accept 0] proc accept {s a p} { fileevent $s readable [list echo $s] fconfigure $s -buffering line } proc echo {s} { global i
︙
490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523	497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534	- + + + + - + + - +	puts ready puts [lindex [fconfigure $f -sockname] 2] set timer [after 20000 "set x done"] vwait x after cancel $timer close $f puts "done $i" } script } script] } -body { set f [open "|[list [interpreter] $path(script)]" r] gets $f gets $f listen set s [socket 127.0.0.1 $listen] fconfigure $s -buffering line catch { for {set x 0} {$x < 50} {incr x} { puts $s "hello abcdefghijklmnop" gets $s } } close $s catch {set x [gets $f]} close $f set x } -cleanup { removeFile script } {done 50} } -result {done 50} set path(script) [makeFile {} script] test socket-2.9 {socket conflict} {socket stdio} { set s [socket -server accept 0] removeFile script file delete $path(script) set f [open $path(script) w] puts -nonewline $f "socket -server accept [lindex [fconfigure $s -sockname] 2]" close $f set f [open "|[list [interpreter] $path(script)]" r] gets $f after 100 set x [list [catch {close $f} msg]]
︙
575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609	586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620	- + - +	close $s close $sock set result } {a:one b: c:two} test socket-3.1 {socket conflict} {socket stdio} { removeFile script file delete $path(script) set f [open $path(script) w] puts $f { set f [socket -server accept 0] puts ready puts [lindex [fconfigure $f -sockname] 2] gets stdin close $f } close $f set f [open "|[list [interpreter] $path(script)]" r+] gets $f gets $f listen set x [list [catch {socket -server accept $listen} msg] \ $msg] puts $f bye close $f set x } {1 {couldn't open socket: address already in use}} test socket-3.2 {server with several clients} {socket stdio} { removeFile script file delete $path(script) set f [open $path(script) w] puts $f { set t1 [after 30000 "set x timed_out"] set t2 [after 31000 "set x timed_out"] set t3 [after 32000 "set x timed_out"] set counter 0 set s [socket -server accept 0]
︙
655 656 657 658 659 660 661 662 663 664 665 666 667 668 669	666 667 668 669 670 671 672 673 674 675 676 677 678 679 680	- +	close $s3 lappend x [gets $f] close $f set x } {ready done} test socket-4.1 {server with several clients} {socket stdio} { removeFile script file delete $path(script) set f [open $path(script) w] puts $f { set port [gets stdin] set s [socket 127.0.0.1 $port] fconfigure $s -buffering line for {set i 0} {$i < 100} {incr i} { puts $s hello
︙
755 756 757 758 759 760 761 762 763 764 765 766 767 768 769	766 767 768 769 770 771 772 773 774 775 776 777 778 779 780	- +	set x {htons problem, should be disallowed, are you running as SU?} close $msg } set x } {couldn't open socket: not owner} test socket-6.1 {accept callback error} {socket stdio} { removeFile script file delete $path(script) set f [open $path(script) w] puts $f { gets stdin port socket 127.0.0.1 $port } close $f set f [open "|[list [interpreter] $path(script)]" r+]
︙
780 781 782 783 784 785 786 787 788 789 790 791 792 793 794	791 792 793 794 795 796 797 798 799 800 801 802 803 804 805	- +	after cancel $timer close $s rename bgerror {} set x } {{divide by zero}} test socket-7.1 {testing socket specific options} {socket stdio} { removeFile script file delete $path(script) set f [open $path(script) w] puts $f { set ss [socket -server accept 0] proc accept args { global x set x done }
︙
808 809 810 811 812 813 814 815 816 817 818 819 820 821 822	819 820 821 822 823 824 825 826 827 828 829 830 831 832 833	- +	close $f set l "" lappend l [string compare [lindex $p 0] 127.0.0.1] lappend l [string compare [lindex $p 2] $listen] lappend l [llength $p] } {0 0 3} test socket-7.2 {testing socket specific options} {socket stdio} { removeFile script file delete $path(script) set f [open $path(script) w] puts $f { set ss [socket -server accept 2821] proc accept args { global x set x done }
︙
1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307	1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318	- + - - + +	} } else { incr len [string length $l] } } set c [socket $remoteServerIP 2836] fileevent $c readable "readlittle $c" set timer [after 10000 "set done timed_out"] set timer [after 40000 "set done timed_out"] vwait done after cancel $timer sendCommand {close $socket10_13_test_server} list $spurious $len } {0 2690} list $spurious $len $done } {0 2690 1} test socket-11.12 {testing EOF stickyness} {socket doTestsWithRemoteServer} { set counter 0 set done 0 proc count_up {s} { global counter done after_id set l [gets $s]
︙
1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 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	1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 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	- - + + - + - + + + - + - - - - + + - + - + + + - +	set count } 65566 set path(script1) [makeFile {} script1] set path(script2) [makeFile {} script2] test socket-12.1 {testing inheritance of server sockets} {socket stdio exec} { removeFile script1 removeFile script2 file delete $path(script1) file delete $path(script2) # Script1 is just a 10 second delay. If the server socket # is inherited, it will be held open for 10 seconds set f [open $path(script1) w] puts $f { after 10000 exit vwait forever } close $f # Script2 creates the server socket, launches script1, # waits a second, and exits. The server socket will now # be closed unless script1 inherited it. set f [open $path(script2) w] puts $f [list set tcltest [interpreter]] puts $f [format { puts -nonewline $f { set f [socket -server accept 0] puts [lindex [fconfigure $f -sockname] 2] proc accept { file addr port } { close $file } exec $tcltest "%s" & exec $tcltest } puts $f [list $path(script1) &] puts $f { close $f after 1000 exit vwait forever } $path(script1)] } close $f # Launch script2 and wait 5 seconds ### exec [interpreter] script2 & set p [open "|[list [interpreter] $path(script2)]" r] gets $p listen after 5000 { set ok_to_proceed 1 } vwait ok_to_proceed # If we can still connect to the server, the socket got inherited. if {[catch {socket 127.0.0.1 $listen} msg]} { set x {server socket was not inherited} } else { close $msg set x {server socket was inherited} } removeFile script1 removeFile script2 close $p set x } {server socket was not inherited} test socket-12.2 {testing inheritance of client sockets} {socket stdio exec} { removeFile script1 removeFile script2 file delete $path(script1) file delete $path(script2) # Script1 is just a 20 second delay. If the server socket # is inherited, it will be held open for 10 seconds set f [open $path(script1) w] puts $f { after 20000 exit vwait forever } close $f # Script2 opens the client socket and writes to it. It then # launches script1 and exits. If the child process inherited the # client socket, the socket will still be open. set f [open $path(script2) w] puts $f [list set tcltest [interpreter]] puts $f [format { puts -nonewline $f { gets stdin port set f [socket 127.0.0.1 $port] exec $tcltest "%s" & exec $tcltest } puts $f [list $path(script1) &] puts $f { puts $f testing flush $f after 1000 exit vwait forever } $path(script1)] } close $f # Create the server socket set server [socket -server accept 0] proc accept { file host port } { # When the client connects, establish the read handler
︙
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	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	- - - - + + - + - + + + - + + + + + - +	set p [open "|[list [interpreter] $path(script2)]" w] puts $p [lindex [fconfigure $server -sockname] 2] ; flush $p vwait x if {!$failed} { vwait failed } removeFile script1 removeFile script2 close $p set x } {client socket was not inherited} test socket-12.3 {testing inheritance of accepted sockets} {socket stdio exec} { removeFile script1 removeFile script2 file delete $path(script1) file delete $path(script2) set f [open $path(script1) w] puts $f { after 10000 exit vwait forever } close $f set f [open $path(script2) w] puts $f [list set tcltest [interpreter]] puts $f [format { puts -nonewline $f { set server [socket -server accept 0] puts stdout [lindex [fconfigure $server -sockname] 2] proc accept { file host port } { proc accept { file host port } } puts $f \{ puts -nonewline $f { global tcltest puts $file {test data on socket} exec $tcltest "%s" & exec $tcltest } puts $f [list $path(script1) &] puts $f { after 1000 exit } puts $f \} puts $f { vwait forever } $path(script1)] } close $f # Launch the script2 process and connect to it. See how long # the socket stays open ## exec [interpreter] script2 & set p [open "|[list [interpreter] $path(script2)]" r]
︙
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	1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641	- - - + - - +	catch { close $file } } return } vwait x removeFile script1 removeFile script2 close $p set x } {accepted socket was not inherited} test socket-13.1 {Testing use of shared socket between two threads} \ {socket testthread} { -constraints {socket testthread} -setup { removeFile script threadReap makeFile { set path(script) [makeFile { set f [socket -server accept 0] set listen [lindex [fconfigure $f -sockname] 2] proc accept {s a p} { fileevent $s readable [list echo $s] fconfigure $s -buffering line } proc echo {s} {
︙
1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680	1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697	- - + + + - + - - + + + - + +	} set i 0 vwait x close $f # thread cleans itself up. testthread exit } script } script] } -body { # create a thread set serverthread [testthread create { source script } ] set serverthread [testthread create [list source $path(script) ] ] update set port [testthread send $serverthread {set listen}] update after 1000 set s [socket 127.0.0.1 $port] fconfigure $s -buffering line catch { puts $s "hello" gets $s result } close $s update after 2000 lappend result [threadReap] set result } -cleanup { removeFile script } -result {hello 1} } {hello 1} removeFile script1 removeFile script2 # cleanup if {[string match sock* $commandSocket] == 1} { puts $commandSocket exit flush $commandSocket } catch {close $commandSocket} catch {close $remoteProcChan} ::tcltest::cleanupTests flush stdout return

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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193

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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323

+ - + - - - + + + + + + + + + + - - + + - + - + + + + - - - + + + + + + + - - + + + - - + - + - - + + + - + + + + + + + + + + + + + + - - + + - - - + + + + + + + - - + + - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - + + + + - - - + + + + - - - - - + + + + + + + + + - - - + + + + + + + - - + + - - - + + + + + + + - - + + - - - + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + - - - - - + + + + + + + + + + + + - + + - - - - + + + + + + + + + + + + - + + - - - - + + + + + + + - - + + + + + + + + + - + + + + + - + + + - - + + + + - - + + + - + - - + +

# Commands covered: source # # 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-1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 by Scriptics Corporation. # Contributions from Don Porter, NIST, 2003. (not subject to US copyright) # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: source.test,v 1.8 2002/07/05 10:38:43 dkf Exp $ # RCS: @(#) $Id: source.test,v 1.8.2.2 2004/02/25 23:38:17 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* if {[catch {package require tcltest 2.1}]} { puts stderr "Skipping tests in [info script]. tcltest 2.1 required." return } namespace eval ::tcl::test::source { namespace import ::tcltest::test namespace import ::tcltest::testConstraint namespace import ::tcltest::cleanupTests namespace import ::tcltest::makeFile namespace import ::tcltest::removeFile namespace import ::tcltest::customMatch set sourcefile [makeFile "" source.file] test source-1.1 {source command} { test source-1.1 {source command} -setup { set x "old x value" set y "old y value" set z "old z value" makeFile { set sourcefile [makeFile { set x 22 set y 33 set z 44 } source.file } source.file] } -body { source $sourcefile list $x $y $z } -cleanup { removeFile source.file } {22 33 44} test source-1.2 {source command} { makeFile {list result} source.file } -result {22 33 44} test source-1.2 {source command} -setup { set sourcefile [makeFile {list result} source.file] } -body { source $sourcefile } -cleanup { removeFile source.file } result test source-1.3 {source command} { } -result result test source-1.3 {source command} -setup { set y {\ } set sourcefile [makeFile {} source.file] set fd [open $sourcefile w] fconfigure $fd -translation lf puts -nonewline $fd "list a b c " puts $fd "list a b c \\" puts $fd [string index $y 0] puts $fd "d e f" close $fd } -body { source $sourcefile } -cleanup { removeFile source.file } {a b c d e f} } -result {a b c d e f} proc ListGlobMatch {expected actual} { if {[llength $expected] != [llength $actual]} { return 0 } foreach e $expected a $actual { if {![string match $e $a]} { return 0 } } return 1 } customMatch listGlob [namespace which ListGlobMatch] test source-2.3 {source error conditions} { makeFile { test source-2.3 {source error conditions} -setup { set sourcefile [makeFile { set x 146 error "error in sourced file" set y $x } source.file list [catch {source $sourcefile} msg] $msg $errorInfo } [list 1 {error in sourced file} "error in sourced file } source.file] } -body { list [catch {source $sourcefile} msg] $msg $::errorInfo } -cleanup { removeFile source.file } -match listGlob -result [list 1 {error in sourced file} \ {error in sourced file while executing \"error \"error in sourced file\"\" (file \"$sourcefile\" line 3) "error "error in sourced file"" (file "*source.file" line 3) invoked from within \"source \$sourcefile\""] test source-2.4 {source error conditions} { makeFile {break} source.file catch {source $sourcefile} } 3 test source-2.5 {source error conditions} { makeFile {continue} source.file catch {source $sourcefile} } 4 test source-2.6 {source error conditions} { normalizeMsg [list [catch {source _non_existent_} msg] $msg $errorCode] } {1 {couldn't read file "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}} "source $sourcefile"}] test source-2.4 {source error conditions} -setup { set sourcefile [makeFile {break} source.file] } -body { source $sourcefile } -cleanup { removeFile source.file } -returnCodes break test source-2.5 {source error conditions} -setup { set sourcefile [makeFile {continue} source.file] } -body { source $sourcefile } -cleanup { removeFile source.file } -returnCodes continue test source-2.6 {source error conditions} -setup { set sourcefile [makeFile {} _non_existent_] removeFile _non_existent_ } -body { list [catch {source $sourcefile} msg] $msg $::errorCode } -match listGlob -result [list 1 \ {couldn't read file "*_non_existent_": no such file or directory} \ {POSIX ENOENT {no such file or directory}}] test source-3.1 {return in middle of source file} { makeFile { test source-3.1 {return in middle of source file} -setup { set sourcefile [makeFile { set x new-x return allDone set y new-y } source.file } source.file] } -body { set x old-x set y old-y set z [source $sourcefile] list $x $y $z } -cleanup { removeFile source.file } {new-x old-y allDone} test source-3.2 {return with special code etc.} { makeFile { } -result {new-x old-y allDone} test source-3.2 {return with special code etc.} -setup { set sourcefile [makeFile { set x new-x return -code break "Silly result" set y new-y } source.file list [catch {source $sourcefile} msg] $msg } {3 {Silly result}} test source-3.3 {return with special code etc.} { makeFile { } source.file] } -body { source $sourcefile } -cleanup { removeFile source.file } -returnCodes break -result {Silly result} test source-3.3 {return with special code etc.} -setup { set sourcefile [makeFile { set x new-x return -code error "Simulated error" set y new-y } source.file list [catch {source $sourcefile} msg] $msg $errorInfo $errorCode } {1 {Simulated error} {Simulated error } source.file] } -body { list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode } -cleanup { removeFile source.file } -result {1 {Simulated error} {Simulated error while executing "source $sourcefile"} NONE} test source-3.4 {return with special code etc.} { makeFile { test source-3.4 {return with special code etc.} -setup { set sourcefile [makeFile { set x new-x return -code error -errorinfo "Simulated errorInfo stuff" set y new-y } source.file list [catch {source $sourcefile} msg] $msg $errorInfo $errorCode } {1 {} {Simulated errorInfo stuff } source.file] } -body { list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode } -cleanup { removeFile source.file } -result {1 {} {Simulated errorInfo stuff invoked from within "source $sourcefile"} NONE} test source-3.5 {return with special code etc.} { makeFile { test source-3.5 {return with special code etc.} -setup { set sourcefile [makeFile { set x new-x return -code error -errorinfo "Simulated errorInfo stuff" \ -errorcode {a b c} set y new-y } source.file list [catch {source $sourcefile} msg] $msg $errorInfo $errorCode } {1 {} {Simulated errorInfo stuff } source.file] } -body { list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode } -cleanup { removeFile source.file } -result {1 {} {Simulated errorInfo stuff invoked from within "source $sourcefile"} {a b c}} # Test for the Macintosh specfic features of the source command test source-4.1 {source error conditions} {macOnly} { list [catch {source -rsrc _no_exist_} msg] $msg } [list 1 "The resource \"_no_exist_\" could not be loaded from application."] test source-4.2 {source error conditions} {macOnly} { list [catch {source -rsrcid bad_id} msg] $msg } [list 1 "expected integer but got \"bad_id\""] test source-4.3 {source error conditions} {macOnly} { list [catch {source -rsrc rsrcName fileName extra} msg] $msg } {1 {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}} test source-4.4 {source error conditions} {macOnly} { list [catch {source non_switch rsrcName} msg] $msg } {1 {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}} test source-4.5 {source error conditions} {macOnly} { list [catch {source -bad_switch argument} msg] $msg } {1 {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}} test source-5.1 {source resource files} {macOnly} { list [catch {source -rsrc rsrcName bad_file} msg] $msg } [list 1 "Error finding the file: \"bad_file\"."] test source-5.2 {source resource files} {macOnly} { makeFile {return} source.file list [catch {source -rsrc rsrcName $sourcefile} msg] $msg } [list 1 "Error reading the file: \"$sourcefile\"."] test source-5.3 {source resource files} {macOnly} { testWriteTextResource -rsrc rsrcName -file rsrc.file {set msg2 ok; return} test source-4.1 {source error conditions} -constraints macOnly -body { source -rsrc _no_exist_ } -result {The resource "_no_exist_" could not be loaded from application.} \ -returnCodes error test source-4.2 {source error conditions} -constraints macOnly -body { source -rsrcid bad_id } -returnCodes error -result {expected integer but got "bad_id"} test source-4.3 {source error conditions} -constraints macOnly -body { source -rsrc rsrcName fileName extra } -returnCodes error -result {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?" or "source -encoding name fileName"} test source-4.4 {source error conditions} -constraints macOnly -body { source non_switch rsrcName } -returnCodes error -result {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?" or "source -encoding name fileName"} test source-4.5 {source error conditions} -constraints macOnly -body { source -bad_switch argument } -returnCodes error -result {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?" or "source -encoding name fileName"} testConstraint testWriteTextResource \ [llength [info commands testWriteTextResource]] test source-5.1 {source resource files} -constraints macOnly -setup { set sourcefile [makeFile {} bad_file] removeFile bad_file } -body { source -rsrc rsrcName $sourcefile } -returnCodes error -match glob -result {Error finding the file: "*bad_file".} test source-5.2 {source resource files} -constraints macOnly -setup { set sourcefile [makeFile {return} source.file] } -body { source -rsrc rsrcName $sourcefile } -cleanup { removeFile source.file } -returnCodes error -match glob \ -result {Error reading the file: "*source.file".} test source-5.3 {source resource files} -constraints { macOnly testWriteTextResource } -setup { set msg2 unset set rsrcFile [makeFile {} rsrc.file] removeFile rsrc.file testWriteTextResource -rsrc rsrcName -file $rsrc.file {set msg2 ok; return} } -body { set result [catch {source -rsrc rsrcName rsrc.file} msg] removeFile rsrc.file list $msg2 $result $msg } -cleanup { removeFile rsrc.file } [list ok 0 {}] test source-5.4 {source resource files} {macOnly} { catch {unset msg2} testWriteTextResource -rsrc fileRsrcName -file rsrc.file {set msg2 ok; return} source -rsrc fileRsrcName rsrc.file } -result [list ok 0 {}] test source-5.4 {source resource files} -constraints { macOnly testWriteTextResource } -setup { set msg2 unset set rsrsFile [makeFile {} rsrc.file] removeFile rsrc.file testWriteTextResource -rsrc fileRsrcName \ -file $rsrcFile {set msg2 ok; return} } -body { source -rsrc fileRsrcName $rsrcFile set result [catch {source -rsrc fileRsrcName} msg] removeFile rsrc.file list $msg2 $result $msg } -cleanup { removeFile rsrc.file } [list ok 1 {The resource "fileRsrcName" could not be loaded from application.}] test source-5.5 {source resource files} {macOnly} { testWriteTextResource -rsrcid 200 -file rsrc.file {set msg2 hello; set msg3 bye} set result [catch {source -rsrcid 200 rsrc.file} msg] } -result [list ok 1 {The resource "fileRsrcName" could not be loaded from application.}] test source-5.5 {source resource files} -constraints { macOnly testWriteTextResource } -setup { set msg2 unset set rsrcFile [makeFile {} rsrc.file] removeFile rsrc.file testWriteTextResource -rsrcid 200 \ -file $rsrcFile {set msg2 hello; set msg3 bye} } -body { set result [catch {source -rsrcid 200 $rsrcFile} msg] removeFile rsrc.file list $msg2 $result $msg } -cleanup { removeFile rsrc.file } [list hello 0 bye] test source-5.6 {source resource files} {macOnly} { testWriteTextResource -rsrcid 200 -file rsrc.file {set msg2 hello; error bad; set msg3 bye} set result [catch {source -rsrcid 200 rsrc.file} msg] } -result [list hello 0 bye] test source-5.6 {source resource files} -constraints { macOnly testWriteTextResource } -setup { set msg2 unset set rsrcFile [makeFile {} rsrc.file] removeFile rsrc.file list $msg2 $result $msg } [list hello 1 bad] testWriteTextResource -rsrcid 200 \ -file $rsrcFile {set msg2 hello; error bad; set msg3 bye} } -body { set result [catch {source -rsrcid 200 rsrc.file} msg] list $msg2 $result $msg } -cleanup { removeFile rsrc.file } -result [list hello 1 bad] test source-6.1 {source is binary ok} { test source-6.1 {source is binary ok} -setup { # Note [makeFile] writes in the system encoding. # [source] defaults to reading in the system encoding. set sourcefile [makeFile [list set x "a b\0c"] source.file] } -body { set x {} makeFile [list set x "a b\0c"] source.file source $sourcefile string length $x } -cleanup { removeFile source.file } -result 5 } 5 test source-6.2 {source skips everything after Ctrl-Z: Bug 2040} { test source-6.2 {source skips everything after Ctrl-Z: Bug 2040} -setup { set sourcefile [makeFile "set x ab\32c" source.file] } -body { set x {} makeFile [list set x "ab\32c"] source.file source $sourcefile string length $x } 2 } -cleanup { removeFile source.file } -result 2 # cleanup cleanupTests catch {::tcltest::removeFile source.file} ::tcltest::cleanupTests } namespace delete ::tcl::test::source return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	# Tests that the stack size is big enough for the application. # # 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) 1998-2000 Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: stack.test,v 1.15 2002/07/29 00:25:49 msofer Exp $ # RCS: @(#) $Id: stack.test,v 1.15.2.1 2004/05/03 18:01:36 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } # Note that a failure in this test results in a crash of the executable.
︙
51 52 53 54 55 56 57 58 59 60	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	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	interp create $slave $slave eval { interp alias {} unknown {} notaknownproc } set msg [$slave eval { catch {foo} msg ; set msg }] interp delete $slave set msg } {too many nested evaluations (infinite loop?)} # Make sure that there is enough stack to run regexp even if we're # close to the recursion limit. [Bug 947070] test stack-3.1 {enough room for regexp near recursion limit} \ -constraints { win } \ -setup { set ::limit [interp recursionlimit {} 10000] set ::depth 0 proc a { max } { if { [info level] < $max } { set ::depth [info level] a $max } else { regexp {^ ?} x } } list [catch { a 10001 }] incr depth -3 set depth2 $depth } -body { list [catch { a $::depth } result] \ $result [expr { $::depth2 - $::depth }] } -cleanup { interp recursionlimit {} $::limit } -result {0 1 1} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End:

︙
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	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	- + + +	# Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: string.test,v 1.36 2003/02/18 02:25:45 hobbs Exp $ # RCS: @(#) $Id: string.test,v 1.36.2.7 2006/01/23 12:11:15 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } # Some tests require the testobj command set ::tcltest::testConstraints(testobj) \ [expr {[info commands testobj] != {}}] set ::tcltest::testConstraints(testindexobj) \ [expr {[info commands testindexobj] != {}}] test string-1.1 {error conditions} { list [catch {string gorp a b} msg] $msg } {1 {bad option "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}} test string-1.2 {error conditions} { list [catch {string} msg] $msg } {1 {wrong # args: should be "string option arg ?arg ...?"}}
︙
209 210 211 212 213 214 215 216 217 218 219 220 221 222	211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231	+ + + + + + +	} -1 test string-4.13 {string first, start index} { string first \u7266 abc\u7266x end-2 } 3 test string-4.14 {string first, negative start index} { string first b abc -1 } 1 test string-4.15 {string first, ability to two-byte encoded utf-8 chars} { # Test for a bug in Tcl 8.3 where test for all-single-byte-encoded # strings was incorrect, leading to an index returned by [string first] # which pointed past the end of the string. set uchar \u057e ;# character with two-byte encoding in utf-8 string first % %#$uchar$uchar#$uchar$uchar#% 3 } 8 test string-5.1 {string index} { list [catch {string index} msg] $msg } {1 {wrong # args: should be "string index string charIndex"}} test string-5.2 {string index} { list [catch {string index a b c} msg] $msg } {1 {wrong # args: should be "string index string charIndex"}}
︙
587 588 589 590 591 592 593 594 595 596 597 598 599 600	596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625	+ + + + + + + + + + + + + + + +	set result "" set numbers [list 1.0 +1.0 ++1.0 +-1.0 -+1.0 -1.0 --1.0 "- +1.0"] foreach num $numbers { lappend result [string is double -strict $num] } set result } {1 1 0 0 0 1 0 0} test string-6.92 {string is double, 32-bit overflow} { # Bug 718878 set x 0x100000000 list [string is integer -failindex var $x] $var } {0 -1} test string-6.93 {string is double, 32-bit overflow} { # Bug 718878 set x 0x100000000 append x "" list [string is integer -failindex var $x] $var } {0 -1} test string-6.94 {string is double, 32-bit overflow} { # Bug 718878 set x 0x100000000 list [string is integer -failindex var [expr {$x}]] $var } {0 -1} catch {rename largest_int {}} test string-7.1 {string last, too few args} { list [catch {string last a} msg] $msg } {1 {wrong # args: should be "string last subString string ?startIndex?"}} test string-7.2 {string last, bad args} {
︙
733 734 735 736 737 738 739 740 741 742 743 744 745 746	758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	} {a4321CaBa43214321c4321} test string-10.18 {string map, empty argument} { string map -nocase {{} abc} foo } foo test string-10.19 {string map, empty arguments} { string map -nocase {{} abc f bar {} def} foo } baroo test string-10.20 {string map, nasty sharing crash from [Bug 1018562]} { set a {a b} string map $a $a } {b b} test string-10.21 {string map, ABR checks} { string map {longstring foob} long } long test string-10.22 {string map, ABR checks} { string map {long foob} long } foob test string-10.23 {string map, ABR checks} { string map {lon foob} long } foobg test string-10.24 {string map, ABR checks} { string map {lon foob} longlo } foobglo test string-10.25 {string map, ABR checks} { string map {lon foob} longlon } foobgfoob test string-10.26 {string map, ABR checks} { string map {longstring foob longstring bar} long } long test string-10.27 {string map, ABR checks} { string map {long foob longstring bar} long } foob test string-10.28 {string map, ABR checks} { string map {lon foob longstring bar} long } foobg test string-10.29 {string map, ABR checks} { string map {lon foob longstring bar} longlo } foobglo test string-10.30 {string map, ABR checks} { string map {lon foob longstring bar} longlon } foobgfoob test string-11.1 {string match, too few args} { list [catch {string match a} msg] $msg } {1 {wrong # args: should be "string match ?-nocase? pattern string"}} test string-11.2 {string match, too many args} { list [catch {string match a b c d} msg] $msg } {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
︙
989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002	1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076	+ + + + + + + + + + + + + + +	set r1 [string range $b 1 end-1] set r2 [string range $b 1 6] string equal $r1 $r2 } 1 test string-12.20 {string range, out of bounds indices} { string range \u00ff 0 1 } \u00ff test string-12.21 {string range, regenerates correct reps, bug 1410553} { set bytes "\x00 \x03 \x41" set rxBuffer {} foreach ch $bytes { append rxBuffer $ch if {$ch eq "\x03"} { string length $rxBuffer } } set rxCRC [string range $rxBuffer end-1 end] binary scan [join $bytes {}] "H*" input_hex binary scan $rxBuffer "H*" rxBuffer_hex binary scan $rxCRC "H*" rxCRC_hex list $input_hex $rxBuffer_hex $rxCRC_hex } {000341 000341 0341} test string-13.1 {string repeat} { list [catch {string repeat} msg] $msg } {1 {wrong # args: should be "string repeat string count"}} test string-13.2 {string repeat} { list [catch {string repeat abc 10 oops} msg] $msg } {1 {wrong # args: should be "string repeat string count"}}
︙
1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318	1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399	+ + + + + + +	} 4 test string-22.12 {string wordstart, unicode} { string wordstart "ab\uc700\uc700 cdef ghi" 12 } 10 test string-22.13 {string wordstart, unicode} { string wordstart "\uc700\uc700 abc" 8 } 3 test string-23.0 {string is boolean, Bug 1187123} testindexobj { set x 5 catch {testindexobj $x foo bar soom} string is boolean $x } 0 # cleanup ::tcltest::cleanupTests return

︙
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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372	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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372	- + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - +	# # Copyright (c) 2001 by ActiveState Corporation. # Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: stringComp.test,v 1.6 2003/02/18 02:25:45 hobbs Exp $ # RCS: @(#) $Id: stringComp.test,v 1.6.2.1 2004/10/28 00:01:12 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } # Some tests require the testobj command set ::tcltest::testConstraints(testobj) \ [expr {[info commands testobj] != {}}] test string-1.1 {error conditions} { test stringComp-1.1 {error conditions} { proc foo {} {string gorp a b} list [catch {foo} msg] $msg } {1 {bad option "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}} test string-1.2 {error conditions} { test stringComp-1.2 {error conditions} { proc foo {} {string} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string option arg ?arg ...?"}} test string-1.3 {error condition - undefined method during compile} { test stringComp-1.3 {error condition - undefined method during compile} { # We don't want this to complain about 'never' because it may never # be called, or string may get redefined. This must compile OK. proc foo {str i} { if {"yes" == "no"} { string never called but complains here } string index $str $i } foo abc 0 } a test string-2.1 {string compare, too few args} { test stringComp-2.1 {string compare, too few args} { proc foo {} {string compare a} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}} test string-2.2 {string compare, bad args} { test stringComp-2.2 {string compare, bad args} { proc foo {} {string compare a b c} list [catch {foo} msg] $msg } {1 {bad option "a": must be -nocase or -length}} test string-2.3 {string compare, bad args} { test stringComp-2.3 {string compare, bad args} { list [catch {string compare -length -nocase str1 str2} msg] $msg } {1 {expected integer but got "-nocase"}} test string-2.4 {string compare, too many args} { test stringComp-2.4 {string compare, too many args} { list [catch {string compare -length 10 -nocase str1 str2 str3} msg] $msg } {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}} test string-2.5 {string compare with length unspecified} { test stringComp-2.5 {string compare with length unspecified} { list [catch {string compare -length 10 10} msg] $msg } {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}} test string-2.6 {string compare} { test stringComp-2.6 {string compare} { proc foo {} {string compare abcde abdef} foo } -1 test string-2.7 {string compare, shortest method name} { test stringComp-2.7 {string compare, shortest method name} { proc foo {} {string c abcde ABCDE} foo } 1 test string-2.8 {string compare} { test stringComp-2.8 {string compare} { proc foo {} {string compare abcde abcde} foo } 0 test string-2.9 {string compare with length} { test stringComp-2.9 {string compare with length} { proc foo {} {string compare -length 2 abcde abxyz} foo } 0 test string-2.10 {string compare with special index} { test stringComp-2.10 {string compare with special index} { proc foo {} {string compare -length end-3 abcde abxyz} list [catch {foo} msg] $msg } {1 {expected integer but got "end-3"}} test string-2.11 {string compare, unicode} { test stringComp-2.11 {string compare, unicode} { proc foo {} {string compare ab\u7266 ab\u7267} foo } -1 test string-2.12 {string compare, high bit} { test stringComp-2.12 {string compare, high bit} { # This test will fail if the underlying comparaison # is using signed chars instead of unsigned chars. # (like SunOS's default memcmp thus the compat/memcmp.c) proc foo {} {string compare "\x80" "@"} foo # Nb this tests works also in utf8 space because \x80 is # translated into a 2 or more bytelength but whose first byte has # the high bit set. } 1 test string-2.13 {string compare -nocase} { test stringComp-2.13 {string compare -nocase} { proc foo {} {string compare -nocase abcde abdef} foo } -1 test string-2.14 {string compare -nocase} { test stringComp-2.14 {string compare -nocase} { proc foo {} {string c -nocase abcde ABCDE} foo } 0 test string-2.15 {string compare -nocase} { test stringComp-2.15 {string compare -nocase} { proc foo {} {string compare -nocase abcde abcde} foo } 0 test string-2.16 {string compare -nocase with length} { test stringComp-2.16 {string compare -nocase with length} { proc foo {} {string compare -length 2 -nocase abcde Abxyz} foo } 0 test string-2.17 {string compare -nocase with length} { test stringComp-2.17 {string compare -nocase with length} { proc foo {} {string compare -nocase -length 3 abcde Abxyz} foo } -1 test string-2.18 {string compare -nocase with length <= 0} { test stringComp-2.18 {string compare -nocase with length <= 0} { proc foo {} {string compare -nocase -length -1 abcde AbCdEf} foo } -1 test string-2.19 {string compare -nocase with excessive length} { test stringComp-2.19 {string compare -nocase with excessive length} { proc foo {} {string compare -nocase -length 50 AbCdEf abcde} foo } 1 test string-2.20 {string compare -len unicode} { test stringComp-2.20 {string compare -len unicode} { # These are strings that are 6 BYTELENGTH long, but the length # shouldn't make a different because there are actually 3 CHARS long proc foo {} {string compare -len 5 \334\334\334 \334\334\374} foo } -1 test string-2.21 {string compare -nocase with special index} { test stringComp-2.21 {string compare -nocase with special index} { proc foo {} {string compare -nocase -length end-3 Abcde abxyz} list [catch {foo} msg] $msg } {1 {expected integer but got "end-3"}} test string-2.22 {string compare, null strings} { test stringComp-2.22 {string compare, null strings} { proc foo {} {string compare "" ""} foo } 0 test string-2.23 {string compare, null strings} { test stringComp-2.23 {string compare, null strings} { proc foo {} {string compare "" foo} foo } -1 test string-2.24 {string compare, null strings} { test stringComp-2.24 {string compare, null strings} { proc foo {} {string compare foo ""} foo } 1 test string-2.25 {string compare -nocase, null strings} { test stringComp-2.25 {string compare -nocase, null strings} { proc foo {} {string compare -nocase "" ""} foo } 0 test string-2.26 {string compare -nocase, null strings} { test stringComp-2.26 {string compare -nocase, null strings} { proc foo {} {string compare -nocase "" foo} foo } -1 test string-2.27 {string compare -nocase, null strings} { test stringComp-2.27 {string compare -nocase, null strings} { proc foo {} {string compare -nocase foo ""} foo } 1 test string-2.28 {string compare with length, unequal strings} { test stringComp-2.28 {string compare with length, unequal strings} { proc foo {} {string compare -length 2 abc abde} foo } 0 test string-2.29 {string compare with length, unequal strings} { test stringComp-2.29 {string compare with length, unequal strings} { proc foo {} {string compare -length 2 ab abde} foo } 0 test string-2.30 {string compare with NUL character vs. other ASCII} { test stringComp-2.30 {string compare with NUL character vs. other ASCII} { # Be careful here, since UTF-8 rep comparison with memcmp() of # these puts chars in the wrong order proc foo {} {string compare \x00 \x01} foo } -1 test string-2.31 {string compare, high bit} { test stringComp-2.31 {string compare, high bit} { proc foo {} {string compare "a\x80" "a@"} foo } 1 test string-2.32 {string compare, high bit} { test stringComp-2.32 {string compare, high bit} { proc foo {} {string compare "a\x00" "a\x01"} foo } -1 test string-2.33 {string compare, high bit} { test stringComp-2.33 {string compare, high bit} { proc foo {} {string compare "\x00\x00" "\x00\x01"} foo } -1 # only need a few tests on equal, since it uses the same code as # string compare, but just modifies the return output test string-3.1 {string equal} { test stringComp-3.1 {string equal} { proc foo {} {string equal abcde abdef} foo } 0 test string-3.2 {string equal} { test stringComp-3.2 {string equal} { proc foo {} {string eq abcde ABCDE} foo } 0 test string-3.3 {string equal} { test stringComp-3.3 {string equal} { proc foo {} {string equal abcde abcde} foo } 1 test string-3.4 {string equal -nocase} { test stringComp-3.4 {string equal -nocase} { proc foo {} {string equal -nocase \334\334\334\334\374\374\374\374 \334\334\334\334\334\334\334\334} foo } 1 test string-3.5 {string equal -nocase} { test stringComp-3.5 {string equal -nocase} { proc foo {} {string equal -nocase abcde abdef} foo } 0 test string-3.6 {string equal -nocase} { test stringComp-3.6 {string equal -nocase} { proc foo {} {string eq -nocase abcde ABCDE} foo } 1 test string-3.7 {string equal -nocase} { test stringComp-3.7 {string equal -nocase} { proc foo {} {string equal -nocase abcde abcde} foo } 1 test string-3.8 {string equal with length, unequal strings} { test stringComp-3.8 {string equal with length, unequal strings} { proc foo {} {string equal -length 2 abc abde} foo } 1 test string-4.1 {string first, too few args} { test stringComp-4.1 {string first, too few args} { proc foo {} {string first a} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string first subString string ?startIndex?"}} test string-4.2 {string first, bad args} { test stringComp-4.2 {string first, bad args} { proc foo {} {string first a b c} list [catch {foo} msg] $msg } {1 {bad index "c": must be integer or end?-integer?}} test string-4.3 {string first, too many args} { test stringComp-4.3 {string first, too many args} { proc foo {} {string first a b 5 d} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string first subString string ?startIndex?"}} test string-4.4 {string first} { test stringComp-4.4 {string first} { proc foo {} {string first bq abcdefgbcefgbqrs} foo } 12 test string-4.5 {string first} { test stringComp-4.5 {string first} { proc foo {} {string fir bcd abcdefgbcefgbqrs} foo } 1 test string-4.6 {string first} { test stringComp-4.6 {string first} { proc foo {} {string f b abcdefgbcefgbqrs} foo } 1 test string-4.7 {string first} { test stringComp-4.7 {string first} { proc foo {} {string first xxx x123xx345xxx789xxx012} foo } 9 test string-4.8 {string first} { test stringComp-4.8 {string first} { proc foo {} {string first "" x123xx345xxx789xxx012} foo } -1 test string-4.9 {string first, unicode} { test stringComp-4.9 {string first, unicode} { proc foo {} {string first x abc\u7266x} foo } 4 test string-4.10 {string first, unicode} { test stringComp-4.10 {string first, unicode} { proc foo {} {string first \u7266 abc\u7266x} foo } 3 test string-4.11 {string first, start index} { test stringComp-4.11 {string first, start index} { proc foo {} {string first \u7266 abc\u7266x 3} foo } 3 test string-4.12 {string first, start index} { test stringComp-4.12 {string first, start index} { proc foo {} {string first \u7266 abc\u7266x 4} foo } -1 test string-4.13 {string first, start index} { test stringComp-4.13 {string first, start index} { proc foo {} {string first \u7266 abc\u7266x end-2} foo } 3 test string-4.14 {string first, negative start index} { test stringComp-4.14 {string first, negative start index} { proc foo {} {string first b abc -1} foo } 1 test string-5.1 {string index} { test stringComp-5.1 {string index} { proc foo {} {string index} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string index string charIndex"}} test string-5.2 {string index} { test stringComp-5.2 {string index} { proc foo {} {string index a b c} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string index string charIndex"}} test string-5.3 {string index} { test stringComp-5.3 {string index} { proc foo {} {string index abcde 0} foo } a test string-5.4 {string index} { test stringComp-5.4 {string index} { proc foo {} {string in abcde 4} foo } e test string-5.5 {string index} { test stringComp-5.5 {string index} { proc foo {} {string index abcde 5} foo } {} test string-5.6 {string index} { test stringComp-5.6 {string index} { proc foo {} {string index abcde -10} list [catch {foo} msg] $msg } {0 {}} test string-5.7 {string index} { test stringComp-5.7 {string index} { proc foo {} {string index a xyz} list [catch {foo} msg] $msg } {1 {bad index "xyz": must be integer or end?-integer?}} test string-5.8 {string index} { test stringComp-5.8 {string index} { proc foo {} {string index abc end} foo } c test string-5.9 {string index} { test stringComp-5.9 {string index} { proc foo {} {string index abc end-1} foo } b test string-5.10 {string index, unicode} { test stringComp-5.10 {string index, unicode} { proc foo {} {string index abc\u7266d 4} foo } d test string-5.11 {string index, unicode} { test stringComp-5.11 {string index, unicode} { proc foo {} {string index abc\u7266d 3} foo } \u7266 test string-5.12 {string index, unicode over char length, under byte length} { test stringComp-5.12 {string index, unicode over char length, under byte length} { proc foo {} {string index \334\374\334\374 6} foo } {} test string-5.13 {string index, bytearray object} { test stringComp-5.13 {string index, bytearray object} { proc foo {} {string index [binary format a5 fuz] 0} foo } f test string-5.14 {string index, bytearray object} { test stringComp-5.14 {string index, bytearray object} { proc foo {} {string index [binary format I* {0x50515253 0x52}] 3} foo } S test string-5.15 {string index, bytearray object} { test stringComp-5.15 {string index, bytearray object} { proc foo {} { set b [binary format I* {0x50515253 0x52}] set i1 [string index $b end-6] set i2 [string index $b 1] string compare $i1 $i2 } foo } 0 test string-5.16 {string index, bytearray object with string obj shimmering} { test stringComp-5.16 {string index, bytearray object with string obj shimmering} { proc foo {} { set str "0123456789\x00 abcdedfghi" binary scan $str H* dump string compare [string index $str 10] \x00 } foo } 0 test string-5.17 {string index, bad integer} { test stringComp-5.17 {string index, bad integer} { proc foo {} {string index "abc" 08} list [catch {foo} msg] $msg } {1 {bad index "08": must be integer or end?-integer? (looks like invalid octal number)}} test string-5.18 {string index, bad integer} { test stringComp-5.18 {string index, bad integer} { proc foo {} {string index "abc" end-00289} list [catch {foo} msg] $msg } {1 {bad index "end-00289": must be integer or end?-integer? (looks like invalid octal number)}} test string-5.19 {string index, bytearray object out of bounds} { test stringComp-5.19 {string index, bytearray object out of bounds} { proc foo {} {string index [binary format I* {0x50515253 0x52}] -1} foo } {} test string-5.20 {string index, bytearray object out of bounds} { test stringComp-5.20 {string index, bytearray object out of bounds} { proc foo {} {string index [binary format I* {0x50515253 0x52}] 20} foo } {} proc largest_int {} { # This will give us what the largest valid int on this machine is,
︙
383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684	383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684	- + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - +	catch {rename largest_int {}} ## string last ## not yet bc ## string length ## not yet bc test string-8.1 {string bytelength} { test stringComp-8.1 {string bytelength} { proc foo {} {string bytelength} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string bytelength string"}} test string-8.2 {string bytelength} { test stringComp-8.2 {string bytelength} { proc foo {} {string bytelength a b} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string bytelength string"}} test string-8.3 {string bytelength} { test stringComp-8.3 {string bytelength} { proc foo {} {string bytelength "\u00c7"} foo } 2 test string-8.4 {string bytelength} { test stringComp-8.4 {string bytelength} { proc foo {} {string b ""} foo } 0 ## string length ## test string-9.1 {string length} { test stringComp-9.1 {string length} { proc foo {} {string length} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string length string"}} test string-9.2 {string length} { test stringComp-9.2 {string length} { proc foo {} {string length a b} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string length string"}} test string-9.3 {string length} { test stringComp-9.3 {string length} { proc foo {} {string length "a little string"} foo } 15 test string-9.4 {string length} { test stringComp-9.4 {string length} { proc foo {} {string le ""} foo } 0 test string-9.5 {string length, unicode} { test stringComp-9.5 {string length, unicode} { proc foo {} {string le "abcd\u7266"} foo } 5 test string-9.6 {string length, bytearray object} { test stringComp-9.6 {string length, bytearray object} { proc foo {} {string length [binary format a5 foo]} foo } 5 test string-9.7 {string length, bytearray object} { test stringComp-9.7 {string length, bytearray object} { proc foo {} {string length [binary format I* {0x50515253 0x52}]} foo } 8 ## string map ## not yet bc ## string match ## test string-11.1 {string match, too few args} { test stringComp-11.1 {string match, too few args} { proc foo {} {string match a} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string match ?-nocase? pattern string"}} test string-11.2 {string match, too many args} { test stringComp-11.2 {string match, too many args} { proc foo {} {string match a b c d} list [catch {foo} msg] $msg } {1 {wrong # args: should be "string match ?-nocase? pattern string"}} test string-11.3 {string match} { test stringComp-11.3 {string match} { proc foo {} {string match abc abc} foo } 1 test string-11.4 {string match} { test stringComp-11.4 {string match} { proc foo {} {string mat abc abd} foo } 0 test string-11.5 {string match} { test stringComp-11.5 {string match} { proc foo {} {string match ab*c abc} foo } 1 test string-11.6 {string match} { test stringComp-11.6 {string match} { proc foo {} {string match ab**c abc} foo } 1 test string-11.7 {string match} { test stringComp-11.7 {string match} { proc foo {} {string match ab* abcdef} foo } 1 test string-11.8 {string match} { test stringComp-11.8 {string match} { proc foo {} {string match *c abc} foo } 1 test string-11.9 {string match} { test stringComp-11.9 {string match} { proc foo {} {string match *3*6*9 0123456789} foo } 1 test string-11.10 {string match} { test stringComp-11.10 {string match} { proc foo {} {string match *3*6*9 01234567890} foo } 0 test string-11.11 {string match} { test stringComp-11.11 {string match} { proc foo {} {string match a?c abc} foo } 1 test string-11.12 {string match} { test stringComp-11.12 {string match} { proc foo {} {string match a??c abc} foo } 0 test string-11.13 {string match} { test stringComp-11.13 {string match} { proc foo {} {string match ?1??4???8? 0123456789} foo } 1 test string-11.14 {string match} { test stringComp-11.14 {string match} { proc foo {} {string match {[abc]bc} abc} foo } 1 test string-11.15 {string match} { test stringComp-11.15 {string match} { proc foo {} {string match {a[abc]c} abc} foo } 1 test string-11.16 {string match} { test stringComp-11.16 {string match} { proc foo {} {string match {a[xyz]c} abc} foo } 0 test string-11.17 {string match} { test stringComp-11.17 {string match} { proc foo {} {string match {12[2-7]45} 12345} foo } 1 test string-11.18 {string match} { test stringComp-11.18 {string match} { proc foo {} {string match {12[ab2-4cd]45} 12345} foo } 1 test string-11.19 {string match} { test stringComp-11.19 {string match} { proc foo {} {string match {12[ab2-4cd]45} 12b45} foo } 1 test string-11.20 {string match} { test stringComp-11.20 {string match} { proc foo {} {string match {12[ab2-4cd]45} 12d45} foo } 1 test string-11.21 {string match} { test stringComp-11.21 {string match} { proc foo {} {string match {12[ab2-4cd]45} 12145} foo } 0 test string-11.22 {string match} { test stringComp-11.22 {string match} { proc foo {} {string match {12[ab2-4cd]45} 12545} foo } 0 test string-11.23 {string match} { test stringComp-11.23 {string match} { proc foo {} {string match {a\*b} a*b} foo } 1 test string-11.24 {string match} { test stringComp-11.24 {string match} { proc foo {} {string match {a\*b} ab} foo } 0 test string-11.25 {string match} { test stringComp-11.25 {string match} { proc foo {} {string match {a\*\?\[\]\\\x} "a*?\[\]\\x"} foo } 1 test string-11.26 {string match} { test stringComp-11.26 {string match} { proc foo {} {string match ** ""} foo } 1 test string-11.27 {string match} { test stringComp-11.27 {string match} { proc foo {} {string match *. ""} foo } 0 test string-11.28 {string match} { test stringComp-11.28 {string match} { proc foo {} {string match "" ""} foo } 1 test string-11.29 {string match} { test stringComp-11.29 {string match} { proc foo {} {string match \[a a} foo } 1 test string-11.30 {string match, bad args} { test stringComp-11.30 {string match, bad args} { proc foo {} {string match - b c} list [catch {foo} msg] $msg } {1 {bad option "-": must be -nocase}} test string-11.31 {string match case} { test stringComp-11.31 {string match case} { proc foo {} {string match a A} foo } 0 test string-11.32 {string match nocase} { test stringComp-11.32 {string match nocase} { proc foo {} {string match -n a A} foo } 1 test string-11.33 {string match nocase} { test stringComp-11.33 {string match nocase} { proc foo {} {string match -nocase a\334 A\374} foo } 1 test string-11.34 {string match nocase} { test stringComp-11.34 {string match nocase} { proc foo {} {string match -nocase a*f ABCDEf} foo } 1 test string-11.35 {string match case, false hope} { test stringComp-11.35 {string match case, false hope} { # This is true because '_' lies between the A-Z and a-z ranges proc foo {} {string match {[A-z]} _} foo } 1 test string-11.36 {string match nocase range} { test stringComp-11.36 {string match nocase range} { # This is false because although '_' lies between the A-Z and a-z ranges, # we lower case the end points before checking the ranges. proc foo {} {string match -nocase {[A-z]} _} foo } 0 test string-11.37 {string match nocase} { test stringComp-11.37 {string match nocase} { proc foo {} {string match -nocase {[A-fh-Z]} g} foo } 0 test string-11.38 {string match case, reverse range} { test stringComp-11.38 {string match case, reverse range} { proc foo {} {string match {[A-fh-Z]} g} foo } 1 test string-11.39 {string match, *\ case} { test stringComp-11.39 {string match, *\ case} { proc foo {} {string match {*\abc} abc} foo } 1 test string-11.40 {string match, *special case} { test stringComp-11.40 {string match, *special case} { proc foo {} {string match {*[ab]} abc} foo } 0 test string-11.41 {string match, *special case} { test stringComp-11.41 {string match, *special case} { proc foo {} {string match {*[ab]*} abc} foo } 1 test string-11.42 {string match, *special case} { test stringComp-11.42 {string match, *special case} { proc foo {} {string match "*\\" "\\"} foo } 0 test string-11.43 {string match, *special case} { test stringComp-11.43 {string match, *special case} { proc foo {} {string match "*\\\\" "\\"} foo } 1 test string-11.44 {string match, *special case} { test stringComp-11.44 {string match, *special case} { proc foo {} {string match "*???" "12345"} foo } 1 test string-11.45 {string match, *special case} { test stringComp-11.45 {string match, *special case} { proc foo {} {string match "*???" "12"} foo } 0 test string-11.46 {string match, *special case} { test stringComp-11.46 {string match, *special case} { proc foo {} {string match "*\\*" "abc*"} foo } 1 test string-11.47 {string match, *special case} { test stringComp-11.47 {string match, *special case} { proc foo {} {string match "*\\*" "*"} foo } 1 test string-11.48 {string match, *special case} { test stringComp-11.48 {string match, *special case} { proc foo {} {string match "*\\*" "*abc"} foo } 0 test string-11.49 {string match, *special case} { test stringComp-11.49 {string match, *special case} { proc foo {} {string match "?\\*" "a*"} foo } 1 test string-11.50 {string match, *special case} { test stringComp-11.50 {string match, *special case} { proc foo {} {string match "\\" "\\"} foo } 0 test string-11.51 {string match; *, -nocase and UTF-8} { test stringComp-11.51 {string match; *, -nocase and UTF-8} { proc foo {} {string match -nocase [binary format I 717316707] \ [binary format I 2028036707]} foo } 1 test string-11.52 {string match, null char in string} { test stringComp-11.52 {string match, null char in string} { proc foo {} { set ptn "*abc*" foreach elem [list "\u0000@abc" "@abc" "\u0000@abc\u0000" "blahabcblah"] { lappend out [string match $ptn $elem] } set out } foo } {1 1 1 1} test string-11.53 {string match, null char in pattern} { test stringComp-11.53 {string match, null char in pattern} { proc foo {} { set out "" foreach {ptn elem} [list \ "*\u0000abc\u0000" "\u0000abc\u0000" \ "*\u0000abc\u0000" "\u0000abc\u0000ef" \ "*\u0000abc\u0000*" "\u0000abc\u0000ef" \ "*\u0000abc\u0000" "@\u0000abc\u0000ef" \ "*\u0000abc\u0000*" "@\u0000abc\u0000ef" \ ] { lappend out [string match $ptn $elem] } set out } foo } {1 0 1 0 1} test string-11.54 {string match, failure} { test stringComp-11.54 {string match, failure} { proc foo {} { set longString "" for {set i 0} {$i < 10} {incr i} { append longString "abcdefghijklmnopqrstuvwxy\u0000z01234567890123" } list [string match *cba* $longString] \ [string match *a*l*\u0000* $longString] \
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	# Commands covered: subst # # 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) 1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: subst.test,v 1.13 2003/02/16 01:36:32 msofer Exp $ # RCS: @(#) $Id: subst.test,v 1.13.2.7 2004/10/26 21:42:53 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } test subst-1.1 {basics} {
︙
30 31 32 33 34 35 36 37 38 39 40 41 42 43	30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47	+ + + +	} {} test subst-2.2 {simple strings} { subst a } a test subst-2.3 {simple strings} { subst abcdefg } abcdefg test subst-2.4 {simple strings} { # Tcl Bug 685106 subst [bytestring bar\x00soom] } [bytestring bar\x00soom] test subst-3.1 {backslash substitutions} { subst {\x\$x\[foo bar]\\} } "x\$x\[foo bar]\\" test subst-3.2 {backslash substitutions with utf chars} { # 'j' is just a char that doesn't mean anything, and \344 is 'ä' # that also doesn't mean anything, but is multi-byte in UTF-8.
︙
211 212 213 214 215 216 217 218 219 220 221	215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	} {foo set a {}{} ; stuff] bar} test subst-11.5 {continue in a subst, parse error} { subst {foo [continue ;set bar baz ;set a {}{} ; stuff] bar} } {foo set bar baz ;set a {}{} ; stuff] bar} test subst-11.6 {continue in a variable subst} { subst {foo $var([continue]) bar} } {foo bar} test subst-12.1 {nasty case, Bug 1036649} { for {set i 0} {$i < 10} {incr i} { set res [list [catch {subst "\[subst {};"} msg] $msg] if {$msg ne "missing close-bracket"} break } set res } {1 {missing close-bracket}} test subst-12.2 {nasty case, Bug 1036649} { for {set i 0} {$i < 10} {incr i} { set res [list [catch {subst "\[subst {}; "} msg] $msg] if {$msg ne "missing close-bracket"} break } set res } {1 {missing close-bracket}} test subst-12.3 {nasty case, Bug 1036649} { set x 0 for {set i 0} {$i < 10} {incr i} { set res [list [catch {subst "\[incr x;"} msg] $msg] if {$msg ne "missing close-bracket"} break } list $res $x } {{1 {missing close-bracket}} 10} test subst-12.4 {nasty case, Bug 1036649} { set x 0 for {set i 0} {$i < 10} {incr i} { set res [list [catch {subst "\[incr x; "} msg] $msg] if {$msg ne "missing close-bracket"} break } list $res $x } {{1 {missing close-bracket}} 10} test subst-12.5 {nasty case, Bug 1036649} { set x 0 for {set i 0} {$i < 10} {incr i} { set res [list [catch {subst "\[incr x"} msg] $msg] if {$msg ne "missing close-bracket"} break } list $res $x } {{1 {missing close-bracket}} 0} # cleanup ::tcltest::cleanupTests return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- +	# 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) 1998-1999 by Scriptics Corporation. # Copyright (c) 2000 by Ajuba Solutions # All rights reserved. # # RCS: @(#) $Id: tcltest.test,v 1.37 2003/01/31 22:19:30 dgp Exp $ # RCS: @(#) $Id: tcltest.test,v 1.37.2.11 2006/03/19 22:47:30 vincentdarley Exp $ # Note that there are several places where the value of # tcltest::currentFailure is stored/reset in the -setup/-cleanup # of a test that has a body that runs [test] that will fail. # This is a workaround of using the same tcltest code that we are # testing to run the test itself. Ditto on things like [verbose]. #
︙
521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537	521 522 523 524 525 526 527 528 529 530 531 532 533 534 535	- - + -	puts [tcltest::outputChannel] "testdir: [tcltest::testsDirectory]" exit } a.tcl] set tdiaf [makeFile {} thisdirectoryisafile] set normaldirectory [makeDirectory normaldirectory] if {$::tcl_platform(platform) == "macintosh"} { set normaldirectory [file normalize $normaldirectory] normalizePath normaldirectory } # -tmpdir, [temporaryDirectory] test tcltest-8.1 {tcltest a.tcl -tmpdir a} {unixOrPc} { file delete -force thisdirectorydoesnotexist slave msg $a -tmpdir thisdirectorydoesnotexist list [file exists [file join thisdirectorydoesnotexist a.tmp]] \ [file delete -force thisdirectorydoesnotexist]
︙
556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578	554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577	+ - + - +	switch $tcl_platform(platform) { "unix" { file attributes $notReadableDir -permissions 00333 file attributes $notWriteableDir -permissions 00555 } default { catch {file attributes $notWriteableDir -readonly 1} catch {testchmod 000 $notWriteableDir} } } test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {unixOnly nonRoot} { test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {unix notRoot} { slave msg $a -tmpdir $notReadableDir string match {*not readable*} $msg } {1} test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {unixOrPc nonRoot} { test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {unixOrPc notRoot} { slave msg $a -tmpdir $notWriteableDir string match {*not writeable*} $msg } {1} test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {unixOrPc} { slave msg $a -tmpdir $normaldirectory # The join is necessary because the message can be split on multiple lines
︙
619 620 621 622 623 624 625 626 627 628 629 630 631 632 633	618 619 620 621 622 623 624 625 626 627 628 629 630 631 632	- +	} {1} test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {unixOrPc} { slave msg $a -testdir $tdiaf string match "*not a directory*" $msg } {1} test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {unixOnly nonRoot} { test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {unix notRoot} { slave msg $a -testdir $notReadableDir string match {*not readable*} $msg } {1} test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} {unixOrPc} { slave msg $a -testdir $normaldirectory
︙
697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719	696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729	- - - - - + + + + + + + + + + + + + + - - - + + + + +	file delete -force $notReadableDir $notWriteableDir removeFile a.tcl removeFile thisdirectoryisafile removeDirectory normaldirectory # -file, -notfile, [matchFiles], [skipFiles] test tcltest-9.1 {-file a*.tcl} {unixOrPc} { slave msg [file join [testsDirectory] all.tcl] -file a*.test list [regexp assocd\.test $msg] } {1} test tcltest-9.2 {-file a*.tcl} {unixOrPc} { test tcltest-9.1 {-file d*.tcl} -constraints {unixOrPc} -setup { set old [testsDirectory] testsDirectory [file dirname [info script]] } -body { slave msg [file join [testsDirectory] all.tcl] -file d*.test set msg } -cleanup { testsDirectory $old } -match regexp -result {dstring\.test} test tcltest-9.2 {-file d*.tcl} -constraints {unixOrPc} -setup { set old [testsDirectory] testsDirectory [file dirname [info script]] } -body { slave msg [file join [testsDirectory] all.tcl] \ -file a*.test -notfile assocd* list [regexp assocd\.test $msg] } {0} -file d*.test -notfile dstring* regexp {dstring\.test} $msg } -cleanup { testsDirectory $old } -result 0 test tcltest-9.3 {matchFiles} { -body { set old [matchFiles] matchFiles foo set current [matchFiles] matchFiles bar
︙
732 733 734 735 736 737 738 739 740 741 742 743 744 745	742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770	+ + + + + + + + + + + + + + +	skipFiles bar set new [skipFiles] skipFiles $old list $current $new } -result {foo bar} } test tcltest-9.5 {GetMatchingFiles: Bug 1119798} -setup { set d [makeDirectory tmp] makeDirectory foo $d makeFile {} fee $d file copy [file join [file dirname [info script]] all.tcl] $d } -body { slave msg [file join [temporaryDirectory] all.tcl] -file f* regexp {exiting with errors:} $msg } -cleanup { file delete [file join $d all.tcl] removeFile fee $d removeDirectory foo $d removeDirectory tmp } -result 0 # -preservecore, [preserveCore] set mc [makeFile { package require tcltest namespace import ::tcltest::test test makecore {make a core file} { set f [open core w]
︙
809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838	834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865	+ +	[regexp {tcltest} [join [list $msg] [split $msg \n]]] \ [regexp {loadScript} [join [list $msg] [split $msg \n]]] } {1 1} test tcltest-12.3 {loadScript} { -setup { set old $::tcltest::loadScript set ::tcltest::loadScript {} } -body { set f1 [loadScript] set f2 [loadScript xxx] set f3 [loadScript] list $f1 $f2 $f3 } -result {{} xxx xxx} -cleanup { set ::tcltest::loadScript $old } } test tcltest-12.4 {loadFile} { -setup { set olds $::tcltest::loadScript set ::tcltest::loadScript {} set oldf $::tcltest::loadFile set ::tcltest::loadFile {} } -body { set f1 [loadScript] set f2 [loadFile] set f3 [loadFile $loadfile]
︙
965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994	992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021	- + - +	[file join $dtd all.tcl] \ -tmpdir [temporaryDirectory]] == 1} { error $msg } } -match regexp -returnCodes 1 -result {Tests located in:.*dirtestdir.*Tests located in:.*dirtestdir2.1.*Tests located in:.*dirtestdir2.2.*Tests located in:.*dirtestdir2.3} -result {Tests located in:.*dirtestdir.*Tests located in:.*dirtestdir2.[123].*Tests located in:.*dirtestdir2.[123].*Tests located in:.*dirtestdir2.[123]} } test tcltest-15.2 {-asidefromdir} { -constraints {unixOrPc} -body { if {[slave msg \ [file join $dtd all.tcl] \ -asidefromdir dirtestdir2.3 \ -tmpdir [temporaryDirectory]] == 1} { error $msg } } -match regexp -returnCodes 1 -result {Tests located in:.*dirtestdir.*Tests located in:.*dirtestdir2.1.*Tests located in:.*dirtestdir2.2.*dirtestdir2.2 test ended at .*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -result {Tests located in:.*dirtestdir.*Tests located in:.*dirtestdir2.[12].*Tests located in:.*dirtestdir2.[12].*dirtestdir2.[12] test ended at .*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Error: No test files remain after applying your match and skip patterns! Error: No test files remain after applying your match and skip patterns! Error: No test files remain after applying your match and skip patterns!$} } test tcltest-15.3 {-relateddir, non-existent dir} { -constraints {unixOrPc}
︙
1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114	1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139	- + - - - - - + + - - + + + + + + - - - - + + + + - + - - - - + + -	} removeDirectory dirtestdir2.3 $dtd removeDirectory dirtestdir2.2 $dtd removeDirectory dirtestdir2.1 $dtd removeDirectory dirtestdir # TCLTEST_OPTIONS test tcltest-19.1 {TCLTEST_OPTIONS default} { test tcltest-19.1 {TCLTEST_OPTIONS default} -setup { -constraints {unixOrPc singleTestInterp} -setup { if {[info exists ::env(TCLTEST_OPTIONS)]} { set oldoptions $::env(TCLTEST_OPTIONS) unset ::env(TCLTEST_OPTIONS) } else { set oldoptions none } # set this to { } instead of just {} to get around quirk in # Windows env handling that removes empty elements from env array. set ::env(TCLTEST_OPTIONS) { } set olddebug [debug] debug 2 interp create slave1 slave1 eval [list set argv {-debug 2}] } -cleanup { slave1 alias puts puts interp create slave2 slave2 alias puts puts } -cleanup { interp delete slave2 interp delete slave1 if {$oldoptions == "none"} { unset ::env(TCLTEST_OPTIONS) } else { set ::env(TCLTEST_OPTIONS) $oldoptions } debug $olddebug } -body { ::tcltest::ProcessCmdLineArgs } -body { slave1 eval [package ifneeded tcltest [package provide tcltest]] slave1 eval tcltest::debug set ::env(TCLTEST_OPTIONS) "-debug 3" slave2 eval [package ifneeded tcltest [package provide tcltest]] ::tcltest::ProcessCmdLineArgs slave2 eval tcltest::debug } -result {^$} -match regexp -output {tcltest::debug\s+= 2.*tcltest::debug\s+= 3} } -result {^3$} -match regexp -output\ {tcltest::debug\s+= 2.*tcltest::debug\s+= 3} } # Begin testing of tcltest procs ... cd [temporaryDirectory] # PrintError test tcltest-20.1 {PrintError} {unixOrPc} { set result [slave msg $printerror]
︙
1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733	1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804	+ + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	} -body { puts -nonewline stdout bla puts -nonewline stdout bla } -output {blabla} test tcltest-25.3 { reported return code (Bug 611922) } -setup { set fail $::tcltest::currentFailure set v [verbose] } -body { # Buggy tcltest will generate result of 2 verbose {} test tcltest-25.3.0 {} -body { error foo } } -cleanup { set ::tcltest::currentFailure $fail verbose $v } -match glob -output {*generated error; Return code was: 1*} test tcltest-26.1 {Bug/RFE 1017151} -setup { makeFile { package require tcltest set errorInfo "Should never see this" tcltest::test tcltest-26.1.0 { no errorInfo when only return code mismatch } -body { set x 1 } -returnCodes error -result 1 tcltest::cleanupTests } test.tcl } -body { slave msg [file join [temporaryDirectory] test.tcl] set msg } -cleanup { removeFile test.tcl } -match glob -result {* ---- Return code should have been one of: 1 ==== tcltest-26.1.0 FAILED*} test tcltest-26.2 {Bug/RFE 1017151} -setup { makeFile { package require tcltest set errorInfo "Should never see this" tcltest::test tcltest-26.2.0 {do not mask body errorInfo} -body { error "body error" } -cleanup { error "cleanup error" } -result 1 tcltest::cleanupTests } test.tcl } -body { slave msg [file join [temporaryDirectory] test.tcl] set msg } -cleanup { removeFile test.tcl } -match glob -result {* ---- errorInfo: body error * ---- errorInfo(cleanup): cleanup error*} cleanupTests } namespace delete ::tcltest::test return

︙
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26	9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26	- + - +	# # Copyright (c) 1997 by 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. # # RCS: @(#) $Id: timer.test,v 1.7 2000/04/10 17:19:05 ericm Exp $ # RCS: @(#) $Id: timer.test,v 1.7.22.2 2005/11/09 21:46:20 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest package require tcltest 2 namespace import -force ::tcltest::* } test timer-1.1 {Tcl_CreateTimerHandler procedure} { foreach i [after info] { after cancel $i }
︙
533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555	533 534 535 536 537 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	- - - - + + + + + + + + + + + - - - - - - - - - + + + + + + + + + - + + +	}} interp delete x set x before after 300 update set x } {before after2 after4} # cleanup ::tcltest::cleanupTests return test timer-10.1 {Bug 1016167: [after] overwrites imports} -setup { interp create slave slave eval namespace export after slave eval namespace eval foo namespace import ::after } -body { slave eval foo::after 1 slave eval namespace origin foo::after } -cleanup { # Bug will cause crash here; would cause failure otherwise interp delete slave } -result ::after test timer-11.2 {Bug 1350293: [after] negative argument} \ -body { set l {} after 100 {lappend l 100; set done 1} after -1 {lappend l -1} vwait done set l } \ -result {-1 100} # cleanup ::tcltest::cleanupTests return

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	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	- + + + + + + + + + + +	# Commands covered: trace # # 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. # # RCS: @(#) $Id: trace.test,v 1.26 2003/02/03 20:16:54 kennykb Exp $ # RCS: @(#) $Id: trace.test,v 1.26.2.17 2006/11/04 01:37:56 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] testConstraint testevalobjv [llength [info commands testevalobjv]] proc getbytes {} { set lines [split [memory info] "\n"] lindex [lindex $lines 3] 3 } proc traceScalar {name1 name2 op} { global info set info [list $name1 $name2 $op [catch {uplevel set $name1} msg] $msg] } proc traceScalarAppend {name1 name2 op} { global info
︙
709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743	719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799	- + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	} {0 xyzzy} test trace-12.8 {errors when setting variable traces} { catch {unset x} set x 44 list [catch {trace add variable x(0) write traceProc} msg] $msg } {1 {can't trace "x(0)": variable isn't array}} # Check deleting one trace from another. # Check trace deletion test trace-13.1 {delete one trace from another} { proc delTraces {args} { global x trace remove variable x read {traceTag 2} trace remove variable x read {traceTag 3} trace remove variable x read {traceTag 4} } catch {unset x} set x 44 set info {} trace add variable x read {traceTag 1} trace add variable x read {traceTag 2} trace add variable x read {traceTag 3} trace add variable x read {traceTag 4} trace add variable x read delTraces trace add variable x read {traceTag 5} set x set info } {5 1} test trace-13.2 {leak when unsetting traced variable} \ -constraints memory -body { set end [getbytes] proc f args {} for {set i 0} {$i < 5} {incr i} { trace add variable bepa write f set bepa a unset bepa set tmp $end set end [getbytes] } expr {$end - $tmp} } -cleanup { unset -nocomplain end i tmp } -result 0 test trace-13.3 {leak when removing traces} \ -constraints memory -body { set end [getbytes] proc f args {} for {set i 0} {$i < 5} {incr i} { trace add variable bepa write f set bepa a trace remove variable bepa write f set tmp $end set end [getbytes] } expr {$end - $tmp} } -cleanup { unset -nocomplain end i tmp } -result 0 test trace-13.4 {leaks in error returns from traces} \ -constraints memory -body { set end [getbytes] for {set i 0} {$i < 5} {incr i} { set apa {a 1 b 2} set bepa [lrange $apa 0 end] trace add variable bepa write {error hej} catch {set bepa a} unset bepa set tmp $end set end [getbytes] } expr {$end - $tmp} } -cleanup { unset -nocomplain end i tmp } -result 0 # Check operation and syntax of "trace" command. # Syntax for adding/removing variable and command traces is basically the # same: # trace add variable name opList command # trace remove variable name opList command
︙
824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895	880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951	- + - + - + - + - + - + - + - + - +	list [catch {trace variable x y z w} msg] $msg } [list 1 "wrong # args: should be \"trace variable name ops command\""] test trace-14.11 {trace command, "trace variable" errors} { list [catch {trace variable x y z} msg] $msg } [list 1 "bad operations \"y\": should be one or more of rwua"] test trace-14.9 {trace command ("remove variable" option)} { test trace-14.12 {trace command ("remove variable" option)} { catch {unset x} set info {} trace add variable x write traceProc trace remove variable x write traceProc } {} test trace-14.10 {trace command ("remove variable" option)} { test trace-14.13 {trace command ("remove variable" option)} { catch {unset x} set info {} trace add variable x write traceProc trace remove variable x write traceProc set x 12345 set info } {} test trace-14.11 {trace command ("remove variable" option)} { test trace-14.14 {trace command ("remove variable" option)} { catch {unset x} set info {} trace add variable x write {traceTag 1} trace add variable x write traceProc trace add variable x write {traceTag 2} set x yy trace remove variable x write traceProc set x 12345 trace remove variable x write {traceTag 1} set x foo trace remove variable x write {traceTag 2} set x gorp set info } {2 x {} write 1 2 1 2} test trace-14.12 {trace command ("remove variable" option)} { test trace-14.15 {trace command ("remove variable" option)} { catch {unset x} set info {} trace add variable x write {traceTag 1} trace remove variable x write non_existent set x 12345 set info } {1} test trace-14.15 {trace command ("info variable" option)} { test trace-14.16 {trace command ("info variable" option)} { catch {unset x} trace add variable x write {traceTag 1} trace add variable x write traceProc trace add variable x write {traceTag 2} trace info variable x } {{write {traceTag 2}} {write traceProc} {write {traceTag 1}}} test trace-14.16 {trace command ("info variable" option)} { test trace-14.17 {trace command ("info variable" option)} { catch {unset x} trace info variable x } {} test trace-14.17 {trace command ("info variable" option)} { test trace-14.18 {trace command ("info variable" option)} { catch {unset x} trace info variable x(0) } {} test trace-14.18 {trace command ("info variable" option)} { test trace-14.19 {trace command ("info variable" option)} { catch {unset x} set x 44 trace info variable x(0) } {} test trace-14.19 {trace command ("info variable" option)} { test trace-14.20 {trace command ("info variable" option)} { catch {unset x} set x 44 trace add variable x write {traceTag 1} proc check {} {global x; trace info variable x} check } {{write {traceTag 1}}}
︙
1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180	1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256	+ + + + + + + + + + + + + + + + + + + + - + - +	proc p1 args { trace vdelete ::foo::x u p1 } trace variable ::foo::x u p1 namespace delete ::foo info exists ::foo::x } 0 test trace-18.3 {namespace delete / trace vdelete combo, Bug \#1337229} { namespace eval ::ns {} trace add variable ::ns::var unset {unset ::ns::var ;#} namespace delete ::ns } {} test trace-18.4 {namespace delete / trace vdelete combo, Bug \#1338280} { namespace eval ::ref {} set ::ref::var1 AAA trace add variable ::ref::var1 unset doTrace set ::ref::var2 BBB trace add variable ::ref::var2 {unset} doTrace proc doTrace {vtraced vidx op} { global info append info [catch {set ::$vtraced}][llength [info vars ::ref::*]] } set info {} namespace delete ::ref rename doTrace {} set info } 1110 # Delete arrays when done, so they can be re-used as scalars # elsewhere. catch {unset x} catch {unset y} test trace-18.2 {trace add command (command existence)} { test trace-19.0.1 {trace add command (command existence)} { # Just in case! catch {rename nosuchname ""} list [catch {trace add command nosuchname rename traceCommand} msg] $msg } {1 {unknown command "nosuchname"}} test trace-18.3 {trace add command (command existence in ns)} { test trace-19.0.2 {trace add command (command existence in ns)} { list [catch {trace add command nosuchns::nosuchname rename traceCommand} msg] $msg } {1 {unknown command "nosuchns::nosuchname"}} test trace-19.1 {trace add command (rename option)} { proc foo {} {} catch {rename bar {}}
︙
1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415	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	+ + + + + + + + + + + + + + + + + + + + +	catch {rename someothername {}} trace add command foo delete [list traceCmdrename foo] rename foo bar rename bar {} # None of these should exist. list [info commands foo] [info commands bar] [info commands someothername] } {{} {} {}} test trace-20.13 {rename trace discards result [Bug 1355342]} { proc foo {} {} trace add command foo rename {set w Aha!;#} list [rename foo bar] [rename bar {}] } {{} {}} test trace-20.14 {rename trace discards error result [Bug 1355342]} { proc foo {} {} trace add command foo rename {error} list [rename foo bar] [rename bar {}] } {{} {}} test trace-20.15 {delete trace discards result [Bug 1355342]} { proc foo {} {} trace add command foo delete {set w Aha!;#} rename foo {} } {} test trace-20.16 {delete trace discards error result [Bug 1355342]} { proc foo {} {} trace add command foo delete {error} rename foo {} } {} proc foo {b} { set a $b } # Delete arrays when done, so they can be re-used as scalars # elsewhere.
︙
1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503	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	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	test trace-21.8 {trace execution: leavestep} { set info {} trace add execution foo {leavestep} [list traceExecute foo] foo 3 trace remove execution foo {leavestep} [list traceExecute foo] set info } {{foo {set b 3} 0 3 leavestep}} test trace-21.9 {trace execution: TCL_EVAL_GLOBAL} testevalobjv { trace add execution foo enter soom proc ::soom args {lappend ::info SUCCESS [info level]} set ::info {} namespace eval test_ns_1 { proc soom args {lappend ::info FAIL [info level]} # [testevalobjv 1 ...] ought to produce the same # results as [uplevel #0 ...]. testevalobjv 1 foo x uplevel #0 foo x } namespace delete test_ns_1 trace remove execution foo enter soom set ::info } {SUCCESS 1 SUCCESS 1} test trace-21.10 {trace execution: TCL_EVAL_GLOBAL} testevalobjv { trace add execution foo leave soom proc ::soom args {lappend ::info SUCCESS [info level]} set ::info {} namespace eval test_ns_1 { proc soom args {lappend ::info FAIL [info level]} # [testevalobjv 1 ...] ought to produce the same # results as [uplevel #0 ...]. testevalobjv 1 foo x uplevel #0 foo x } namespace delete test_ns_1 trace remove execution foo leave soom set ::info } {SUCCESS 1 SUCCESS 1} test trace-21.11 {trace execution and alias} -setup { set res {} proc ::x {} {return ::} namespace eval a {} proc ::a::x {} {return ::a} interp alias {} y {} x } -body { lappend res [namespace eval ::a y] trace add execution ::x enter { rename ::x {} proc ::x {} {return ::} #} lappend res [namespace eval ::a y] } -cleanup { namespace delete a rename ::x {} } -result {:: ::} proc factorial {n} { if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] } return 1 } test trace-22.1 {recursive(1) trace execution: enter} {
︙
1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992	2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140	- + +	foo {if {[catch {bar}]} { return "error" } else { return "ok" }} 2 error leavestep foo foo 0 error leave}} test trace-28.4 {exec traces in slave with 'return -code error'} {knownBug} { test trace-28.4 {exec traces in slave with 'return -code error'} { interp create slave interp alias slave traceExecute {} traceExecute set info {} set res [interp eval slave { set info {} set res {} proc foo {} { if {[catch {bar}]} { return "error"
︙
2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 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	2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189	- + - + - - - - + + + + - - - - + + + +	# With the trace active lappend res [foo] trace remove execution foo {enter enterstep leave leavestep} \ [list traceExecute foo] list $res [join $info \n] list $res }] interp delete slave set res lappend res [join $info \n] } {{error error} {foo foo enter foo {if {[catch {bar}]} { return "error" } else { return "ok" }} enterstep return "error" } else { return "ok" }} enterstep foo {catch bar} enterstep foo bar enterstep foo {return -code error msg} enterstep foo {return -code error msg} 2 msg leavestep foo bar 1 msg leavestep foo {catch bar} 0 1 leavestep foo {return error} enterstep foo {return error} 2 error leavestep foo {if {[catch {bar}]} { return "error" } else { return "ok" }} 2 error leavestep return "error" } else { return "ok" }} 2 error leavestep foo foo 0 error leave}} test trace-28.5 {exec traces} { set info {} proc foo {args} { set a 1 } trace add execution foo {enter enterstep leave leavestep} \ [list traceExecute foo]
︙
2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108	2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -	test trace-28.9 {exec trace info nonsense} { list [catch {trace info execution thisdoesntexist} res] $res } {1 {unknown command "thisdoesntexist"}} test trace-28.10 {exec trace info nonsense} { list [catch {trace remove execution} res] $res } {1 {wrong # args: should be "trace remove execution name opList command"}} # Missing test number to keep in sync with the 8.5 branch # (want to backport those tests?) test trace-31.1 {command and execution traces shared struct} { # Tcl Bug 807243 proc foo {} {} trace add command foo delete foo trace add execution foo enter foo set result [trace info command foo] trace remove command foo delete foo trace remove execution foo enter foo rename foo {} set result } [list [list delete foo]] test trace-31.2 {command and execution traces shared struct} { # Tcl Bug 807243 proc foo {} {} trace add command foo delete foo trace add execution foo enter foo set result [trace info execution foo] trace remove command foo delete foo trace remove execution foo enter foo rename foo {} set result } [list [list enter foo]] test trace-32.1 { TraceCommandInfo refcount decr in TraceCommandProc w/o loss of reference } { # Tcl Bug 811483 proc foo {} {} trace add command foo delete foo trace add execution foo enter foo set result [trace info command foo] rename foo {} set result } [list [list delete foo]] test trace-33.1 {variable match with remove variable} { unset -nocomplain x trace variable x w foo trace remove variable x write foo llength [trace info variable x] } 0 test trace-34.1 {Bug 1201035} { set ::x [list] proc foo {} {lappend ::x foo} proc bar args { lappend ::x $args trace remove execution foo leavestep bar trace remove execution foo enterstep bar trace add execution foo leavestep bar trace add execution foo enterstep bar lappend ::x done } trace add execution foo leavestep bar trace add execution foo enterstep bar foo set ::x } {{{lappend ::x foo} enterstep} done foo} test trace-34.2 {Bug 1224585} { proc foo {} {} proc bar args {trace remove execution foo leave soom} trace add execution foo leave bar trace add execution foo leave soom foo } {} test trace-34.3 {Bug 1224585} { proc foo {} {set x {}} proc bar args {trace remove execution foo enterstep soom} trace add execution foo enterstep soom trace add execution foo enterstep bar foo } {} # We test here for the half-documented and currently valid interplay between # delete traces and namespace deletion. test trace-34.4 {Bug 1047286} { variable x notrace proc callback {old - -} { variable x "$old exists: [namespace which -command $old]" } namespace eval ::foo {proc bar {} {}} trace add command ::foo::bar delete [namespace code callback] namespace delete ::foo set x } {::foo::bar exists: ::foo::bar} test trace-34.5 {Bug 1047286} { variable x notrace proc callback {old - -} { variable x "$old exists: [namespace which -command $old]" } namespace eval ::foo {proc bar {} {}} trace add command ::foo::bar delete [namespace code callback] namespace eval ::foo namespace delete ::foo set x } {::foo::bar exists: } test trace-34.6 {Bug 1458266} -setup { proc dummy {} {} proc stepTraceHandler {cmdString args} { variable log append log "[expr {[info level] - 1}]: [lindex [split $cmdString] 0]\n" dummy isTracedInside_2 } proc cmdTraceHandler {cmdString args} { # silent } proc isTracedInside_1 {} { isTracedInside_2 } proc isTracedInside_2 {} { set x 2 } } -body { variable log {} trace add execution isTracedInside_1 enterstep stepTraceHandler trace add execution isTracedInside_2 enterstep stepTraceHandler isTracedInside_1 variable first $log set log {} trace add execution dummy enter cmdTraceHandler isTracedInside_1 variable second $log expr {($first eq $second) ? "ok" : "\n$first\nand\n\n$second\ndiffer"} } -cleanup { unset -nocomplain log first second rename dummy {} rename stepTraceHandler {} rename cmdTraceHandler {} rename isTracedInside_1 {} rename isTracedInside_2 {} } -result ok # Delete procedures when done, so we don't clash with other tests # (e.g. foobar will clash with 'unknown' tests). catch {rename foobar {}} catch {rename foo {}} catch {rename bar {}} # Unset the varaible when done catch {unset info} # cleanup ::tcltest::cleanupTests return

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	# This file tests the tclUnixFCmd.c file. # # 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) 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: unixFCmd.test,v 1.17 2003/01/25 00:16:39 hobbs Exp $ # RCS: @(#) $Id: unixFCmd.test,v 1.17.2.1 2003/04/14 15:45:57 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } # These tests really need to be run from a writable directory, which
︙
281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317	281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317	- + - - - - - - - - + + + + + + + +	} {1 {could not set permissions for file "foo.test": no such file or directory}} test unixFCmd-17.3 {SetPermissionsAttribute} {unixOnly notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -permissions foo} msg] $msg \ [file delete -force -- foo.test] } {1 {unknown permission string format "foo"} {}} test unixFCmd-17.3 {SetPermissionsAttribute} {unixOnly notRoot} { test unixFCmd-17.4 {SetPermissionsAttribute} {unixOnly notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -permissions ---rwx} msg] $msg \ [file delete -force -- foo.test] } {1 {unknown permission string format "---rwx"} {}} close [open foo.test w] set ::i 4 proc permcheck {testnum permstr expected} { test $testnum {SetPermissionsAttribute} {unixOnly notRoot} { file attributes foo.test -permissions $permstr file attributes foo.test -permissions } $expected } permcheck unixFCmd-17.4 rwxrwxrwx 00777 permcheck unixFCmd-17.5 r--r---w- 00442 permcheck unixFCmd-17.6 0 00000 permcheck unixFCmd-17.7 u+rwx,g+r 00740 permcheck unixFCmd-17.8 u-w 00540 permcheck unixFCmd-17.9 o+rwx 00547 permcheck unixFCmd-17.10 --x--x--x 00111 permcheck unixFCmd-17.11 a+rwx 00777 permcheck unixFCmd-17.5 rwxrwxrwx 00777 permcheck unixFCmd-17.6 r--r---w- 00442 permcheck unixFCmd-17.7 0 00000 permcheck unixFCmd-17.8 u+rwx,g+r 00740 permcheck unixFCmd-17.9 u-w 00540 permcheck unixFCmd-17.10 o+rwx 00547 permcheck unixFCmd-17.11 --x--x--x 00111 permcheck unixFCmd-17.12 a+rwx 00777 file delete -force -- foo.test test unixFCmd-18.1 {Unix pwd} {nonPortable unixOnly notRoot} { # This test is nonportable because SunOS generates a weird error # message when the current directory isn't readable. set cd [pwd] set nd $cd/tstdir
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	- + - +	# The file tests the functions in the tclUnixInit.c file. # # 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) 1997 by 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. # # RCS: @(#) $Id: unixInit.test,v 1.30 2002/12/04 07:07:40 hobbs Exp $ # RCS: @(#) $Id: unixInit.test,v 1.30.2.12 2005/04/27 21:07:52 dgp Exp $ package require tcltest 2 namespace import -force ::tcltest::* catch {unset path} unset -nocomplain path if {[info exists env(TCL_LIBRARY)]} { set oldlibrary $env(TCL_LIBRARY) unset env(TCL_LIBRARY) } catch {set oldlang $env(LANG)} set env(LANG) C
︙
262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289	262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + +	set x [lrange [getlibpath /tmp/sparkly/tcltest] 0 4] file delete -force /tmp/sparkly file delete -force /tmp/library set x } [list /tmp/lib/tcl[info tclversion] /lib/tcl[info tclversion] \ /tmp/library /library /tcl[info patchlevel]/library] test unixInit-2.10 {TclpInitLibraryPath: executable relative} -constraints { unixOnly stdio } -setup { set tmpDir [makeDirectory tmp] set sparklyDir [makeDirectory sparkly $tmpDir] set execPath [file join [makeDirectory bin $sparklyDir] tcltest] file copy [interpreter] $execPath set libDir [makeDirectory lib $sparklyDir] set scriptDir [makeDirectory tcl[info tclversion] $libDir] makeFile {} init.tcl $scriptDir set saveDir [pwd] cd $libDir } -body { # Checking for Bug 832657 set x [lrange [getlibpath [file join .. bin tcltest]] 2 3] foreach p $x { lappend y [file normalize $p] } set y } -cleanup { cd $saveDir unset saveDir removeFile init.tcl $scriptDir unset scriptDir removeDirectory tcl[info tclversion] $libDir unset libDir file delete $execPath unset execPath removeDirectory bin $sparklyDir removeDirectory lib $sparklyDir unset sparklyDir removeDirectory sparkly $tmpDir unset tmpDir removeDirectory tmp unset x p y } -result [list [file join [temporaryDirectory] tmp sparkly library] \ [file join [temporaryDirectory] tmp library] ] test unixInit-3.1 {TclpSetInitialEncodings} -constraints { unixOnly stdio } -body { set env(LANG) C set f [open "|[list [interpreter]]" w+] fconfigure $f -buffering none puts $f {puts [encoding system]; exit} set enc [gets $f] close $f unset env(LANG) set enc } -match regexp -result ^iso8859-15?$ } -match regexp -result [expr { ($tcl_platform(os) eq "Darwin") ? "^utf-8$" : "^iso8859-15?$"}] test unixInit-3.2 {TclpSetInitialEncodings} {unixOnly stdio} { set env(LANG) japanese catch {set oldlc_all $env(LC_ALL)} set env(LC_ALL) japanese set f [open "|[list [interpreter]]" w+] fconfigure $f -buffering none
︙
299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330	340 341 342 343 344 345 346 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	- + + + + + + + + + + + + + + + + + -	# Some older HP-UX systems need us to accept this as valid # Bug 453883 reports that newer HP-UX systems report euc-jp # like everybody else. lappend validEncodings shiftjis } expr {[lsearch -exact $validEncodings $enc] < 0} } 0 test unixInit-4.1 {TclpSetVariables} {unixOnly} { # just make sure they exist set a [list $tcl_library $tcl_pkgPath $tcl_platform(os)] set a [list $tcl_platform(osVersion) $tcl_platform(machine)] set tcl_platform(platform) } "unix" test unixInit-5.1 {Tcl_Init} {emptyTest unixOnly} { # test initScript } {} test unixInit-6.1 {Tcl_SourceRCFile} {emptyTest unixOnly} { } {} test unixInit-7.1 {closed standard channel: Bug 772288} -constraints { unixOnly stdio } -body { set tclsh [interpreter] set crash [makeFile {puts [open /dev/null]} crash.tcl] set crashtest [makeFile " close stdin [list exec $tclsh $crash] " crashtest.tcl] exec $tclsh $crashtest } -cleanup { removeFile crash.tcl removeFile crashtest.tcl } -returnCodes 0 # cleanup if {[info exists oldlibrary]} { set env(TCL_LIBRARY) $oldlibrary } catch {unset env(LANG)} catch {set env(LANG) $oldlang} unset -nocomplain path ::tcltest::cleanupTests return

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	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	- + - + + + + + + - + - +	# This file contains tests for tclUnixNotfy.c. # # 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) 1997 by 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. # # RCS: @(#) $Id: unixNotfy.test,v 1.11 2003/02/01 21:07:28 kennykb Exp $ # RCS: @(#) $Id: unixNotfy.test,v 1.11.2.4 2005/05/14 20:52:31 das Exp $ # The tests should not be run if you have a notifier which is unable to # detect infinite vwaits, as the tests below will hang. The presence of # the "testthread" command indicates that this is the case. if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest package require tcltest 2 namespace import -force ::tcltest::* } if {[info exists tk_version]} { puts "When run in a Tk shell, these tests run hang. Skipping tests ..." ::tcltest::cleanupTests return } set ::tcltest::testConstraints(testthread) \ [expr {[info commands testthread] != {}}] # Darwin always uses a threaded notifier testConstraint unthreaded [expr { (![info exist tcl_platform(threaded)] || !$tcl_platform(threaded)) && $tcl_platform(os) ne "Darwin" }] # The next two tests will hang if threads are enabled because the notifier # will not necessarily wait for ever in this case, so it does not generate # an error. test unixNotfy-1.1 {Tcl_DeleteFileHandler} \ -constraints {unixOnly && !testthread} \ -constraints {unixOnly && unthreaded} \ -body { catch {vwait x} set f [open [makeFile "" foo] w] fileevent $f writable {set x 1} vwait x close $f list [catch {vwait x} msg] $msg } \ -result {1 {can't wait for variable "x": would wait forever}} \ -cleanup { catch { close $f } catch { removeFile foo } } test unixNotfy-1.2 {Tcl_DeleteFileHandler} \ -constraints {unixOnly && !testthread} \ -constraints {unixOnly && unthreaded} \ -body { catch {vwait x} set f1 [open [makeFile "" foo] w] set f2 [open [makeFile "" foo2] w] fileevent $f1 writable {set x 1} fileevent $f2 writable {set y 1} vwait x
︙
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 116 117 118 119 120 121 122 123	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 116 117 118 119 120 121 122 123 124 125 126	- + - + - - + - + - + - - - - + + +	catch { close $f1 } catch { close $f2 } catch { removeFile foo } catch { removeFile foo2 } } test unixNotfy-2.1 {Tcl_DeleteFileHandler} \ -constraints {unixOnly && testthread} \ -constraints {unixOnly testthread} \ -body { update set f [open [makeFile "" foo] w] fileevent $f writable {set x 1} vwait x close $f testthread create "after 500 testthread create "testthread send [testthread id] {set x ok}" testthread send [testthread id] {set x ok} testthread exit" vwait x threadReap set x } \ -result {ok} \ -cleanup { catch { close $f } catch { removeFile foo } } test unixNotfy-2.2 {Tcl_DeleteFileHandler} \ -constraints {unixOnly && testthread} \ -constraints {unixOnly testthread} \ -body { update set f1 [open [makeFile "" foo] w] set f2 [open [makeFile "" foo2] w] fileevent $f1 writable {set x 1} fileevent $f2 writable {set y 1} vwait x close $f1 vwait y close $f2 testthread create "after 500 testthread create "testthread send [testthread id] {set x ok}" testthread send [testthread id] {set x ok} testthread exit" vwait x set x vwait x threadReap set x } \ -result {ok} \ -cleanup { catch { close $f1 } catch { close $f2 } catch { removeFile foo } catch { removeFile foo2 } } # cleanup ::tcltest::cleanupTests return

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	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	- + - + + + +	# This file contains a collection of tests for tclUtf.c # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1997 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. # # RCS: @(#) $Id: utf.test,v 1.8 2001/05/28 04:31:14 hobbs Exp $ # RCS: @(#) $Id: utf.test,v 1.8.14.5 2005/09/07 14:35:56 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest package require tcltest 2 namespace import -force ::tcltest::* } catch {unset x} test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} { set x \x01 } [bytestring "\x01"] test utf-1.2 {Tcl_UniCharToUtf: 2 byte sequences} { set x "\x00" } [bytestring "\xc0\x80"] test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} { set x "\xe0" } [bytestring "\xc3\xa0"] test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} { set x "\u4e4e" } [bytestring "\xe4\xb9\x8e"] test utf-1.5 {Tcl_UniCharToUtf: negative Tcl_UniChar} { string length [format %c -1] } 1 test utf-2.1 {Tcl_UtfToUniChar: low ascii} { string length "abc" } {3} test utf-2.2 {Tcl_UtfToUniChar: naked trail bytes} { string length [bytestring "\x82\x83\x84"] } {3}
︙
54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76	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	+ - - + + - - + + - - + + + + + + + + + + + + + + + + +	test utf-2.8 {Tcl_UtfToUniChar: longer UTF sequences not supported} { string length [bytestring "\xF4\xA2\xA2\xA2"] } {4} test utf-3.1 {Tcl_UtfCharComplete} { } {} testConstraint testnumutfchars [llength [info commands testnumutfchars]] test utf-4.1 {Tcl_NumUtfChars: zero length} { string length "" test utf-4.1 {Tcl_NumUtfChars: zero length} testnumutfchars { testnumutfchars "" } {0} test utf-4.2 {Tcl_NumUtfChars: length 1} { string length [bytestring "\xC2\xA2"] test utf-4.2 {Tcl_NumUtfChars: length 1} testnumutfchars { testnumutfchars [bytestring "\xC2\xA2"] } {1} test utf-4.3 {Tcl_NumUtfChars: long string} { string length [bytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"] test utf-4.3 {Tcl_NumUtfChars: long string} testnumutfchars { testnumutfchars [bytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"] } {7} test utf-4.4 {Tcl_NumUtfChars: #u0000} testnumutfchars { testnumutfchars [bytestring "\xC0\x80"] } {1} test utf-4.5 {Tcl_NumUtfChars: zero length, calc len} testnumutfchars { testnumutfchars "" 1 } {0} test utf-4.6 {Tcl_NumUtfChars: length 1, calc len} testnumutfchars { testnumutfchars [bytestring "\xC2\xA2"] 1 } {1} test utf-4.7 {Tcl_NumUtfChars: long string, calc len} testnumutfchars { testnumutfchars [bytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"] 1 } {7} test utf-4.8 {Tcl_NumUtfChars: #u0000, calc len} testnumutfchars { testnumutfchars [bytestring "\xC0\x80"] 1 } {1} test utf-5.1 {Tcl_UtfFindFirsts} { } {} test utf-6.1 {Tcl_UtfNext} { } {}
︙
286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317	305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 355 356 357	- + - + + + + + + + + + - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + +	string is digit \u1040 } {1} test utf-24.2 {unicode digit char in regc_locale.c} { # this returns 1 with Unicode 3 compliance list [regexp {^[[:digit:]]+$} \u1040] [regexp {^\d+$} \u1040] } {1 1} test utf-24.1 {TclUniCharIsSpace} { test utf-24.3 {TclUniCharIsSpace} { # this returns 1 with Unicode 3 compliance string is space \u1680 } {1} test utf-24.2 {unicode space char in regc_locale.c} { test utf-24.4 {unicode space char in regc_locale.c} { # this returns 1 with Unicode 3 compliance list [regexp {^[[:space:]]+$} \u1680] [regexp {^\s+$} \u1680] } {1 1} testConstraint teststringobj [llength [info commands teststringobj]] test utf-25.1 {Tcl_UniCharNcasecmp} teststringobj { testobj freeallvars teststringobj set 1 a teststringobj set 2 b teststringobj getunicode 1 teststringobj getunicode 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] # cleanup ::tcltest::cleanupTests return } -1 test utf-25.2 {Tcl_UniCharNcasecmp} teststringobj { testobj freeallvars teststringobj set 1 b teststringobj set 2 a teststringobj getunicode 1 teststringobj getunicode 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } 1 test utf-25.3 {Tcl_UniCharNcasecmp} teststringobj { testobj freeallvars teststringobj set 1 B teststringobj set 2 a teststringobj getunicode 1 teststringobj getunicode 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } 1 test utf-25.4 {Tcl_UniCharNcasecmp} teststringobj { testobj freeallvars teststringobj set 1 aBcB teststringobj set 2 abca teststringobj getunicode 1 teststringobj getunicode 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } 1 # cleanup ::tcltest::cleanupTests return

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	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23	- + - - - - - - -	# This file is a Tcl script to test the code in the file tclUtil.c. # This file is organized in the standard fashion for Tcl tests. # # Copyright (c) 1995-1998 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. # # RCS: @(#) $Id: util.test,v 1.10 2002/01/02 13:52:04 dkf Exp $ # RCS: @(#) $Id: util.test,v 1.10.4.4 2005/10/28 03:26:33 mdejong Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } if {[info commands testobj] == {}} { puts "This application hasn't been compiled with the \"testobj\"" puts "command, so I can't test the Tcl type and object support." ::tcltest::cleanupTests return } test util-1.1 {TclFindElement procedure - binary element in middle of list} { lindex {0 foo\x00help 1} 1 } "foo\x00help" test util-1.2 {TclFindElement procedure - binary element at end of list} { lindex {0 foo\x00help} 1 } "foo\x00help"
︙
296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313	289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 355 356 357 358 359 360	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	list [catch {set tcl_precision abc} msg] $msg $tcl_precision } {1 {can't set "tcl_precision": improper value for precision} 12} set tcl_precision 12 # This test always succeeded in the C locale anyway... test util-8.1 {TclNeedSpace - correct UTF8 handling} { # Bug 411825 # Note that this test relies on the fact that # [interp target] calls on Tcl_AppendElement() # which calls on TclNeedSpace(). If [interp target] # is ever updated, this test will no longer test # TclNeedSpace. interp create \u5420 interp create [list \u5420 foo] interp alias {} fooset [list \u5420 foo] set set result [interp target {} fooset] interp delete \u5420 set result } "\u5420 foo" tcltest::testConstraint testdstring [expr {[info commands testdstring] != {}}] test util-8.2 {TclNeedSpace - correct UTF8 handling} testdstring { # Bug 411825 # This tests the same bug as the previous test, but # should be more future-proof, as the DString # operations will likely continue to call TclNeedSpace testdstring free testdstring append \u5420 -1 testdstring element foo llength [testdstring get] } 2 test util-8.3 {TclNeedSpace - correct UTF8 handling} testdstring { # Bug 411825 - new variant reported by Dossy Shiobara testdstring free testdstring append \u00A0 -1 testdstring element foo llength [testdstring get] } 2 test util-8.4 {TclNeedSpace - correct UTF8 handling} testdstring { # Another bug uncovered while fixing 411825 testdstring free testdstring append {\ } -1 testdstring append \{ -1 testdstring element foo llength [testdstring get] } 2 test util-8.5 {TclNeedSpace - correct UTF8 handling} testdstring { # Note that in this test TclNeedSpace actually gets it wrong, # claiming we need a space when we really do not. Extra space # between list elements is harmless though, and better to have # extra space in really weird string reps of lists, than to # invest the effort required to make TclNeedSpace foolproof. testdstring free testdstring append {\\ } -1 testdstring element foo list [llength [testdstring get]] [string length [testdstring get]] } {2 7} test util-8.6 {TclNeedSpace - correct UTF8 handling} testdstring { # Another example of TclNeedSpace harmlessly getting it wrong. testdstring free testdstring append {\\ } -1 testdstring append \{ -1 testdstring element foo testdstring append \} -1 list [llength [testdstring get]] [string length [testdstring get]] } {2 9} # cleanup ::tcltest::cleanupTests return

︙
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	- +	# # Copyright (c) 1997 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. # # RCS: @(#) $Id: var.test,v 1.20 2002/10/17 17:41:45 dgp Exp $ # RCS: @(#) $Id: var.test,v 1.20.2.4 2007/03/13 15:59:53 dgp Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.2 namespace import -force ::tcltest::* }
︙
258 259 260 261 262 263 264 265 266 267 268 269 270 271	258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281	+ + + + + + + + + +	set xxxxx } {hello} test var-3.9 {MakeUpvar, my var has invalid ns name} { catch {unset aaaaa} set aaaaa 789789 list [catch {upvar #0 aaaaa test_ns_fred::lnk} msg] $msg } {1 {can't create "test_ns_fred::lnk": parent namespace doesn't exist}} test var-3.10 {MakeUpvar, } { namespace eval {} { set bar 0 namespace eval foo upvar bar bar set foo::bar 1 catch {list $bar $foo::bar} msg unset ::aaaaa set msg } } {1 1} if {[info commands testgetvarfullname] != {}} { test var-4.1 {Tcl_GetVariableName, global variable} { catch {unset a} set a 123 testgetvarfullname a global } ::a
︙
665 666 667 668 669 670 671 672 673 674 675 676 677 678	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 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	} set x "If you see this, it worked" } "If you see this, it worked" test var-14.1 {array names syntax} -body { array names foo bar baz snafu } -returnCodes 1 -match glob -result * test var-15.1 {segfault in [unset], [Bug 735335]} { proc A { name } { upvar $name var set var $name } # # Note that the variable name has to be # unused previously for the segfault to # be triggered. # namespace eval test A useSomeUnlikelyNameHere namespace eval test unset useSomeUnlikelyNameHere } {} test var-16.1 {CallVarTraces: save/restore interp error state: 1038021} { trace add variable errorCode write { ;#} catch {error foo bar baz} trace remove variable errorCode write { ;#} set errorInfo } bar test var-17.1 {TclArraySet [Bug 1669489]} -setup { unset -nocomplain ::a } -body { namespace eval :: { set elements {1 2 3 4} trace add variable a write {string length $elements ;#} array set a $elements } } -cleanup { unset -nocomplain ::a ::elements } -result {} catch {namespace delete ns} catch {unset arr} catch {unset v} catch {rename p ""} catch {namespace delete test_ns_var}
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	# This file tests the tclWinDde.c file. # # 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) 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. # # RCS: @(#) $Id: winDde.test,v 1.13 2003/01/16 20:51:57 hobbs Exp $ # RCS: @(#) $Id: winDde.test,v 1.13.2.2 2005/06/21 22:59:03 patthoyts Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } if {$tcl_platform(platform) == "windows"} {
︙
48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69	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	+ + - + + +	puts "Unable to find the dde package. Skipping dde tests." ::tcltest::cleanupTests return } } puts $f [list dde servername $ddeServerName] puts $f { after 200 {set ready 1} vwait ready puts ready vwait done update after 200 {set final 1} vwait final exit } close $f set f [open |[list [interpreter] $::scriptName] r] fconfigure $f -buffering line -blocking 1 gets $f return $f } test winDde-1.1 {Settings the server's topic name} {pcOnly} { list [dde servername foobar] [dde servername] [dde servername self] } {foobar foobar self}
︙
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157	113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166	+ - - - - + + + + - - - + + + + - - - - + + + + + - - - + + + + - - - - - + + + + + - - - + + + + - - - - + + + + - - - + + +	test winDde-3.5 {DDE request locally} {pcOnly} { set a "" dde execute TclEval self {set a "foo"} dde request -binary TclEval self a } "foo\x00" test winDde-4.1 {DDE execute remotely} {stdio pcOnly} { list [catch { set a "" set child [createChildProcess child] dde execute TclEval child {set a "foo"} dde execute TclEval child {set done 1} set a "" set child [createChildProcess child] dde execute TclEval child {set a "foo"} dde execute TclEval child {set done 1} set a } "" set a } err] $err } [list 0 ""] test winDde-4.2 {DDE execute remotely} {stdio pcOnly} { list [catch { set a "" set child [createChildProcess child] dde execute -async TclEval child {set a "foo"} dde execute TclEval child {set done 1} set a "" set child [createChildProcess child] dde execute -async TclEval child {set a "foo"} after 400 {set ::_dde_forever 1} ; vwait ::_dde_forever; #update dde execute TclEval child {set done 1} set a } "" set a } err] $err } [list 0 ""] test winDde-4.3 {DDE request locally} {stdio pcOnly} { list [catch { set a "" set child [createChildProcess child] dde execute TclEval child {set a "foo"} set a [dde request TclEval child a] dde execute TclEval child {set done 1} set a "" set child [createChildProcess child] dde execute TclEval child {set a "foo"} set a [dde request TclEval child a] dde execute TclEval child {set done 1} set a } foo set a } err] $err } [list 0 foo] test winDde-4.4 {DDE eval locally} {stdio pcOnly} { list [catch { set a "" set child [createChildProcess child] set a [dde eval child set a "foo"] dde execute TclEval child {set done 1} set a "" set child [createChildProcess child] set a [dde eval child set a "foo"] dde execute TclEval child {set done 1} set a } foo set a } err] $err } [list 0 foo] test winDde-5.1 {check for bad arguments} {pcOnly} { catch {dde execute "" "" "" ""} result set result } {wrong # args: should be "dde execute ?-async? serviceName topicName value"} test winDde-5.2 {check for bad arguments} {pcOnly} {
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	# This file tests the tclWinFCmd.c file. # # 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) 1996-1997 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. # # RCS: @(#) $Id: winFCmd.test,v 1.20 2002/10/04 08:25:14 dkf Exp $ # RCS: @(#) $Id: winFCmd.test,v 1.20.2.9 2006/03/19 22:47:30 vincentdarley Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* }
︙
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	60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78	- - + + - - + - - - - - - - -	set ::tcltest::testConstraints(cdrom) 0 set ::tcltest::testConstraints(exdev) 0 # find a CD-ROM so we can test read-only filesystems. set cdrom {} set nodrive x: foreach p {d e f g h i j k l m n o p q r s t u v w x y z} { if { [info commands ::testvolumetype] ne {} } { foreach p {d e f g h i j k l m n o p q r s t u v w x y z} { set name ${p}:/dummy~~.fil if [catch {set fd [open $name w]}] { if { ! [catch { testvolumetype ${p}: } result] && $result eq {CDFS} } { set err [lindex $errorCode 1] if {$cdrom == "" && $err == "EACCES"} { set cdrom ${p}: } if {$err == "ENOENT"} { set nodrive ${p}: } } else { close $fd file delete $name } } proc findfile {dir} { foreach p [glob $dir/*] { if {[file type $p] == "file"} { return $p
︙
594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609	585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605	- - + + + + + + +	} {0} test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} {pcOnly 95} { cleanup list [catch {testfile rmdir nul} msg] $msg } {1 {nul EACCES}} test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} {pcOnly nt} { cleanup list [catch {testfile rmdir /} msg] $msg } {1 {/ EACCES}} set res [list [catch {testfile rmdir /} msg] $msg] # WinXP returns EEXIST, WinNT seems to return EACCES. No policy # decision has been made as to which is correct. regsub {E(ACCES|EXIST)} $res "EACCES or EEXIST" res # Don't mind which drive we're on regsub {[A-Z]:} $res "" } {1 {/ EACCES or EEXIST}} test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} {pcOnly 95} { cleanup createfile tf1 list [catch {testfile rmdir tf1} msg] $msg } {1 {tf1 ENOTDIR}} test winFCmd-6.13 {TclpRemoveDirectory: write-protected} {pcOnly} { cleanup
︙
688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706	684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702	- + - +	test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} \ {pcOnly} { # can't make it happen } {} test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} {pcOnly} { cleanup file mkdir td1 testchmod 000 td1 createfile td1/tf1 tf1 testchmod 000 td1 testfile cpdir td1 td2 list [file exists td2] [file writable td2] } {1 0} } {1 1} test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} {pcOnly} { cleanup file mkdir td1 createfile td1/tf1 tf1 testfile rmdir -force td1 file exists td1 } {0}
︙
744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762	740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758	- + - +	createfile td1/tf4 testfile cpdir td1 td2 lsort [glob td2/*] } {td2/td2 td2/tf1 td2/tf2 td2/tf3 td2/tf4} test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} {pcOnly} { cleanup file mkdir td1 testchmod 000 td1 createfile td1/tf1 tf1 testchmod 000 td1 testfile cpdir td1 td2 list [file exists td2] [file writable td2] } {1 0} } {1 1} test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} \ {pcOnly} { cleanup file mkdir td1 createfile td1/tf1 tf1 testfile rmdir -force td1 file exists td1
︙
964 965 966 967 968 969 970 971 972 973 974 975 976 977	960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	test winFCmd-15.10 {SetWinFileAttributes - failing} {pcOnly cdrom} { cleanup catch {file attributes $cdfile -archive 1} } {1} test winFCmd-16.1 {Windows file normalization} {pcOnly} { list [file normalize c:/] [file normalize C:/] } {C:/ C:/} test winFCmd-16.2 {Windows file normalization} {pcOnly} { close [open td1... w] set res [file tail [file normalize td1]] file delete td1... set res } {td1} set pwd [pwd] set d [string index $pwd 0] test winFCmd-16.3 {Windows file normalization} {pcOnly} { file norm ${d}:foo } [file join $pwd foo] test winFCmd-16.4 {Windows file normalization} {pcOnly} { file norm [string tolower ${d}]:foo } [file join $pwd foo] test winFCmd-16.5 {Windows file normalization} {pcOnly} { file norm ${d}:foo/bar } [file join $pwd foo/bar] test winFCmd-16.6 {Windows file normalization} {pcOnly} { file norm ${d}:foo\\bar } [file join $pwd foo/bar] test winFCmd-16.7 {Windows file normalization} {pcOnly} { file norm /bar } "${d}:/bar" test winFCmd-16.8 {Windows file normalization} {pcOnly} { file norm ///bar } "${d}:/bar" test winFCmd-16.9 {Windows file normalization} {pcOnly} { file norm /bar/foo } "${d}:/bar/foo" if {$d eq "C"} { set dd "D" } else { set dd "C" } test winFCmd-16.10 {Windows file normalization} {pcOnly} { file norm ${dd}:foo } "${dd}:/foo" test winFCmd-16.11 {Windows file normalization} {pcOnly cdrom} { cd ${d}: cd $cdrom cd ${d}: cd $cdrom # Must not crash set result "no crash" } {no crash} test winFCmd-16.12 {Windows file normalization} {pcOnly} { set oldhome "" catch {set oldhome $::env(HOME)} set ::env(HOME) ${d}: cd set result [pwd]; # <- Must not crash set ::env(HOME) $oldhome set result } ${d}:/ cd $pwd unset d dd pwd test winFCmd-18.1 {Windows reserved path names} -constraints win -body { file pathtype com1 } -result "absolute" test winFCmd-18.1.2 {Windows reserved path names} -constraints win -body { file pathtype com4 } -result "absolute" test winFCmd-18.1.3 {Windows reserved path names} -constraints win -body { file pathtype com5 } -result "relative" test winFCmd-18.1.4 {Windows reserved path names} -constraints win -body { file pathtype lpt3 } -result "absolute" test winFCmd-18.1.5 {Windows reserved path names} -constraints win -body { file pathtype lpt4 } -result "relative" test winFCmd-18.1.6 {Windows reserved path names} -constraints win -body { file pathtype nul } -result "absolute" test winFCmd-18.1.7 {Windows reserved path names} -constraints win -body { file pathtype null } -result "relative" test winFCmd-18.2 {Windows reserved path names} -constraints win -body { file pathtype com1: } -result "absolute" test winFCmd-18.3 {Windows reserved path names} -constraints win -body { file pathtype COM1 } -result "absolute" test winFCmd-18.4 {Windows reserved path names} -constraints win -body { file pathtype CoM1: } -result "absolute" test winFCmd-18.5 {Windows reserved path names} -constraints win -body { file normalize com1: } -result COM1 test winFCmd-18.6 {Windows reserved path names} -constraints win -body { file normalize COM1: } -result COM1 test winFCmd-18.7 {Windows reserved path names} -constraints win -body { file normalize cOm1 } -result COM1 test winFCmd-18.8 {Windows reserved path names} -constraints win -body { file normalize cOm1: } -result COM1 # This block of code used to occur after the "return" call, so I'm # commenting it out and assuming that this code is still under construction. #foreach source {tef ted tnf tnd "" nul com1} { # foreach chmodsrc {000 755} { # foreach dest "tfn tfe tdn tdempty tdfull td1/td2 $p $p/td1 {} nul" { # foreach chmoddst {000 755} {
︙

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	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	- + - + - +	# This file tests the tclWinFile.c file. # # 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) 1997 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. # # RCS: @(#) $Id: winFile.test,v 1.9 2002/07/18 16:36:56 vincentdarley Exp $ # RCS: @(#) $Id: winFile.test,v 1.9.2.1 2003/04/14 15:45:58 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } test winFile-1.1 {TclpGetUserHome} {pcOnly} { list [catch {glob ~nosuchuser} msg] $msg } {1 {user "nosuchuser" doesn't exist}} test winFile-1.2 {TclpGetUserHome} {pcOnly nt nonPortable} { # The administrator account should always exist. catch {glob ~administrator} } {0} test winFile-1.2 {TclpGetUserHome} {pcOnly 95} { test winFile-1.3 {TclpGetUserHome} {pcOnly 95} { # Find some user in system.ini and then see if they have a home. set f [open $::env(windir)/system.ini] set x 0 while {![eof $f]} { set line [gets $f] if {$line == "\[Password Lists]"} { gets $f set name [lindex [split [gets $f] =] 0] if {$name != ""} { set x [catch {glob ~$name}] break } } } close $f set x } {0} test winFile-1.3 {TclpGetUserHome} {pcOnly nt nonPortable} { test winFile-1.4 {TclpGetUserHome} {pcOnly nt nonPortable} { catch {glob ~stanton@workgroup} } {0} test winFile-2.1 {TclpMatchFiles: case sensitivity} {pcOnly} { makeFile {} GlobCapS set result [list [glob -nocomplain GlobC*] [glob -nocomplain globc*]] removeFile GlobCapS
︙

︙
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25	8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26	- + +	# # Copyright (c) 1996 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. # # RCS: @(#) $Id: winPipe.test,v 1.22 2002/12/17 02:47:39 davygrvy Exp $ # RCS: @(#) $Id: winPipe.test,v 1.22.2.4 2005/04/20 00:14:54 hobbs Exp $ package require tcltest namespace import -force ::tcltest::* unset -nocomplain path testConstraint exec [llength [info commands exec]] set bindir [file join [pwd] [file dirname [info nameofexecutable]]] set cat32 [file join $bindir cat32.exe] set ::tcltest::testConstraints(cat32) [file exists $cat32]
︙
290 291 292 293 294 295 296 297 298 299 300 301 302 303	291 292 293 294 295 296 297 298 299 300 301 302 303 304 305	+	vwait x puts $f foobar flush $f vwait x lappend x [read $f] after 100 { lappend x timeout } vwait x fconfigure $f -blocking 1 lappend x [catch {close $f} msg] $msg } {writable timeout readable {foobar } timeout 1 stderr32} test winpipe-6.2 {PipeSetupProc & PipeCheckProc: write threads} \ {pcOnly exec cat32} { set f [open "|[list $cat32]" r+] fconfigure $f -blocking 0
︙
311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330	313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	lappend x [catch {close $f} msg] $msg } {writable timeout 0 {}} set path(echoArgs.tcl) [makeFile { puts "[list $argv0 $argv]" } echoArgs.tcl] ### validate the raw output of BuildCommandLine(). ### test winpipe-7.1 {BuildCommandLine: null arguments} {pcOnly exec} { exec $env(COMSPEC) /c echo foo "" bar } {foo "" bar} test winpipe-7.2 {BuildCommandLine: null arguments} {pcOnly exec} { exec $env(COMSPEC) /c echo foo {} bar } {foo "" bar} test winpipe-7.3 {BuildCommandLine: dbl quote quoting #1} {pcOnly exec} { exec $env(COMSPEC) /c echo foo {"} bar } {foo \" bar} test winpipe-7.4 {BuildCommandLine: dbl quote quoting #2} {pcOnly exec} { exec $env(COMSPEC) /c echo foo {""} bar } {foo \"\" bar} test winpipe-7.5 {BuildCommandLine: dbl quote quoting #3} {pcOnly exec} { exec $env(COMSPEC) /c echo foo {" } bar } {foo "\" " bar} test winpipe-7.6 {BuildCommandLine: dbl quote quoting #4} {pcOnly exec} { exec $env(COMSPEC) /c echo foo {a="b"} bar } {foo a=\"b\" bar} test winpipe-7.7 {BuildCommandLine: dbl quote quoting #5} {pcOnly exec} { exec $env(COMSPEC) /c echo foo {a = "b"} bar } {foo "a = \"b\"" bar} test winpipe-7.8 {BuildCommandLine: dbl quote quoting #6} {pcOnly exec} { exec $env(COMSPEC) /c echo {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo} } {\"hello\" \"\"hello\"\" \"\"\"hello\"\"\" \"\\\"hello\\\"\" "he llo" "he \" llo"} test winpipe-7.9 {BuildCommandLine: N backslashes followed a quote rule #1} {pcOnly exec} { exec $env(COMSPEC) /c echo foo \\ bar } {foo \ bar} test winpipe-7.10 {BuildCommandLine: N backslashes followed a quote rule #2} {pcOnly exec} { exec $env(COMSPEC) /c echo foo \\\\ bar } {foo \\ bar} test winpipe-7.11 {BuildCommandLine: N backslashes followed a quote rule #3} {pcOnly exec} { exec $env(COMSPEC) /c echo foo \\\ \\ bar } {foo "\ \\" bar} test winpipe-7.12 {BuildCommandLine: N backslashes followed a quote rule #4} {pcOnly exec} { exec $env(COMSPEC) /c echo foo \\\ \\\\ bar } {foo "\ \\\\" bar} test winpipe-7.13 {BuildCommandLine: N backslashes followed a quote rule #5} {pcOnly exec} { exec $env(COMSPEC) /c echo foo \\\ \\\\\\ bar } {foo "\ \\\\\\" bar} test winpipe-7.14 {BuildCommandLine: N backslashes followed a quote rule #6} {pcOnly exec} { exec $env(COMSPEC) /c echo foo \\\ \\\" bar } {foo "\ \\\"" bar} test winpipe-7.15 {BuildCommandLine: N backslashes followed a quote rule #7} {pcOnly exec} { exec $env(COMSPEC) /c echo foo \\\ \\\\\" bar } {foo "\ \\\\\"" bar} test winpipe-7.16 {BuildCommandLine: N backslashes followed a quote rule #8} {pcOnly exec} { exec $env(COMSPEC) /c echo foo \\\ \\\\\\\" bar } {foo "\ \\\\\\\"" bar} test winpipe-7.17 {BuildCommandLine: special chars #4} {pcOnly exec} { exec $env(COMSPEC) /c echo foo \{ bar } "foo \{ bar" test winpipe-7.18 {BuildCommandLine: special chars #5} {pcOnly exec} { exec $env(COMSPEC) /c echo foo \} bar } "foo \} bar" ### validate the pass-thru from BuildCommandLine() to the crt's parse_cmdline(). ### test winpipe-8.1 {BuildCommandLine/parse_cmdline pass-thru: null arguments} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo "" bar } [list $path(echoArgs.tcl) {foo {} bar}] test winpipe-7.2 {BuildCommandLine: null arguments} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo \" bar } [list $path(echoArgs.tcl) {foo {"} bar}] } [list $path(echoArgs.tcl) [list foo {} bar]] test winpipe-8.2 {BuildCommandLine/parse_cmdline pass-thru: null arguments} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo {} bar } [list $path(echoArgs.tcl) [list foo {} bar]] test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #1} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo {"} bar } [list $path(echoArgs.tcl) [list foo {"} bar]] test winpipe-8.4 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #2} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo {""} bar } [list $path(echoArgs.tcl) [list foo {""} bar]] test winpipe-8.5 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #3} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo {" } bar } [list $path(echoArgs.tcl) [list foo {" } bar]] test winpipe-8.6 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #4} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo {a="b"} bar } [list $path(echoArgs.tcl) [list foo {a="b"} bar]] test winpipe-8.7 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #5} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo {a = "b"} bar } [list $path(echoArgs.tcl) [list foo {a = "b"} bar]] test winpipe-8.8 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #6} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo} } [list $path(echoArgs.tcl) [list {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo}]] test winpipe-8.9 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #1} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo \\ bar } [list $path(echoArgs.tcl) [list foo \\ bar]] test winpipe-8.10 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #2} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo \\\\ bar } [list $path(echoArgs.tcl) [list foo \\\\ bar]] test winpipe-8.11 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #3} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo \\\ \\ bar } [list $path(echoArgs.tcl) [list foo \\\ \\ bar]] test winpipe-8.12 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #4} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\ bar } [list $path(echoArgs.tcl) [list foo \\\ \\\\ bar]] test winpipe-8.13 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #5} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\\ bar } [list $path(echoArgs.tcl) [list foo \\\ \\\\\\ bar]] test winpipe-8.14 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #6} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\" bar } [list $path(echoArgs.tcl) [list foo \\\ \\\" bar]] test winpipe-8.15 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #7} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\" bar } [list $path(echoArgs.tcl) [list foo \\\ \\\\\" bar]] test winpipe-8.16 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #8} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\\\" bar } [list $path(echoArgs.tcl) [list foo \\\ \\\\\\\" bar]] test winpipe-8.17 {BuildCommandLine/parse_cmdline pass-thru: special chars #1} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo \{ bar } [list $path(echoArgs.tcl) [list foo \{ bar]] test winpipe-8.18 {BuildCommandLine/parse_cmdline pass-thru: special chars #2} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo \} bar } [list $path(echoArgs.tcl) [list foo \} bar]] test winpipe-8.19 {ensure parse_cmdline isn't doing wildcard replacement} {pcOnly exec} { exec [interpreter] $path(echoArgs.tcl) foo * makefile.?c bar } [list $path(echoArgs.tcl) [list foo * makefile.?c bar]] # restore old values for env(TMP) and env(TEMP) if {[catch {set env(TMP) $env_tmp}]} { unset env(TMP) } if {[catch {set env(TEMP) $env_temp}]} {
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	# This file tests the tclWinTime.c file. # # 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) 1997 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. # # RCS: @(#) $Id: winTime.test,v 1.8 2003/02/27 23:47:01 hobbs Exp $ # RCS: @(#) $Id: winTime.test,v 1.8.2.1 2003/04/12 20:11:34 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } testConstraint testwinclock [llength [info commands testwinclock]]
︙
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	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	- - + + + - - + + - + - + + - - - - - - - - - - - -	set ::env(TZ) PST8 set result [clock format 1 -format %Y] unset ::env(TZ) set result } {1969} # Next test tries to make sure that the Tcl clock stays in step # with the Windows clock. 3000 iterations really isn't enough, # but how many does a tester have patience for? # with the Windows clock. 30 sec really isn't enough, # but how much time does a tester have patience for? test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock} { # May fail due to OS/hardware discrepancies. See: # http://support.microsoft.com/default.aspx?scid=kb;en-us;274323 set failed {} set ok 1 foreach start_sec [testwinclock] break for { set i 0 } { $i < 3000 } { incr i } { foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] {} while { 1 } { foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] break set diff [expr { $tcl_sec - $sys_sec + 1.0e-6 * ( $tcl_usec - $sys_usec ) }] if { abs($diff) > 0.02 } { if { abs($diff) > 0.06 } { set failed "Tcl clock differs from system clock by $diff sec" break } else { after 10 testwinsleep 1 } if { $sys_sec - $start_sec >= 30 } break } set failed } {} # cleanup ::tcltest::cleanupTests return

︙
88 89 90 91 92 93 94 95 96 97 98 99 100 101 102	88 89 90 91 92 93 94 95 96 97 98 99 100 101 102	- +	case 's': symbol = 1; break; case 'm': fixmissing = 0; break; default: goto usage; } } if ((optind < argc - 1) || (optind >= argc)) { usage:
︙
170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193	170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193	- + - +	rest++; } str = rest; } if (enc < 32 || uni < 32) { continue; } hi = enc >> 8; lo = enc & 0xff; if (toUnicode[hi] == NULL) { toUnicode[hi] = (Rune *) malloc(256 * sizeof(Rune)); memset(toUnicode[hi], 0, 256 * sizeof(Rune)); } toUnicode[hi][lo] = uni; } fclose(fp); dot = strrchr(argv[argc - 1], '.'); if (dot != NULL) { *dot = '\0'; } if (type == -1) {
︙
224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244	224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251	- + + + + + + + +	used = 0; for (hi = 0; hi < 256; hi++) { if (toUnicode[hi] != NULL) { used++; } } printf("%c\n%04X %d %d\n", "SDM"[type], fallbackChar, symbol, used); for (hi = 0; hi < 256; hi++) { if (toUnicode[hi] != NULL) { printf("%02X\n", hi); for (lo = 0; lo < 256; lo++) { printf("%04X", toUnicode[hi][lo]); if ((lo & 0x0f) == 0x0f) { putchar('\n'); } } } } for (hi = 0; hi < 256; hi++) { if (toUnicode[hi] != NULL) { free(toUnicode[hi]); toUnicode[hi] = NULL; } } return 0; }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	# index.tcl -- # # This file defines procedures that are used during the first pass of # the man page conversion. It is used to extract information used to # generate a table of contents and a keyword list. # # Copyright (c) 1996 by Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: index.tcl,v 1.3 1998/09/14 18:40:15 stanton Exp $ # RCS: @(#) $Id: index.tcl,v 1.3.40.1 2003/06/04 23:41:15 mistachkin Exp $ # # Global variables used by these scripts: # # state - state variable that controls action of text proc. # # topics - array indexed by (package,section,topic) with value
︙
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73	59 60 61 62 63 64 65 66 67 68 69 70 71 72 73	- +	foreach i [array names topics "${pkg},*"] { regsub {^.*,(.*),.*$} $i {\1} i set temp($i) {} } lsort [array names temp] } # getSections -- # getTopics -- # # Generate a sorted list of topics in the specified section of the # specified package from the topics array. # # Arguments: # pkg - Name of package to search. # sect - Name of section to search.
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- +	# man2help.tcl -- # # This file defines procedures that work in conjunction with the # man2tcl program to generate a Windows help file from Tcl manual # entries. # # Copyright (c) 1996 by Sun Microsystems, Inc. # # RCS: @(#) $Id: man2help.tcl,v 1.13 2002/08/09 00:13:54 davygrvy Exp $ # RCS: @(#) $Id: man2help.tcl,v 1.13.2.1 2003/06/04 23:41:15 mistachkin Exp $ # # # PASS 1 # set man2tclprog [file join [file dirname [info script]] man2tcl.exe]
︙
24 25 26 27 28 29 30 31 32 33 34 35 36 37 38	24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44	+ + + + - + + +	doFile $f } set fd [open [file join [file dirname [info script]] $basename$version.cnt] w] fconfigure $fd -translation crlf puts $fd ":Base $basename$version.hlp" foreach package [getPackages] { foreach section [getSections $package] { if {![info exists lastSection]} { set lastSection {} } if {[string compare $lastSection $section]} { puts $fd "1 $section" puts $fd "1 $section" } set lastSection $section set lastTopic {} foreach topic [getTopics $package $section] { if {[string compare $lastTopic $topic]} { set id $topics($package,$section,$topic) puts $fd "2 $topic=$id" set lastTopic $topic }
︙

︙
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	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	- + + + + + + + +	* man2tcl ?fileName? * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: man2tcl.c,v 1.7 2002/05/08 23:48:13 davygrvy Exp $ * RCS: @(#) $Id: man2tcl.c,v 1.7.2.1 2003/12/09 15:32:20 dkf Exp $ */ static char sccsid[] = "@(#) man2tcl.c 1.3 95/08/12 17:34:08"; #include <stdio.h> #include <string.h> #include <ctype.h> #ifndef NO_ERRNO_H #include <errno.h> #endif /* * Imported things that aren't defined in header files: */ /* * Some <errno.h> define errno to be something complex and * thread-aware; in that case we definitely do not want to declare * errno ourselves! */ #ifndef errno extern int errno; #endif /* * Current line number, used for error messages. */ static int lineNumber;
︙

︙
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	8 9 10 11 12 13 14 15 16 17 18 19 20 21 22	- +	Japanese Font Size=10 Start Gradient=0 0 255 End Gradient=0 0 0 Windows Flags=00000000000000010010110000001000 Log Pathname=%MAINDIR%\INSTALL.LOG Message Font=MS Sans Serif Font Size=8 Disk Label=tcl8.4.2 Disk Label=tcl8.4.16 Disk Filename=setup Patch Flags=0000000000000001 Patch Threshold=85 Patch Memory=4000 Variable Name1=_SYS_ Variable Default1=C:\WINDOWS\SYSTEM Variable Flags1=00001000
︙
1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458	1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458	- + - +	item: Install File Source=${__TCLBASEDIR__}\library\opt\optparse.tcl Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\optparse.tcl Flags=0000000000000010 end item: Install File Source=${__TCLBASEDIR__}\library\http\pkgIndex.tcl Destination=%MAINDIR%\lib\tcl%VER%\http2.4\pkgIndex.tcl Destination=%MAINDIR%\lib\tcl%VER%\http2.5\pkgIndex.tcl Flags=0000000000000010 end item: Install File Source=${__TCLBASEDIR__}\library\http\http.tcl Destination=%MAINDIR%\lib\tcl%VER%\http2.4\http.tcl Destination=%MAINDIR%\lib\tcl%VER%\http2.5\http.tcl Flags=0000000000000010 end item: Install File Source=${__TKBASEDIR__}\library\msgbox.tcl Destination=%MAINDIR%\lib\tk%VER%\msgbox.tcl Flags=0000000000000010 end
︙

︙
33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52	33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52	- + - +	item: Install File Source=n:\dist\tcl8.0\library\opt0.4\optparse.tcl Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\optparse.tcl Flags=0000000000000010 end item: Install File Source=n:\dist\tcl8.0\library\http\pkgIndex.tcl Destination=%MAINDIR%\lib\tcl%VER%\http2.4\pkgIndex.tcl Destination=%MAINDIR%\lib\tcl%VER%\http2.5\pkgIndex.tcl Flags=0000000000000010 end item: Install File Source=n:\dist\tcl8.0\library\http\http.tcl Destination=%MAINDIR%\lib\tcl%VER%\http2.4\http.tcl Destination=%MAINDIR%\lib\tcl%VER%\http2.5\http.tcl Flags=0000000000000010 end item: Install File Source=n:\dist\tcl8.0\library\safe.tcl Destination=%MAINDIR%\lib\tcl%VER%\safe.tcl Flags=0000000000000010 end
︙

1 2 3 4 5 6 7 8 9 10 11 12	1 2 3 4 5 6 7 8 9 10 11 12	- + - +	#!/bin/sh # The next line is executed by /bin/sh, but not tcl \ exec tclsh8.2 "$0" ${1+"$@"} exec tclsh8.4 "$0" ${1+"$@"} package require Tcl 8.2 package require Tcl 8.4 # Convert Ousterhout format man pages into highly crosslinked # hypertext. # # Along the way detect many unmatched font changes and other odd # things. #
︙
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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159	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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180	- + - + - + - - - + + + + + + + + + + + + + + + + + + + + + + + - - - + + + - - - - - - - - - - - - + + + + + + + + + + + - - - - - - - - - + + + + + + + - + + + + +	# May 28, 1997 - added tcl8.0b1/tk8.0b1 to the list of distributions # - cleaned source for tclsh8.0 execution # - renamed output files for windoze installation # - added spaces to tables # Oct 24, 1997 - moved from 8.0b1 to 8.0 release # set Version "0.30" set Version "0.32" proc parse_command_line {} { global argv Version # These variables determine where the man pages come from and where # the converted pages go to. global tcltkdir tkdir tcldir webdir global tcltkdir tkdir tcldir webdir build_tcl build_tk # Set defaults based on original code. set tcltkdir ../.. set tkdir {} set tcldir {} set webdir ../html set build_tcl 0 # Directory names for Tcl and Tk, in priority order. set tclDirList {tcl8.4 tcl8.3 tcl8.2 tcl8.1 tcl8.0 tcl} set tkDirList {tk8.4 tk8.3 tk8.2 tk8.1 tk8.0 tk} set build_tk 0 # Default search version is a glob pattern set useversion {{,[8-9].[0-9]{,.[0-9]{,[0-9]}}}} # Handle arguments a la GNU: # --version # --useversion=<version> # --help # --srcdir=/path # --htmldir=/path foreach option $argv { switch -glob -- $option { --version { puts "tcltk-man-html $Version" exit 0 } --help { puts "usage: tcltk-man-html \[OPTION\] ...\n" puts " --help print this help, then exit" puts " --version print version number, then exit" puts " --srcdir=DIR find tcl and tk source below DIR" puts " --htmldir=DIR put generated HTML in DIR" puts " --tcl build tcl help" puts " --tk build tk help" puts " --useversion version of tcl/tk to search for" exit 0 } --srcdir=* { # length of "--srcdir=" is 9. set tcltkdir [string range $option 9 end] } --htmldir=* { # length of "--htmldir=" is 10 set webdir [string range $option 10 end] } --useversion=* { # length of "--useversion=" is 13 set useversion [string range $option 13 end] } --tcl { set build_tcl 1 } --tk { set build_tk 1 } default { puts stderr "tcltk-man-html: unrecognized option -- `$option'" exit 1 } } } if {!$build_tcl && !$build_tk} {set build_tcl 1; set build_tk 1} if {$build_tcl} { # Find Tcl. foreach dir $tclDirList { if {[file isdirectory $tcltkdir/$dir]} then { # Find Tcl. set tcldir [lindex [lsort [glob -nocomplain -tails -type d \ -directory $tcltkdir tcl$useversion]] end] set tcldir $dir break } } if {$tcldir == ""} then { puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir" exit 1 } # Find Tk. foreach dir $tkDirList { if {[file isdirectory $tcltkdir/$dir]} then { if {$tcldir == ""} then { puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir" exit 1 } puts "using Tcl source directory $tcldir" } if {$build_tk} { # Find Tk. set tkdir [lindex [lsort [glob -nocomplain -tails -type d \ -directory $tcltkdir tk$useversion]] end] set tkdir $dir break } } if {$tkdir == ""} then { puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir" exit 1 } if {$tkdir == ""} then { puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir" exit 1 } puts "using Tk source directory $tkdir" } # the title for the man pages overall global overall_title set overall_title "[capitalize $tcldir]/[capitalize $tkdir] Manual" set overall_title "" if {$build_tcl} {append overall_title "[capitalize $tcldir]"} if {$build_tcl && $build_tk} {append overall_title "/"} if {$build_tk} {append overall_title "[capitalize $tkdir]"} append overall_title " Manual" } proc capitalize {string} { return [string toupper $string 0] } ##
︙
214 215 216 217 218 219 220 221 222 223 224 225 226 227	235 236 237 238 239 240 241 242 243 244 245 246 247 248 249	+	"\\\n" "\n" \ \" {&quot;} \ {<} {&lt;} \ {>} {&gt;} \ {\(+-} {&#177;} \ {\fP} {\fR} \ {\.} . \ {\(bu} {&#8226;} \ ] $text] regsub -all {\\o'o\^'} $text {\&ocirc;} text; # o-circumflex in re_syntax.n regsub -all {\\-\\\|\\-} $text -- text; # two hyphens regsub -all -- {\\-\\\^\\-} $text -- text; # two hyphens regsub -all {\\-} $text - text; # a hyphen regsub -all "\\\\\n" $text "\\&#92;\n" text; # backslashed newline while {[string first "\\" $text] >= 0} {
︙
463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486	485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508	- + - +	man-puts <P>$rest return } if {[next-op-is .RE rest]} { return } } man-puts <DL><P><DD> man-puts <DL><DD> while {[more-text]} { set line [next-text] if {[is-a-directive $line]} { split-directive $line code rest switch -exact $code { .RE { break } .SH { .SH - .SS { manerror "unbalanced .RS at section end" backup-text 1 break } default { output-directive $line }
︙
496 497 498 499 500 501 502 503 504 505 506 507 508 509 510	518 519 520 521 522 523 524 525 526 527 528 529 530 531 532	- +	## process .IP lists which may be plain indents, ## numeric lists, or definition lists ## proc output-IP-list {context code rest} { global manual if {![string length $rest]} { # blank label, plain indent, no contents entry man-puts <DL><P><DD> man-puts <DL><DD> while {[more-text]} { set line [next-text] if {[is-a-directive $line]} { split-directive $line code rest if {[string equal $code ".IP"] && [string equal $rest {}]} { man-puts "<P>" continue
︙
518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553	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 568 569 570 571 572 573 574 575 576 577 578 579 580 581	+ - + + + + - + + + - +	} else { man-puts $line } } man-puts </DL> } else { # labelled list, make contents if { if {[string compare $context ".SH"]} { [string compare $context ".SH"] && [string compare $context ".SS"] } then { man-puts <P> } man-puts <DL> lappend manual(section-toc) <DL> backup-text 1 set accept_RE 0 set para {} while {[more-text]} { set line [next-text] if {[is-a-directive $line]} { split-directive $line code rest switch -exact $code { .IP { if {$accept_RE} { output-IP-list .IP $code $rest continue } if {[string equal $manual(section) "ARGUMENTS"] || \ [regexp {^\[\d+\]$} $rest]} { man-puts "<P><DT>$rest<DD>" man-puts "$para<DT>$rest<DD>" } elseif {[string equal {&#8226;} $rest]} { man-puts "$para<DT><DD>$rest&nbsp;" } else { man-puts "<P><DT>[long-toc $rest]<DD>" man-puts "$para<DT>[long-toc $rest]<DD>" } if {[string equal $manual(name):$manual(section) \ "selection:DESCRIPTION"]} { if {[match-text .RE @rest .RS .RS]} { man-puts <DT>[long-toc $rest]<DD> } }
︙
574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595	602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624	- + +	} else { output-directive $line } } .PP { if {[match-text @rest1 .br @rest2 .RS]} { # yet another nroff kludge as above man-puts "<P><DT>[long-toc $rest1]" man-puts "$para<DT>[long-toc $rest1]" man-puts "<DT>[long-toc $rest2]<DD>" incr accept_RE 1 } elseif {[match-text @rest .RE]} { # gad, this is getting ridiculous if {!$accept_RE} { man-puts "</DL><P>$rest<DL>" backup-text 1 set para {} break } else { man-puts "<P>$rest" incr accept_RE -1 } } elseif {$accept_RE} { output-directive $line
︙
609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624	638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654	+ - +	backup-text 1 break } } } else { man-puts $line } set para <P> } man-puts <P></DL> man-puts "$para</DL>" lappend manual(section-toc) </DL> if {$accept_RE} { manerror "missing .RE in output-IP-list" } } } ##
︙
662 663 664 665 666 667 668 669 670 671 672 673 674 675	692 693 694 695 696 697 698 699 700 701 702 703 704 705 706	+	## ## nothing to reference ## if {![info exists manual(name-$lref)]} { foreach name {array file history info interp string trace after clipboard grab image option pack place selection tk tkwait update winfo wm} { if {[regexp "^$name \[a-z0-9]*\$" $lref] && \ [info exists manual(name-$name)] && \ [string compare $manual(tail) "$name.n"]} { return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>" } } if {[lsearch {stdin stdout stderr end} $lref] >= 0} { # no good place to send these # tcl tokens?
︙
934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955	965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990	- + + - + + + +	# process format directive split-directive $line code rest switch -exact $code { .BS - .BE { # man-puts <HR> } .SH { .SH - .SS { # drain any open lists # announce the subject set manual(section) $rest # start our own stack of stuff set manual($manual(name)-$manual(section)) {} lappend manual(has-$manual(section)) $manual(name) if {[string compare .SS $code]} { man-puts "<H3>[long-toc $manual(section)]</H3>" man-puts "<H3>[long-toc $manual(section)]</H3>" } else { man-puts "<H4>[long-toc $manual(section)]</H4>" } # some sections can simply free wheel their way through the text # some sections can be processed in their own loops switch -exact $manual(section) { NAME { if {[lsearch {CrtImgType.3 CrtItemType.3 CrtPhImgFmt.3} $manual(tail)] >= 0} { # these manual pages have two NAME sections if {[info exists manual($manual(tail)-NAME)]} {
︙
974 975 976 977 978 979 980 981 982 983 984 985 986 987	1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023	+	while {1} { if {[next-op-is .nf rest] || [next-op-is .br rest] || [next-op-is .fi rest]} { continue } if {[next-op-is .SH rest] || [next-op-is .SS rest] || [next-op-is .BE rest] || [next-op-is .SO rest]} { backup-text 1 break } if {[next-op-is .sp rest]} { #man-puts <P>
︙
1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016	1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052	- +	} } lappend manual(section-toc) </DL> return } {SEE ALSO} { while {[more-text]} { if {[next-op-is .SH rest]} { if {[next-op-is .SH rest] || [next-op-is .SS rest]} { backup-text 1 return } set more [next-text] if {[is-a-directive $more]} { manerror "$more" backup-text 1
︙
1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043	1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079	- +	} man-puts [join $nmore {, }] } return } KEYWORDS { while {[more-text]} { if {[next-op-is .SH rest]} { if {[next-op-is .SH rest] || [next-op-is .SS rest]} { backup-text 1 return } set more [next-text] if {[is-a-directive $more]} { manerror "$more" backup-text 1
︙
1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066	1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102	- +	} man-puts [join $keys {, }] } return } } if {[next-op-is .IP rest]} { output-IP-list .SH .IP $rest output-IP-list $code .IP $rest return } if {[next-op-is .PP rest]} { return } return }
︙
1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161	1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198	+	{bind:MODIFIERS} - {bind:EVENT TYPES} - {bind:BINDING SCRIPTS AND SUBSTITUTIONS} - {expr:OPERANDS} - {expr:MATH FUNCTIONS} - {history:DESCRIPTION} - {history:HISTORY REVISION} - {re_syntax:BRACKET EXPRESSIONS} - {switch:DESCRIPTION} - {upvar:DESCRIPTION} { return; # fix.me } default { manerror "ignoring $line" }
︙
1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292	1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330	- + +	## ## foreach of the man directories specified by args ## convert manpages into hypertext in the directory ## specified by html. ## proc make-man-pages {html args} { global env manual overall_title global env manual overall_title tcltkdesc makedirhier $html set manual(short-toc-n) 1 set manual(short-toc-fp) [open $html/contents.htm w] puts $manual(short-toc-fp) "<HTML><HEAD><TITLE>$overall_title</TITLE></HEAD>" puts $manual(short-toc-fp) "<BODY><HR><H3>$overall_title</H3><HR><DL>" set manual(merge-copyrights) {} foreach arg $args { if {$arg == ""} {continue} set manual(wing-glob) [lindex $arg 0] set manual(wing-name) [lindex $arg 1] set manual(wing-file) [lindex $arg 2] set manual(wing-description) [lindex $arg 3] set manual(wing-copyrights) {} makedirhier $html/$manual(wing-file) set manual(wing-toc-fp) [open $html/$manual(wing-file)/contents.htm w]
︙
1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374	1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412	- + - +	} } if {"$manual(partial-text)" != {}} { lappend manual(text) [process-text $manual(partial-text)] set manual(partial-text) {} } switch -exact $code { .SH { .SH - .SS { if {[llength $rest] == 0} { gets $manual(infp) rest } lappend manual(text) ".SH [unquote $rest]" lappend manual(text) "$code [unquote $rest]" } .TH { lappend manual(text) "$code [unquote $rest]" } .HS - .UL - .ta { lappend manual(text) "$code [unquote $rest]"
︙
1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398	1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438	- + + +	lappend manual(text) [concat .IP [process-text "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]] } .IP { regexp {^(.*) +\d+$} $rest all rest lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]" } .TP { set next [gets $manual(infp)] while {[is-a-directive [set next [gets $manual(infp)]]]} { manerror "ignoring $next after .TP" } if {"$next" != {'}} { lappend manual(text) ".IP [process-text $next]" } } .OP { lappend manual(text) [concat .OP [process-text \ "\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]]
︙
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	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	- + - - + + - - + + - +	## ## build the keyword index. ## proc strcasecmp {a b} { return [string compare -nocase $a $b] } set keys [lsort -command strcasecmp [array names manual keyword-*]] makedirhier $html/Keywords catch {eval file delete -- [glob $html/Keywords/*]} puts $manual(short-toc-fp) {<DT><A HREF="Keywords/contents.htm">Keywords</A><DD>The keywords from the Tcl/Tk man pages.} puts $manual(short-toc-fp) "<DT><A HREF=\"Keywords/contents.htm\">Keywords</A><DD>The keywords from the $tcltkdesc man pages." set keyfp [open $html/Keywords/contents.htm w] puts $keyfp "<HTML><HEAD><TITLE>Tcl/Tk Keywords</TITLE></HEAD>" puts $keyfp "<BODY><HR><H3>Tcl/Tk Keywords</H3><HR><H2>" puts $keyfp "<HTML><HEAD><TITLE>$tcltkdesc Keywords</TITLE></HEAD>" puts $keyfp "<BODY><HR><H3>$tcltkdesc Keywords</H3><HR><H2>" foreach a {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} { puts $keyfp "<A HREF=\"$a.htm\">$a</A>" set afp [open $html/Keywords/$a.htm w] puts $afp "<HTML><HEAD><TITLE>Tcl/Tk Keywords - $a</TITLE></HEAD>" puts $afp "<BODY><HR><H3>Tcl/Tk Keywords - $a</H3><HR><H2>" puts $afp "<HTML><HEAD><TITLE>$tcltkdesc Keywords - $a</TITLE></HEAD>" puts $afp "<BODY><HR><H3>$tcltkdesc Keywords - $a</H3><HR><H2>" foreach b {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} { puts $afp "<A HREF=\"$b.htm\">$b</A>" } puts $afp "</H2><HR><DL>" foreach k $keys { if {[regexp -nocase -- "^keyword-$a" $k]} { if {[string match -nocase "keyword-${a}*" $k]} { set k [string range $k 8 end] puts $afp "<DT><A NAME=\"$k\">$k</A><DD>" set refs {} foreach man $manual(keyword-$k) { set name [lindex $man 0] set file [lindex $man 1] lappend refs "<A HREF=\"../$file\">$name</A>"
︙
1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689	1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734	+ + + + + + + - + - - - - - - - + + + + +	} puts $manual(outfp) </BODY></HTML> close $manual(outfp) } return {} } parse_command_line set tcltkdesc ""; set cmdesc ""; set appdir "" if {$build_tcl} {append tcltkdesc "Tcl"; append cmdesc "Tcl"; append appdir "$tcldir"} if {$build_tcl && $build_tk} {append tcltkdesc "/"; append cmdesc " and "; append appdir ","} if {$build_tk} {append tcltkdesc "Tk"; append cmdesc "Tk"; append appdir "$tkdir"} set usercmddesc {The interpreters which implement Tcl and Tk.} set usercmddesc "The interpreters which implement $cmdesc." set tclcmddesc {The commands which the <B>tclsh</B> interpreter implements.} set tkcmddesc {The additional commands which the <B>wish</B> interpreter implements.} set tcllibdesc {The C functions which a Tcl extended C program may use.} set tklibdesc {The additional C functions which a Tk extended C program may use.} parse_command_line if {1} { if {[catch { make-man-pages $webdir \ "$tcltkdir/{$tkdir,$tcldir}/doc/*.1 {Tcl/Tk Applications} UserCmd {$usercmddesc}" \ "$tcltkdir/$tcldir/doc/*.n {Tcl Commands} TclCmd {$tclcmddesc}" \ "$tcltkdir/$tkdir/doc/*.n {Tk Commands} TkCmd {$tkcmddesc}" \ "$tcltkdir/$tcldir/doc/*.3 {Tcl Library} TclLib {$tcllibdesc}" \ "$tcltkdir/$tkdir/doc/*.3 {Tk Library} TkLib {$tklibdesc}" "$tcltkdir/{$appdir}/doc/*.1 \"$tcltkdesc Applications\" UserCmd {$usercmddesc}" \ [expr {$build_tcl ? "$tcltkdir/$tcldir/doc/*.n {Tcl Commands} TclCmd {$tclcmddesc}" : ""}] \ [expr {$build_tk ? "$tcltkdir/$tkdir/doc/*.n {Tk Commands} TkCmd {$tkcmddesc}" : ""}] \ [expr {$build_tcl ? "$tcltkdir/$tcldir/doc/*.3 {Tcl Library} TclLib {$tcllibdesc}" : ""}] \ [expr {$build_tk ? "$tcltkdir/$tkdir/doc/*.3 {Tk Library} TkLib {$tklibdesc}" : ""}] } error]} { puts $error\n$errorInfo } }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	# # This file is a Makefile for Tcl. If it has the name "Makefile.in" # then it is a template for a Makefile; to generate the actual Makefile, # run "./configure", which is a configuration script generated by the # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # # RCS: @(#) $Id: Makefile.in,v 1.121 2003/01/28 11:03:52 mdejong Exp $ # RCS: @(#) $Id: Makefile.in,v 1.121.2.21 2007/06/06 09:54:33 das Exp $ VERSION = @TCL_VERSION@ MAJOR_VERSION = @TCL_MAJOR_VERSION@ MINOR_VERSION = @TCL_MINOR_VERSION@ PATCH_LEVEL = @TCL_PATCH_LEVEL@ #----------------------------------------------------------------
︙
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 95 96 97 98 99 100 101 102 103 104 105	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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117	- + - + + + + + + + + + + + + + - + - +	mandir = @mandir@ # The following definition can be set to non-null for special systems # like AFS with replication. It allows the pathnames used for installation # to be different than those used for actually reference files at # run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix # when installing files. INSTALL_ROOT = INSTALL_ROOT = $(DESTDIR) # Path for the platform independent Tcl scripting libraries: TCL_LIBRARY = $(prefix)/lib/tcl$(VERSION) TCL_LIBRARY = @TCL_LIBRARY@ # Path to use at runtime to refer to LIB_INSTALL_DIR: LIB_RUNTIME_DIR = $(libdir) # Directory in which to install the program tclsh: BIN_INSTALL_DIR = $(INSTALL_ROOT)$(bindir) # Directory in which to install libtcl.so or libtcl.a: LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir) # Path name to use when installing library scripts. SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY) # Directory in which to install the include file tcl.h: INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir) # Path to the private tcl header dir: PRIVATE_INCLUDE_DIR = @PRIVATE_INCLUDE_DIR@ # Directory in which to (optionally) install the private tcl headers: PRIVATE_INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(PRIVATE_INCLUDE_DIR) # Top-level directory in which to install manual entries: MAN_INSTALL_DIR = $(INSTALL_ROOT)$(mandir) # Directory in which to install manual entry for tclsh: MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1 # Directory in which to install manual entries for Tcl's C library # procedures: MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3 # Directory in which to install manual entries for the built-in # Tcl commands: MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann # Path to the html documentation dir: HTML_DIR = @HTML_DIR@ # Directory in which to install html documentation: HTML_INSTALL_DIR = $(INSTALL_ROOT)$(HTML_DIR) # Package search path. TCL_PACKAGE_PATH = @TCL_PACKAGE_PATH@ # Libraries built with optimization switches have this additional extension TCL_DBGX = @TCL_DBGX@ # warning flags CFLAGS_WARNING = @CFLAGS_WARNING@ # The default switches for optimization or debugging CFLAGS_DEBUG = @CFLAGS_DEBUG@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ # To change the compiler switches, for example to change from optimization to # debugging symbols, change the following line: #CFLAGS = $(CFLAGS_DEBUG) #CFLAGS = $(CFLAGS_OPTIMIZE) #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DTCL_DBGX=$(TCL_DBGX) CFLAGS = @CFLAGS_DEFAULT@ @CFLAGS@ -DTCL_DBGX=$(TCL_DBGX) # Flags to pass to the linker LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ LDFLAGS = @LDFLAGS@ @LDFLAGS_DEFAULT@ LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@ # To disable ANSI-C procedure prototypes reverse the comment characters # on the following lines: PROTO_FLAGS = #PROTO_FLAGS = -DNO_PROTOTYPE # Mathematical functions like sin and atan2 are enabled for expressions
︙
124 125 126 127 128 129 130 131 132 133 134 135 136 137 138	136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151	- + +	# following pairs of lines. In addition, you'll have to provide your # own replacement for the "panic" procedure (see panic.c for what # the current one does). GENERIC_FLAGS = #GENERIC_FLAGS = -DTCL_GENERIC_ONLY UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \ tclUnixFile.o tclUnixPipe.o tclUnixSock.o \ tclUnixTime.o tclUnixInit.o tclUnixThrd.o tclUnixTime.o tclUnixInit.o tclUnixThrd.o \ tclUnixCompat.o #UNIX_OBJS = NOTIFY_OBJS = tclUnixNotfy.o #NOTIFY_OBJS = # To enable memory debugging reverse the comment characters on the following # lines or call configure with --enable-symbols=mem # Warning: if you enable memory debugging, you must do it *everywhere*,
︙
166 167 168 169 170 171 172 173 174 175 176 177 178 179 180	179 180 181 182 183 184 185 186 187 188 189 190 191 192 193	- +	# Tcl used to let the configure script choose which program to use # for installing, but there are just too many different versions of # "install" around; better to use the install-sh script that comes # with the distribution, which is slower but guaranteed to work. INSTALL_STRIP_PROGRAM = -s INSTALL_STRIP_LIBRARY = -S -S INSTALL_STRIP_LIBRARY = -S -S INSTALL = @srcdir@/install-sh -c INSTALL_PROGRAM = ${INSTALL} INSTALL_LIBRARY = ${INSTALL} INSTALL_DATA = ${INSTALL} -m 644 # TCL_EXE is the name of a tclsh executable that is available *BEFORE*
︙
189 190 191 192 193 194 195 196 197 198 199 200 201 202 203	202 203 204 205 206 207 208 209 210 211 212 213 214 215	-	# symbols mean. The values of the symbols are normally set by the # configure script. You shouldn't normally need to modify any of # these definitions by hand. STLIB_LD = @STLIB_LD@ SHLIB_LD = @SHLIB_LD@ SHLIB_CFLAGS = @SHLIB_CFLAGS@ SHLIB_LD_FLAGS = @SHLIB_LD_FLAGS@ SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ TCL_SHLIB_LD_EXTRAS = @TCL_SHLIB_LD_EXTRAS@ SHLIB_SUFFIX = @SHLIB_SUFFIX@ #SHLIB_SUFFIX = DLTEST_TARGETS = dltest.marker
︙
235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269	247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281	- + - + - + - + - +	# The information below is modified by the configure script when # Makefile is generated from Makefile.in. You shouldn't normally # modify any of this stuff by hand. #---------------------------------------------------------------- COMPAT_OBJS = @LIBOBJS@ AC_FLAGS = @EXTRA_CFLAGS@ @DEFS@ AC_FLAGS = @DEFS@ AR = @AR@ RANLIB = @RANLIB@ SRC_DIR = @srcdir@ TOP_DIR = @srcdir@/.. TOP_DIR = $(SRC_DIR)/.. GENERIC_DIR = $(TOP_DIR)/generic COMPAT_DIR = $(TOP_DIR)/compat TOOL_DIR = $(TOP_DIR)/tools UNIX_DIR = $(TOP_DIR)/unix UNIX_DIR = $(SRC_DIR) MAC_OSX_DIR = $(TOP_DIR)/macosx # Must be absolute because of the cd dltest $(DLTEST_DIR)/configure below. DLTEST_DIR = @TCL_SRC_DIR@/unix/dltest # Must be absolute to so the corresponding tcltest's tcl_library is absolute. TCL_BUILDTIME_LIBRARY = @TCL_SRC_DIR@/library CC = @CC@ #CC = purify -best-effort @CC@ -DPURIFY # Flags to be passed to mkLinks to control whether the manpages # Flags to be passed to installManPage to control whether the manpages # should be compressed and linked with softlinks MKLINKS_FLAGS = @MKLINKS_FLAGS@ MAN_FLAGS = @MAN_FLAGS@ #---------------------------------------------------------------- # The information below is usually usable as is. The configure # script won't modify it and it only exists to make working # around selected rare system configurations easier. #----------------------------------------------------------------
︙
277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303	289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315	- + - + - +	#---------------------------------------------------------------- CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ -I${GENERIC_DIR} -I${SRC_DIR} \ ${AC_FLAGS} ${MATH_FLAGS} ${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \ ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS} ${ENV_FLAGS} \ -DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\" -DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\" @EXTRA_CC_SWITCHES@ STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ -I${GENERIC_DIR} -I${SRC_DIR} \ ${AC_FLAGS} ${MATH_FLAGS} ${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \ ${COMPILE_DEBUG_FLAGS} ${ENV_FLAGS} -DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\" ${COMPILE_DEBUG_FLAGS} ${ENV_FLAGS} -DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\" @EXTRA_CC_SWITCHES@ LIBS = @DL_LIBS@ @LIBS@ $(MATH_LIBS) DEPEND_SWITCHES = ${CFLAGS} -I${GENERIC_DIR} -I${SRC_DIR} \ ${AC_FLAGS} ${MATH_FLAGS} \ ${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \ -DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\" -DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\" @EXTRA_CC_SWITCHES@ TCLSH_OBJS = tclAppInit.o TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ tclThreadTest.o tclUnixTest.o XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
︙
314 315 316 317 318 319 320 321 322 323 324 325 326 327	326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341	+ +	tclObj.o tclPanic.o tclParse.o tclParseExpr.o tclPipe.o \ tclPkg.o tclPosixStr.o tclPreserve.o tclProc.o tclRegexp.o \ tclResolve.o tclResult.o tclScan.o tclStringObj.o tclThread.o \ tclThreadAlloc.o tclThreadJoin.o tclStubInit.o tclStubLib.o \ tclTimer.o tclUtf.o tclUtil.o tclVar.o STUB_LIB_OBJS = tclStubLib.o ${COMPAT_OBJS} MAC_OSX_OBJS = tclMacOSXBundle.o tclMacOSXNotify.o OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \ @DL_OBJS@ @PLAT_OBJS@ TCL_DECLS = \ $(GENERIC_DIR)/tcl.decls \ $(GENERIC_DIR)/tclInt.decls
︙
411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451	425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469	- - + + + + + - + + - +	UNIX_SRCS = \ $(UNIX_DIR)/tclAppInit.c \ $(UNIX_DIR)/tclUnixChan.c \ $(UNIX_DIR)/tclUnixEvent.c \ $(UNIX_DIR)/tclUnixFCmd.c \ $(UNIX_DIR)/tclUnixFile.c \ $(UNIX_DIR)/tclUnixNotfy.c \ $(UNIX_DIR)/tclUnixPipe.c \ $(UNIX_DIR)/tclUnixSock.c \ $(UNIX_DIR)/tclUnixTest.c \ $(UNIX_DIR)/tclUnixThrd.c \ $(UNIX_DIR)/tclUnixTime.c \ $(UNIX_DIR)/tclUnixInit.c $(UNIX_DIR)/tclUnixInit.c \ $(UNIX_DIR)/tclUnixCompat.c NOTIFY_SRCS = \ $(UNIX_DIR)/tclUnixNotfy.c DL_SRCS = \ $(UNIX_DIR)/tclLoadAix.c \ $(UNIX_DIR)/tclLoadAout.c \ $(UNIX_DIR)/tclLoadDl.c \ $(UNIX_DIR)/tclLoadDl2.c \ $(UNIX_DIR)/tclLoadDld.c \ $(UNIX_DIR)/tclLoadDyld.c \ $(GENERIC_DIR)/tclLoadNone.c \ $(UNIX_DIR)/tclLoadOSF.c \ $(UNIX_DIR)/tclLoadShl.c MAC_OSX_SRCS = \ $(MAC_OSX_DIR)/tclMacOSXBundle.c $(MAC_OSX_DIR)/tclMacOSXBundle.c \ $(MAC_OSX_DIR)/tclMacOSXNotify.c # Note: don't include DL_SRCS or MAC_OSX_SRCS in SRCS: most of those # files won't compile on the current machine, and they will cause # problems for things like "make depend". SRCS = $(GENERIC_SRCS) $(UNIX_SRCS) $(STUB_SRCS) SRCS = $(GENERIC_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) $(STUB_SRCS) @PLAT_SRCS@ all: binaries libraries doc binaries: ${LIB_FILE} $(STUB_LIB_FILE) $(TCL_BUILD_EXP_FILE) tclsh libraries:
︙
470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548	488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573	- + - + - + - + - + - + - + - + + + - + - + + + + + +	@echo ${OBJS} # This targets actually build the objects needed for the lib in the above # case objs: ${OBJS} tclsh: ${TCLSH_OBJS} ${TCL_LIB_FILE} ${CC} ${LDFLAGS} ${TCLSH_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \ ${CC} ${CFLAGS} ${LDFLAGS} ${TCLSH_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -o tclsh # Resetting the LIB_RUNTIME_DIR below is required so that # the generated tcltest executable gets the build directory # burned into its ld search path. This keeps tcltest from # picking up an already installed version of the Tcl library. tcltest: ${TCLTEST_OBJS} ${TCL_LIB_FILE} ${BUILD_DLTEST} $(MAKE) tcltest-real LIB_RUNTIME_DIR=`pwd` tcltest-real: ${CC} ${LDFLAGS} ${TCLTEST_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \ ${CC} ${CFLAGS} ${LDFLAGS} ${TCLTEST_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -o tcltest # Note, in the target below TCL_LIBRARY needs to be set or else # "make test" won't work in the case where the compilation directory # isn't the same as the source directory. # Specifying TESTFLAGS on the command line is the standard way to pass # args to tcltest, ie: # % make test TESTFLAGS="-verbose bps -file fileName.test" test: tcltest @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \ @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \ TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \ ./tcltest $(TOP_DIR)/tests/all.tcl $(TESTFLAGS) $(TCLTESTARGS) # Useful target to launch a built tcltest with the proper path,... runtest: tcltest @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \ @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \ TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \ ./tcltest # Useful target for running the test suite with an unwritable current # directory... ro-test: tcltest @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \ @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \ TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \ echo 'exec chmod -w .;package require tcltest;tcltest::temporaryDirectory /tmp;source ../tests/all.tcl;exec chmod +w .' | ./tcltest # This target can be used to run tclsh from the build directory # via `make shell SCRIPT=/tmp/foo.tcl` shell: tclsh @@LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \ @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \ TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \ ./tclsh $(SCRIPT) # This target can be used to run tclsh inside either gdb or insight gdb: tclsh @echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}" > gdb.run @echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > gdb.run @echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run $(GDB) ./tclsh --command=gdb.run rm gdb.run # This target can be used to run tclsh inside ddd ddd: tclsh @echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}" > gdb.run @echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > gdb.run @echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run $(DDD) -command=gdb.run ./tclsh rm gdb.run VALGRINDARGS=--tool=memcheck --num-callers=8 --leak-resolution=high --leak-check=yes --show-reachable=yes -v valgrind: tclsh tcltest @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \ @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \ TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \ valgrind --num-callers=8 --leak-resolution=high -v --leak-check=yes --show-reachable=yes $(VALGRINDARGS) ./tcltest $(TOP_DIR)/tests/all.tcl -singleproc 1 $(TESTFLAGS) $(TCLTESTARGS) valgrind $(VALGRINDARGS) ./tcltest $(TOP_DIR)/tests/all.tcl -singleproc 1 $(TESTFLAGS) $(TCLTESTARGS) valgrindshell: tclsh @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \ TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \ valgrind $(VALGRINDARGS) ./tclsh $(SCRIPT) # The following target outputs the name of the top-level source directory # for Tcl (it is used by Tk's configure script, for example). The # .NO_PARALLEL line is needed to avoid problems under Sun's "pmake". # Note: this target is now obsolete (use the autoconf variable # TCL_SRC_DIR from tclConfig.sh instead).
︙
571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588	596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615	- + + + - +	# target (via the BUILD_DLTEST variable) if dynamic loading is supported # on this platform. The Makefile in the dltest subdirectory creates # the dltest.marker file in this directory after a successful build. dltest.marker: cd dltest ; $(MAKE) install: install-binaries install-libraries install-doc INSTALL_TARGETS = install-binaries install-libraries install-doc @EXTRA_INSTALL@ install: $(INSTALL_TARGETS) install-strip: $(MAKE) install \ $(MAKE) $(INSTALL_TARGETS) \ INSTALL_PROGRAM="$(INSTALL_PROGRAM) ${INSTALL_STRIP_PROGRAM}" \ INSTALL_LIBRARY="$(INSTALL_LIBRARY) ${INSTALL_STRIP_LIBRARY}" # Note: before running ranlib below, must cd to target directory because # some ranlibs write to current directory, and this might not always be # possible (e.g. if installing as root).
︙
611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667	638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695	+ - + - + - + - +	@$(INSTALL_PROGRAM) tclsh $(BIN_INSTALL_DIR)/tclsh$(VERSION) @echo "Installing tclConfig.sh to $(LIB_INSTALL_DIR)/" @$(INSTALL_DATA) tclConfig.sh $(LIB_INSTALL_DIR)/tclConfig.sh @if test "$(STUB_LIB_FILE)" != "" ; then \ echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \ @INSTALL_STUB_LIB@ ; \ fi @EXTRA_INSTALL_BINARIES@ install-libraries: libraries @for i in $(INCLUDE_INSTALL_DIR) $(SCRIPT_INSTALL_DIR); \ do \ if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ mkdir -p $$i; \ chmod 755 $$i; \ else true; \ fi; \ done; @for i in http2.4 http1.0 opt0.4 encoding msgcat1.3 tcltest2.2; \ @for i in http2.5 http1.0 opt0.4 encoding msgcat1.3 tcltest2.2; \ do \ if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ mkdir -p $(SCRIPT_INSTALL_DIR)/$$i; \ chmod 755 $(SCRIPT_INSTALL_DIR)/$$i; \ else true; \ fi; \ done; @if test ! -x $(SRC_DIR)/install-sh; then \ chmod +x $(SRC_DIR)/install-sh; \ fi @echo "Installing header files"; @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \ $(GENERIC_DIR)/tclPlatDecls.h ; \ $(GENERIC_DIR)/tclPlatDecls.h; \ do \ $(INSTALL_DATA) $$i $(INCLUDE_INSTALL_DIR); \ done; @echo "Installing library files to $(SCRIPT_INSTALL_DIR)"; @for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex $(UNIX_DIR)/tclAppInit.c $(UNIX_DIR)/ldAix; \ do \ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \ done; @echo "Installing library http1.0 directory"; @for j in $(TOP_DIR)/library/http1.0/*.tcl ; \ do \ $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/http1.0; \ done; @echo "Installing library http2.4 directory"; @echo "Installing library http2.5 directory"; @for j in $(TOP_DIR)/library/http/*.tcl ; \ do \ $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/http2.4; \ $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/http2.5; \ done; @echo "Installing library opt0.4 directory"; @for j in $(TOP_DIR)/library/opt/*.tcl ; \ do \ $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/opt0.4; \ done; @echo "Installing library msgcat1.3 directory";
︙
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 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768	704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809	- - + + - - - - + + + + + - - - - - + + + + + - - - + + + + + + + + + + - + - - - + + + - - - - + + + + + + + - + - - - - - + + + - + - + + + + + - + - +	done; @echo "Installing library encoding directory"; @for i in $(TOP_DIR)/library/encoding/*.enc ; do \ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/encoding; \ done; install-doc: doc @if test ! -x $(UNIX_DIR)/mkLinks; then \ chmod +x $(UNIX_DIR)/mkLinks; \ @if test ! -x $(UNIX_DIR)/installManPage; then \ chmod +x $(UNIX_DIR)/installManPage; \ fi @for i in $(MAN_INSTALL_DIR) $(MAN1_INSTALL_DIR) $(MAN3_INSTALL_DIR) $(MANN_INSTALL_DIR) ; \ do \ if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ mkdir -p $$i; \ chmod 755 $$i; \ else true; \ fi; \ done; @echo "Installing top-level (.1) docs"; @cd $(TOP_DIR)/doc; for i in *.1; \ do \ rm -f $(MAN1_INSTALL_DIR)/$$i; \ @echo "Installing and cross-linking top-level (.1) docs"; @for i in $(TOP_DIR)/doc/*.1; do \ $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i $(MAN1_INSTALL_DIR); \ done sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \ $$i > $(MAN1_INSTALL_DIR)/$$i; \ chmod 444 $(MAN1_INSTALL_DIR)/$$i; \ done; @echo "Cross-linking top-level (.1) docs"; @echo "Installing and cross-linking C API (.3) docs"; @for i in $(TOP_DIR)/doc/*.3; do \ $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i $(MAN3_INSTALL_DIR); \ done @$(UNIX_DIR)/mkLinks $(MKLINKS_FLAGS) $(MAN1_INSTALL_DIR) @echo "Installing C API (.3) docs"; @cd $(TOP_DIR)/doc; for i in *.3; \ @echo "Installing and cross-linking command (.n) docs"; @for i in $(TOP_DIR)/doc/*.n; do \ $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i $(MANN_INSTALL_DIR); \ done # Optional target to install private headers install-private-headers: libraries @for i in $(PRIVATE_INCLUDE_INSTALL_DIR); \ do \ if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ rm -f $(MAN3_INSTALL_DIR)/$$i; \ mkdir -p $$i; \ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \ $$i > $(MAN3_INSTALL_DIR)/$$i; \ chmod 444 $(MAN3_INSTALL_DIR)/$$i; \ chmod 755 $$i; \ else true; \ fi; \ done; @echo "Cross-linking C API (.3) docs"; @$(UNIX_DIR)/mkLinks $(MKLINKS_FLAGS) $(MAN3_INSTALL_DIR) @echo "Installing command (.n) docs"; @cd $(TOP_DIR)/doc; for i in *.n; \ @if test ! -x $(SRC_DIR)/install-sh; then \ chmod +x $(SRC_DIR)/install-sh; \ fi @echo "Installing private header files"; @for i in $(GENERIC_DIR)/tclInt.h $(GENERIC_DIR)/tclIntDecls.h \ $(GENERIC_DIR)/tclIntPlatDecls.h \ $(UNIX_DIR)/tclUnixPort.h $(GENERIC_DIR)/tclMath.h; \ do \ rm -f $(MANN_INSTALL_DIR)/$$i; \ $(INSTALL_DATA) $$i $(PRIVATE_INCLUDE_INSTALL_DIR); \ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \ $$i > $(MANN_INSTALL_DIR)/$$i; \ chmod 444 $(MANN_INSTALL_DIR)/$$i; \ done; @echo "Cross-linking command (.n) docs"; @$(UNIX_DIR)/mkLinks $(MKLINKS_FLAGS) $(MANN_INSTALL_DIR) @sed -e 's#\.\./unix/##' $(GENERIC_DIR)/tclPort.h > tclPort.h; \ $(INSTALL_DATA) tclPort.h $(PRIVATE_INCLUDE_INSTALL_DIR); \ rm -f tclPort.h Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in $(SHELL) config.status clean: rm -f *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \ errors tclsh tcltest lib.exp errors tclsh tcltest lib.exp Tcl cd dltest ; $(MAKE) clean distclean: clean rm -rf Makefile config.status config.cache config.log tclConfig.sh \ $(PACKAGE).* prototype $(PACKAGE).* prototype *.plist Tcl.framework cd dltest ; $(MAKE) distclean depend: makedepend -- $(DEPEND_SWITCHES) -- $(SRCS) # Test binaries. The rules for tclTestInit.o and xtTestInit.o are # complicated because they are compiled from tclAppInit.c. Can't use # the "-o" option because this doesn't work on some strange compilers # (e.g. UnixWare). # To enable concurrent parallel make of tclsh and tcltest resp xttest, these # targets have to depend on tclsh, this ensures that linking of tclsh with # tclAppInit.o does not execute concurrently with the renaming and recompiling # of that same object file in the targets below. tclTestInit.o: $(UNIX_DIR)/tclAppInit.c tclTestInit.o: $(UNIX_DIR)/tclAppInit.c tclsh @if test -f tclAppInit.o ; then \ rm -f tclAppInit.sav; \ mv tclAppInit.o tclAppInit.sav; \ fi; $(CC) -c $(CC_SWITCHES) \ -DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \ -DTCL_TEST $(UNIX_DIR)/tclAppInit.c rm -f tclTestInit.o mv tclAppInit.o tclTestInit.o @if test -f tclAppInit.sav ; then \ mv tclAppInit.sav tclAppInit.o; \ fi; xtTestInit.o: $(UNIX_DIR)/tclAppInit.c xtTestInit.o: $(UNIX_DIR)/tclAppInit.c tclsh @if test -f tclAppInit.o ; then \ rm -f tclAppInit.sav; \ mv tclAppInit.o tclAppInit.sav; \ fi; $(CC) -c $(CC_SWITCHES) \ -DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \ -DTCL_TEST -DTCL_XT_TEST $(UNIX_DIR)/tclAppInit.c
︙
1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057	1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104	+ + - + + + + +	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTime.c tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c $(GENERIC_DIR)/tclInitScript.h tclConfig.sh $(CC) -c $(CC_SWITCHES) -DTCL_LIBRARY=\"${TCL_LIBRARY}\" \ -DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\"" \ $(UNIX_DIR)/tclUnixInit.c tclUnixCompat.o: $(UNIX_DIR)/tclUnixCompat.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixCompat.c # This is the CFBundle interface. It is only used on Mac OS X. # The following are Mac OS X only sources: tclMacOSXBundle.o: $(MAC_OSX_DIR)/tclMacOSXBundle.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXBundle.c tclMacOSXNotify.o: $(MAC_OSX_DIR)/tclMacOSXNotify.c $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXNotify.c # The following targets are not completely general. They are provide # purely for documentation purposes so people who are interested in # the Xt based notifier can modify them to suit their own installation. xttest: ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \ @DL_OBJS@ ${BUILD_DLTEST} ${CC} ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
︙
1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120	1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166	-	waitpid.o: $(COMPAT_DIR)/waitpid.c $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/waitpid.c # Stub library binaries, these must be compiled for use in a shared library # even though they will be placed in a static archive tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclStubLib.c .c.o: $(CC) -c $(CC_SWITCHES) $< #
︙
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	1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211	- - + + + - + - +	$(GENERIC_DIR)/tcl.decls $(GENERIC_DIR)/tclInt.decls # # Target to check that all exported functions have an entry in the stubs # tables. # checkstubs: -@for i in `nm -p $(TCL_LIB_FILE) | awk '$$2 ~ /T/ { print $$3 }' \ checkstubs: $(TCL_LIB_FILE) -@for i in `nm -p $(TCL_LIB_FILE) \ | awk '$$2 ~ /^[TDBCS]$$/ { sub("^_", "", $$3); print $$3 }' \ | sort -n`; do \ match=0; \ for j in $(TCL_DECLS); do \ if [ `grep -c $$i $$j` -gt 0 ]; then \ if [ `grep -c "$$i *(" $$j` -gt 0 ]; then \ match=1; \ fi; \ done; \ if [ $$match -eq 0 ]; then echo $$i; fi \ done # # Target to check that all public APIs which are not command # implementations have an entry in section three of the distributed # manpages. # checkdoc: checkdoc: $(TCL_LIB_FILE) -@for i in `nm -p $(TCL_LIB_FILE) | awk '$$3 ~ /Tcl_/ { print $$3 }' \ | grep -v 'Cmd$$' | sort -n`; do \ match=0; \ for j in $(TOP_DIR)/doc/*.3; do \ if [ `grep '\-' $$j | grep -c $$i` -gt 0 ]; then \ match=1; \ fi; \
︙
1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234	1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276	- + + + - - - - - - + - - - + - +	# # Target to make sure that only symbols with "Tcl" prefixes are # exported. # checkexports: $(TCL_LIB_FILE) -nm -p $(TCL_LIB_FILE) | awk '$$2 ~ /[TDB]/ { print $$3 }' | sort -n | grep -v '^[Tt]cl' -@nm -p $(TCL_LIB_FILE) \ | awk '$$2 ~ /^[TDBCS]$$/ { sub("^_", "", $$3); print $$3 }' \ | sort -n | grep -E -v '^[Tt]cl' || true # # Target to create a Tcl RPM for Linux. Requires that you be on a Linux # system. # rpm: all /bin/rpm rm -f THIS.TCL.SPEC echo "%define _builddir `pwd`" > THIS.TCL.SPEC echo "%define _rpmdir `pwd`/RPMS" >> THIS.TCL.SPEC cat tcl.spec >> THIS.TCL.SPEC mkdir -p RPMS/i386 rpm -bb THIS.TCL.SPEC mv RPMS/i386/*.rpm . rm -rf RPMS THIS.TCL.SPEC mklinks: $(TCL_EXE) $(UNIX_DIR)/mkLinks.tcl \ $(UNIX_DIR)/../doc/*.[13n] > $(UNIX_DIR)/mkLinks chmod +x $(UNIX_DIR)/mkLinks # # Target to create a proper Tcl distribution from information in the # master source directory. DISTDIR must be defined to indicate where # to put the distribution. # to put the distribution. DISTDIR must be an absolute path name. # DISTROOT = /tmp/dist DISTNAME = tcl${VERSION}${PATCH_LEVEL} ZIPNAME = tcl${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}-src.zip DISTDIR = $(DISTROOT)/$(DISTNAME) $(UNIX_DIR)/configure: $(UNIX_DIR)/configure.in autoconf $(UNIX_DIR)/configure.in > $(UNIX_DIR)/configure dist: $(UNIX_DIR)/configure mklinks dist: rm -rf $(DISTDIR) mkdir -p $(DISTDIR)/unix cp -p $(UNIX_DIR)/*.c $(UNIX_DIR)/*.h $(DISTDIR)/unix cp $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix chmod 664 $(DISTDIR)/unix/Makefile.in cp $(UNIX_DIR)/configure $(UNIX_DIR)/configure.in \ $(UNIX_DIR)/tcl.m4 $(UNIX_DIR)/aclocal.m4 \ $(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/install-sh \ $(UNIX_DIR)/README $(UNIX_DIR)/ldAix $(UNIX_DIR)/tcl.spec \ $(UNIX_DIR)/mkLinks \ $(UNIX_DIR)/installManPage \ $(DISTDIR)/unix chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in chmod 775 $(DISTDIR)/unix/ldAix chmod +x $(DISTDIR)/unix/install-sh mkdir $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.c $(GENERIC_DIR)/*.h $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic
︙
1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262	1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304	- - + +	done; mkdir $(DISTDIR)/library/encoding cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding mkdir $(DISTDIR)/doc cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \ $(TOP_DIR)/doc/man.macros $(DISTDIR)/doc mkdir $(DISTDIR)/compat cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/compat/*.c \ $(TOP_DIR)/compat/*.h $(TOP_DIR)/compat/README \ cp -p $(TOP_DIR)/license.terms $(COMPAT_DIR)/*.c \ $(COMPAT_DIR)/*.h $(COMPAT_DIR)/README \ $(DISTDIR)/compat mkdir $(DISTDIR)/tests cp -p $(TOP_DIR)/license.terms $(DISTDIR)/tests cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \ $(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \ $(DISTDIR)/tests mkdir $(DISTDIR)/win
︙
1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315	1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358	- - + + + - + - - - - - + + + + +	$(TOP_DIR)/mac/*.c $(TOP_DIR)/mac/*.h $(TOP_DIR)/mac/*.r \ $(DISTDIR)/mac cp -p $(TOP_DIR)/mac/porting.notes $(TOP_DIR)/mac/README $(DISTDIR)/mac cp -p $(TOP_DIR)/mac/*.pch $(DISTDIR)/mac cp -p $(TOP_DIR)/mac/*.doc $(TOP_DIR)/mac/*.html $(DISTDIR)/mac cp -p $(TOP_DIR)/license.terms $(DISTDIR)/mac mkdir $(DISTDIR)/macosx cp -p $(TOP_DIR)/macosx/Makefile \ $(TOP_DIR)/macosx/*.c \ cp -p $(MAC_OSX_DIR)/Makefile $(MAC_OSX_DIR)/README \ $(MAC_OSX_DIR)/*.c $(MAC_OSX_DIR)/*.in \ $(DISTDIR)/macosx cp -p $(TOP_DIR)/license.terms $(DISTDIR)/macosx mkdir $(DISTDIR)/macosx/Tcl.pbproj cp -p $(TOP_DIR)/macosx/Tcl.pbproj/*.pbx* $(DISTDIR)/macosx/Tcl.pbproj cp -p $(MAC_OSX_DIR)/Tcl.pbproj/*.pbx* $(DISTDIR)/macosx/Tcl.pbproj mkdir $(DISTDIR)/unix/dltest cp -p $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \ $(UNIX_DIR)/dltest/README \ $(DISTDIR)/unix/dltest mkdir $(DISTDIR)/tools cp -p $(TOP_DIR)/tools/Makefile.in $(TOP_DIR)/tools/README \ $(TOP_DIR)/tools/configure $(TOP_DIR)/tools/configure.in \ $(TOP_DIR)/tools/*.tcl $(TOP_DIR)/tools/man2tcl.c \ $(TOP_DIR)/tools/tcl.wse.in $(TOP_DIR)/tools/*.bmp \ $(TOP_DIR)/tools/tcl.hpj.in \ cp -p $(TOOL_DIR)/Makefile.in $(TOOL_DIR)/README \ $(TOOL_DIR)/configure $(TOOL_DIR)/configure.in \ $(TOOL_DIR)/*.tcl $(TOOL_DIR)/man2tcl.c \ $(TOOL_DIR)/tcl.wse.in $(TOOL_DIR)/*.bmp \ $(TOOL_DIR)/tcl.hpj.in \ $(DISTDIR)/tools $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/tools/tcl.hpj.in \ $(DISTDIR)/tools/tcl.wse.in # # The following target can only be used for non-patch releases. Use # the "allpatch" target below for patch releases.
︙
1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357	1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412	- + - - - + + + + + + + + + + + + + + +	mv $(DISTROOT)/tcl${VERSION} $(DISTROOT)/$(DISTNAME) mv $(DISTROOT)/old $(DISTROOT)/tcl${VERSION} # # This target creates the HTML folder for Tcl & Tk and places it # in DISTDIR/html. It uses the tcltk-man2html.tcl tool from # the Tcl group's tool workspace. It depends on the Tcl & Tk being # in directories called tcl8.3 & tk8.3 up two directories from the # in directories called tcl8.* & tk8.* up two directories from the # TOOL_DIR. # html: $(TCL_EXE) $(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(DISTDIR)/html \ --srcdir=$(TOP_DIR)/.. html: tclsh $(BUILD_HTML) @EXTRA_BUILD_HTML@ html-tcl: tclsh $(BUILD_HTML) --tcl @EXTRA_BUILD_HTML@ html-tk: tclsh $(BUILD_HTML) --tk @EXTRA_BUILD_HTML@ BUILD_HTML = \ @@LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \ TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \ ./tclsh $(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) \ --srcdir=$(TOP_DIR)/.. $(BUILD_HTML_FLAGS) # # Target to create a Macintosh version of the distribution. This will # do a normal distribution and then massage the output to prepare it # for moving to the Mac platform. This requires a few scripts and # programs found only in the Tcl group's tool workspace. #
︙

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	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	- + + - +	Tcl UNIX README --------------- RCS: @(#) $Id: README,v 1.24 2002/10/10 04:56:21 hobbs Exp $ RCS: @(#) $Id: README,v 1.24.2.2 2005/12/03 00:35:44 das Exp $ This is the directory where you configure, compile, test, and install UNIX versions of Tcl. This directory also contains source files for Tcl that are specific to UNIX. Some of the files in this directory are used on the PC or Mac platform too, but they all depend on UNIX (POSIX/ANSI C) interfaces and some of them only make sense under UNIX. Updated forms of the information found in this file is available at: http://www.tcl.tk/doc/howto/compile.html#unix For information on platforms where Tcl is known to compile, along with any porting notes for getting it to work on those platforms, see: http://www.tcl.tk/software/tcltk/platforms.html The rest of this file contains instructions on how to do this. The release should compile and run either "out of the box" or with trivial changes on any UNIX-like system that approximates POSIX, BSD, or System V. We know that it runs on workstations from Sun, H-P, DEC, IBM, and SGI, as well as PCs running Linux, BSDI, and SCO UNIX. To compile for a PC running Windows, see the README file in the directory ../win. To compile for Max OS X, see the README in the directory ../macosx. To compile for a Macintosh, see the README file in the directory ../mac. compile for a classic Macintosh, see the README file in the directory ../mac. How To Compile And Install Tcl: ------------------------------- (a) If you have already compiled Tcl once in this directory and are now preparing to compile again in the same directory but for a different platform, or if you have applied patches, type "make distclean" to
︙
78 79 80 81 82 83 84 85 86 87 88 89 90 91	79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97	+ + + + +	default on platforms where nl_langinfo is found. --disable-langinfo Specifically disables use of nl_langinfo. --enable-man-symlinks Use symlinks for linking the manpages that should be reachable under several names. --enable-man-compression=PROG Compress the manpages using PROG. Mac OS X only: --enable-framework package Tcl as a framework. --disable-corefoundation disable use of CoreFoundation API and revert to standard select based notifier, required when using naked fork (i.e. not followed by execve). Note: by default gcc will be used if it can be located on the PATH. if you want to use cc instead of gcc, set the CC environment variable to "cc" before running configure. It is not safe to edit the Makefile to use gcc after configure is run. Also note that you should use the same compiler when building extensions.
︙

more than 10,000 changes

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	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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110	- + - + - - + + + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - - + + + - + - - - - - - - - - - + + + + + + + + + + + + + + + +	#! /bin/bash -norc dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. # # RCS: @(#) $Id: configure.in,v 1.106 2003/02/15 02:16:33 hobbs Exp $ # RCS: @(#) $Id: configure.in,v 1.106.2.37 2007/06/06 09:54:35 das Exp $ AC_INIT(../generic/tcl.h) AC_PREREQ(2.13) TCL_VERSION=8.4 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=4 TCL_PATCH_LEVEL=".2" TCL_PATCH_LEVEL=".16" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ if test "${prefix}" = "NONE"; then prefix=/usr/local fi if test "${exec_prefix}" = "NONE"; then exec_prefix=$prefix fi # libdir must be a fully qualified path and (not ${exec_prefix}/lib) eval libdir="$libdir" # Make sure srcdir is fully qualified! srcdir=`cd $srcdir ; pwd` TCL_SRC_DIR=`cd $srcdir/..; pwd` #------------------------------------------------------------------------ # Compress and/or soft link the manpages? #------------------------------------------------------------------------ SC_CONFIG_MANPAGES SC_CONFIG_MANPAGES([tcl]) #------------------------------------------------------------------------ # Standard compiler checks #------------------------------------------------------------------------ # If the user did not set CFLAGS, set it now to keep # the AC_PROG_CC macro from adding "-g -O2". if test "${CFLAGS+set}" != "set" ; then CFLAGS="" fi AC_PROG_CC AC_HAVE_HEADERS(unistd.h limits.h) #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: # - stdlib.h doesn't define strtol, strtoul, or # strtod insome versions of SunOS # - some versions of string.h don't declare procedures such # as strstr # Do this early, otherwise an autoconf bug throws errors on configure #-------------------------------------------------------------------- SC_MISSING_POSIX_HEADERS #------------------------------------------------------------------------ # If we're using GCC, see if the compiler understands -pipe. If so, use it. # It makes compiling go faster. (This is only a performance feature.) #------------------------------------------------------------------------ if test -z "$no_pipe" && test -n "$GCC"; then AC_CACHE_CHECK([if the compiler understands -pipe], tcl_cv_cc_pipe, [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" AC_TRY_COMPILE(,, tcl_cv_cc_pipe=yes, tcl_cv_cc_pipe=no) CFLAGS=$hold_cflags]) if test $tcl_cv_cc_pipe = yes; then CFLAGS="$CFLAGS -pipe" fi fi #------------------------------------------------------------------------ # Threads support #------------------------------------------------------------------------ SC_ENABLE_THREADS #------------------------------------------------------------------------ #-------------------------------------------------------------------- # If we're using GCC, see if the compiler understands -pipe. If so, use it. # It makes compiling go faster. (This is only a performance feature.) #------------------------------------------------------------------------ # Look for libraries that we will need when compiling the Tcl shell #-------------------------------------------------------------------- SC_TCL_LINK_LIBS if test -z "$no_pipe"; then if test -n "$GCC"; then AC_MSG_CHECKING([if the compiler understands -pipe]) OLDCC="$CC" CC="$CC -pipe" AC_TRY_COMPILE(,, AC_MSG_RESULT(yes), CC="$OLDCC" AC_MSG_RESULT(no)) fi fi # Add the threads support libraries LIBS="$LIBS$THREADS_LIBS" SC_ENABLE_SHARED #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. #-------------------------------------------------------------------- SC_CONFIG_CFLAGS SC_ENABLE_SYMBOLS TCL_DBGX=${DBGX} #-------------------------------------------------------------------- # Detect what compiler flags to set for 64-bit support. #-------------------------------------------------------------------- SC_TCL_EARLY_FLAGS
︙
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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159	123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211	- + - - + + + + + + + - + - - - - - + - + + + + + + + + + + + + + + + + + + + + + + + - + - - + - - - - + + + - - - + + - - + - +	#-------------------------------------------------------------------- # Check if Posix compliant getcwd exists, if not we'll use getwd. AC_CHECK_FUNCS(getcwd, , [AC_DEFINE(USEGETWD)]) # Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really # define USEGETWD even if the posix getcwd exists. Add a test ? AC_REPLACE_FUNCS(opendir strstr) AC_REPLACE_FUNCS(opendir strstr strtol strtoll strtoull tmpnam waitpid) AC_REPLACE_FUNCS(strtol strtoll strtoull tmpnam waitpid) AC_CHECK_FUNC(strerror, , [AC_DEFINE(NO_STRERROR)]) AC_CHECK_FUNC(getwd, , [AC_DEFINE(NO_GETWD)]) AC_CHECK_FUNC(wait3, , [AC_DEFINE(NO_WAIT3)]) AC_CHECK_FUNC(uname, , [AC_DEFINE(NO_UNAME)]) if test "`uname -s`" = "Darwin" && test "${TCL_THREADS}" = 1 && \ test "`uname -r | awk -F. '{print [$]1}'`" -lt 7; then # prior to Darwin 7, realpath is not threadsafe, so don't # use it when threads are enabled, c.f. bug # 711232 ac_cv_func_realpath=no fi AC_CHECK_FUNC(realpath, , [AC_DEFINE(NO_REALPATH)]) #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special # Look for thread-safe variants of some library functions. # notes: # - stdlib.h doesn't define strtol, strtoul, or # strtod insome versions of SunOS # - some versions of string.h don't declare procedures such # as strstr #-------------------------------------------------------------------- if test "${TCL_THREADS}" = 1; then SC_MISSING_POSIX_HEADERS SC_TCL_GETPWUID_R SC_TCL_GETPWNAM_R SC_TCL_GETGRGID_R SC_TCL_GETGRNAM_R if test "`uname -s`" = "Darwin" && \ test "`uname -r | awk -F. '{print [$]1}'`" -gt 5; then # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX # are actually MT-safe as they always return pointers # from the TSD instead of the static storage. AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME) AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR) elif test "`uname -s`" = "HP-UX" && \ test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then # Starting with HPUX 11.00 (we believe), gethostbyX # are actually MT-safe as they always return pointers # from TSD instead of static storage. AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME) AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR) else SC_TCL_GETHOSTBYNAME_R SC_TCL_GETHOSTBYADDR_R fi fi #--------------------------------------------------------------------------- # Determine which interface to use to talk to the serial port. # Note that #include lines must begin in leftmost column for # some compilers to recognize them as preprocessor directives. #--------------------------------------------------------------------------- SC_SERIAL_PORT #-------------------------------------------------------------------- # Include sys/select.h if it exists and if it supplies things # that appear to be useful and aren't already in sys/types.h. # This appears to be true only on the RS/6000 under AIX. Some # systems like OSF/1 have a sys/select.h that's of no use, and # other systems like SCO UNIX have a sys/select.h that's # pernicious. If "fd_set" isn't defined anywhere then set a # special flag. #-------------------------------------------------------------------- AC_MSG_CHECKING([for fd_set in sys/types]) AC_CACHE_CHECK([for fd_set in sys/types], tcl_cv_type_fd_set, [ AC_CACHE_VAL(tcl_cv_type_fd_set, AC_TRY_COMPILE([#include <sys/types.h>],[fd_set readMask, writeMask;], tcl_cv_type_fd_set=yes, tcl_cv_type_fd_set=no)) tcl_cv_type_fd_set=yes, tcl_cv_type_fd_set=no)]) AC_MSG_RESULT($tcl_cv_type_fd_set) tk_ok=$tcl_cv_type_fd_set if test $tcl_cv_type_fd_set = no; then AC_MSG_CHECKING([for fd_mask in sys/select]) tcl_ok=$tcl_cv_type_fd_set if test $tcl_ok = no; then AC_CACHE_CHECK([for fd_mask in sys/select], tcl_cv_grep_fd_mask, [ AC_CACHE_VAL(tcl_cv_grep_fd_mask, AC_HEADER_EGREP(fd_mask, sys/select.h, tcl_cv_grep_fd_mask=present, tcl_cv_grep_fd_mask=missing)) AC_EGREP_HEADER(fd_mask, sys/select.h, tcl_cv_grep_fd_mask=present, tcl_cv_grep_fd_mask=missing)]) AC_MSG_RESULT($tcl_cv_grep_fd_mask) if test $tcl_cv_grep_fd_mask = present; then AC_DEFINE(HAVE_SYS_SELECT_H) tk_ok=yes tcl_ok=yes fi fi if test $tk_ok = no; then if test $tcl_ok = no; then AC_DEFINE(NO_FD_SET) fi #------------------------------------------------------------------------------ # Find out all about time handling differences. #------------------------------------------------------------------------------
︙
179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254	231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317	- - - - - - - + + + + + + + + - - - + + + - - - - + + + + - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + - + + - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + -	#-------------------------------------------------------------------- AC_CHECK_FUNC(memmove, , [AC_DEFINE(NO_MEMMOVE) AC_DEFINE(NO_STRING_H)]) #-------------------------------------------------------------------- # On some systems strstr is broken: it returns a pointer even # even if the original string is empty. #-------------------------------------------------------------------- AC_MSG_CHECKING([proper strstr implementation]) AC_TRY_RUN([ extern int strstr(); int main() { exit(strstr("\0test", "test") ? 1 : 0); dnl only run if AC_REPLACE_FUNCS(strstr) hasn't already added strstr.o if test "x${ac_cv_func_strstr}" = "xyes"; then AC_CACHE_CHECK([proper strstr implementation], tcl_cv_strstr_unbroken, [ AC_TRY_RUN([ extern int strstr(); int main() { exit(strstr("\0test", "test") ? 1 : 0); } ], tcl_ok=yes, tcl_ok=no, tcl_ok=no) if test $tcl_ok = yes; then }], tcl_cv_strstr_unbroken=ok, tcl_cv_strstr_unbroken=broken, tcl_cv_strstr_unbroken=broken)]) if test $tcl_cv_strstr_unbroken = broken; then AC_MSG_RESULT(yes) else AC_MSG_RESULT([broken, using substitute]) LIBOBJS="$LIBOBJS strstr.o" LIBOBJS="$LIBOBJS strstr.o" fi fi #-------------------------------------------------------------------- # Check for strtoul function. This is tricky because under some # versions of AIX strtoul returns an incorrect terminator # pointer for the string "0". #-------------------------------------------------------------------- AC_CHECK_FUNC(strtoul, tcl_ok=1, tcl_ok=0) if test $tcl_ok = 1; then AC_CACHE_CHECK([proper strtoul implementation], tcl_cv_strtoul_unbroken, [ AC_TRY_RUN([ extern int strtoul(); int main() { char *string = "0"; char *term; int value; value = strtoul(string, &term, 0); if ((value != 0) || (term != (string+1))) { exit(1); } exit(0); }], , tcl_ok=0, tcl_ok=0) if test "$tcl_ok" = 0; then AC_TRY_RUN([ extern int strtoul(); int main() { char *string = "0"; char *term; int value; value = strtoul(string, &term, 0); if ((value != 0) || (term != (string+1))) { exit(1); } exit(0); }], tcl_cv_strtoul_unbroken=ok , tcl_cv_strtoul_unbroken=broken, tcl_cv_strtoul_unbroken=broken)]) if test $tcl_cv_strtoul_unbroken = broken; then tcl_ok=0 fi fi if test $tcl_ok = 0; then test -n "$verbose" && echo " Adding strtoul.o." LIBOBJS="$LIBOBJS strtoul.o" fi #-------------------------------------------------------------------- # Check for the strtod function. This is tricky because in some # versions of Linux strtod mis-parses strings starting with "+". #-------------------------------------------------------------------- AC_CHECK_FUNC(strtod, tcl_ok=1, tcl_ok=0) if test $tcl_ok = 1; then AC_CACHE_CHECK([proper strtod implementation], tcl_cv_strtod_unbroken, [ AC_TRY_RUN([ extern double strtod(); int main() { char *string = " +69"; char *term; double value; value = strtod(string, &term); if ((value != 69) || (term != (string+4))) { exit(1); } exit(0); }], , tcl_ok=0, tcl_ok=0) if test "$tcl_ok" = 0; then AC_TRY_RUN([ extern double strtod(); int main() { char *string = " +69"; char *term; double value; value = strtod(string, &term); if ((value != 69) || (term != (string+4))) { exit(1); } exit(0); }], tcl_cv_strtod_unbroken=ok , tcl_cv_strtod_unbroken=broken, tcl_cv_strtod_unbroken=broken)]) if test $tcl_cv_strtod_unbroken = broken; then tcl_ok=0 fi fi if test $tcl_ok = 0; then test -n "$verbose" && echo " Adding strtod.o." LIBOBJS="$LIBOBJS strtod.o" fi #-------------------------------------------------------------------- # Under Solaris 2.4, strtod returns the wrong value for the # terminating character under some conditions. Check for this # and if the problem exists use a substitute procedure
︙
263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288	326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350	- - + + -	#-------------------------------------------------------------------- AC_TYPE_MODE_T AC_TYPE_PID_T AC_TYPE_SIZE_T AC_TYPE_UID_T AC_MSG_CHECKING([for socklen_t]) AC_CACHE_VAL(ac_cv_type_socklen_t,[AC_EGREP_CPP(changequote(<<,>>)dnl AC_CACHE_CHECK([for socklen_t], ac_cv_type_socklen_t, [ AC_EGREP_CPP(changequote(<<,>>)dnl <<(^|[^a-zA-Z_0-9])socklen_t[^a-zA-Z_0-9]>>dnl changequote([,]),[ #include <sys/types.h> #include <sys/socket.h> #if STDC_HEADERS #include <stdlib.h> #include <stddef.h> #endif ], ac_cv_type_socklen_t=yes, ac_cv_type_socklen_t=no)]) AC_MSG_RESULT($ac_cv_type_socklen_t) if test $ac_cv_type_socklen_t = no; then AC_DEFINE(socklen_t, unsigned) fi #-------------------------------------------------------------------- # If a system doesn't have an opendir function (man, that's old!) # then we have to supply a different version of dirent.h which
︙
296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318	358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378	- - + - + -	# The check below checks whether <sys/wait.h> defines the type # "union wait" correctly. It's needed because of weirdness in # HP-UX where "union wait" is defined in both the BSD and SYS-V # environments. Checking the usability of WIFEXITED seems to do # the trick. #-------------------------------------------------------------------- AC_MSG_CHECKING([union wait]) AC_CACHE_VAL(tcl_cv_union_wait, AC_CACHE_CHECK([union wait], tcl_cv_union_wait, [ AC_TRY_LINK([#include <sys/types.h> #include <sys/wait.h>], [ union wait x; WIFEXITED(x); /* Generates compiler error if WIFEXITED * uses an int. */ ], tcl_cv_union_wait=yes, tcl_cv_union_wait=no)) ], tcl_cv_union_wait=yes, tcl_cv_union_wait=no)]) AC_MSG_RESULT($tcl_cv_union_wait) if test $tcl_cv_union_wait = no; then AC_DEFINE(NO_UNION_WAIT) fi #-------------------------------------------------------------------- # Check whether there is an strncasecmp function on this system. # This is a bit tricky because under SCO it's in -lsocket and
︙
341 342 343 344 345 346 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	401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442	- + - - + - - + - - + - - + -	# declare it. #-------------------------------------------------------------------- AC_CHECK_FUNC(BSDgettimeofday, [AC_DEFINE(HAVE_BSDGETTIMEOFDAY)], [ AC_CHECK_FUNC(gettimeofday, , [AC_DEFINE(NO_GETTOD)]) ]) AC_MSG_CHECKING([for gettimeofday declaration]) AC_CACHE_CHECK([for gettimeofday declaration], tcl_cv_grep_gettimeofday, [ AC_CACHE_VAL(tcl_cv_grep_gettimeofday, AC_EGREP_HEADER(gettimeofday, sys/time.h, tcl_cv_grep_gettimeofday=present, tcl_cv_grep_gettimeofday=missing)) tcl_cv_grep_gettimeofday=present, tcl_cv_grep_gettimeofday=missing)]) AC_MSG_RESULT($tcl_cv_grep_gettimeofday) if test $tcl_cv_grep_gettimeofday = missing ; then AC_DEFINE(GETTOD_NOT_DECLARED) fi #-------------------------------------------------------------------- # The following code checks to see whether it is possible to get # signed chars on this platform. This is needed in order to # properly generate sign-extended ints from character values. #-------------------------------------------------------------------- AC_C_CHAR_UNSIGNED AC_MSG_CHECKING([signed char declarations]) AC_CACHE_CHECK([signed char declarations], tcl_cv_char_signed, [ AC_CACHE_VAL(tcl_cv_char_signed, AC_TRY_COMPILE(, [ signed char *p; p = 0; ], tcl_cv_char_signed=yes, tcl_cv_char_signed=no)) ], tcl_cv_char_signed=yes, tcl_cv_char_signed=no)]) AC_MSG_RESULT($tcl_cv_char_signed) if test $tcl_cv_char_signed = yes; then AC_DEFINE(HAVE_SIGNED_CHAR) fi #-------------------------------------------------------------------- # Does putenv() copy or not? We need to know to avoid memory leaks. #-------------------------------------------------------------------- AC_MSG_CHECKING([for a putenv() that copies the buffer]) AC_CACHE_CHECK([for a putenv() that copies the buffer], tcl_cv_putenv_copy, [ AC_CACHE_VAL(tcl_cv_putenv_copy, AC_TRY_RUN([ #include <stdlib.h> #define OURVAR "havecopy=yes" int main (int argc, char *argv[]) { char *foo, *bar; foo = (char *)strdup(OURVAR);
︙
395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559	450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692	- + - - - + + + - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - + + - - + + - - - + + + + + + + + + + - - + + + + + + + + + + + + + + - - + + - - - + + - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + - + + - + - + +	/* does copy */ return 1; } } ], tcl_cv_putenv_copy=no, tcl_cv_putenv_copy=yes, tcl_cv_putenv_copy=no) tcl_cv_putenv_copy=no)]) ) AC_MSG_RESULT($tcl_cv_putenv_copy) if test $tcl_cv_putenv_copy = yes; then AC_DEFINE(HAVE_PUTENV_THAT_COPIES) fi #-------------------------------------------------------------------- # Check for support of nl_langinfo function #-------------------------------------------------------------------- SC_ENABLE_LANGINFO #-------------------------------------------------------------------- # Look for libraries that we will need when compiling the Tcl shell # Darwin specific API checks and defines #-------------------------------------------------------------------- if test "`uname -s`" = "Darwin" ; then AC_CHECK_HEADERS(copyfile.h) SC_TCL_LINK_LIBS # Add the threads support libraries LIBS="$LIBS$THREADS_LIBS" SC_ENABLE_SHARED AC_CHECK_FUNCS(copyfile) if test $tcl_corefoundation = yes; then AC_CHECK_HEADERS(libkern/OSAtomic.h) AC_CHECK_FUNCS(OSSpinLockLock) AC_CHECK_FUNCS(pthread_atfork) fi AC_DEFINE(USE_VFORK) AC_DEFINE(TCL_DEFAULT_ENCODING, "utf-8") AC_DEFINE(TCL_LOAD_FROM_MEMORY) AC_CHECK_HEADERS(AvailabilityMacros.h) if test "$ac_cv_header_AvailabilityMacros_h" = yes; then AC_CACHE_CHECK([if weak import is available], tcl_cv_cc_weak_import, [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" AC_TRY_LINK([ #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020 #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020 #endif #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1020 #error MAC_OS_X_VERSION_MIN_REQUIRED < 1020 #endif int rand(void) __attribute__((weak_import)); ], [rand();], tcl_cv_cc_weak_import=yes, tcl_cv_cc_weak_import=no) CFLAGS=$hold_cflags]) if test $tcl_cv_cc_weak_import = yes; then AC_DEFINE(HAVE_WEAK_IMPORT) fi fi fi #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. # Check for support of fts functions (readdir replacement) #-------------------------------------------------------------------- AC_CACHE_CHECK([for fts], tcl_cv_api_fts, [ SC_CONFIG_CFLAGS AC_TRY_LINK([ #include <sys/param.h> SC_ENABLE_SYMBOLS TCL_DBGX=${DBGX} #include <sys/stat.h> #include <fts.h> ], [ char*const p[2] = {"/", NULL}; FTS *f = fts_open(p, FTS_PHYSICAL|FTS_NOCHDIR|FTS_NOSTAT, NULL); FTSENT *e = fts_read(f); fts_close(f); ], tcl_cv_api_fts=yes, tcl_cv_api_fts=no)]) if test $tcl_cv_api_fts = yes; then AC_DEFINE(HAVE_FTS) fi #-------------------------------------------------------------------- # The statements below check for systems where POSIX-style # non-blocking I/O (O_NONBLOCK) doesn't work or is unimplemented. # On these systems (mostly older ones), use the old BSD-style # FIONBIO approach instead. #-------------------------------------------------------------------- SC_BLOCKING_STYLE #-------------------------------------------------------------------- # The statements below define a collection of symbols related to # building libtcl as a shared library instead of a static library. #-------------------------------------------------------------------- TCL_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX} TCL_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX} eval "TCL_LIB_FILE=libtcl${LIB_SUFFIX}" SC_ENABLE_FRAMEWORK # tclConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed # so that the backslashes quoting the DBX braces are dropped. # Trick to replace DBGX with TCL_DBGX DBGX='${TCL_DBGX}' eval "TCL_LIB_FILE=${TCL_LIB_FILE}" TCL_LIBRARY='$(prefix)/lib/tcl$(VERSION)' PRIVATE_INCLUDE_DIR='$(includedir)' HTML_DIR='$(DISTDIR)/html' # Note: in the following variable, it's important to use the absolute # path name of the Tcl directory rather than "..": this is because # AIX remembers this path and will attempt to use it at run-time to look # up the Tcl library. if test "`uname -s`" = "Darwin" ; then SC_ENABLE_FRAMEWORK TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version ${TCL_VERSION}`echo ${TCL_PATCH_LEVEL} | awk ['{match($0, "\\\.[0-9]+"); print substr($0,RSTART,RLENGTH)}']`" TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -install_name ${DYLIB_INSTALL_DIR}/${TCL_LIB_FILE} -seg1addr 0xa000000' TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tcl-Info.plist' EXTRA_TCLSH_LIBS='-sectcreate __TEXT __info_plist Tclsh-Info.plist' tcl_config_files="${tcl_config_files} [Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in]" fi if test "$FRAMEWORK_BUILD" = "1" ; then AC_DEFINE(TCL_FRAMEWORK) TCL_BUILD_LIB_SPEC="-F`pwd` -framework Tcl" TCL_LIB_SPEC="-framework Tcl" # Construct a fake local framework structure to make linking with # '-framework Tcl' and running of tcltest work TCL_LIB_FILE="Tcl" elif test "$SHARED_BUILD" = "0" || test "$TCL_NEEDS_EXP_FILE" = "0"; then if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then AC_OUTPUT_COMMANDS([test "$FRAMEWORK_BUILD" = "1" && n=Tcl && f=$n.framework && v=Versions/$VERSION && TCL_LIB_FLAG="-ltcl${TCL_VERSION}\${TCL_DBGX}" else TCL_LIB_FLAG="-ltcl`echo ${TCL_VERSION} | tr -d .`\${TCL_DBGX}" echo "creating $f" && rm -rf $f && mkdir -p $f/$v/Resources && ln -s $v/$n $v/Resources $f && ln -s ../../../$n $f/$v && ln -s ../../../../$n-Info.plist $f/$v/Resources/Info.plist && unset n f v ], [VERSION=${TCL_VERSION} FRAMEWORK_BUILD=${FRAMEWORK_BUILD}]) LD_LIBRARY_PATH_VAR="DYLD_FRAMEWORK_PATH" if test "${libdir}" = '${exec_prefix}/lib'; then # override libdir default libdir="/Library/Frameworks" fi TCL_LIB_FILE="Tcl" TCL_LIB_FLAG="-framework Tcl" TCL_BUILD_LIB_SPEC="-F`pwd` -framework Tcl" TCL_LIB_SPEC="-F${libdir} -framework Tcl" libdir="${libdir}/Tcl.framework/Versions/\${VERSION}" TCL_LIBRARY="${libdir}/Resources/Scripts" includedir="${libdir}/Headers" PRIVATE_INCLUDE_DIR="${libdir}/PrivateHeaders" HTML_DIR="${libdir}/Resources/Documentation/Reference/Tcl" EXTRA_INSTALL="install-private-headers html-tcl" EXTRA_BUILD_HTML='@ln -fs contents.htm $(HTML_INSTALL_DIR)/TclTOC.html' EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources" && mkdir -p "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tcl-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Finalizing Tcl.framework" && rm -f "$(LIB_INSTALL_DIR)/../Current" && ln -s "$(VERSION)" "$(LIB_INSTALL_DIR)/../Current" && for f in "$(LIB_FILE)" tclConfig.sh Resources Headers PrivateHeaders; do rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/Current/$$f" "$(LIB_INSTALL_DIR)/../.."; done && f="$(STUB_LIB_FILE)" && rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/$(VERSION)/$$f" "$(LIB_INSTALL_DIR)/../.."' TCL_YEAR="`date +%Y`" # Don't use AC_DEFINE for the following as the framework version define # needs to go into the Makefile even when using autoheader, so that we # can pick up a potential make override of VERSION. Also, don't put this # into CFLAGS as it should not go into tclConfig.sh EXTRA_CC_SWITCHES='-DTCL_FRAMEWORK_VERSION=\"$(VERSION)\"' else # libdir must be a fully qualified path and not ${exec_prefix}/lib eval libdir="$libdir" if test "$SHARED_BUILD" = "0" || test "$TCL_NEEDS_EXP_FILE" = "0"; then if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then TCL_LIB_FLAG="-ltcl${TCL_VERSION}\${TCL_DBGX}" else TCL_LIB_FLAG="-ltcl`echo ${TCL_VERSION} | tr -d .`\${TCL_DBGX}" fi TCL_BUILD_LIB_SPEC="-L`pwd` ${TCL_LIB_FLAG}" TCL_LIB_SPEC="-L${libdir} ${TCL_LIB_FLAG}" else TCL_BUILD_EXP_FILE="lib.exp" eval "TCL_EXP_FILE=libtcl${TCL_EXPORT_FILE_SUFFIX}" # Replace DBGX with TCL_DBGX eval "TCL_EXP_FILE=\"${TCL_EXP_FILE}\"" if test "$GCC" = "yes" ; then TCL_BUILD_LIB_SPEC="-Wl,-bI:`pwd`/${TCL_BUILD_EXP_FILE} -L`pwd`" TCL_LIB_SPEC="-Wl,-bI:${libdir}/${TCL_EXP_FILE} -L`pwd`" else TCL_BUILD_LIB_SPEC="-bI:`pwd`/${TCL_BUILD_EXP_FILE}" TCL_LIB_SPEC="-bI:${libdir}/${TCL_EXP_FILE}" TCL_BUILD_LIB_SPEC="-L`pwd` ${TCL_LIB_FLAG}" TCL_LIB_SPEC="-L${libdir} ${TCL_LIB_FLAG}" else TCL_BUILD_EXP_FILE="lib.exp" eval "TCL_EXP_FILE=libtcl${TCL_EXPORT_FILE_SUFFIX}" # Replace DBGX with TCL_DBGX eval "TCL_EXP_FILE=\"${TCL_EXP_FILE}\"" if test "$GCC" = "yes" ; then TCL_BUILD_LIB_SPEC="-Wl,-bI:`pwd`/${TCL_BUILD_EXP_FILE} -L`pwd`" TCL_LIB_SPEC="-Wl,-bI:${libdir}/${TCL_EXP_FILE} -L`pwd`" else TCL_BUILD_LIB_SPEC="-bI:`pwd`/${TCL_BUILD_EXP_FILE}" TCL_LIB_SPEC="-bI:${libdir}/${TCL_EXP_FILE}" fi fi fi VERSION='${VERSION}' eval "CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}" eval "CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}" eval "CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}" VERSION=${TCL_VERSION} #-------------------------------------------------------------------- # The statements below define the symbol TCL_PACKAGE_PATH, which # gives a list of directories that may contain packages. The list # consists of one directory for machine-dependent binaries and # another for platform-independent scripts. #-------------------------------------------------------------------- if test "$FRAMEWORK_BUILD" = "1" ; then TCL_PACKAGE_PATH="${libdir}/Resources/Scripts" TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl /Network/Library/Tcl /System/Library/Tcl ~/Library/Frameworks /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks" elif test "$prefix" != "$exec_prefix"; then TCL_PACKAGE_PATH="${libdir} ${prefix}/lib" else TCL_PACKAGE_PATH="${prefix}/lib" fi #-------------------------------------------------------------------- # The statements below define various symbols relating to Tcl # stub support. #-------------------------------------------------------------------- # Replace ${VERSION} with contents of ${TCL_VERSION} eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}" # Replace DBGX with TCL_DBGX eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_DIR=${libdir}" if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}\${TCL_DBGX}" else TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`\${TCL_DBGX}" fi TCL_BUILD_STUB_LIB_SPEC="-L`pwd` ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_SPEC="-L${libdir} ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_SPEC="-L${TCL_STUB_LIB_DIR} ${TCL_STUB_LIB_FLAG}" TCL_BUILD_STUB_LIB_PATH="`pwd`/${TCL_STUB_LIB_FILE}" TCL_STUB_LIB_PATH="${libdir}/${TCL_STUB_LIB_FILE}" TCL_STUB_LIB_PATH="${TCL_STUB_LIB_DIR}/${TCL_STUB_LIB_FILE}" # Install time header dir can be set via --includedir eval "TCL_INCLUDE_SPEC=\"-I${includedir}\"" #------------------------------------------------------------------------ # tclConfig.sh refers to this by a different name #------------------------------------------------------------------------ TCL_SHARED_BUILD=${SHARED_BUILD} AC_SUBST(TCL_VERSION) AC_SUBST(TCL_MAJOR_VERSION) AC_SUBST(TCL_MINOR_VERSION) AC_SUBST(TCL_PATCH_LEVEL) AC_SUBST(TCL_YEAR) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_LIB_SPEC) AC_SUBST(TCL_STUB_LIB_FILE) AC_SUBST(TCL_STUB_LIB_FLAG) AC_SUBST(TCL_STUB_LIB_SPEC)
︙
581 582 583 584 585 586 587 588	714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734	+ + + + + + + + + + + + - + +	AC_SUBST(TCL_UNSHARED_LIB_SUFFIX) AC_SUBST(TCL_HAS_LONGLONG) AC_SUBST(BUILD_DLTEST) AC_SUBST(TCL_PACKAGE_PATH) AC_SUBST(TCL_LIBRARY) AC_SUBST(PRIVATE_INCLUDE_DIR) AC_SUBST(HTML_DIR) AC_SUBST(EXTRA_CC_SWITCHES) AC_SUBST(EXTRA_INSTALL) AC_SUBST(EXTRA_INSTALL_BINARIES) AC_SUBST(EXTRA_BUILD_HTML) AC_SUBST(EXTRA_TCLSH_LIBS) SC_OUTPUT_COMMANDS_PRE AC_OUTPUT(Makefile dltest/Makefile tclConfig.sh) tcl_config_files="${tcl_config_files} [Makefile dltest/Makefile tclConfig.sh]" AC_OUTPUT([${tcl_config_files}])

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16	- + - +	# This Makefile is used to create several test cases for Tcl's load # command. It also illustrates how to take advantage of configuration # exported by Tcl to set up Makefiles for shared libraries. # RCS: @(#) $Id: Makefile.in,v 1.11 2002/07/16 22:44:43 mdejong Exp $ # RCS: @(#) $Id: Makefile.in,v 1.11.2.2 2004/09/23 20:04:07 mdejong Exp $ TCL_DBGX = @TCL_DBGX@ CC = @CC@ LIBS = @TCL_BUILD_STUB_LIB_SPEC@ @DL_LIBS@ @LIBS@ @MATH_LIBS@ AC_FLAGS = @EXTRA_CFLAGS@ AC_FLAGS = @DEFS@ SHLIB_CFLAGS = @SHLIB_CFLAGS@ SHLIB_LD = @SHLIB_LD@ SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ SHLIB_SUFFIX = @SHLIB_SUFFIX@ SRC_DIR = @srcdir@ TCL_VERSION= @TCL_VERSION@
︙
41 42 43 44 45 46 47 48 49 50 51 52	41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56	- + + + + +	${SHLIB_LD} -o pkgd${SHLIB_SUFFIX} pkgd.o ${SHLIB_LD_LIBS} pkge${SHLIB_SUFFIX}: $(SRC_DIR)/pkge.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkge.c ${SHLIB_LD} -o pkge${SHLIB_SUFFIX} pkge.o ${SHLIB_LD_LIBS} clean: rm -f *.o *${SHLIB_SUFFIX} config.cache config.log config.status rm -f *.o config.cache config.log config.status rm -f lib.exp ../dltest.marker @if test "$(SHLIB_SUFFIX)" != ""; then \ echo "rm -f *${SHLIB_SUFFIX}" ; \ rm -f *${SHLIB_SUFFIX} ; \ fi distclean: clean rm -f Makefile

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	/* * pkga.c -- * * This file contains a simple Tcl package "pkga" that is intended * for testing the Tcl dynamic loading facilities. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: pkga.c,v 1.4 2000/04/04 08:06:07 hobbs Exp $ * RCS: @(#) $Id: pkga.c,v 1.4.24.3 2004/06/08 20:25:45 dgp Exp $ */ #include "tcl.h" /* * Prototypes for procedures defined later in this file: */
︙
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64	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	+ + + + + + + - + +	Pkga_EqObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj * CONST objv[]; /* Argument objects. */ { int result; CONST char *str1, *str2; int len1, len2; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string1 string2"); return TCL_ERROR; } str1 = Tcl_GetStringFromObj(objv[1], &len1); str2 = Tcl_GetStringFromObj(objv[2], &len2); if (len1 == len2) { result = (Tcl_UtfNcmp(str1, str2, len1) == 0); } else { result = !strcmp(Tcl_GetString(objv[1]), Tcl_GetString(objv[2])); result = 0; } Tcl_SetObjResult(interp, Tcl_NewIntObj(result)); return TCL_OK; }  /* *---------------------------------------------------------------------- *
︙

	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	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	#!/bin/sh ZIP=: while true; do case $1 in -s | --symlinks ) S="-s ";; -z | --compress ) ZIP=$2; shift ;; -e | --extension ) Z=$2; shift ;; -s | --suffix ) SUFFIX=$2; shift ;; *) break ;; esac shift done if test "$#" != 2; then echo "Usage: installManPages <options> file dir" exit 1 fi MANPAGE=$1 DIR=$2 test -z "$S" && S="$DIR/" # A sed script to parse the alternative names out of a man page. # # /^\\.SH NAME/{ ;# Look for a line, that starts with .SH NAME # s/^.*$// ;# Delete the content of this line from the buffer # n ;# Read next line # s/,//g ;# Remove all commas ... # s/\\\ //g ;# .. and backslash-escaped spaces. # s/ \\\-.*// ;# Delete from \- to the end of line # p ;# print the result # q ;# exit # } # # Backslashes are trippled in the sed script, because it is in # backticks which don't pass backslashes literally. # # Please keep the commented version above updated if you # change anything to the script below. NAMES=`sed -n ' /^\\.SH NAME/{ s/^.*$// n s/,//g s/\\\ //g s/ \\\-.*// p q }' $MANPAGE` SECTION=`echo $MANPAGE | sed 's/.*\(.\)$/\1/'` SRCDIR=`dirname $MANPAGE` FIRST="" for f in $NAMES; do f=$f.$SECTION$SUFFIX if test -z "$FIRST" ; then FIRST=$f rm -f $DIR/$FIRST $DIR/$FIRST.* sed -e "/man\.macros/r $SRCDIR/man.macros" -e "/man\.macros/d" \ $MANPAGE > $DIR/$FIRST chmod 444 $DIR/$FIRST $ZIP $DIR/$FIRST else rm -f $DIR/$f $DIR/$f.* ln $S$FIRST$Z $DIR/$f$Z fi done

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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 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 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

#!/bin/sh # This script is invoked when installing manual entries. It generates # additional links to manual entries, corresponding to the procedure # and command names described by the manual entry. For example, the # Tcl manual entry Hash.3 describes procedures Tcl_InitHashTable, # Tcl_CreateHashEntry, and many more. This script will make hard # links so that Tcl_InitHashTable.3, Tcl_CreateHashEntry.3, and so # on all refer to Hash.3 in the installed directory. # # Because of the length of command and procedure names, this mechanism # only works on machines that support file names longer than 14 characters. # This script checks to see if long file names are supported, and it # doesn't make any links if they are not. # # The script takes one argument, which is the name of the directory # where the manual entries have been installed. ZIP=true while true; do case $1 in -s | --symlinks ) S=-s ;; -z | --compress ) ZIP=$2 shift ;; *) break ;; esac shift done if test $# != 1; then echo "Usage: mkLinks <options> dir" exit 1 fi if test "x$ZIP" != "xtrue"; then touch TeST $ZIP TeST Z=`ls TeST* | sed 's/^[^.]*//'` rm -f TeST* fi cd $1 echo foo > xyzzyTestingAVeryLongFileName.foo x=`echo xyzzyTe*` echo foo > xyzzyTestingaverylongfilename.foo y=`echo xyzzyTestingav*` rm xyzzyTe* if test "$x" != "xyzzyTestingAVeryLongFileName.foo"; then exit fi if test "$y" != "xyzzyTestingaverylongfilename.foo"; then CASEINSENSITIVEFS=1 fi if test -r Access.3; then rm -f Access.3.* $ZIP Access.3 rm -f Tcl_Access.3 Tcl_Access.3.* rm -f Tcl_Stat.3 Tcl_Stat.3.* ln $S Access.3$Z Tcl_Access.3$Z ln $S Access.3$Z Tcl_Stat.3$Z fi if test -r AddErrInfo.3; then rm -f AddErrInfo.3.* $ZIP AddErrInfo.3 rm -f Tcl_AddObjErrorInfo.3 Tcl_AddObjErrorInfo.3.* rm -f Tcl_AddErrorInfo.3 Tcl_AddErrorInfo.3.* rm -f Tcl_SetObjErrorCode.3 Tcl_SetObjErrorCode.3.* rm -f Tcl_SetErrorCode.3 Tcl_SetErrorCode.3.* rm -f Tcl_SetErrorCodeVA.3 Tcl_SetErrorCodeVA.3.* rm -f Tcl_PosixError.3 Tcl_PosixError.3.* rm -f Tcl_LogCommandInfo.3 Tcl_LogCommandInfo.3.* ln $S AddErrInfo.3$Z Tcl_AddObjErrorInfo.3$Z ln $S AddErrInfo.3$Z Tcl_AddErrorInfo.3$Z ln $S AddErrInfo.3$Z Tcl_SetObjErrorCode.3$Z ln $S AddErrInfo.3$Z Tcl_SetErrorCode.3$Z ln $S AddErrInfo.3$Z Tcl_SetErrorCodeVA.3$Z ln $S AddErrInfo.3$Z Tcl_PosixError.3$Z ln $S AddErrInfo.3$Z Tcl_LogCommandInfo.3$Z fi if test -r Alloc.3; then rm -f Alloc.3.* $ZIP Alloc.3 rm -f Tcl_Alloc.3 Tcl_Alloc.3.* rm -f Tcl_Free.3 Tcl_Free.3.* rm -f Tcl_Realloc.3 Tcl_Realloc.3.* rm -f Tcl_AttemptAlloc.3 Tcl_AttemptAlloc.3.* rm -f Tcl_AttemptRealloc.3 Tcl_AttemptRealloc.3.* rm -f ckalloc.3 ckalloc.3.* rm -f ckfree.3 ckfree.3.* rm -f ckrealloc.3 ckrealloc.3.* rm -f attemptckalloc.3 attemptckalloc.3.* rm -f attemptckrealloc.3 attemptckrealloc.3.* ln $S Alloc.3$Z Tcl_Alloc.3$Z ln $S Alloc.3$Z Tcl_Free.3$Z ln $S Alloc.3$Z Tcl_Realloc.3$Z ln $S Alloc.3$Z Tcl_AttemptAlloc.3$Z ln $S Alloc.3$Z Tcl_AttemptRealloc.3$Z ln $S Alloc.3$Z ckalloc.3$Z ln $S Alloc.3$Z ckfree.3$Z ln $S Alloc.3$Z ckrealloc.3$Z ln $S Alloc.3$Z attemptckalloc.3$Z ln $S Alloc.3$Z attemptckrealloc.3$Z fi if test -r AllowExc.3; then rm -f AllowExc.3.* $ZIP AllowExc.3 rm -f Tcl_AllowExceptions.3 Tcl_AllowExceptions.3.* ln $S AllowExc.3$Z Tcl_AllowExceptions.3$Z fi if test -r AppInit.3; then rm -f AppInit.3.* $ZIP AppInit.3 rm -f Tcl_AppInit.3 Tcl_AppInit.3.* ln $S AppInit.3$Z Tcl_AppInit.3$Z fi if test -r AssocData.3; then rm -f AssocData.3.* $ZIP AssocData.3 rm -f Tcl_GetAssocData.3 Tcl_GetAssocData.3.* rm -f Tcl_SetAssocData.3 Tcl_SetAssocData.3.* rm -f Tcl_DeleteAssocData.3 Tcl_DeleteAssocData.3.* ln $S AssocData.3$Z Tcl_GetAssocData.3$Z ln $S AssocData.3$Z Tcl_SetAssocData.3$Z ln $S AssocData.3$Z Tcl_DeleteAssocData.3$Z fi if test -r Async.3; then rm -f Async.3.* $ZIP Async.3 rm -f Tcl_AsyncCreate.3 Tcl_AsyncCreate.3.* rm -f Tcl_AsyncMark.3 Tcl_AsyncMark.3.* rm -f Tcl_AsyncInvoke.3 Tcl_AsyncInvoke.3.* rm -f Tcl_AsyncDelete.3 Tcl_AsyncDelete.3.* rm -f Tcl_AsyncReady.3 Tcl_AsyncReady.3.* ln $S Async.3$Z Tcl_AsyncCreate.3$Z ln $S Async.3$Z Tcl_AsyncMark.3$Z ln $S Async.3$Z Tcl_AsyncInvoke.3$Z ln $S Async.3$Z Tcl_AsyncDelete.3$Z ln $S Async.3$Z Tcl_AsyncReady.3$Z fi if test -r BackgdErr.3; then rm -f BackgdErr.3.* $ZIP BackgdErr.3 rm -f Tcl_BackgroundError.3 Tcl_BackgroundError.3.* ln $S BackgdErr.3$Z Tcl_BackgroundError.3$Z fi if test -r Backslash.3; then rm -f Backslash.3.* $ZIP Backslash.3 rm -f Tcl_Backslash.3 Tcl_Backslash.3.* ln $S Backslash.3$Z Tcl_Backslash.3$Z fi if test -r BoolObj.3; then rm -f BoolObj.3.* $ZIP BoolObj.3 rm -f Tcl_NewBooleanObj.3 Tcl_NewBooleanObj.3.* rm -f Tcl_SetBooleanObj.3 Tcl_SetBooleanObj.3.* rm -f Tcl_GetBooleanFromObj.3 Tcl_GetBooleanFromObj.3.* ln $S BoolObj.3$Z Tcl_NewBooleanObj.3$Z ln $S BoolObj.3$Z Tcl_SetBooleanObj.3$Z ln $S BoolObj.3$Z Tcl_GetBooleanFromObj.3$Z fi if test -r ByteArrObj.3; then rm -f ByteArrObj.3.* $ZIP ByteArrObj.3 rm -f Tcl_NewByteArrayObj.3 Tcl_NewByteArrayObj.3.* rm -f Tcl_SetByteArrayObj.3 Tcl_SetByteArrayObj.3.* rm -f Tcl_GetByteArrayFromObj.3 Tcl_GetByteArrayFromObj.3.* rm -f Tcl_SetByteArrayLength.3 Tcl_SetByteArrayLength.3.* ln $S ByteArrObj.3$Z Tcl_NewByteArrayObj.3$Z ln $S ByteArrObj.3$Z Tcl_SetByteArrayObj.3$Z ln $S ByteArrObj.3$Z Tcl_GetByteArrayFromObj.3$Z ln $S ByteArrObj.3$Z Tcl_SetByteArrayLength.3$Z fi if test -r CallDel.3; then rm -f CallDel.3.* $ZIP CallDel.3 rm -f Tcl_CallWhenDeleted.3 Tcl_CallWhenDeleted.3.* rm -f Tcl_DontCallWhenDeleted.3 Tcl_DontCallWhenDeleted.3.* ln $S CallDel.3$Z Tcl_CallWhenDeleted.3$Z ln $S CallDel.3$Z Tcl_DontCallWhenDeleted.3$Z fi if test -r ChnlStack.3; then rm -f ChnlStack.3.* $ZIP ChnlStack.3 rm -f Tcl_StackChannel.3 Tcl_StackChannel.3.* rm -f Tcl_UnstackChannel.3 Tcl_UnstackChannel.3.* rm -f Tcl_GetStackedChannel.3 Tcl_GetStackedChannel.3.* rm -f Tcl_GetTopChannel.3 Tcl_GetTopChannel.3.* ln $S ChnlStack.3$Z Tcl_StackChannel.3$Z ln $S ChnlStack.3$Z Tcl_UnstackChannel.3$Z ln $S ChnlStack.3$Z Tcl_GetStackedChannel.3$Z ln $S ChnlStack.3$Z Tcl_GetTopChannel.3$Z fi if test -r CmdCmplt.3; then rm -f CmdCmplt.3.* $ZIP CmdCmplt.3 rm -f Tcl_CommandComplete.3 Tcl_CommandComplete.3.* ln $S CmdCmplt.3$Z Tcl_CommandComplete.3$Z fi if test -r Concat.3; then rm -f Concat.3.* $ZIP Concat.3 rm -f Tcl_Concat.3 Tcl_Concat.3.* ln $S Concat.3$Z Tcl_Concat.3$Z fi if test -r CrtChannel.3; then rm -f CrtChannel.3.* $ZIP CrtChannel.3 rm -f Tcl_CreateChannel.3 Tcl_CreateChannel.3.* rm -f Tcl_GetChannelInstanceData.3 Tcl_GetChannelInstanceData.3.* rm -f Tcl_GetChannelType.3 Tcl_GetChannelType.3.* rm -f Tcl_GetChannelName.3 Tcl_GetChannelName.3.* rm -f Tcl_GetChannelHandle.3 Tcl_GetChannelHandle.3.* rm -f Tcl_GetChannelMode.3 Tcl_GetChannelMode.3.* rm -f Tcl_GetChannelBufferSize.3 Tcl_GetChannelBufferSize.3.* rm -f Tcl_SetChannelBufferSize.3 Tcl_SetChannelBufferSize.3.* rm -f Tcl_NotifyChannel.3 Tcl_NotifyChannel.3.* rm -f Tcl_BadChannelOption.3 Tcl_BadChannelOption.3.* rm -f Tcl_ChannelName.3 Tcl_ChannelName.3.* rm -f Tcl_ChannelVersion.3 Tcl_ChannelVersion.3.* rm -f Tcl_ChannelBlockModeProc.3 Tcl_ChannelBlockModeProc.3.* rm -f Tcl_ChannelCloseProc.3 Tcl_ChannelCloseProc.3.* rm -f Tcl_ChannelClose2Proc.3 Tcl_ChannelClose2Proc.3.* rm -f Tcl_ChannelInputProc.3 Tcl_ChannelInputProc.3.* rm -f Tcl_ChannelOutputProc.3 Tcl_ChannelOutputProc.3.* rm -f Tcl_ChannelSeekProc.3 Tcl_ChannelSeekProc.3.* rm -f Tcl_ChannelWideSeekProc.3 Tcl_ChannelWideSeekProc.3.* rm -f Tcl_ChannelSetOptionProc.3 Tcl_ChannelSetOptionProc.3.* rm -f Tcl_ChannelGetOptionProc.3 Tcl_ChannelGetOptionProc.3.* rm -f Tcl_ChannelWatchProc.3 Tcl_ChannelWatchProc.3.* rm -f Tcl_ChannelGetHandleProc.3 Tcl_ChannelGetHandleProc.3.* rm -f Tcl_ChannelFlushProc.3 Tcl_ChannelFlushProc.3.* rm -f Tcl_ChannelHandlerProc.3 Tcl_ChannelHandlerProc.3.* rm -f Tcl_IsChannelShared.3 Tcl_IsChannelShared.3.* rm -f Tcl_IsChannelRegistered.3 Tcl_IsChannelRegistered.3.* rm -f Tcl_CutChannel.3 Tcl_CutChannel.3.* rm -f Tcl_SpliceChannel.3 Tcl_SpliceChannel.3.* rm -f Tcl_IsChannelExisting.3 Tcl_IsChannelExisting.3.* rm -f Tcl_ClearChannelHandlers.3 Tcl_ClearChannelHandlers.3.* rm -f Tcl_GetChannelThread.3 Tcl_GetChannelThread.3.* rm -f Tcl_ChannelBuffered.3 Tcl_ChannelBuffered.3.* ln $S CrtChannel.3$Z Tcl_CreateChannel.3$Z ln $S CrtChannel.3$Z Tcl_GetChannelInstanceData.3$Z ln $S CrtChannel.3$Z Tcl_GetChannelType.3$Z ln $S CrtChannel.3$Z Tcl_GetChannelName.3$Z ln $S CrtChannel.3$Z Tcl_GetChannelHandle.3$Z ln $S CrtChannel.3$Z Tcl_GetChannelMode.3$Z ln $S CrtChannel.3$Z Tcl_GetChannelBufferSize.3$Z ln $S CrtChannel.3$Z Tcl_SetChannelBufferSize.3$Z ln $S CrtChannel.3$Z Tcl_NotifyChannel.3$Z ln $S CrtChannel.3$Z Tcl_BadChannelOption.3$Z ln $S CrtChannel.3$Z Tcl_ChannelName.3$Z ln $S CrtChannel.3$Z Tcl_ChannelVersion.3$Z ln $S CrtChannel.3$Z Tcl_ChannelBlockModeProc.3$Z ln $S CrtChannel.3$Z Tcl_ChannelCloseProc.3$Z ln $S CrtChannel.3$Z Tcl_ChannelClose2Proc.3$Z ln $S CrtChannel.3$Z Tcl_ChannelInputProc.3$Z ln $S CrtChannel.3$Z Tcl_ChannelOutputProc.3$Z ln $S CrtChannel.3$Z Tcl_ChannelSeekProc.3$Z ln $S CrtChannel.3$Z Tcl_ChannelWideSeekProc.3$Z ln $S CrtChannel.3$Z Tcl_ChannelSetOptionProc.3$Z ln $S CrtChannel.3$Z Tcl_ChannelGetOptionProc.3$Z ln $S CrtChannel.3$Z Tcl_ChannelWatchProc.3$Z ln $S CrtChannel.3$Z Tcl_ChannelGetHandleProc.3$Z ln $S CrtChannel.3$Z Tcl_ChannelFlushProc.3$Z ln $S CrtChannel.3$Z Tcl_ChannelHandlerProc.3$Z ln $S CrtChannel.3$Z Tcl_IsChannelShared.3$Z ln $S CrtChannel.3$Z Tcl_IsChannelRegistered.3$Z ln $S CrtChannel.3$Z Tcl_CutChannel.3$Z ln $S CrtChannel.3$Z Tcl_SpliceChannel.3$Z ln $S CrtChannel.3$Z Tcl_IsChannelExisting.3$Z ln $S CrtChannel.3$Z Tcl_ClearChannelHandlers.3$Z ln $S CrtChannel.3$Z Tcl_GetChannelThread.3$Z ln $S CrtChannel.3$Z Tcl_ChannelBuffered.3$Z fi if test -r CrtChnlHdlr.3; then rm -f CrtChnlHdlr.3.* $ZIP CrtChnlHdlr.3 rm -f Tcl_CreateChannelHandler.3 Tcl_CreateChannelHandler.3.* rm -f Tcl_DeleteChannelHandler.3 Tcl_DeleteChannelHandler.3.* ln $S CrtChnlHdlr.3$Z Tcl_CreateChannelHandler.3$Z ln $S CrtChnlHdlr.3$Z Tcl_DeleteChannelHandler.3$Z fi if test -r CrtCloseHdlr.3; then rm -f CrtCloseHdlr.3.* $ZIP CrtCloseHdlr.3 rm -f Tcl_CreateCloseHandler.3 Tcl_CreateCloseHandler.3.* rm -f Tcl_DeleteCloseHandler.3 Tcl_DeleteCloseHandler.3.* ln $S CrtCloseHdlr.3$Z Tcl_CreateCloseHandler.3$Z ln $S CrtCloseHdlr.3$Z Tcl_DeleteCloseHandler.3$Z fi if test -r CrtCommand.3; then rm -f CrtCommand.3.* $ZIP CrtCommand.3 rm -f Tcl_CreateCommand.3 Tcl_CreateCommand.3.* ln $S CrtCommand.3$Z Tcl_CreateCommand.3$Z fi if test -r CrtFileHdlr.3; then rm -f CrtFileHdlr.3.* $ZIP CrtFileHdlr.3 rm -f Tcl_CreateFileHandler.3 Tcl_CreateFileHandler.3.* rm -f Tcl_DeleteFileHandler.3 Tcl_DeleteFileHandler.3.* ln $S CrtFileHdlr.3$Z Tcl_CreateFileHandler.3$Z ln $S CrtFileHdlr.3$Z Tcl_DeleteFileHandler.3$Z fi if test -r CrtInterp.3; then rm -f CrtInterp.3.* $ZIP CrtInterp.3 rm -f Tcl_CreateInterp.3 Tcl_CreateInterp.3.* rm -f Tcl_DeleteInterp.3 Tcl_DeleteInterp.3.* rm -f Tcl_InterpDeleted.3 Tcl_InterpDeleted.3.* ln $S CrtInterp.3$Z Tcl_CreateInterp.3$Z ln $S CrtInterp.3$Z Tcl_DeleteInterp.3$Z ln $S CrtInterp.3$Z Tcl_InterpDeleted.3$Z fi if test -r CrtMathFnc.3; then rm -f CrtMathFnc.3.* $ZIP CrtMathFnc.3 rm -f Tcl_CreateMathFunc.3 Tcl_CreateMathFunc.3.* rm -f Tcl_GetMathFuncInfo.3 Tcl_GetMathFuncInfo.3.* rm -f Tcl_ListMathFuncs.3 Tcl_ListMathFuncs.3.* ln $S CrtMathFnc.3$Z Tcl_CreateMathFunc.3$Z ln $S CrtMathFnc.3$Z Tcl_GetMathFuncInfo.3$Z ln $S CrtMathFnc.3$Z Tcl_ListMathFuncs.3$Z fi if test -r CrtObjCmd.3; then rm -f CrtObjCmd.3.* $ZIP CrtObjCmd.3 rm -f Tcl_CreateObjCommand.3 Tcl_CreateObjCommand.3.* rm -f Tcl_DeleteCommand.3 Tcl_DeleteCommand.3.* rm -f Tcl_DeleteCommandFromToken.3 Tcl_DeleteCommandFromToken.3.* rm -f Tcl_GetCommandInfo.3 Tcl_GetCommandInfo.3.* rm -f Tcl_GetCommandInfoFromToken.3 Tcl_GetCommandInfoFromToken.3.* rm -f Tcl_SetCommandInfo.3 Tcl_SetCommandInfo.3.* rm -f Tcl_SetCommandInfoFromToken.3 Tcl_SetCommandInfoFromToken.3.* rm -f Tcl_GetCommandName.3 Tcl_GetCommandName.3.* rm -f Tcl_GetCommandFullName.3 Tcl_GetCommandFullName.3.* rm -f Tcl_GetCommandFromObj.3 Tcl_GetCommandFromObj.3.* ln $S CrtObjCmd.3$Z Tcl_CreateObjCommand.3$Z ln $S CrtObjCmd.3$Z Tcl_DeleteCommand.3$Z ln $S CrtObjCmd.3$Z Tcl_DeleteCommandFromToken.3$Z ln $S CrtObjCmd.3$Z Tcl_GetCommandInfo.3$Z ln $S CrtObjCmd.3$Z Tcl_GetCommandInfoFromToken.3$Z ln $S CrtObjCmd.3$Z Tcl_SetCommandInfo.3$Z ln $S CrtObjCmd.3$Z Tcl_SetCommandInfoFromToken.3$Z ln $S CrtObjCmd.3$Z Tcl_GetCommandName.3$Z ln $S CrtObjCmd.3$Z Tcl_GetCommandFullName.3$Z ln $S CrtObjCmd.3$Z Tcl_GetCommandFromObj.3$Z fi if test -r CrtSlave.3; then rm -f CrtSlave.3.* $ZIP CrtSlave.3 rm -f Tcl_IsSafe.3 Tcl_IsSafe.3.* rm -f Tcl_MakeSafe.3 Tcl_MakeSafe.3.* rm -f Tcl_CreateSlave.3 Tcl_CreateSlave.3.* rm -f Tcl_GetSlave.3 Tcl_GetSlave.3.* rm -f Tcl_GetMaster.3 Tcl_GetMaster.3.* rm -f Tcl_GetInterpPath.3 Tcl_GetInterpPath.3.* rm -f Tcl_CreateAlias.3 Tcl_CreateAlias.3.* rm -f Tcl_CreateAliasObj.3 Tcl_CreateAliasObj.3.* rm -f Tcl_GetAlias.3 Tcl_GetAlias.3.* rm -f Tcl_GetAliasObj.3 Tcl_GetAliasObj.3.* rm -f Tcl_ExposeCommand.3 Tcl_ExposeCommand.3.* rm -f Tcl_HideCommand.3 Tcl_HideCommand.3.* ln $S CrtSlave.3$Z Tcl_IsSafe.3$Z ln $S CrtSlave.3$Z Tcl_MakeSafe.3$Z ln $S CrtSlave.3$Z Tcl_CreateSlave.3$Z ln $S CrtSlave.3$Z Tcl_GetSlave.3$Z ln $S CrtSlave.3$Z Tcl_GetMaster.3$Z ln $S CrtSlave.3$Z Tcl_GetInterpPath.3$Z ln $S CrtSlave.3$Z Tcl_CreateAlias.3$Z ln $S CrtSlave.3$Z Tcl_CreateAliasObj.3$Z ln $S CrtSlave.3$Z Tcl_GetAlias.3$Z ln $S CrtSlave.3$Z Tcl_GetAliasObj.3$Z ln $S CrtSlave.3$Z Tcl_ExposeCommand.3$Z ln $S CrtSlave.3$Z Tcl_HideCommand.3$Z fi if test -r CrtTimerHdlr.3; then rm -f CrtTimerHdlr.3.* $ZIP CrtTimerHdlr.3 rm -f Tcl_CreateTimerHandler.3 Tcl_CreateTimerHandler.3.* rm -f Tcl_DeleteTimerHandler.3 Tcl_DeleteTimerHandler.3.* ln $S CrtTimerHdlr.3$Z Tcl_CreateTimerHandler.3$Z ln $S CrtTimerHdlr.3$Z Tcl_DeleteTimerHandler.3$Z fi if test -r CrtTrace.3; then rm -f CrtTrace.3.* $ZIP CrtTrace.3 rm -f Tcl_CreateTrace.3 Tcl_CreateTrace.3.* rm -f Tcl_CreateObjTrace.3 Tcl_CreateObjTrace.3.* rm -f Tcl_DeleteTrace.3 Tcl_DeleteTrace.3.* ln $S CrtTrace.3$Z Tcl_CreateTrace.3$Z ln $S CrtTrace.3$Z Tcl_CreateObjTrace.3$Z ln $S CrtTrace.3$Z Tcl_DeleteTrace.3$Z fi if test -r DString.3; then rm -f DString.3.* $ZIP DString.3 rm -f Tcl_DStringInit.3 Tcl_DStringInit.3.* rm -f Tcl_DStringAppend.3 Tcl_DStringAppend.3.* rm -f Tcl_DStringAppendElement.3 Tcl_DStringAppendElement.3.* rm -f Tcl_DStringStartSublist.3 Tcl_DStringStartSublist.3.* rm -f Tcl_DStringEndSublist.3 Tcl_DStringEndSublist.3.* rm -f Tcl_DStringLength.3 Tcl_DStringLength.3.* rm -f Tcl_DStringValue.3 Tcl_DStringValue.3.* rm -f Tcl_DStringSetLength.3 Tcl_DStringSetLength.3.* rm -f Tcl_DStringTrunc.3 Tcl_DStringTrunc.3.* rm -f Tcl_DStringFree.3 Tcl_DStringFree.3.* rm -f Tcl_DStringResult.3 Tcl_DStringResult.3.* rm -f Tcl_DStringGetResult.3 Tcl_DStringGetResult.3.* ln $S DString.3$Z Tcl_DStringInit.3$Z ln $S DString.3$Z Tcl_DStringAppend.3$Z ln $S DString.3$Z Tcl_DStringAppendElement.3$Z ln $S DString.3$Z Tcl_DStringStartSublist.3$Z ln $S DString.3$Z Tcl_DStringEndSublist.3$Z ln $S DString.3$Z Tcl_DStringLength.3$Z ln $S DString.3$Z Tcl_DStringValue.3$Z ln $S DString.3$Z Tcl_DStringSetLength.3$Z ln $S DString.3$Z Tcl_DStringTrunc.3$Z ln $S DString.3$Z Tcl_DStringFree.3$Z ln $S DString.3$Z Tcl_DStringResult.3$Z ln $S DString.3$Z Tcl_DStringGetResult.3$Z fi if test -r DetachPids.3; then rm -f DetachPids.3.* $ZIP DetachPids.3 rm -f Tcl_DetachPids.3 Tcl_DetachPids.3.* rm -f Tcl_ReapDetachedProcs.3 Tcl_ReapDetachedProcs.3.* rm -f Tcl_WaitPid.3 Tcl_WaitPid.3.* ln $S DetachPids.3$Z Tcl_DetachPids.3$Z ln $S DetachPids.3$Z Tcl_ReapDetachedProcs.3$Z ln $S DetachPids.3$Z Tcl_WaitPid.3$Z fi if test -r DoOneEvent.3; then rm -f DoOneEvent.3.* $ZIP DoOneEvent.3 rm -f Tcl_DoOneEvent.3 Tcl_DoOneEvent.3.* ln $S DoOneEvent.3$Z Tcl_DoOneEvent.3$Z fi if test -r DoWhenIdle.3; then rm -f DoWhenIdle.3.* $ZIP DoWhenIdle.3 rm -f Tcl_DoWhenIdle.3 Tcl_DoWhenIdle.3.* rm -f Tcl_CancelIdleCall.3 Tcl_CancelIdleCall.3.* ln $S DoWhenIdle.3$Z Tcl_DoWhenIdle.3$Z ln $S DoWhenIdle.3$Z Tcl_CancelIdleCall.3$Z fi if test -r DoubleObj.3; then rm -f DoubleObj.3.* $ZIP DoubleObj.3 rm -f Tcl_NewDoubleObj.3 Tcl_NewDoubleObj.3.* rm -f Tcl_SetDoubleObj.3 Tcl_SetDoubleObj.3.* rm -f Tcl_GetDoubleFromObj.3 Tcl_GetDoubleFromObj.3.* ln $S DoubleObj.3$Z Tcl_NewDoubleObj.3$Z ln $S DoubleObj.3$Z Tcl_SetDoubleObj.3$Z ln $S DoubleObj.3$Z Tcl_GetDoubleFromObj.3$Z fi if test -r DumpActiveMemory.3; then rm -f DumpActiveMemory.3.* $ZIP DumpActiveMemory.3 rm -f Tcl_DumpActiveMemory.3 Tcl_DumpActiveMemory.3.* rm -f Tcl_InitMemory.3 Tcl_InitMemory.3.* rm -f Tcl_ValidateAllMemory.3 Tcl_ValidateAllMemory.3.* ln $S DumpActiveMemory.3$Z Tcl_DumpActiveMemory.3$Z ln $S DumpActiveMemory.3$Z Tcl_InitMemory.3$Z ln $S DumpActiveMemory.3$Z Tcl_ValidateAllMemory.3$Z fi if test -r Encoding.3; then rm -f Encoding.3.* $ZIP Encoding.3 rm -f Tcl_GetEncoding.3 Tcl_GetEncoding.3.* rm -f Tcl_FreeEncoding.3 Tcl_FreeEncoding.3.* rm -f Tcl_ExternalToUtfDString.3 Tcl_ExternalToUtfDString.3.* rm -f Tcl_ExternalToUtf.3 Tcl_ExternalToUtf.3.* rm -f Tcl_UtfToExternalDString.3 Tcl_UtfToExternalDString.3.* rm -f Tcl_UtfToExternal.3 Tcl_UtfToExternal.3.* rm -f Tcl_WinTCharToUtf.3 Tcl_WinTCharToUtf.3.* rm -f Tcl_WinUtfToTChar.3 Tcl_WinUtfToTChar.3.* rm -f Tcl_GetEncodingName.3 Tcl_GetEncodingName.3.* rm -f Tcl_SetSystemEncoding.3 Tcl_SetSystemEncoding.3.* rm -f Tcl_GetEncodingNames.3 Tcl_GetEncodingNames.3.* rm -f Tcl_CreateEncoding.3 Tcl_CreateEncoding.3.* rm -f Tcl_GetDefaultEncodingDir.3 Tcl_GetDefaultEncodingDir.3.* rm -f Tcl_SetDefaultEncodingDir.3 Tcl_SetDefaultEncodingDir.3.* ln $S Encoding.3$Z Tcl_GetEncoding.3$Z ln $S Encoding.3$Z Tcl_FreeEncoding.3$Z ln $S Encoding.3$Z Tcl_ExternalToUtfDString.3$Z ln $S Encoding.3$Z Tcl_ExternalToUtf.3$Z ln $S Encoding.3$Z Tcl_UtfToExternalDString.3$Z ln $S Encoding.3$Z Tcl_UtfToExternal.3$Z ln $S Encoding.3$Z Tcl_WinTCharToUtf.3$Z ln $S Encoding.3$Z Tcl_WinUtfToTChar.3$Z ln $S Encoding.3$Z Tcl_GetEncodingName.3$Z ln $S Encoding.3$Z Tcl_SetSystemEncoding.3$Z ln $S Encoding.3$Z Tcl_GetEncodingNames.3$Z ln $S Encoding.3$Z Tcl_CreateEncoding.3$Z ln $S Encoding.3$Z Tcl_GetDefaultEncodingDir.3$Z ln $S Encoding.3$Z Tcl_SetDefaultEncodingDir.3$Z fi if test -r Environment.3; then rm -f Environment.3.* $ZIP Environment.3 rm -f Tcl_PutEnv.3 Tcl_PutEnv.3.* ln $S Environment.3$Z Tcl_PutEnv.3$Z fi if test -r Eval.3; then rm -f Eval.3.* $ZIP Eval.3 rm -f Tcl_EvalObjEx.3 Tcl_EvalObjEx.3.* rm -f Tcl_EvalFile.3 Tcl_EvalFile.3.* rm -f Tcl_EvalObjv.3 Tcl_EvalObjv.3.* rm -f Tcl_Eval.3 Tcl_Eval.3.* rm -f Tcl_EvalEx.3 Tcl_EvalEx.3.* rm -f Tcl_GlobalEval.3 Tcl_GlobalEval.3.* rm -f Tcl_GlobalEvalObj.3 Tcl_GlobalEvalObj.3.* rm -f Tcl_VarEval.3 Tcl_VarEval.3.* rm -f Tcl_VarEvalVA.3 Tcl_VarEvalVA.3.* ln $S Eval.3$Z Tcl_EvalObjEx.3$Z ln $S Eval.3$Z Tcl_EvalFile.3$Z ln $S Eval.3$Z Tcl_EvalObjv.3$Z ln $S Eval.3$Z Tcl_Eval.3$Z ln $S Eval.3$Z Tcl_EvalEx.3$Z ln $S Eval.3$Z Tcl_GlobalEval.3$Z ln $S Eval.3$Z Tcl_GlobalEvalObj.3$Z ln $S Eval.3$Z Tcl_VarEval.3$Z ln $S Eval.3$Z Tcl_VarEvalVA.3$Z fi if test -r Exit.3; then rm -f Exit.3.* $ZIP Exit.3 rm -f Tcl_Exit.3 Tcl_Exit.3.* rm -f Tcl_Finalize.3 Tcl_Finalize.3.* rm -f Tcl_CreateExitHandler.3 Tcl_CreateExitHandler.3.* rm -f Tcl_DeleteExitHandler.3 Tcl_DeleteExitHandler.3.* rm -f Tcl_ExitThread.3 Tcl_ExitThread.3.* rm -f Tcl_FinalizeThread.3 Tcl_FinalizeThread.3.* rm -f Tcl_CreateThreadExitHandler.3 Tcl_CreateThreadExitHandler.3.* rm -f Tcl_DeleteThreadExitHandler.3 Tcl_DeleteThreadExitHandler.3.* ln $S Exit.3$Z Tcl_Exit.3$Z ln $S Exit.3$Z Tcl_Finalize.3$Z ln $S Exit.3$Z Tcl_CreateExitHandler.3$Z ln $S Exit.3$Z Tcl_DeleteExitHandler.3$Z ln $S Exit.3$Z Tcl_ExitThread.3$Z ln $S Exit.3$Z Tcl_FinalizeThread.3$Z ln $S Exit.3$Z Tcl_CreateThreadExitHandler.3$Z ln $S Exit.3$Z Tcl_DeleteThreadExitHandler.3$Z fi if test -r ExprLong.3; then rm -f ExprLong.3.* $ZIP ExprLong.3 rm -f Tcl_ExprLong.3 Tcl_ExprLong.3.* rm -f Tcl_ExprDouble.3 Tcl_ExprDouble.3.* rm -f Tcl_ExprBoolean.3 Tcl_ExprBoolean.3.* rm -f Tcl_ExprString.3 Tcl_ExprString.3.* ln $S ExprLong.3$Z Tcl_ExprLong.3$Z ln $S ExprLong.3$Z Tcl_ExprDouble.3$Z ln $S ExprLong.3$Z Tcl_ExprBoolean.3$Z ln $S ExprLong.3$Z Tcl_ExprString.3$Z fi if test -r ExprLongObj.3; then rm -f ExprLongObj.3.* $ZIP ExprLongObj.3 rm -f Tcl_ExprLongObj.3 Tcl_ExprLongObj.3.* rm -f Tcl_ExprDoubleObj.3 Tcl_ExprDoubleObj.3.* rm -f Tcl_ExprBooleanObj.3 Tcl_ExprBooleanObj.3.* rm -f Tcl_ExprObj.3 Tcl_ExprObj.3.* ln $S ExprLongObj.3$Z Tcl_ExprLongObj.3$Z ln $S ExprLongObj.3$Z Tcl_ExprDoubleObj.3$Z ln $S ExprLongObj.3$Z Tcl_ExprBooleanObj.3$Z ln $S ExprLongObj.3$Z Tcl_ExprObj.3$Z fi if test -r FileSystem.3; then rm -f FileSystem.3.* $ZIP FileSystem.3 rm -f Tcl_FSRegister.3 Tcl_FSRegister.3.* rm -f Tcl_FSUnregister.3 Tcl_FSUnregister.3.* rm -f Tcl_FSData.3 Tcl_FSData.3.* rm -f Tcl_FSMountsChanged.3 Tcl_FSMountsChanged.3.* rm -f Tcl_FSGetFileSystemForPath.3 Tcl_FSGetFileSystemForPath.3.* rm -f Tcl_FSGetPathType.3 Tcl_FSGetPathType.3.* rm -f Tcl_FSCopyFile.3 Tcl_FSCopyFile.3.* rm -f Tcl_FSCopyDirectory.3 Tcl_FSCopyDirectory.3.* rm -f Tcl_FSCreateDirectory.3 Tcl_FSCreateDirectory.3.* rm -f Tcl_FSDeleteFile.3 Tcl_FSDeleteFile.3.* rm -f Tcl_FSRemoveDirectory.3 Tcl_FSRemoveDirectory.3.* rm -f Tcl_FSRenameFile.3 Tcl_FSRenameFile.3.* rm -f Tcl_FSListVolumes.3 Tcl_FSListVolumes.3.* rm -f Tcl_FSEvalFile.3 Tcl_FSEvalFile.3.* rm -f Tcl_FSLoadFile.3 Tcl_FSLoadFile.3.* rm -f Tcl_FSMatchInDirectory.3 Tcl_FSMatchInDirectory.3.* rm -f Tcl_FSLink.3 Tcl_FSLink.3.* rm -f Tcl_FSLstat.3 Tcl_FSLstat.3.* rm -f Tcl_FSUtime.3 Tcl_FSUtime.3.* rm -f Tcl_FSFileAttrsGet.3 Tcl_FSFileAttrsGet.3.* rm -f Tcl_FSFileAttrsSet.3 Tcl_FSFileAttrsSet.3.* rm -f Tcl_FSFileAttrStrings.3 Tcl_FSFileAttrStrings.3.* rm -f Tcl_FSStat.3 Tcl_FSStat.3.* rm -f Tcl_FSAccess.3 Tcl_FSAccess.3.* rm -f Tcl_FSOpenFileChannel.3 Tcl_FSOpenFileChannel.3.* rm -f Tcl_FSGetCwd.3 Tcl_FSGetCwd.3.* rm -f Tcl_FSChdir.3 Tcl_FSChdir.3.* rm -f Tcl_FSPathSeparator.3 Tcl_FSPathSeparator.3.* rm -f Tcl_FSJoinPath.3 Tcl_FSJoinPath.3.* rm -f Tcl_FSSplitPath.3 Tcl_FSSplitPath.3.* rm -f Tcl_FSEqualPaths.3 Tcl_FSEqualPaths.3.* rm -f Tcl_FSGetNormalizedPath.3 Tcl_FSGetNormalizedPath.3.* rm -f Tcl_FSJoinToPath.3 Tcl_FSJoinToPath.3.* rm -f Tcl_FSConvertToPathType.3 Tcl_FSConvertToPathType.3.* rm -f Tcl_FSGetInternalRep.3 Tcl_FSGetInternalRep.3.* rm -f Tcl_FSGetTranslatedPath.3 Tcl_FSGetTranslatedPath.3.* rm -f Tcl_FSGetTranslatedStringPath.3 Tcl_FSGetTranslatedStringPath.3.* rm -f Tcl_FSNewNativePath.3 Tcl_FSNewNativePath.3.* rm -f Tcl_FSGetNativePath.3 Tcl_FSGetNativePath.3.* rm -f Tcl_FSFileSystemInfo.3 Tcl_FSFileSystemInfo.3.* rm -f Tcl_AllocStatBuf.3 Tcl_AllocStatBuf.3.* ln $S FileSystem.3$Z Tcl_FSRegister.3$Z ln $S FileSystem.3$Z Tcl_FSUnregister.3$Z ln $S FileSystem.3$Z Tcl_FSData.3$Z ln $S FileSystem.3$Z Tcl_FSMountsChanged.3$Z ln $S FileSystem.3$Z Tcl_FSGetFileSystemForPath.3$Z ln $S FileSystem.3$Z Tcl_FSGetPathType.3$Z ln $S FileSystem.3$Z Tcl_FSCopyFile.3$Z ln $S FileSystem.3$Z Tcl_FSCopyDirectory.3$Z ln $S FileSystem.3$Z Tcl_FSCreateDirectory.3$Z ln $S FileSystem.3$Z Tcl_FSDeleteFile.3$Z ln $S FileSystem.3$Z Tcl_FSRemoveDirectory.3$Z ln $S FileSystem.3$Z Tcl_FSRenameFile.3$Z ln $S FileSystem.3$Z Tcl_FSListVolumes.3$Z ln $S FileSystem.3$Z Tcl_FSEvalFile.3$Z ln $S FileSystem.3$Z Tcl_FSLoadFile.3$Z ln $S FileSystem.3$Z Tcl_FSMatchInDirectory.3$Z ln $S FileSystem.3$Z Tcl_FSLink.3$Z ln $S FileSystem.3$Z Tcl_FSLstat.3$Z ln $S FileSystem.3$Z Tcl_FSUtime.3$Z ln $S FileSystem.3$Z Tcl_FSFileAttrsGet.3$Z ln $S FileSystem.3$Z Tcl_FSFileAttrsSet.3$Z ln $S FileSystem.3$Z Tcl_FSFileAttrStrings.3$Z ln $S FileSystem.3$Z Tcl_FSStat.3$Z ln $S FileSystem.3$Z Tcl_FSAccess.3$Z ln $S FileSystem.3$Z Tcl_FSOpenFileChannel.3$Z ln $S FileSystem.3$Z Tcl_FSGetCwd.3$Z ln $S FileSystem.3$Z Tcl_FSChdir.3$Z ln $S FileSystem.3$Z Tcl_FSPathSeparator.3$Z ln $S FileSystem.3$Z Tcl_FSJoinPath.3$Z ln $S FileSystem.3$Z Tcl_FSSplitPath.3$Z ln $S FileSystem.3$Z Tcl_FSEqualPaths.3$Z ln $S FileSystem.3$Z Tcl_FSGetNormalizedPath.3$Z ln $S FileSystem.3$Z Tcl_FSJoinToPath.3$Z ln $S FileSystem.3$Z Tcl_FSConvertToPathType.3$Z ln $S FileSystem.3$Z Tcl_FSGetInternalRep.3$Z ln $S FileSystem.3$Z Tcl_FSGetTranslatedPath.3$Z ln $S FileSystem.3$Z Tcl_FSGetTranslatedStringPath.3$Z ln $S FileSystem.3$Z Tcl_FSNewNativePath.3$Z ln $S FileSystem.3$Z Tcl_FSGetNativePath.3$Z ln $S FileSystem.3$Z Tcl_FSFileSystemInfo.3$Z ln $S FileSystem.3$Z Tcl_AllocStatBuf.3$Z fi if test -r FindExec.3; then rm -f FindExec.3.* $ZIP FindExec.3 rm -f Tcl_FindExecutable.3 Tcl_FindExecutable.3.* rm -f Tcl_GetNameOfExecutable.3 Tcl_GetNameOfExecutable.3.* ln $S FindExec.3$Z Tcl_FindExecutable.3$Z ln $S FindExec.3$Z Tcl_GetNameOfExecutable.3$Z fi if test -r GetCwd.3; then rm -f GetCwd.3.* $ZIP GetCwd.3 rm -f Tcl_GetCwd.3 Tcl_GetCwd.3.* rm -f Tcl_Chdir.3 Tcl_Chdir.3.* ln $S GetCwd.3$Z Tcl_GetCwd.3$Z ln $S GetCwd.3$Z Tcl_Chdir.3$Z fi if test -r GetHostName.3; then rm -f GetHostName.3.* $ZIP GetHostName.3 rm -f Tcl_GetHostName.3 Tcl_GetHostName.3.* ln $S GetHostName.3$Z Tcl_GetHostName.3$Z fi if test -r GetIndex.3; then rm -f GetIndex.3.* $ZIP GetIndex.3 rm -f Tcl_GetIndexFromObj.3 Tcl_GetIndexFromObj.3.* rm -f Tcl_GetIndexFromObjStruct.3 Tcl_GetIndexFromObjStruct.3.* ln $S GetIndex.3$Z Tcl_GetIndexFromObj.3$Z ln $S GetIndex.3$Z Tcl_GetIndexFromObjStruct.3$Z fi if test -r GetInt.3; then rm -f GetInt.3.* $ZIP GetInt.3 rm -f Tcl_GetInt.3 Tcl_GetInt.3.* rm -f Tcl_GetDouble.3 Tcl_GetDouble.3.* rm -f Tcl_GetBoolean.3 Tcl_GetBoolean.3.* ln $S GetInt.3$Z Tcl_GetInt.3$Z ln $S GetInt.3$Z Tcl_GetDouble.3$Z ln $S GetInt.3$Z Tcl_GetBoolean.3$Z fi if test -r GetOpnFl.3; then rm -f GetOpnFl.3.* $ZIP GetOpnFl.3 rm -f Tcl_GetOpenFile.3 Tcl_GetOpenFile.3.* ln $S GetOpnFl.3$Z Tcl_GetOpenFile.3$Z fi if test -r GetStdChan.3; then rm -f GetStdChan.3.* $ZIP GetStdChan.3 rm -f Tcl_GetStdChannel.3 Tcl_GetStdChannel.3.* rm -f Tcl_SetStdChannel.3 Tcl_SetStdChannel.3.* ln $S GetStdChan.3$Z Tcl_GetStdChannel.3$Z ln $S GetStdChan.3$Z Tcl_SetStdChannel.3$Z fi if test -r GetTime.3; then rm -f GetTime.3.* $ZIP GetTime.3 rm -f Tcl_GetTime.3 Tcl_GetTime.3.* ln $S GetTime.3$Z Tcl_GetTime.3$Z fi if test -r GetVersion.3; then rm -f GetVersion.3.* $ZIP GetVersion.3 rm -f Tcl_GetVersion.3 Tcl_GetVersion.3.* ln $S GetVersion.3$Z Tcl_GetVersion.3$Z fi if test -r Hash.3; then rm -f Hash.3.* $ZIP Hash.3 rm -f Tcl_InitHashTable.3 Tcl_InitHashTable.3.* rm -f Tcl_InitCustomHashTable.3 Tcl_InitCustomHashTable.3.* rm -f Tcl_InitObjHashTable.3 Tcl_InitObjHashTable.3.* rm -f Tcl_DeleteHashTable.3 Tcl_DeleteHashTable.3.* rm -f Tcl_CreateHashEntry.3 Tcl_CreateHashEntry.3.* rm -f Tcl_DeleteHashEntry.3 Tcl_DeleteHashEntry.3.* rm -f Tcl_FindHashEntry.3 Tcl_FindHashEntry.3.* rm -f Tcl_GetHashValue.3 Tcl_GetHashValue.3.* rm -f Tcl_SetHashValue.3 Tcl_SetHashValue.3.* rm -f Tcl_GetHashKey.3 Tcl_GetHashKey.3.* rm -f Tcl_FirstHashEntry.3 Tcl_FirstHashEntry.3.* rm -f Tcl_NextHashEntry.3 Tcl_NextHashEntry.3.* rm -f Tcl_HashStats.3 Tcl_HashStats.3.* ln $S Hash.3$Z Tcl_InitHashTable.3$Z ln $S Hash.3$Z Tcl_InitCustomHashTable.3$Z ln $S Hash.3$Z Tcl_InitObjHashTable.3$Z ln $S Hash.3$Z Tcl_DeleteHashTable.3$Z ln $S Hash.3$Z Tcl_CreateHashEntry.3$Z ln $S Hash.3$Z Tcl_DeleteHashEntry.3$Z ln $S Hash.3$Z Tcl_FindHashEntry.3$Z ln $S Hash.3$Z Tcl_GetHashValue.3$Z ln $S Hash.3$Z Tcl_SetHashValue.3$Z ln $S Hash.3$Z Tcl_GetHashKey.3$Z ln $S Hash.3$Z Tcl_FirstHashEntry.3$Z ln $S Hash.3$Z Tcl_NextHashEntry.3$Z ln $S Hash.3$Z Tcl_HashStats.3$Z fi if test -r Init.3; then rm -f Init.3.* $ZIP Init.3 rm -f Tcl_Init.3 Tcl_Init.3.* ln $S Init.3$Z Tcl_Init.3$Z fi if test -r InitStubs.3; then rm -f InitStubs.3.* $ZIP InitStubs.3 rm -f Tcl_InitStubs.3 Tcl_InitStubs.3.* ln $S InitStubs.3$Z Tcl_InitStubs.3$Z fi if test -r IntObj.3; then rm -f IntObj.3.* $ZIP IntObj.3 rm -f Tcl_NewIntObj.3 Tcl_NewIntObj.3.* rm -f Tcl_NewLongObj.3 Tcl_NewLongObj.3.* rm -f Tcl_NewWideIntObj.3 Tcl_NewWideIntObj.3.* rm -f Tcl_SetIntObj.3 Tcl_SetIntObj.3.* rm -f Tcl_SetLongObj.3 Tcl_SetLongObj.3.* rm -f Tcl_SetWideIntObj.3 Tcl_SetWideIntObj.3.* rm -f Tcl_GetIntFromObj.3 Tcl_GetIntFromObj.3.* rm -f Tcl_GetLongFromObj.3 Tcl_GetLongFromObj.3.* rm -f Tcl_GetWideIntFromObj.3 Tcl_GetWideIntFromObj.3.* ln $S IntObj.3$Z Tcl_NewIntObj.3$Z ln $S IntObj.3$Z Tcl_NewLongObj.3$Z ln $S IntObj.3$Z Tcl_NewWideIntObj.3$Z ln $S IntObj.3$Z Tcl_SetIntObj.3$Z ln $S IntObj.3$Z Tcl_SetLongObj.3$Z ln $S IntObj.3$Z Tcl_SetWideIntObj.3$Z ln $S IntObj.3$Z Tcl_GetIntFromObj.3$Z ln $S IntObj.3$Z Tcl_GetLongFromObj.3$Z ln $S IntObj.3$Z Tcl_GetWideIntFromObj.3$Z fi if test -r Interp.3; then rm -f Interp.3.* $ZIP Interp.3 rm -f Tcl_Interp.3 Tcl_Interp.3.* ln $S Interp.3$Z Tcl_Interp.3$Z fi if test -r LinkVar.3; then rm -f LinkVar.3.* $ZIP LinkVar.3 rm -f Tcl_LinkVar.3 Tcl_LinkVar.3.* rm -f Tcl_UnlinkVar.3 Tcl_UnlinkVar.3.* rm -f Tcl_UpdateLinkedVar.3 Tcl_UpdateLinkedVar.3.* ln $S LinkVar.3$Z Tcl_LinkVar.3$Z ln $S LinkVar.3$Z Tcl_UnlinkVar.3$Z ln $S LinkVar.3$Z Tcl_UpdateLinkedVar.3$Z fi if test -r ListObj.3; then rm -f ListObj.3.* $ZIP ListObj.3 rm -f Tcl_ListObjAppendList.3 Tcl_ListObjAppendList.3.* rm -f Tcl_ListObjAppendElement.3 Tcl_ListObjAppendElement.3.* rm -f Tcl_NewListObj.3 Tcl_NewListObj.3.* rm -f Tcl_SetListObj.3 Tcl_SetListObj.3.* rm -f Tcl_ListObjGetElements.3 Tcl_ListObjGetElements.3.* rm -f Tcl_ListObjLength.3 Tcl_ListObjLength.3.* rm -f Tcl_ListObjIndex.3 Tcl_ListObjIndex.3.* rm -f Tcl_ListObjReplace.3 Tcl_ListObjReplace.3.* ln $S ListObj.3$Z Tcl_ListObjAppendList.3$Z ln $S ListObj.3$Z Tcl_ListObjAppendElement.3$Z ln $S ListObj.3$Z Tcl_NewListObj.3$Z ln $S ListObj.3$Z Tcl_SetListObj.3$Z ln $S ListObj.3$Z Tcl_ListObjGetElements.3$Z ln $S ListObj.3$Z Tcl_ListObjLength.3$Z ln $S ListObj.3$Z Tcl_ListObjIndex.3$Z ln $S ListObj.3$Z Tcl_ListObjReplace.3$Z fi if test -r Macintosh.3; then rm -f Macintosh.3.* $ZIP Macintosh.3 rm -f Tcl_MacSetEventProc.3 Tcl_MacSetEventProc.3.* rm -f Tcl_MacConvertTextResource.3 Tcl_MacConvertTextResource.3.* rm -f Tcl_MacEvalResource.3 Tcl_MacEvalResource.3.* rm -f Tcl_MacFindResource.3 Tcl_MacFindResource.3.* rm -f Tcl_GetOSTypeFromObj.3 Tcl_GetOSTypeFromObj.3.* rm -f Tcl_SetOSTypeObj.3 Tcl_SetOSTypeObj.3.* rm -f Tcl_NewOSTypeObj.3 Tcl_NewOSTypeObj.3.* ln $S Macintosh.3$Z Tcl_MacSetEventProc.3$Z ln $S Macintosh.3$Z Tcl_MacConvertTextResource.3$Z ln $S Macintosh.3$Z Tcl_MacEvalResource.3$Z ln $S Macintosh.3$Z Tcl_MacFindResource.3$Z ln $S Macintosh.3$Z Tcl_GetOSTypeFromObj.3$Z ln $S Macintosh.3$Z Tcl_SetOSTypeObj.3$Z ln $S Macintosh.3$Z Tcl_NewOSTypeObj.3$Z fi if test -r Notifier.3; then rm -f Notifier.3.* $ZIP Notifier.3 rm -f Tcl_CreateEventSource.3 Tcl_CreateEventSource.3.* rm -f Tcl_DeleteEventSource.3 Tcl_DeleteEventSource.3.* rm -f Tcl_SetMaxBlockTime.3 Tcl_SetMaxBlockTime.3.* rm -f Tcl_QueueEvent.3 Tcl_QueueEvent.3.* rm -f Tcl_ThreadQueueEvent.3 Tcl_ThreadQueueEvent.3.* rm -f Tcl_ThreadAlert.3 Tcl_ThreadAlert.3.* rm -f Tcl_GetCurrentThread.3 Tcl_GetCurrentThread.3.* rm -f Tcl_DeleteEvents.3 Tcl_DeleteEvents.3.* rm -f Tcl_InitNotifier.3 Tcl_InitNotifier.3.* rm -f Tcl_FinalizeNotifier.3 Tcl_FinalizeNotifier.3.* rm -f Tcl_WaitForEvent.3 Tcl_WaitForEvent.3.* rm -f Tcl_AlertNotifier.3 Tcl_AlertNotifier.3.* rm -f Tcl_SetTimer.3 Tcl_SetTimer.3.* rm -f Tcl_ServiceAll.3 Tcl_ServiceAll.3.* rm -f Tcl_ServiceEvent.3 Tcl_ServiceEvent.3.* rm -f Tcl_GetServiceMode.3 Tcl_GetServiceMode.3.* rm -f Tcl_SetServiceMode.3 Tcl_SetServiceMode.3.* ln $S Notifier.3$Z Tcl_CreateEventSource.3$Z ln $S Notifier.3$Z Tcl_DeleteEventSource.3$Z ln $S Notifier.3$Z Tcl_SetMaxBlockTime.3$Z ln $S Notifier.3$Z Tcl_QueueEvent.3$Z ln $S Notifier.3$Z Tcl_ThreadQueueEvent.3$Z ln $S Notifier.3$Z Tcl_ThreadAlert.3$Z ln $S Notifier.3$Z Tcl_GetCurrentThread.3$Z ln $S Notifier.3$Z Tcl_DeleteEvents.3$Z ln $S Notifier.3$Z Tcl_InitNotifier.3$Z ln $S Notifier.3$Z Tcl_FinalizeNotifier.3$Z ln $S Notifier.3$Z Tcl_WaitForEvent.3$Z ln $S Notifier.3$Z Tcl_AlertNotifier.3$Z ln $S Notifier.3$Z Tcl_SetTimer.3$Z ln $S Notifier.3$Z Tcl_ServiceAll.3$Z ln $S Notifier.3$Z Tcl_ServiceEvent.3$Z ln $S Notifier.3$Z Tcl_GetServiceMode.3$Z ln $S Notifier.3$Z Tcl_SetServiceMode.3$Z fi if test -r Object.3; then rm -f Object.3.* $ZIP Object.3 rm -f Tcl_NewObj.3 Tcl_NewObj.3.* rm -f Tcl_DuplicateObj.3 Tcl_DuplicateObj.3.* rm -f Tcl_IncrRefCount.3 Tcl_IncrRefCount.3.* rm -f Tcl_DecrRefCount.3 Tcl_DecrRefCount.3.* rm -f Tcl_IsShared.3 Tcl_IsShared.3.* rm -f Tcl_InvalidateStringRep.3 Tcl_InvalidateStringRep.3.* ln $S Object.3$Z Tcl_NewObj.3$Z ln $S Object.3$Z Tcl_DuplicateObj.3$Z ln $S Object.3$Z Tcl_IncrRefCount.3$Z ln $S Object.3$Z Tcl_DecrRefCount.3$Z ln $S Object.3$Z Tcl_IsShared.3$Z ln $S Object.3$Z Tcl_InvalidateStringRep.3$Z fi if test -r ObjectType.3; then rm -f ObjectType.3.* $ZIP ObjectType.3 rm -f Tcl_RegisterObjType.3 Tcl_RegisterObjType.3.* rm -f Tcl_GetObjType.3 Tcl_GetObjType.3.* rm -f Tcl_AppendAllObjTypes.3 Tcl_AppendAllObjTypes.3.* rm -f Tcl_ConvertToType.3 Tcl_ConvertToType.3.* ln $S ObjectType.3$Z Tcl_RegisterObjType.3$Z ln $S ObjectType.3$Z Tcl_GetObjType.3$Z ln $S ObjectType.3$Z Tcl_AppendAllObjTypes.3$Z ln $S ObjectType.3$Z Tcl_ConvertToType.3$Z fi if test -r OpenFileChnl.3; then rm -f OpenFileChnl.3.* $ZIP OpenFileChnl.3 rm -f Tcl_OpenFileChannel.3 Tcl_OpenFileChannel.3.* rm -f Tcl_OpenCommandChannel.3 Tcl_OpenCommandChannel.3.* rm -f Tcl_MakeFileChannel.3 Tcl_MakeFileChannel.3.* rm -f Tcl_GetChannel.3 Tcl_GetChannel.3.* rm -f Tcl_GetChannelNames.3 Tcl_GetChannelNames.3.* rm -f Tcl_GetChannelNamesEx.3 Tcl_GetChannelNamesEx.3.* rm -f Tcl_RegisterChannel.3 Tcl_RegisterChannel.3.* rm -f Tcl_UnregisterChannel.3 Tcl_UnregisterChannel.3.* rm -f Tcl_DetachChannel.3 Tcl_DetachChannel.3.* rm -f Tcl_IsStandardChannel.3 Tcl_IsStandardChannel.3.* rm -f Tcl_Close.3 Tcl_Close.3.* rm -f Tcl_ReadChars.3 Tcl_ReadChars.3.* rm -f Tcl_Read.3 Tcl_Read.3.* rm -f Tcl_GetsObj.3 Tcl_GetsObj.3.* rm -f Tcl_Gets.3 Tcl_Gets.3.* rm -f Tcl_WriteObj.3 Tcl_WriteObj.3.* rm -f Tcl_WriteChars.3 Tcl_WriteChars.3.* rm -f Tcl_Write.3 Tcl_Write.3.* rm -f Tcl_Flush.3 Tcl_Flush.3.* rm -f Tcl_Seek.3 Tcl_Seek.3.* rm -f Tcl_Tell.3 Tcl_Tell.3.* rm -f Tcl_GetChannelOption.3 Tcl_GetChannelOption.3.* rm -f Tcl_SetChannelOption.3 Tcl_SetChannelOption.3.* rm -f Tcl_Eof.3 Tcl_Eof.3.* rm -f Tcl_InputBlocked.3 Tcl_InputBlocked.3.* rm -f Tcl_InputBuffered.3 Tcl_InputBuffered.3.* rm -f Tcl_OutputBuffered.3 Tcl_OutputBuffered.3.* rm -f Tcl_Ungets.3 Tcl_Ungets.3.* rm -f Tcl_ReadRaw.3 Tcl_ReadRaw.3.* rm -f Tcl_WriteRaw.3 Tcl_WriteRaw.3.* ln $S OpenFileChnl.3$Z Tcl_OpenFileChannel.3$Z ln $S OpenFileChnl.3$Z Tcl_OpenCommandChannel.3$Z ln $S OpenFileChnl.3$Z Tcl_MakeFileChannel.3$Z ln $S OpenFileChnl.3$Z Tcl_GetChannel.3$Z ln $S OpenFileChnl.3$Z Tcl_GetChannelNames.3$Z ln $S OpenFileChnl.3$Z Tcl_GetChannelNamesEx.3$Z ln $S OpenFileChnl.3$Z Tcl_RegisterChannel.3$Z ln $S OpenFileChnl.3$Z Tcl_UnregisterChannel.3$Z ln $S OpenFileChnl.3$Z Tcl_DetachChannel.3$Z ln $S OpenFileChnl.3$Z Tcl_IsStandardChannel.3$Z ln $S OpenFileChnl.3$Z Tcl_Close.3$Z ln $S OpenFileChnl.3$Z Tcl_ReadChars.3$Z ln $S OpenFileChnl.3$Z Tcl_Read.3$Z ln $S OpenFileChnl.3$Z Tcl_GetsObj.3$Z ln $S OpenFileChnl.3$Z Tcl_Gets.3$Z ln $S OpenFileChnl.3$Z Tcl_WriteObj.3$Z ln $S OpenFileChnl.3$Z Tcl_WriteChars.3$Z ln $S OpenFileChnl.3$Z Tcl_Write.3$Z ln $S OpenFileChnl.3$Z Tcl_Flush.3$Z ln $S OpenFileChnl.3$Z Tcl_Seek.3$Z ln $S OpenFileChnl.3$Z Tcl_Tell.3$Z ln $S OpenFileChnl.3$Z Tcl_GetChannelOption.3$Z ln $S OpenFileChnl.3$Z Tcl_SetChannelOption.3$Z ln $S OpenFileChnl.3$Z Tcl_Eof.3$Z ln $S OpenFileChnl.3$Z Tcl_InputBlocked.3$Z ln $S OpenFileChnl.3$Z Tcl_InputBuffered.3$Z ln $S OpenFileChnl.3$Z Tcl_OutputBuffered.3$Z ln $S OpenFileChnl.3$Z Tcl_Ungets.3$Z ln $S OpenFileChnl.3$Z Tcl_ReadRaw.3$Z ln $S OpenFileChnl.3$Z Tcl_WriteRaw.3$Z fi if test -r OpenTcp.3; then rm -f OpenTcp.3.* $ZIP OpenTcp.3 rm -f Tcl_OpenTcpClient.3 Tcl_OpenTcpClient.3.* rm -f Tcl_MakeTcpClientChannel.3 Tcl_MakeTcpClientChannel.3.* rm -f Tcl_OpenTcpServer.3 Tcl_OpenTcpServer.3.* ln $S OpenTcp.3$Z Tcl_OpenTcpClient.3$Z ln $S OpenTcp.3$Z Tcl_MakeTcpClientChannel.3$Z ln $S OpenTcp.3$Z Tcl_OpenTcpServer.3$Z fi if test -r Panic.3; then rm -f Panic.3.* $ZIP Panic.3 rm -f Tcl_Panic.3 Tcl_Panic.3.* rm -f Tcl_PanicVA.3 Tcl_PanicVA.3.* rm -f Tcl_SetPanicProc.3 Tcl_SetPanicProc.3.* if test "${CASEINSENSITIVEFS:-}" != "1"; then rm -f panic.3 panic.3.* ; fi rm -f panicVA.3 panicVA.3.* ln $S Panic.3$Z Tcl_Panic.3$Z ln $S Panic.3$Z Tcl_PanicVA.3$Z ln $S Panic.3$Z Tcl_SetPanicProc.3$Z if test "${CASEINSENSITIVEFS:-}" != "1"; then ln $S Panic.3$Z panic.3$Z ; fi ln $S Panic.3$Z panicVA.3$Z fi if test -r ParseCmd.3; then rm -f ParseCmd.3.* $ZIP ParseCmd.3 rm -f Tcl_ParseCommand.3 Tcl_ParseCommand.3.* rm -f Tcl_ParseExpr.3 Tcl_ParseExpr.3.* rm -f Tcl_ParseBraces.3 Tcl_ParseBraces.3.* rm -f Tcl_ParseQuotedString.3 Tcl_ParseQuotedString.3.* rm -f Tcl_ParseVarName.3 Tcl_ParseVarName.3.* rm -f Tcl_ParseVar.3 Tcl_ParseVar.3.* rm -f Tcl_FreeParse.3 Tcl_FreeParse.3.* rm -f Tcl_EvalTokens.3 Tcl_EvalTokens.3.* rm -f Tcl_EvalTokensStandard.3 Tcl_EvalTokensStandard.3.* ln $S ParseCmd.3$Z Tcl_ParseCommand.3$Z ln $S ParseCmd.3$Z Tcl_ParseExpr.3$Z ln $S ParseCmd.3$Z Tcl_ParseBraces.3$Z ln $S ParseCmd.3$Z Tcl_ParseQuotedString.3$Z ln $S ParseCmd.3$Z Tcl_ParseVarName.3$Z ln $S ParseCmd.3$Z Tcl_ParseVar.3$Z ln $S ParseCmd.3$Z Tcl_FreeParse.3$Z ln $S ParseCmd.3$Z Tcl_EvalTokens.3$Z ln $S ParseCmd.3$Z Tcl_EvalTokensStandard.3$Z fi if test -r PkgRequire.3; then rm -f PkgRequire.3.* $ZIP PkgRequire.3 rm -f Tcl_PkgRequire.3 Tcl_PkgRequire.3.* rm -f Tcl_PkgRequireEx.3 Tcl_PkgRequireEx.3.* rm -f Tcl_PkgPresent.3 Tcl_PkgPresent.3.* rm -f Tcl_PkgPresentEx.3 Tcl_PkgPresentEx.3.* rm -f Tcl_PkgProvide.3 Tcl_PkgProvide.3.* rm -f Tcl_PkgProvideEx.3 Tcl_PkgProvideEx.3.* ln $S PkgRequire.3$Z Tcl_PkgRequire.3$Z ln $S PkgRequire.3$Z Tcl_PkgRequireEx.3$Z ln $S PkgRequire.3$Z Tcl_PkgPresent.3$Z ln $S PkgRequire.3$Z Tcl_PkgPresentEx.3$Z ln $S PkgRequire.3$Z Tcl_PkgProvide.3$Z ln $S PkgRequire.3$Z Tcl_PkgProvideEx.3$Z fi if test -r Preserve.3; then rm -f Preserve.3.* $ZIP Preserve.3 rm -f Tcl_Preserve.3 Tcl_Preserve.3.* rm -f Tcl_Release.3 Tcl_Release.3.* rm -f Tcl_EventuallyFree.3 Tcl_EventuallyFree.3.* ln $S Preserve.3$Z Tcl_Preserve.3$Z ln $S Preserve.3$Z Tcl_Release.3$Z ln $S Preserve.3$Z Tcl_EventuallyFree.3$Z fi if test -r PrintDbl.3; then rm -f PrintDbl.3.* $ZIP PrintDbl.3 rm -f Tcl_PrintDouble.3 Tcl_PrintDouble.3.* ln $S PrintDbl.3$Z Tcl_PrintDouble.3$Z fi if test -r RecEvalObj.3; then rm -f RecEvalObj.3.* $ZIP RecEvalObj.3 rm -f Tcl_RecordAndEvalObj.3 Tcl_RecordAndEvalObj.3.* ln $S RecEvalObj.3$Z Tcl_RecordAndEvalObj.3$Z fi if test -r RecordEval.3; then rm -f RecordEval.3.* $ZIP RecordEval.3 rm -f Tcl_RecordAndEval.3 Tcl_RecordAndEval.3.* ln $S RecordEval.3$Z Tcl_RecordAndEval.3$Z fi if test -r RegExp.3; then rm -f RegExp.3.* $ZIP RegExp.3 rm -f Tcl_RegExpMatch.3 Tcl_RegExpMatch.3.* rm -f Tcl_RegExpCompile.3 Tcl_RegExpCompile.3.* rm -f Tcl_RegExpExec.3 Tcl_RegExpExec.3.* rm -f Tcl_RegExpRange.3 Tcl_RegExpRange.3.* rm -f Tcl_GetRegExpFromObj.3 Tcl_GetRegExpFromObj.3.* rm -f Tcl_RegExpMatchObj.3 Tcl_RegExpMatchObj.3.* rm -f Tcl_RegExpExecObj.3 Tcl_RegExpExecObj.3.* rm -f Tcl_RegExpGetInfo.3 Tcl_RegExpGetInfo.3.* ln $S RegExp.3$Z Tcl_RegExpMatch.3$Z ln $S RegExp.3$Z Tcl_RegExpCompile.3$Z ln $S RegExp.3$Z Tcl_RegExpExec.3$Z ln $S RegExp.3$Z Tcl_RegExpRange.3$Z ln $S RegExp.3$Z Tcl_GetRegExpFromObj.3$Z ln $S RegExp.3$Z Tcl_RegExpMatchObj.3$Z ln $S RegExp.3$Z Tcl_RegExpExecObj.3$Z ln $S RegExp.3$Z Tcl_RegExpGetInfo.3$Z fi if test -r SaveResult.3; then rm -f SaveResult.3.* $ZIP SaveResult.3 rm -f Tcl_SaveResult.3 Tcl_SaveResult.3.* rm -f Tcl_RestoreResult.3 Tcl_RestoreResult.3.* rm -f Tcl_DiscardResult.3 Tcl_DiscardResult.3.* ln $S SaveResult.3$Z Tcl_SaveResult.3$Z ln $S SaveResult.3$Z Tcl_RestoreResult.3$Z ln $S SaveResult.3$Z Tcl_DiscardResult.3$Z fi if test -r SetErrno.3; then rm -f SetErrno.3.* $ZIP SetErrno.3 rm -f Tcl_SetErrno.3 Tcl_SetErrno.3.* rm -f Tcl_GetErrno.3 Tcl_GetErrno.3.* rm -f Tcl_ErrnoId.3 Tcl_ErrnoId.3.* rm -f Tcl_ErrnoMsg.3 Tcl_ErrnoMsg.3.* ln $S SetErrno.3$Z Tcl_SetErrno.3$Z ln $S SetErrno.3$Z Tcl_GetErrno.3$Z ln $S SetErrno.3$Z Tcl_ErrnoId.3$Z ln $S SetErrno.3$Z Tcl_ErrnoMsg.3$Z fi if test -r SetRecLmt.3; then rm -f SetRecLmt.3.* $ZIP SetRecLmt.3 rm -f Tcl_SetRecursionLimit.3 Tcl_SetRecursionLimit.3.* ln $S SetRecLmt.3$Z Tcl_SetRecursionLimit.3$Z fi if test -r SetResult.3; then rm -f SetResult.3.* $ZIP SetResult.3 rm -f Tcl_SetObjResult.3 Tcl_SetObjResult.3.* rm -f Tcl_GetObjResult.3 Tcl_GetObjResult.3.* rm -f Tcl_SetResult.3 Tcl_SetResult.3.* rm -f Tcl_GetStringResult.3 Tcl_GetStringResult.3.* rm -f Tcl_AppendResult.3 Tcl_AppendResult.3.* rm -f Tcl_AppendResultVA.3 Tcl_AppendResultVA.3.* rm -f Tcl_AppendElement.3 Tcl_AppendElement.3.* rm -f Tcl_ResetResult.3 Tcl_ResetResult.3.* rm -f Tcl_FreeResult.3 Tcl_FreeResult.3.* ln $S SetResult.3$Z Tcl_SetObjResult.3$Z ln $S SetResult.3$Z Tcl_GetObjResult.3$Z ln $S SetResult.3$Z Tcl_SetResult.3$Z ln $S SetResult.3$Z Tcl_GetStringResult.3$Z ln $S SetResult.3$Z Tcl_AppendResult.3$Z ln $S SetResult.3$Z Tcl_AppendResultVA.3$Z ln $S SetResult.3$Z Tcl_AppendElement.3$Z ln $S SetResult.3$Z Tcl_ResetResult.3$Z ln $S SetResult.3$Z Tcl_FreeResult.3$Z fi if test -r SetVar.3; then rm -f SetVar.3.* $ZIP SetVar.3 rm -f Tcl_SetVar2Ex.3 Tcl_SetVar2Ex.3.* rm -f Tcl_SetVar.3 Tcl_SetVar.3.* rm -f Tcl_SetVar2.3 Tcl_SetVar2.3.* rm -f Tcl_ObjSetVar2.3 Tcl_ObjSetVar2.3.* rm -f Tcl_GetVar2Ex.3 Tcl_GetVar2Ex.3.* rm -f Tcl_GetVar.3 Tcl_GetVar.3.* rm -f Tcl_GetVar2.3 Tcl_GetVar2.3.* rm -f Tcl_ObjGetVar2.3 Tcl_ObjGetVar2.3.* rm -f Tcl_UnsetVar.3 Tcl_UnsetVar.3.* rm -f Tcl_UnsetVar2.3 Tcl_UnsetVar2.3.* ln $S SetVar.3$Z Tcl_SetVar2Ex.3$Z ln $S SetVar.3$Z Tcl_SetVar.3$Z ln $S SetVar.3$Z Tcl_SetVar2.3$Z ln $S SetVar.3$Z Tcl_ObjSetVar2.3$Z ln $S SetVar.3$Z Tcl_GetVar2Ex.3$Z ln $S SetVar.3$Z Tcl_GetVar.3$Z ln $S SetVar.3$Z Tcl_GetVar2.3$Z ln $S SetVar.3$Z Tcl_ObjGetVar2.3$Z ln $S SetVar.3$Z Tcl_UnsetVar.3$Z ln $S SetVar.3$Z Tcl_UnsetVar2.3$Z fi if test -r Signal.3; then rm -f Signal.3.* $ZIP Signal.3 rm -f Tcl_SignalId.3 Tcl_SignalId.3.* rm -f Tcl_SignalMsg.3 Tcl_SignalMsg.3.* ln $S Signal.3$Z Tcl_SignalId.3$Z ln $S Signal.3$Z Tcl_SignalMsg.3$Z fi if test -r Sleep.3; then rm -f Sleep.3.* $ZIP Sleep.3 rm -f Tcl_Sleep.3 Tcl_Sleep.3.* ln $S Sleep.3$Z Tcl_Sleep.3$Z fi if test -r SourceRCFile.3; then rm -f SourceRCFile.3.* $ZIP SourceRCFile.3 rm -f Tcl_SourceRCFile.3 Tcl_SourceRCFile.3.* ln $S SourceRCFile.3$Z Tcl_SourceRCFile.3$Z fi if test -r SplitList.3; then rm -f SplitList.3.* $ZIP SplitList.3 rm -f Tcl_SplitList.3 Tcl_SplitList.3.* rm -f Tcl_Merge.3 Tcl_Merge.3.* rm -f Tcl_ScanElement.3 Tcl_ScanElement.3.* rm -f Tcl_ConvertElement.3 Tcl_ConvertElement.3.* rm -f Tcl_ScanCountedElement.3 Tcl_ScanCountedElement.3.* rm -f Tcl_ConvertCountedElement.3 Tcl_ConvertCountedElement.3.* ln $S SplitList.3$Z Tcl_SplitList.3$Z ln $S SplitList.3$Z Tcl_Merge.3$Z ln $S SplitList.3$Z Tcl_ScanElement.3$Z ln $S SplitList.3$Z Tcl_ConvertElement.3$Z ln $S SplitList.3$Z Tcl_ScanCountedElement.3$Z ln $S SplitList.3$Z Tcl_ConvertCountedElement.3$Z fi if test -r SplitPath.3; then rm -f SplitPath.3.* $ZIP SplitPath.3 rm -f Tcl_SplitPath.3 Tcl_SplitPath.3.* rm -f Tcl_JoinPath.3 Tcl_JoinPath.3.* rm -f Tcl_GetPathType.3 Tcl_GetPathType.3.* ln $S SplitPath.3$Z Tcl_SplitPath.3$Z ln $S SplitPath.3$Z Tcl_JoinPath.3$Z ln $S SplitPath.3$Z Tcl_GetPathType.3$Z fi if test -r StaticPkg.3; then rm -f StaticPkg.3.* $ZIP StaticPkg.3 rm -f Tcl_StaticPackage.3 Tcl_StaticPackage.3.* ln $S StaticPkg.3$Z Tcl_StaticPackage.3$Z fi if test -r StdChannels.3; then rm -f StdChannels.3.* $ZIP StdChannels.3 rm -f Tcl_StandardChannels.3 Tcl_StandardChannels.3.* ln $S StdChannels.3$Z Tcl_StandardChannels.3$Z fi if test -r StrMatch.3; then rm -f StrMatch.3.* $ZIP StrMatch.3 rm -f Tcl_StringMatch.3 Tcl_StringMatch.3.* rm -f Tcl_StringCaseMatch.3 Tcl_StringCaseMatch.3.* ln $S StrMatch.3$Z Tcl_StringMatch.3$Z ln $S StrMatch.3$Z Tcl_StringCaseMatch.3$Z fi if test -r StringObj.3; then rm -f StringObj.3.* $ZIP StringObj.3 rm -f Tcl_NewStringObj.3 Tcl_NewStringObj.3.* rm -f Tcl_NewUnicodeObj.3 Tcl_NewUnicodeObj.3.* rm -f Tcl_SetStringObj.3 Tcl_SetStringObj.3.* rm -f Tcl_SetUnicodeObj.3 Tcl_SetUnicodeObj.3.* rm -f Tcl_GetStringFromObj.3 Tcl_GetStringFromObj.3.* rm -f Tcl_GetString.3 Tcl_GetString.3.* rm -f Tcl_GetUnicodeFromObj.3 Tcl_GetUnicodeFromObj.3.* rm -f Tcl_GetUnicode.3 Tcl_GetUnicode.3.* rm -f Tcl_GetUniChar.3 Tcl_GetUniChar.3.* rm -f Tcl_GetCharLength.3 Tcl_GetCharLength.3.* rm -f Tcl_GetRange.3 Tcl_GetRange.3.* rm -f Tcl_AppendToObj.3 Tcl_AppendToObj.3.* rm -f Tcl_AppendUnicodeToObj.3 Tcl_AppendUnicodeToObj.3.* rm -f Tcl_AppendStringsToObj.3 Tcl_AppendStringsToObj.3.* rm -f Tcl_AppendStringsToObjVA.3 Tcl_AppendStringsToObjVA.3.* rm -f Tcl_AppendObjToObj.3 Tcl_AppendObjToObj.3.* rm -f Tcl_SetObjLength.3 Tcl_SetObjLength.3.* rm -f Tcl_ConcatObj.3 Tcl_ConcatObj.3.* rm -f Tcl_AttemptSetObjLength.3 Tcl_AttemptSetObjLength.3.* ln $S StringObj.3$Z Tcl_NewStringObj.3$Z ln $S StringObj.3$Z Tcl_NewUnicodeObj.3$Z ln $S StringObj.3$Z Tcl_SetStringObj.3$Z ln $S StringObj.3$Z Tcl_SetUnicodeObj.3$Z ln $S StringObj.3$Z Tcl_GetStringFromObj.3$Z ln $S StringObj.3$Z Tcl_GetString.3$Z ln $S StringObj.3$Z Tcl_GetUnicodeFromObj.3$Z ln $S StringObj.3$Z Tcl_GetUnicode.3$Z ln $S StringObj.3$Z Tcl_GetUniChar.3$Z ln $S StringObj.3$Z Tcl_GetCharLength.3$Z ln $S StringObj.3$Z Tcl_GetRange.3$Z ln $S StringObj.3$Z Tcl_AppendToObj.3$Z ln $S StringObj.3$Z Tcl_AppendUnicodeToObj.3$Z ln $S StringObj.3$Z Tcl_AppendStringsToObj.3$Z ln $S StringObj.3$Z Tcl_AppendStringsToObjVA.3$Z ln $S StringObj.3$Z Tcl_AppendObjToObj.3$Z ln $S StringObj.3$Z Tcl_SetObjLength.3$Z ln $S StringObj.3$Z Tcl_ConcatObj.3$Z ln $S StringObj.3$Z Tcl_AttemptSetObjLength.3$Z fi if test -r SubstObj.3; then rm -f SubstObj.3.* $ZIP SubstObj.3 rm -f Tcl_SubstObj.3 Tcl_SubstObj.3.* ln $S SubstObj.3$Z Tcl_SubstObj.3$Z fi if test -r TCL_MEM_DEBUG.3; then rm -f TCL_MEM_DEBUG.3.* $ZIP TCL_MEM_DEBUG.3 fi if test -r Tcl.n; then rm -f Tcl.n.* $ZIP Tcl.n fi if test -r Tcl_Main.3; then rm -f Tcl_Main.3.* $ZIP Tcl_Main.3 rm -f Tcl_SetMainLoop.3 Tcl_SetMainLoop.3.* ln $S Tcl_Main.3$Z Tcl_SetMainLoop.3$Z fi if test -r Thread.3; then rm -f Thread.3.* $ZIP Thread.3 rm -f Tcl_ConditionNotify.3 Tcl_ConditionNotify.3.* rm -f Tcl_ConditionWait.3 Tcl_ConditionWait.3.* rm -f Tcl_ConditionFinalize.3 Tcl_ConditionFinalize.3.* rm -f Tcl_GetThreadData.3 Tcl_GetThreadData.3.* rm -f Tcl_MutexLock.3 Tcl_MutexLock.3.* rm -f Tcl_MutexUnlock.3 Tcl_MutexUnlock.3.* rm -f Tcl_MutexFinalize.3 Tcl_MutexFinalize.3.* rm -f Tcl_CreateThread.3 Tcl_CreateThread.3.* rm -f Tcl_JoinThread.3 Tcl_JoinThread.3.* ln $S Thread.3$Z Tcl_ConditionNotify.3$Z ln $S Thread.3$Z Tcl_ConditionWait.3$Z ln $S Thread.3$Z Tcl_ConditionFinalize.3$Z ln $S Thread.3$Z Tcl_GetThreadData.3$Z ln $S Thread.3$Z Tcl_MutexLock.3$Z ln $S Thread.3$Z Tcl_MutexUnlock.3$Z ln $S Thread.3$Z Tcl_MutexFinalize.3$Z ln $S Thread.3$Z Tcl_CreateThread.3$Z ln $S Thread.3$Z Tcl_JoinThread.3$Z fi if test -r ToUpper.3; then rm -f ToUpper.3.* $ZIP ToUpper.3 rm -f Tcl_UniCharToUpper.3 Tcl_UniCharToUpper.3.* rm -f Tcl_UniCharToLower.3 Tcl_UniCharToLower.3.* rm -f Tcl_UniCharToTitle.3 Tcl_UniCharToTitle.3.* rm -f Tcl_UtfToUpper.3 Tcl_UtfToUpper.3.* rm -f Tcl_UtfToLower.3 Tcl_UtfToLower.3.* rm -f Tcl_UtfToTitle.3 Tcl_UtfToTitle.3.* ln $S ToUpper.3$Z Tcl_UniCharToUpper.3$Z ln $S ToUpper.3$Z Tcl_UniCharToLower.3$Z ln $S ToUpper.3$Z Tcl_UniCharToTitle.3$Z ln $S ToUpper.3$Z Tcl_UtfToUpper.3$Z ln $S ToUpper.3$Z Tcl_UtfToLower.3$Z ln $S ToUpper.3$Z Tcl_UtfToTitle.3$Z fi if test -r TraceCmd.3; then rm -f TraceCmd.3.* $ZIP TraceCmd.3 rm -f Tcl_CommandTraceInfo.3 Tcl_CommandTraceInfo.3.* rm -f Tcl_TraceCommand.3 Tcl_TraceCommand.3.* rm -f Tcl_UntraceCommand.3 Tcl_UntraceCommand.3.* ln $S TraceCmd.3$Z Tcl_CommandTraceInfo.3$Z ln $S TraceCmd.3$Z Tcl_TraceCommand.3$Z ln $S TraceCmd.3$Z Tcl_UntraceCommand.3$Z fi if test -r TraceVar.3; then rm -f TraceVar.3.* $ZIP TraceVar.3 rm -f Tcl_TraceVar.3 Tcl_TraceVar.3.* rm -f Tcl_TraceVar2.3 Tcl_TraceVar2.3.* rm -f Tcl_UntraceVar.3 Tcl_UntraceVar.3.* rm -f Tcl_UntraceVar2.3 Tcl_UntraceVar2.3.* rm -f Tcl_VarTraceInfo.3 Tcl_VarTraceInfo.3.* rm -f Tcl_VarTraceInfo2.3 Tcl_VarTraceInfo2.3.* ln $S TraceVar.3$Z Tcl_TraceVar.3$Z ln $S TraceVar.3$Z Tcl_TraceVar2.3$Z ln $S TraceVar.3$Z Tcl_UntraceVar.3$Z ln $S TraceVar.3$Z Tcl_UntraceVar2.3$Z ln $S TraceVar.3$Z Tcl_VarTraceInfo.3$Z ln $S TraceVar.3$Z Tcl_VarTraceInfo2.3$Z fi if test -r Translate.3; then rm -f Translate.3.* $ZIP Translate.3 rm -f Tcl_TranslateFileName.3 Tcl_TranslateFileName.3.* ln $S Translate.3$Z Tcl_TranslateFileName.3$Z fi if test -r UniCharIsAlpha.3; then rm -f UniCharIsAlpha.3.* $ZIP UniCharIsAlpha.3 rm -f Tcl_UniCharIsAlnum.3 Tcl_UniCharIsAlnum.3.* rm -f Tcl_UniCharIsAlpha.3 Tcl_UniCharIsAlpha.3.* rm -f Tcl_UniCharIsControl.3 Tcl_UniCharIsControl.3.* rm -f Tcl_UniCharIsDigit.3 Tcl_UniCharIsDigit.3.* rm -f Tcl_UniCharIsGraph.3 Tcl_UniCharIsGraph.3.* rm -f Tcl_UniCharIsLower.3 Tcl_UniCharIsLower.3.* rm -f Tcl_UniCharIsPrint.3 Tcl_UniCharIsPrint.3.* rm -f Tcl_UniCharIsPunct.3 Tcl_UniCharIsPunct.3.* rm -f Tcl_UniCharIsSpace.3 Tcl_UniCharIsSpace.3.* rm -f Tcl_UniCharIsUpper.3 Tcl_UniCharIsUpper.3.* rm -f Tcl_UniCharIsWordChar.3 Tcl_UniCharIsWordChar.3.* ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsAlnum.3$Z ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsAlpha.3$Z ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsControl.3$Z ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsDigit.3$Z ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsGraph.3$Z ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsLower.3$Z ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsPrint.3$Z ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsPunct.3$Z ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsSpace.3$Z ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsUpper.3$Z ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsWordChar.3$Z fi if test -r UpVar.3; then rm -f UpVar.3.* $ZIP UpVar.3 rm -f Tcl_UpVar.3 Tcl_UpVar.3.* rm -f Tcl_UpVar2.3 Tcl_UpVar2.3.* ln $S UpVar.3$Z Tcl_UpVar.3$Z ln $S UpVar.3$Z Tcl_UpVar2.3$Z fi if test -r Utf.3; then rm -f Utf.3.* $ZIP Utf.3 rm -f Tcl_UniChar.3 Tcl_UniChar.3.* rm -f Tcl_UniCharCaseMatch.3 Tcl_UniCharCaseMatch.3.* rm -f Tcl_UniCharNcasecmp.3 Tcl_UniCharNcasecmp.3.* rm -f Tcl_UniCharToUtf.3 Tcl_UniCharToUtf.3.* rm -f Tcl_UtfToUniChar.3 Tcl_UtfToUniChar.3.* rm -f Tcl_UniCharToUtfDString.3 Tcl_UniCharToUtfDString.3.* rm -f Tcl_UtfToUniCharDString.3 Tcl_UtfToUniCharDString.3.* rm -f Tcl_UniCharLen.3 Tcl_UniCharLen.3.* rm -f Tcl_UniCharNcmp.3 Tcl_UniCharNcmp.3.* rm -f Tcl_UtfCharComplete.3 Tcl_UtfCharComplete.3.* rm -f Tcl_NumUtfChars.3 Tcl_NumUtfChars.3.* rm -f Tcl_UtfFindFirst.3 Tcl_UtfFindFirst.3.* rm -f Tcl_UtfFindLast.3 Tcl_UtfFindLast.3.* rm -f Tcl_UtfNext.3 Tcl_UtfNext.3.* rm -f Tcl_UtfPrev.3 Tcl_UtfPrev.3.* rm -f Tcl_UniCharAtIndex.3 Tcl_UniCharAtIndex.3.* rm -f Tcl_UtfAtIndex.3 Tcl_UtfAtIndex.3.* rm -f Tcl_UtfBackslash.3 Tcl_UtfBackslash.3.* ln $S Utf.3$Z Tcl_UniChar.3$Z ln $S Utf.3$Z Tcl_UniCharCaseMatch.3$Z ln $S Utf.3$Z Tcl_UniCharNcasecmp.3$Z ln $S Utf.3$Z Tcl_UniCharToUtf.3$Z ln $S Utf.3$Z Tcl_UtfToUniChar.3$Z ln $S Utf.3$Z Tcl_UniCharToUtfDString.3$Z ln $S Utf.3$Z Tcl_UtfToUniCharDString.3$Z ln $S Utf.3$Z Tcl_UniCharLen.3$Z ln $S Utf.3$Z Tcl_UniCharNcmp.3$Z ln $S Utf.3$Z Tcl_UtfCharComplete.3$Z ln $S Utf.3$Z Tcl_NumUtfChars.3$Z ln $S Utf.3$Z Tcl_UtfFindFirst.3$Z ln $S Utf.3$Z Tcl_UtfFindLast.3$Z ln $S Utf.3$Z Tcl_UtfNext.3$Z ln $S Utf.3$Z Tcl_UtfPrev.3$Z ln $S Utf.3$Z Tcl_UniCharAtIndex.3$Z ln $S Utf.3$Z Tcl_UtfAtIndex.3$Z ln $S Utf.3$Z Tcl_UtfBackslash.3$Z fi if test -r WrongNumArgs.3; then rm -f WrongNumArgs.3.* $ZIP WrongNumArgs.3 rm -f Tcl_WrongNumArgs.3 Tcl_WrongNumArgs.3.* ln $S WrongNumArgs.3$Z Tcl_WrongNumArgs.3$Z fi if test -r after.n; then rm -f after.n.* $ZIP after.n fi if test -r append.n; then rm -f append.n.* $ZIP append.n fi if test -r array.n; then rm -f array.n.* $ZIP array.n fi if test -r bgerror.n; then rm -f bgerror.n.* $ZIP bgerror.n fi if test -r binary.n; then rm -f binary.n.* $ZIP binary.n fi if test -r break.n; then rm -f break.n.* $ZIP break.n fi if test -r case.n; then rm -f case.n.* $ZIP case.n fi if test -r catch.n; then rm -f catch.n.* $ZIP catch.n fi if test -r cd.n; then rm -f cd.n.* $ZIP cd.n fi if test -r clock.n; then rm -f clock.n.* $ZIP clock.n fi if test -r close.n; then rm -f close.n.* $ZIP close.n fi if test -r concat.n; then rm -f concat.n.* $ZIP concat.n fi if test -r continue.n; then rm -f continue.n.* $ZIP continue.n fi if test -r dde.n; then rm -f dde.n.* $ZIP dde.n fi if test -r encoding.n; then rm -f encoding.n.* $ZIP encoding.n fi if test -r eof.n; then rm -f eof.n.* $ZIP eof.n fi if test -r error.n; then rm -f error.n.* $ZIP error.n fi if test -r eval.n; then rm -f eval.n.* $ZIP eval.n fi if test -r exec.n; then rm -f exec.n.* $ZIP exec.n fi if test -r exit.n; then rm -f exit.n.* $ZIP exit.n fi if test -r expr.n; then rm -f expr.n.* $ZIP expr.n fi if test -r fblocked.n; then rm -f fblocked.n.* $ZIP fblocked.n fi if test -r fconfigure.n; then rm -f fconfigure.n.* $ZIP fconfigure.n fi if test -r fcopy.n; then rm -f fcopy.n.* $ZIP fcopy.n fi if test -r file.n; then rm -f file.n.* $ZIP file.n fi if test -r fileevent.n; then rm -f fileevent.n.* $ZIP fileevent.n fi if test -r filename.n; then rm -f filename.n.* $ZIP filename.n fi if test -r flush.n; then rm -f flush.n.* $ZIP flush.n fi if test -r for.n; then rm -f for.n.* $ZIP for.n fi if test -r foreach.n; then rm -f foreach.n.* $ZIP foreach.n fi if test -r format.n; then rm -f format.n.* $ZIP format.n fi if test -r gets.n; then rm -f gets.n.* $ZIP gets.n fi if test -r glob.n; then rm -f glob.n.* $ZIP glob.n fi if test -r global.n; then rm -f global.n.* $ZIP global.n fi if test -r history.n; then rm -f history.n.* $ZIP history.n fi if test -r http.n; then rm -f http.n.* $ZIP http.n fi if test -r if.n; then rm -f if.n.* $ZIP if.n fi if test -r incr.n; then rm -f incr.n.* $ZIP incr.n fi if test -r info.n; then rm -f info.n.* $ZIP info.n fi if test -r interp.n; then rm -f interp.n.* $ZIP interp.n fi if test -r join.n; then rm -f join.n.* $ZIP join.n fi if test -r lappend.n; then rm -f lappend.n.* $ZIP lappend.n fi if test -r library.n; then rm -f library.n.* $ZIP library.n rm -f auto_execok.n auto_execok.n.* rm -f auto_import.n auto_import.n.* rm -f auto_load.n auto_load.n.* rm -f auto_mkindex.n auto_mkindex.n.* rm -f auto_mkindex_old.n auto_mkindex_old.n.* rm -f auto_qualify.n auto_qualify.n.* rm -f auto_reset.n auto_reset.n.* rm -f tcl_findLibrary.n tcl_findLibrary.n.* rm -f parray.n parray.n.* rm -f tcl_endOfWord.n tcl_endOfWord.n.* rm -f tcl_startOfNextWord.n tcl_startOfNextWord.n.* rm -f tcl_startOfPreviousWord.n tcl_startOfPreviousWord.n.* rm -f tcl_wordBreakAfter.n tcl_wordBreakAfter.n.* rm -f tcl_wordBreakBefore.n tcl_wordBreakBefore.n.* ln $S library.n$Z auto_execok.n$Z ln $S library.n$Z auto_import.n$Z ln $S library.n$Z auto_load.n$Z ln $S library.n$Z auto_mkindex.n$Z ln $S library.n$Z auto_mkindex_old.n$Z ln $S library.n$Z auto_qualify.n$Z ln $S library.n$Z auto_reset.n$Z ln $S library.n$Z tcl_findLibrary.n$Z ln $S library.n$Z parray.n$Z ln $S library.n$Z tcl_endOfWord.n$Z ln $S library.n$Z tcl_startOfNextWord.n$Z ln $S library.n$Z tcl_startOfPreviousWord.n$Z ln $S library.n$Z tcl_wordBreakAfter.n$Z ln $S library.n$Z tcl_wordBreakBefore.n$Z fi if test -r lindex.n; then rm -f lindex.n.* $ZIP lindex.n fi if test -r linsert.n; then rm -f linsert.n.* $ZIP linsert.n fi if test -r list.n; then rm -f list.n.* $ZIP list.n fi if test -r llength.n; then rm -f llength.n.* $ZIP llength.n fi if test -r load.n; then rm -f load.n.* $ZIP load.n fi if test -r lrange.n; then rm -f lrange.n.* $ZIP lrange.n fi if test -r lreplace.n; then rm -f lreplace.n.* $ZIP lreplace.n fi if test -r lsearch.n; then rm -f lsearch.n.* $ZIP lsearch.n fi if test -r lset.n; then rm -f lset.n.* $ZIP lset.n fi if test -r lsort.n; then rm -f lsort.n.* $ZIP lsort.n fi if test -r memory.n; then rm -f memory.n.* $ZIP memory.n fi if test -r msgcat.n; then rm -f msgcat.n.* $ZIP msgcat.n fi if test -r namespace.n; then rm -f namespace.n.* $ZIP namespace.n fi if test -r open.n; then rm -f open.n.* $ZIP open.n fi if test -r package.n; then rm -f package.n.* $ZIP package.n fi if test -r packagens.n; then rm -f packagens.n.* $ZIP packagens.n rm -f pkg::create.n pkg::create.n.* ln $S packagens.n$Z pkg::create.n$Z fi if test -r pid.n; then rm -f pid.n.* $ZIP pid.n fi if test -r pkgMkIndex.n; then rm -f pkgMkIndex.n.* $ZIP pkgMkIndex.n rm -f pkg_mkIndex.n pkg_mkIndex.n.* ln $S pkgMkIndex.n$Z pkg_mkIndex.n$Z fi if test -r proc.n; then rm -f proc.n.* $ZIP proc.n fi if test -r puts.n; then rm -f puts.n.* $ZIP puts.n fi if test -r pwd.n; then rm -f pwd.n.* $ZIP pwd.n fi if test -r re_syntax.n; then rm -f re_syntax.n.* $ZIP re_syntax.n fi if test -r read.n; then rm -f read.n.* $ZIP read.n fi if test -r regexp.n; then rm -f regexp.n.* $ZIP regexp.n fi if test -r registry.n; then rm -f registry.n.* $ZIP registry.n fi if test -r regsub.n; then rm -f regsub.n.* $ZIP regsub.n fi if test -r rename.n; then rm -f rename.n.* $ZIP rename.n fi if test -r resource.n; then rm -f resource.n.* $ZIP resource.n fi if test -r return.n; then rm -f return.n.* $ZIP return.n fi if test -r safe.n; then rm -f safe.n.* $ZIP safe.n rm -f SafeBase.n SafeBase.n.* ln $S safe.n$Z SafeBase.n$Z fi if test -r scan.n; then rm -f scan.n.* $ZIP scan.n fi if test -r seek.n; then rm -f seek.n.* $ZIP seek.n fi if test -r set.n; then rm -f set.n.* $ZIP set.n fi if test -r socket.n; then rm -f socket.n.* $ZIP socket.n fi if test -r source.n; then rm -f source.n.* $ZIP source.n fi if test -r split.n; then rm -f split.n.* $ZIP split.n fi if test -r string.n; then rm -f string.n.* $ZIP string.n fi if test -r subst.n; then rm -f subst.n.* $ZIP subst.n fi if test -r switch.n; then rm -f switch.n.* $ZIP switch.n fi if test -r tclsh.1; then rm -f tclsh.1.* $ZIP tclsh.1 fi if test -r tcltest.n; then rm -f tcltest.n.* $ZIP tcltest.n fi if test -r tclvars.n; then rm -f tclvars.n.* $ZIP tclvars.n fi if test -r tell.n; then rm -f tell.n.* $ZIP tell.n fi if test -r time.n; then rm -f time.n.* $ZIP time.n fi if test -r trace.n; then rm -f trace.n.* $ZIP trace.n fi if test -r unknown.n; then rm -f unknown.n.* $ZIP unknown.n fi if test -r unset.n; then rm -f unset.n.* $ZIP unset.n fi if test -r update.n; then rm -f update.n.* $ZIP update.n fi if test -r uplevel.n; then rm -f uplevel.n.* $ZIP uplevel.n fi if test -r upvar.n; then rm -f upvar.n.* $ZIP upvar.n fi if test -r variable.n; then rm -f variable.n.* $ZIP variable.n fi if test -r vwait.n; then rm -f vwait.n.* $ZIP vwait.n fi if test -r while.n; then rm -f while.n.* $ZIP while.n fi exit 0

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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

#!/bin/sh # mkLinks.tcl -- # This generates the mkLinks script # \ exec tclsh "$0" ${1+"$@"} puts stdout \ {#!/bin/sh # This script is invoked when installing manual entries. It generates # additional links to manual entries, corresponding to the procedure # and command names described by the manual entry. For example, the # Tcl manual entry Hash.3 describes procedures Tcl_InitHashTable, # Tcl_CreateHashEntry, and many more. This script will make hard # links so that Tcl_InitHashTable.3, Tcl_CreateHashEntry.3, and so # on all refer to Hash.3 in the installed directory. # # Because of the length of command and procedure names, this mechanism # only works on machines that support file names longer than 14 characters. # This script checks to see if long file names are supported, and it # doesn't make any links if they are not. # # The script takes one argument, which is the name of the directory # where the manual entries have been installed. ZIP=true while true; do case $1 in -s | --symlinks ) S=-s ;; -z | --compress ) ZIP=$2 shift ;; *) break ;; esac shift done if test $# != 1; then echo "Usage: mkLinks <options> dir" exit 1 fi if test "x$ZIP" != "xtrue"; then touch TeST $ZIP TeST Z=`ls TeST* | sed 's/^[^.]*//'` rm -f TeST* fi cd $1 echo foo > xyzzyTestingAVeryLongFileName.foo x=`echo xyzzyTe*` echo foo > xyzzyTestingaverylongfilename.foo y=`echo xyzzyTestingav*` rm xyzzyTe* if test "$x" != "xyzzyTestingAVeryLongFileName.foo"; then exit fi if test "$y" != "xyzzyTestingaverylongfilename.foo"; then CASEINSENSITIVEFS=1 fi } set case_insensitive_test { if test "${CASEINSENSITIVEFS:-}" != "1"; then} set case_insensitive_test_fi {; fi} foreach file $argv { set in [open $file] set tail [file tail $file] set ext [file extension $file] set state begin while {[gets $in line] >= 0} { switch $state { begin { if {[regexp "^.SH NAME" $line]} { set state name } } name { regsub {\\-.*} $line {} line set rmOutput "" set lnOutput "" set namelist {} foreach name [split $line ,] { regsub -all {(\\)? } $name "" name if {![string match $name*$ext $tail]} { if {[string match -nocase $name*$ext $tail]} { set tst $case_insensitive_test set tstfi $case_insensitive_test_fi } else { set tst "" set tstfi "" } lappend namelist $name$ext append rmOutput " $tst rm -f $name$ext $name$ext.* $tstfi\n" append lnOutput " $tst ln \$S $tail\$Z $name$ext\$Z $tstfi\n" } } puts "if test -r $tail; then" puts " rm -f $tail.*" puts " \$ZIP $tail" if { [llength $namelist] } { puts -nonewline $rmOutput puts -nonewline $lnOutput } puts "fi" set state end } end { break } } } close $in } puts "exit 0"

︙
13 14 15 16 17 18 19 20 21 22 23 24 25 26 27	13 14 15 16 17 18 19 20 21 22 23 24 25 26 27	- +	# --with-tcl=... # # Defines the following vars: # TCL_BIN_DIR Full path to the directory containing # the tclConfig.sh file #------------------------------------------------------------------------ AC_DEFUN(SC_PATH_TCLCONFIG, [ AC_DEFUN([SC_PATH_TCLCONFIG], [ # # Ok, lets find the tcl configuration # First, look for one uninstalled. # the alternative search directory is invoked by --with-tcl # if test x"${no_tcl}" = x ; then
︙
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 95 96 97 98 99 100	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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124	+ + + + + + + + + + + + + + + + + + + + + + + + - + - +	fi fi # then check for a private Tcl installation if test x"${ac_cv_c_tclconfig}" = x ; then for i in \ ../tcl \ `ls -dr ../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ ../../tcl \ `ls -dr ../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ ../../../tcl \ `ls -dr ../../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/unix/tclConfig.sh" ; then ac_cv_c_tclconfig=`(cd $i/unix; pwd)` break fi done fi # on Darwin, check in Framework installation locations if test "`uname -s`" = "Darwin" -a x"${ac_cv_c_tclconfig}" = x ; then for i in `ls -d ~/Library/Frameworks 2>/dev/null` \ `ls -d /Library/Frameworks 2>/dev/null` \ `ls -d /Network/Library/Frameworks 2>/dev/null` \ `ls -d /System/Library/Frameworks 2>/dev/null` \ ; do if test -f "$i/Tcl.framework/tclConfig.sh" ; then ac_cv_c_tclconfig=`(cd $i/Tcl.framework; pwd)` break fi done fi # check in a few common install locations if test x"${ac_cv_c_tclconfig}" = x ; then for i in `ls -d ${libdir} 2>/dev/null` \ `ls -d ${exec_prefix}/lib 2>/dev/null` \ `ls -d ${prefix}/lib 2>/dev/null` \ `ls -d /usr/local/lib 2>/dev/null` \ `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ ; do if test -f "$i/tclConfig.sh" ; then ac_cv_c_tclconfig=`(cd $i; pwd)` break fi done fi # check in a few other private locations if test x"${ac_cv_c_tclconfig}" = x ; then for i in \ ${srcdir}/../tcl \ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/unix/tclConfig.sh" ; then ac_cv_c_tclconfig=`(cd $i/unix; pwd)` break fi done fi ]) if test x"${ac_cv_c_tclconfig}" = x ; then TCL_BIN_DIR="# no Tcl configs found" AC_MSG_WARN(Can't find Tcl configuration definitions) AC_MSG_WARN([Can't find Tcl configuration definitions]) exit 0 else no_tcl= TCL_BIN_DIR=${ac_cv_c_tclconfig} AC_MSG_RESULT(found $TCL_BIN_DIR/tclConfig.sh) AC_MSG_RESULT([found ${TCL_BIN_DIR}/tclConfig.sh]) fi fi ]) #------------------------------------------------------------------------ # SC_PATH_TKCONFIG -- #
︙
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123	133 134 135 136 137 138 139 140 141 142 143 144 145 146 147	- +	# --with-tk=... # # Defines the following vars: # TK_BIN_DIR Full path to the directory containing # the tkConfig.sh file #------------------------------------------------------------------------ AC_DEFUN(SC_PATH_TKCONFIG, [ AC_DEFUN([SC_PATH_TKCONFIG], [ # # Ok, lets find the tk configuration # First, look for one uninstalled. # the alternative search directory is invoked by --with-tk # if test x"${no_tk}" = x ; then
︙
136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196	160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245	+ + + + + + + + + + + + + + + + + + + + + + + + + + - + - + -	fi fi # then check for a private Tk library if test x"${ac_cv_c_tkconfig}" = x ; then for i in \ ../tk \ `ls -dr ../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../tk[[8-9]].[[0-9]]* 2>/dev/null` \ ../../tk \ `ls -dr ../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../tk[[8-9]].[[0-9]]* 2>/dev/null` \ ../../../tk \ `ls -dr ../../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/unix/tkConfig.sh" ; then ac_cv_c_tkconfig=`(cd $i/unix; pwd)` break fi done fi # on Darwin, check in Framework installation locations if test "`uname -s`" = "Darwin" -a x"${ac_cv_c_tkconfig}" = x ; then for i in `ls -d ~/Library/Frameworks 2>/dev/null` \ `ls -d /Library/Frameworks 2>/dev/null` \ `ls -d /Network/Library/Frameworks 2>/dev/null` \ `ls -d /System/Library/Frameworks 2>/dev/null` \ ; do if test -f "$i/Tk.framework/tkConfig.sh" ; then ac_cv_c_tkconfig=`(cd $i/Tk.framework; pwd)` break fi done fi # check in a few common install locations if test x"${ac_cv_c_tkconfig}" = x ; then for i in `ls -d ${libdir} 2>/dev/null` \ `ls -d ${exec_prefix}/lib 2>/dev/null` \ `ls -d ${prefix}/lib 2>/dev/null` \ `ls -d /usr/local/lib 2>/dev/null` \ `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ ; do if test -f "$i/tkConfig.sh" ; then ac_cv_c_tkconfig=`(cd $i; pwd)` break fi done fi # check in a few other private locations if test x"${ac_cv_c_tkconfig}" = x ; then for i in \ ${srcdir}/../tk \ `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/unix/tkConfig.sh" ; then ac_cv_c_tkconfig=`(cd $i/unix; pwd)` break fi done fi ]) if test x"${ac_cv_c_tkconfig}" = x ; then TK_BIN_DIR="# no Tk configs found" AC_MSG_WARN(Can't find Tk configuration definitions) AC_MSG_WARN([Can't find Tk configuration definitions]) exit 0 else no_tk= TK_BIN_DIR=${ac_cv_c_tkconfig} AC_MSG_RESULT(found $TK_BIN_DIR/tkConfig.sh) AC_MSG_RESULT([found ${TK_BIN_DIR}/tkConfig.sh]) fi fi ]) #------------------------------------------------------------------------ # SC_LOAD_TCLCONFIG -- # # Load the tclConfig.sh file #
︙
204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255	253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321	- - + + - + - + - + + + + - + - - - + + + + + + + + + + + + + - - - + + + + + + + + + + + - - - - - +	# Subst the following vars: # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE # #------------------------------------------------------------------------ AC_DEFUN(SC_LOAD_TCLCONFIG, [ AC_MSG_CHECKING([for existence of $TCL_BIN_DIR/tclConfig.sh]) AC_DEFUN([SC_LOAD_TCLCONFIG], [ AC_MSG_CHECKING([for existence of ${TCL_BIN_DIR}/tclConfig.sh]) if test -f "$TCL_BIN_DIR/tclConfig.sh" ; then if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then AC_MSG_RESULT([loading]) . $TCL_BIN_DIR/tclConfig.sh . ${TCL_BIN_DIR}/tclConfig.sh else AC_MSG_RESULT([file not found]) AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh]) fi # eval is required to do the TCL_DBGX substitution eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\"" eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" # # If the TCL_BIN_DIR is the build directory (not the install directory), # then set the common variable name to the value of the build variables. # For example, the variable TCL_LIB_SPEC will be set to the value # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC # instead of TCL_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. # if test -f $TCL_BIN_DIR/Makefile ; then if test -f ${TCL_BIN_DIR}/Makefile ; then TCL_LIB_SPEC=${TCL_BUILD_LIB_SPEC} TCL_STUB_LIB_SPEC=${TCL_BUILD_STUB_LIB_SPEC} TCL_STUB_LIB_PATH=${TCL_BUILD_STUB_LIB_PATH} elif test "`uname -s`" = "Darwin"; then # If Tcl was built as a framework, attempt to use the libraries # from the framework at the given location so that linking works # against Tcl.framework installed in an arbitary location. case ${TCL_DEFS} in *TCL_FRAMEWORK*) if test -f ${TCL_BIN_DIR}/${TCL_LIB_FILE}; then for i in "`cd ${TCL_BIN_DIR}; pwd`" \ "`cd ${TCL_BIN_DIR}/../..; pwd`"; do if test "`basename "$i"`" = "${TCL_LIB_FILE}.framework"; then TCL_LIB_SPEC="-F`dirname "$i"` -framework ${TCL_LIB_FILE}" break fi # fi done fi if test -f ${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}; then TCL_STUB_LIB_SPEC="-L${TCL_BIN_DIR} ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_PATH="${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}" fi ;; esac fi # eval is required to do the TCL_DBGX substitution # eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\"" eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\"" eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\"" eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\"" AC_SUBST(TCL_VERSION) AC_SUBST(TCL_PATCH_LEVEL) AC_SUBST(TCL_BIN_DIR) AC_SUBST(TCL_SRC_DIR) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_LIB_SPEC)
︙
270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297	336 337 338 339 340 341 342 343 344 345 346 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485	- - + + - + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	# # Results: # # Sets the following vars that should be in tkConfig.sh: # TK_BIN_DIR #------------------------------------------------------------------------ AC_DEFUN(SC_LOAD_TKCONFIG, [ AC_MSG_CHECKING([for existence of $TK_BIN_DIR/tkConfig.sh]) AC_DEFUN([SC_LOAD_TKCONFIG], [ AC_MSG_CHECKING([for existence of ${TK_BIN_DIR}/tkConfig.sh]) if test -f "$TK_BIN_DIR/tkConfig.sh" ; then if test -f "${TK_BIN_DIR}/tkConfig.sh" ; then AC_MSG_RESULT([loading]) . $TK_BIN_DIR/tkConfig.sh . ${TK_BIN_DIR}/tkConfig.sh else AC_MSG_RESULT([could not find $TK_BIN_DIR/tkConfig.sh]) AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh]) fi # eval is required to do the TK_DBGX substitution eval "TK_LIB_FILE=\"${TK_LIB_FILE}\"" eval "TK_STUB_LIB_FILE=\"${TK_STUB_LIB_FILE}\"" # If the TK_BIN_DIR is the build directory (not the install directory), # then set the common variable name to the value of the build variables. # For example, the variable TK_LIB_SPEC will be set to the value # of TK_BUILD_LIB_SPEC. An extension should make use of TK_LIB_SPEC # instead of TK_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. if test -f ${TK_BIN_DIR}/Makefile ; then TK_LIB_SPEC=${TK_BUILD_LIB_SPEC} TK_STUB_LIB_SPEC=${TK_BUILD_STUB_LIB_SPEC} TK_STUB_LIB_PATH=${TK_BUILD_STUB_LIB_PATH} elif test "`uname -s`" = "Darwin"; then # If Tk was built as a framework, attempt to use the libraries # from the framework at the given location so that linking works # against Tk.framework installed in an arbitary location. case ${TK_DEFS} in *TK_FRAMEWORK*) if test -f ${TK_BIN_DIR}/${TK_LIB_FILE}; then for i in "`cd ${TK_BIN_DIR}; pwd`" \ "`cd ${TK_BIN_DIR}/../..; pwd`"; do if test "`basename "$i"`" = "${TK_LIB_FILE}.framework"; then TK_LIB_SPEC="-F`dirname "$i"` -framework ${TK_LIB_FILE}" break fi done fi if test -f ${TK_BIN_DIR}/${TK_STUB_LIB_FILE}; then TK_STUB_LIB_SPEC="-L${TK_BIN_DIR} ${TK_STUB_LIB_FLAG}" TK_STUB_LIB_PATH="${TK_BIN_DIR}/${TK_STUB_LIB_FILE}" fi ;; esac fi # eval is required to do the TK_DBGX substitution eval "TK_LIB_FLAG=\"${TK_LIB_FLAG}\"" eval "TK_LIB_SPEC=\"${TK_LIB_SPEC}\"" eval "TK_STUB_LIB_FLAG=\"${TK_STUB_LIB_FLAG}\"" eval "TK_STUB_LIB_SPEC=\"${TK_STUB_LIB_SPEC}\"" AC_SUBST(TK_VERSION) AC_SUBST(TK_BIN_DIR) AC_SUBST(TK_SRC_DIR) AC_SUBST(TK_LIB_FILE) AC_SUBST(TK_LIB_FLAG) AC_SUBST(TK_LIB_SPEC) AC_SUBST(TK_STUB_LIB_FILE) AC_SUBST(TK_STUB_LIB_FLAG) AC_SUBST(TK_STUB_LIB_SPEC) ]) #------------------------------------------------------------------------ # SC_PROG_TCLSH # Locate a tclsh shell installed on the system path. This macro # will only find a Tcl shell that already exists on the system. # It will not find a Tcl shell in the Tcl build directory or # a Tcl shell that has been installed from the Tcl build directory. # If a Tcl shell can't be located on the PATH, then TCLSH_PROG will # be set to "". Extensions should take care not to create Makefile # rules that are run by default and depend on TCLSH_PROG. An # extension can't assume that an executable Tcl shell exists at # build time. # # Arguments # none # # Results # Subst's the following values: # TCLSH_PROG #------------------------------------------------------------------------ AC_DEFUN([SC_PROG_TCLSH], [ AC_MSG_CHECKING([for tclsh]) AC_CACHE_VAL(ac_cv_path_tclsh, [ search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/tclsh[[8-9]]* 2> /dev/null` \ `ls -r $dir/tclsh* 2> /dev/null` ; do if test x"$ac_cv_path_tclsh" = x ; then if test -f "$j" ; then ac_cv_path_tclsh=$j break fi fi done done ]) if test -f "$ac_cv_path_tclsh" ; then TCLSH_PROG="$ac_cv_path_tclsh" AC_MSG_RESULT([$TCLSH_PROG]) else # It is not an error if an installed version of Tcl can't be located. TCLSH_PROG="" AC_MSG_RESULT([No tclsh found on PATH]) fi AC_SUBST(TCLSH_PROG) ]) #------------------------------------------------------------------------ # SC_BUILD_TCLSH # Determine the fully qualified path name of the tclsh executable # in the Tcl build directory. This macro will correctly determine # the name of the tclsh executable even if tclsh has not yet # been built in the build directory. The build tclsh must be used # when running tests from an extension build directory. It is not # correct to use the TCLSH_PROG in cases like this. # # Arguments # none # # Results # Subst's the following values: # BUILD_TCLSH #------------------------------------------------------------------------ AC_DEFUN([SC_BUILD_TCLSH], [ AC_MSG_CHECKING([for tclsh in Tcl build directory]) BUILD_TCLSH=${TCL_BIN_DIR}/tclsh AC_MSG_RESULT([$BUILD_TCLSH]) AC_SUBST(BUILD_TCLSH) ]) #------------------------------------------------------------------------ # SC_ENABLE_SHARED -- # # Allows the building of shared libraries #
︙
307 308 309 310 311 312 313 314 315 316 317 318 319 320 321	495 496 497 498 499 500 501 502 503 504 505 506 507 508 509	- +	# STATIC_BUILD Used for building import/export libraries # on Windows. # # Sets the following vars: # SHARED_BUILD Value of 1 or 0 #------------------------------------------------------------------------ AC_DEFUN(SC_ENABLE_SHARED, [ AC_DEFUN([SC_ENABLE_SHARED], [ AC_MSG_CHECKING([how to build libraries]) AC_ARG_ENABLE(shared, [ --enable-shared build and link with shared libraries [--enable-shared]], [tcl_ok=$enableval], [tcl_ok=yes]) if test "${enable_shared+set}" = set; then enableval="$enable_shared"
︙
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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468	535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682	- - - - - - - - - + + + + + + + + + + + + - - - - - - - - - + + + + + + + + + + - - - - - - + + + + + + - + + + - + - + + + + - + - - + + + - + + - + + - - - + + + + + - + - + + - + + + + + + + + + + + +	# Adds the following arguments to configure: # --enable-framework=yes|no # # Sets the following vars: # FRAMEWORK_BUILD Value of 1 or 0 #------------------------------------------------------------------------ AC_DEFUN(SC_ENABLE_FRAMEWORK, [ AC_MSG_CHECKING([how to package libraries]) AC_ARG_ENABLE(framework, [ --enable-framework package shared libraries in frameworks [--disable-framework]], [tcl_ok=$enableval], [tcl_ok=no]) if test "${enable_framework+set}" = set; then enableval="$enable_framework" tcl_ok=$enableval AC_DEFUN([SC_ENABLE_FRAMEWORK], [ if test "`uname -s`" = "Darwin" ; then AC_MSG_CHECKING([how to package libraries]) AC_ARG_ENABLE(framework, [ --enable-framework package shared libraries in MacOSX frameworks [--disable-framework]], [enable_framework=$enableval], [enable_framework=no]) if test $enable_framework = yes; then if test $SHARED_BUILD = 0; then AC_MSG_WARN([Frameworks can only be built if --enable-shared is yes]) enable_framework=no fi if test $tcl_corefoundation = no; then else tcl_ok=no fi if test "$tcl_ok" = "yes" ; then AC_MSG_RESULT([framework]) FRAMEWORK_BUILD=1 if test "${SHARED_BUILD}" = "0" ; then AC_MSG_WARN("Frameworks can only be built if --enable-shared is yes") AC_MSG_WARN([Frameworks can only be used when CoreFoundation is available]) enable_framework=no fi fi if test $enable_framework = yes; then AC_MSG_RESULT([framework]) FRAMEWORK_BUILD=1 else if test $SHARED_BUILD = 1; then AC_MSG_RESULT([shared library]) FRAMEWORK_BUILD=0 fi else AC_MSG_RESULT([standard shared library]) FRAMEWORK_BUILD=0 fi else AC_MSG_RESULT([static library]) fi FRAMEWORK_BUILD=0 fi fi ]) #------------------------------------------------------------------------ # SC_ENABLE_THREADS -- # # Specify if thread support should be enabled # Specify if thread support should be enabled. TCL_THREADS is # checked so that if you are compiling an extension against a # threaded core, your extension must be compiled threaded as well. # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --enable-threads # # Sets the following vars: # THREADS_LIBS Thread library(s) # # Defines the following vars: # TCL_THREADS # _REENTRANT # _THREAD_SAFE # #------------------------------------------------------------------------ AC_DEFUN(SC_ENABLE_THREADS, [ AC_DEFUN([SC_ENABLE_THREADS], [ AC_MSG_CHECKING(for building with threads) AC_ARG_ENABLE(threads, [ --enable-threads build with threads], [tcl_ok=$enableval], [tcl_ok=no]) if test "${TCL_THREADS}" = 1; then tcl_threaded_core=1; fi if test "$tcl_ok" = "yes"; then if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then AC_MSG_RESULT(yes) TCL_THREADS=1 AC_DEFINE(TCL_THREADS) # USE_THREAD_ALLOC tells us to try the special thread-based # allocator that significantly reduces lock contention AC_DEFINE(USE_THREAD_ALLOC) AC_DEFINE(_REENTRANT) if test "`uname -s`" = "SunOS" ; then AC_DEFINE(_POSIX_PTHREAD_SEMANTICS) fi AC_DEFINE(_THREAD_SAFE) AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no) if test "$tcl_ok" = "no"; then # Check a little harder for __pthread_mutex_init in the same # library, as some systems hide it there until pthread.h is # defined. We could alternatively do an AC_TRY_COMPILE with # pthread.h, but that will work with libpthread really doesn't # exist, like AIX 4.2. [Bug: 4359] AC_CHECK_LIB(pthread,__pthread_mutex_init,tcl_ok=yes,tcl_ok=no) AC_CHECK_LIB(pthread, __pthread_mutex_init, tcl_ok=yes, tcl_ok=no) fi if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -lpthread" else AC_CHECK_LIB(pthreads,pthread_mutex_init,tcl_ok=yes,tcl_ok=no) AC_CHECK_LIB(pthreads, pthread_mutex_init, tcl_ok=yes, tcl_ok=no) if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -lpthreads" else AC_CHECK_LIB(c,pthread_mutex_init,tcl_ok=yes,tcl_ok=no) if test "$tcl_ok" = "no"; then AC_CHECK_LIB(c_r,pthread_mutex_init,tcl_ok=yes,tcl_ok=no) AC_CHECK_LIB(c, pthread_mutex_init, tcl_ok=yes, tcl_ok=no) if test "$tcl_ok" = "no"; then AC_CHECK_LIB(c_r, pthread_mutex_init, tcl_ok=yes, tcl_ok=no) if test "$tcl_ok" = "yes"; then # The space is needed THREADS_LIBS=" -pthread" else TCL_THREADS=0 AC_MSG_WARN("Don t know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile...") AC_MSG_WARN([Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile...]) fi fi fi fi fi # Does the pthread-implementation provide # 'pthread_attr_setstacksize' ? ac_saved_libs=$LIBS LIBS="$LIBS $THREADS_LIBS" AC_CHECK_FUNCS(pthread_attr_setstacksize) AC_CHECK_FUNCS(pthread_atfork) LIBS=$ac_saved_libs AC_CHECK_FUNCS(readdir_r) else TCL_THREADS=0 fi # Do checking message here to not mess up interleaved configure output AC_MSG_CHECKING([for building with threads]) if test "${TCL_THREADS}" = 1; then AC_DEFINE(TCL_THREADS, 1, [Are we building with threads enabled?]) if test "${tcl_threaded_core}" = 1; then AC_MSG_RESULT([yes (threaded core)]) else AC_MSG_RESULT([yes]) fi else AC_MSG_RESULT([no (default)]) fi AC_SUBST(TCL_THREADS) ]) #------------------------------------------------------------------------ # SC_ENABLE_SYMBOLS -- # # Specify if debugging symbols should be used.
︙
488 489 490 491 492 493 494 495 496 497 498 499 500 501 502	702 703 704 705 706 707 708 709 710 711 712 713 714 715 716	- +	# Sets to $(CFLAGS_OPTIMIZE) if false # LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true # Sets to $(LDFLAGS_OPTIMIZE) if false # DBGX Debug library extension # #------------------------------------------------------------------------ AC_DEFUN(SC_ENABLE_SYMBOLS, [ AC_DEFUN([SC_ENABLE_SYMBOLS], [ AC_MSG_CHECKING([for build with symbols]) AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols [--disable-symbols]], [tcl_ok=$enableval], [tcl_ok=no]) # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' DBGX=""
︙
545 546 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 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624	759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909	- + - - + - + - - - + + + - - - + - - + + + - - + + + + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - + + + + + + + - - + + + + + - - + + + + + - - - - - - - + + + + + -	# --enable-langinfo=yes|no (default is yes) # # Defines the following vars: # HAVE_LANGINFO Triggers use of nl_langinfo if defined. # #------------------------------------------------------------------------ AC_DEFUN(SC_ENABLE_LANGINFO, [ AC_DEFUN([SC_ENABLE_LANGINFO], [ AC_ARG_ENABLE(langinfo, [ --enable-langinfo use nl_langinfo if possible to determine encoding at startup, otherwise use old heuristic], [langinfo_ok=$enableval], [langinfo_ok=yes]) HAVE_LANGINFO=0 if test "$langinfo_ok" = "yes"; then if test "$langinfo_ok" = "yes"; then AC_CHECK_HEADER(langinfo.h,[langinfo_ok=yes],[langinfo_ok=no]) AC_CHECK_HEADER(langinfo.h,[langinfo_ok=yes],[langinfo_ok=no]) fi fi AC_MSG_CHECKING([whether to use nl_langinfo]) if test "$langinfo_ok" = "yes"; then AC_CACHE_VAL(tcl_cv_langinfo_h, [ AC_TRY_COMPILE([#include <langinfo.h>], [nl_langinfo(CODESET);],[langinfo_ok=yes],[langinfo_ok=no]) if test "$langinfo_ok" = "no"; then AC_TRY_COMPILE([#include <langinfo.h>], [nl_langinfo(CODESET);], [tcl_cv_langinfo_h=yes],[tcl_cv_langinfo_h=no])]) AC_MSG_RESULT([$tcl_cv_langinfo_h]) langinfo_ok="no (could not compile with nl_langinfo)"; fi if test "$langinfo_ok" = "yes"; then if test $tcl_cv_langinfo_h = yes; then AC_DEFINE(HAVE_LANGINFO) fi fi AC_MSG_RESULT([$langinfo_ok]) else AC_MSG_RESULT([$langinfo_ok]) fi ]) #-------------------------------------------------------------------- # SC_CONFIG_MANPAGES # # Decide whether to use symlinks for linking the manpages and # whether to compress the manpages after installation. # Decide whether to use symlinks for linking the manpages, # whether to compress the manpages after installation, and # whether to add a package name suffix to the installed # manpages to avoidfile name clashes. # If compression is enabled also find out what file name suffix # the given compression program is using. # # Arguments: # none # # Results: # # Adds the following arguments to configure: # --enable-man-symlinks # --enable-man-compression=PROG # --enable-man-suffix[=STRING] # # Defines the following variable: # # MKLINKS_FLAGS - The apropriate flags for mkLinks # according to the user's selection. # MAN_FLAGS - The apropriate flags for installManPage # according to the user's selection. # #-------------------------------------------------------------------- AC_DEFUN([SC_CONFIG_MANPAGES], [ AC_MSG_CHECKING([whether to use symlinks for manpages]) AC_ARG_ENABLE(man-symlinks, [ --enable-man-symlinks use symlinks for the manpages], test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks", enableval="no") AC_MSG_RESULT([$enableval]) AC_MSG_CHECKING([whether to compress the manpages]) AC_ARG_ENABLE(man-compression, [ --enable-man-compression=PROG compress the manpages with PROG], [case $enableval in yes) AC_MSG_ERROR([missing argument to --enable-man-compression]);; no) ;; *) MAN_FLAGS="$MAN_FLAGS --compress $enableval";; esac], enableval="no") AC_MSG_RESULT([$enableval]) if test "$enableval" != "no"; then AC_MSG_CHECKING([for compressed file suffix]) touch TeST $enableval TeST Z=`ls TeST* | sed 's/^....//'` rm -f TeST* MAN_FLAGS="$MAN_FLAGS --extension $Z" AC_MSG_RESULT([$Z]) fi AC_MSG_CHECKING([whether to add a package name suffix for the manpages]) AC_ARG_ENABLE(man-suffix, [ --enable-man-suffix=STRING use STRING as a suffix to manpage file names (default: $1)], [case $enableval in yes) enableval="$1" MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; no) ;; *) MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; esac], enableval="no") AC_MSG_RESULT([$enableval]) AC_SUBST(MAN_FLAGS) ]) #-------------------------------------------------------------------- # SC_CONFIG_SYSTEM # # Determine what the system is (some things cannot be easily checked # on a feature-driven basis, alas). This can usually be done via the # "uname" command, but there are a few systems, like Next, where # this doesn't work. # # Arguments: # none # # Results: # Defines the following var: # # system - System/platform/version identification code. # #-------------------------------------------------------------------- AC_DEFUN(SC_CONFIG_MANPAGES, [ AC_MSG_CHECKING([whether to use symlinks for manpages]) AC_ARG_ENABLE(man-symlinks, [ --enable-man-symlinks use symlinks for the manpages], test "$enableval" != "no" && MKLINKS_FLAGS="$MKLINKS_FLAGS --symlinks", AC_DEFUN([SC_CONFIG_SYSTEM], [ AC_CACHE_CHECK([system version], tcl_cv_sys_version, [ if test -f /usr/lib/NextStep/software_version; then tcl_cv_sys_version=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version` else tcl_cv_sys_version=`uname -s`-`uname -r` if test "$?" -ne 0 ; then enableval="no") AC_MSG_RESULT([$enableval]) AC_MSG_WARN([can't find uname command]) tcl_cv_sys_version=unknown else # Special check for weird MP-RAS system (uname returns weird # results, and the version is kept in special file). AC_MSG_CHECKING([compression for manpages]) AC_ARG_ENABLE(man-compression, if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then tcl_cv_sys_version=MP-RAS-`awk '{print [$]3}' /etc/.relid` fi if test "`uname -s`" = "AIX" ; then tcl_cv_sys_version=AIX-`uname -v`.`uname -r` [ --enable-man-compression=PROG compress the manpages with PROG], test "$enableval" = "yes" && echo && AC_MSG_ERROR([missing argument to --enable-man-compression]) test "$enableval" != "no" && MKLINKS_FLAGS="$MKLINKS_FLAGS --compress $enableval", enableval="no") AC_MSG_RESULT([$enableval]) fi fi fi ]) system=$tcl_cv_sys_version AC_SUBST(MKLINKS_FLAGS) ]) #-------------------------------------------------------------------- # SC_CONFIG_CFLAGS # # Try to determine the proper flags to pass to the compiler # for building shared libraries and other such nonsense.
︙
657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673	942 943 944 945 946 947 948 949 950 951 952 953 954 955	- - -	# STLIB_LD - Base command to use for combining object files # into a static library. # SHLIB_CFLAGS - Flags to pass to cc when compiling the components # of a shared library (may request position-independent # code, among other things). # SHLIB_LD - Base command to use for combining object files # into a shared library. # SHLIB_LD_FLAGS -Flags to pass when building a shared library. This # differes from the SHLIB_CFLAGS as it is not used # when building object files or executables. # SHLIB_LD_LIBS - Dependent libraries for the linker to scan when # creating shared libraries. This symbol typically # goes at the end of the "ld" commands that build # shared libraries. The value of the symbol is # "${LIBS}" if all of the dependent libraries should # be specified when creating a shared library. If # dependent libraries should not be specified (as on
︙
705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891	987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131	- + - + - + - - - - - + - - + - + + + - + - - - - - + - - - - - - - - - - - - - + - - - - - - - - - - + - + + - + - - + + + + + + - - + + + - + + + + + + + + + + + + + + + + + + + + + + + - + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -	# The name of the built export / import file which # should be used to link to the Tcl shared library. # Empty if Tcl is unshared. # CFLAGS_DEBUG - # Flags used when running the compiler in debug mode # CFLAGS_OPTIMIZE - # Flags used when running the compiler in optimize mode # EXTRA_CFLAGS # CFLAGS - Additional CFLAGS added as necessary (usually 64-bit) # #-------------------------------------------------------------------- AC_DEFUN(SC_CONFIG_CFLAGS, [ AC_DEFUN([SC_CONFIG_CFLAGS], [ # Step 0.a: Enable 64 bit support? AC_MSG_CHECKING([if 64bit support is requested]) AC_ARG_ENABLE(64bit,[ --enable-64bit enable 64bit support (where applicable)],,enableval="no") AC_ARG_ENABLE(64bit,[ --enable-64bit enable 64bit support (where applicable)], if test "$enableval" = "yes"; then do64bit=yes else do64bit=no [do64bit=$enableval], [do64bit=no]) fi AC_MSG_RESULT($do64bit) AC_MSG_RESULT([$do64bit]) # Step 0.b: Enable Solaris 64 bit VIS support? AC_MSG_CHECKING([if 64bit Sparc VIS support is requested]) AC_ARG_ENABLE(64bit-vis,[ --enable-64bit-vis enable 64bit Sparc VIS support],,enableval="no") AC_ARG_ENABLE(64bit-vis,[ --enable-64bit-vis enable 64bit Sparc VIS support], [do64bitVIS=$enableval], [do64bitVIS=no]) AC_MSG_RESULT([$do64bitVIS]) if test "$enableval" = "yes"; then if test "$do64bitVIS" = "yes"; then # Force 64bit on with VIS do64bit=yes do64bitVIS=yes else do64bitVIS=no fi AC_MSG_RESULT($do64bitVIS) # Step 1: set the variable "system" to hold the name and version number # for the system. This can usually be done via the "uname" command, but # for the system. # there are a few systems, like Next, where this doesn't work. AC_MSG_CHECKING([system version (for dynamic loading)]) if test -f /usr/lib/NextStep/software_version; then system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version` else system=`uname -s`-`uname -r` if test "$?" -ne 0 ; then AC_MSG_RESULT([unknown (can't find uname command)]) system=unknown else # Special check for weird MP-RAS system (uname returns weird # results, and the version is kept in special file). SC_CONFIG_SYSTEM if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then system=MP-RAS-`awk '{print $3}' /etc/.relid'` fi if test "`uname -s`" = "AIX" ; then system=AIX-`uname -v`.`uname -r` fi AC_MSG_RESULT($system) fi fi # Step 2: check for existence of -ldl library. This is needed because # Linux can use either -ldl or -ldld for dynamic loading. AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no) # Require ranlib early so we can override it in special cases below. AC_REQUIRE([AC_PROG_RANLIB]) # Step 3: set configuration options based on system name and version. do64bit_ok=no EXTRA_CFLAGS="" LDFLAGS_ORIG="$LDFLAGS" TCL_EXPORT_FILE_SUFFIX="" UNSHARED_LIB_SUFFIX="" TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`' ECHO_VERSION='`echo ${VERSION}`' TCL_LIB_VERSIONS_OK=ok CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE=-O if test "$GCC" = "yes" ; then CFLAGS_WARNING="-Wall -Wconversion -Wno-implicit-int" CFLAGS_WARNING="-Wall -Wno-implicit-int -fno-strict-aliasing" else CFLAGS_WARNING="" fi TCL_NEEDS_EXP_FILE=0 TCL_BUILD_EXP_FILE="" TCL_EXP_FILE="" dnl FIXME: Replace AC_CHECK_PROG with AC_CHECK_TOOL once cross compiling is fixed. dnl AC_CHECK_TOOL(AR, ar) AC_CHECK_PROG(AR, ar, ar) if test "${AR}" = "" ; then AC_MSG_ERROR([Required archive tool 'ar' not found on PATH.]) fi STLIB_LD='${AR} cr' LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH" PLAT_OBJS="" PLAT_SRCS="" case $system in AIX-5.*) AIX-*) if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes" ; then # AIX requires the _r compiler when gcc isn't being used if test "${CC}" != "cc_r" ; then CC=${CC}_r case "${CC}" in *_r) # ok ... ;; *) CC=${CC}_r fi AC_MSG_RESULT(Using $CC for compiling with threads) ;; esac AC_MSG_RESULT([Using $CC for compiling with threads]) fi LIBS="$LIBS -lc" # AIX-5 uses ELF style dynamic libraries SHLIB_CFLAGS="" # Note: need the LIBS below, otherwise Tk won't find Tcl's # symbols when dynamically loaded into tclsh. SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" LD_LIBRARY_PATH_VAR="LIBPATH" # Check to enable 64-bit flags for compiler/linker on AIX 4+ if test "$do64bit" = "yes" -a "`uname -v`" -gt "3" ; then if test "$GCC" = "yes" ; then AC_MSG_WARN([64bit mode not supported with GCC on $system]) else do64bit_ok=yes CFLAGS="$CFLAGS -q64" LDFLAGS="$LDFLAGS -q64" RANLIB="${RANLIB} -X64" AR="${AR} -X64" SHLIB_LD_FLAGS="-b64" fi fi if test "`uname -m`" = "ia64" ; then # AIX-5 uses ELF style dynamic libraries on IA-64, but not PPC SHLIB_LD="/usr/ccs/bin/ld -G -z text" # AIX-5 has dl* in libc.so DL_LIBS="" if test "$GCC" = "yes" ; then CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' else CC_SEARCH_FLAGS='-R${LIB_RUNTIME_DIR}' fi LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' else if test "$GCC" = "yes" ; then SHLIB_LD="gcc -shared" else SHLIB_LD="${TCL_SRC_DIR}/unix/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry" SHLIB_LD="/bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry" fi SHLIB_LD="${TCL_SRC_DIR}/unix/ldAix ${SHLIB_LD} ${SHLIB_LD_FLAGS}" DL_LIBS="-ldl" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} TCL_NEEDS_EXP_FILE=1 TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.exp' fi # Note: need the LIBS below, otherwise Tk won't find Tcl's # symbols when dynamically loaded into tclsh. DL_OBJS="tclLoadDl.o" LDFLAGS="" LD_LIBRARY_PATH_VAR="LIBPATH" # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = "yes" ; then if test "$GCC" = "yes" ; then AC_MSG_WARN("64bit mode not supported with GCC on $system") else do64bit_ok=yes EXTRA_CFLAGS="-q64" LDFLAGS="-q64" RANLIB="${RANLIB} -X64" AR="${AR} -X64" SHLIB_LD_FLAGS="-b64" fi fi ;; AIX-*) if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes" ; then # AIX requires the _r compiler when gcc isn't being used if test "${CC}" != "cc_r" ; then CC=${CC}_r fi AC_MSG_RESULT(Using $CC for compiling with threads) fi LIBS="$LIBS -lc" SHLIB_CFLAGS="" SHLIB_LD="${TCL_SRC_DIR}/unix/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} LD_LIBRARY_PATH_VAR="LIBPATH" TCL_NEEDS_EXP_FILE=1 TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.exp' # AIX v<=4.1 has some different flags than 4.2+ if test "$system" = "AIX-4.1" -o "`uname -v`" -lt "4" ; then LIBOBJS="$LIBOBJS tclLoadAix.o" DL_LIBS="-lld" fi # On AIX <=v4 systems, libbsd.a has to be linked in to support
︙
901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 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	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 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 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 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983	- + - - - - - + - - - - - - - + + + + + + + - + + + + + + - - + - + + + - + + - + + + + + + - + - + - - - - + + + + - + - - - + + - - - - - + - + - - - + - - + + - + - + - + - - - + + + - - + - + - + - + + + + + - + + + + + + + - + - + - - + + + + + + + + + + + + + - - + - + - + - - - + + - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - + + + + + + + + - + + + - + + + + + + + + + + - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - + + - - - - - + + + + - - + + - - + + - - + - + - + - - - + + - - - - + + - - - + + + + + + + + + - - + + - - + + + + + + + - - + + + + + + + + + + + + + + + + - + - + + - + - - - - + + + - - + - - - + - + + + + + + +	# known GMT value. AC_CHECK_LIB(bsd, gettimeofday, libbsd=yes, libbsd=no) if test $libbsd = yes; then MATH_LIBS="$MATH_LIBS -lbsd" AC_DEFINE(USE_DELTA_FOR_TZ) fi ;; # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = "yes" ; then if test "$GCC" = "yes" ; then AC_MSG_WARN("64bit mode not supported with GCC on $system") else BeOS*) do64bit_ok=yes EXTRA_CFLAGS="-q64" LDFLAGS="-q64" RANLIB="${RANLIB} -X64" AR="${AR} -X64" SHLIB_LD_FLAGS="-b64" fi SHLIB_CFLAGS="-fPIC" SHLIB_LD="${CC} -nostart" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" fi #----------------------------------------------------------- # Check for inet_ntoa in -lbind, for BeOS (which also needs # -lsocket, even if the network functions are in -lnet which # is always linked to, for compatibility. #----------------------------------------------------------- AC_CHECK_LIB(bind, inet_ntoa, [LIBS="$LIBS -lbind -lsocket"]) ;; BSD/OS-2.1*|BSD/OS-3*) SHLIB_CFLAGS="" SHLIB_LD="shlicc -r" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; BSD/OS-4.*) SHLIB_CFLAGS="-export-dynamic -fPIC" SHLIB_LD="cc -shared" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="-export-dynamic" LDFLAGS="$LDFLAGS -export-dynamic" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; dgux*) SHLIB_CFLAGS="-K PIC" SHLIB_LD="cc -G" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; HP-UX-*.11.*) # Use updated header definitions where possible AC_DEFINE(_XOPEN_SOURCE) # Use the XOPEN network library AC_DEFINE(_XOPEN_SOURCE_EXTENDED) # Use the XOPEN network library LIBS="$LIBS -lxnet" # Use the XOPEN network library if test "`uname -m`" = "ia64" ; then SHLIB_SUFFIX=".so" else SHLIB_SUFFIX=".sl" SHLIB_SUFFIX=".sl" fi AC_CHECK_LIB(dld, shl_load, tcl_ok=yes, tcl_ok=no) if test "$tcl_ok" = yes; then SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" SHLIB_LD_LIBS='${LIBS}' DL_OBJS="tclLoadShl.o" DL_LIBS="-ldld" LDFLAGS="-Wl,-E" LDFLAGS="$LDFLAGS -Wl,-E" CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.' LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' LD_LIBRARY_PATH_VAR="SHLIB_PATH" fi if test "$GCC" = "yes" ; then SHLIB_LD="gcc -shared" SHLIB_LD_LIBS='${LIBS}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} fi # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc #EXTRA_CFLAGS="+DAportable" #CFLAGS="$CFLAGS +DAportable" # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = "yes" ; then if test "$GCC" = "yes" ; then hpux_arch=`gcc -dumpmachine` hpux_arch=`${CC} -dumpmachine` case $hpux_arch in hppa64*) # 64-bit gcc in use. Fix flags for GNU ld. do64bit_ok=yes SHLIB_LD="gcc -shared" SHLIB_LD_LIBS="" LD_SEARCH_FLAGS='' CC_SEARCH_FLAGS='' SHLIB_LD="${CC} -shared" SHLIB_LD_LIBS='${LIBS}' CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ;; *) AC_MSG_WARN("64bit mode not supported with GCC on $system") AC_MSG_WARN([64bit mode not supported with GCC on $system]) ;; esac else do64bit_ok=yes if test "`uname -m`" = "ia64" ; then EXTRA_CFLAGS="+DD64" LDFLAGS="+DD64 $LDFLAGS" CFLAGS="$CFLAGS +DD64" LDFLAGS="$LDFLAGS +DD64" else EXTRA_CFLAGS="+DA2.0W" LDFLAGS="+DA2.0W $LDFLAGS" fi fi fi ;; HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*) SHLIB_SUFFIX=".sl" AC_CHECK_LIB(dld, shl_load, tcl_ok=yes, tcl_ok=no) if test "$tcl_ok" = yes; then SHLIB_CFLAGS="+z" SHLIB_LD="ld -b" SHLIB_LD_LIBS="" DL_OBJS="tclLoadShl.o" DL_LIBS="-ldld" LDFLAGS="-Wl,-E" LDFLAGS="$LDFLAGS -Wl,-E" CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.' LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' LD_LIBRARY_PATH_VAR="SHLIB_PATH" fi ;; IRIX-4.*) SHLIB_CFLAGS="-G 0" SHLIB_SUFFIX=".a" SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0" SHLIB_LD_LIBS='${LIBS}' DL_OBJS="tclLoadAout.o" DL_LIBS="" LDFLAGS="-Wl,-D,08000000" LDFLAGS="$LDFLAGS -Wl,-D,08000000" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a' ;; IRIX-5.*) SHLIB_CFLAGS="" SHLIB_LD="ld -shared -rdata_shared" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' EXTRA_CFLAGS="" LDFLAGS="" ;; IRIX-6.*|IRIX64-6.5*) IRIX-6.*) SHLIB_CFLAGS="" SHLIB_LD="ld -n32 -shared -rdata_shared" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' if test "$GCC" = "yes" ; then EXTRA_CFLAGS="-mabi=n32" LDFLAGS="-mabi=n32" CFLAGS="$CFLAGS -mabi=n32" LDFLAGS="$LDFLAGS -mabi=n32" else case $system in IRIX-6.3) # Use to build 6.2 compatible binaries on 6.3. EXTRA_CFLAGS="-n32 -D_OLD_TERMIOS" CFLAGS="$CFLAGS -n32 -D_OLD_TERMIOS" ;; *) EXTRA_CFLAGS="-n32" CFLAGS="$CFLAGS -n32" ;; esac LDFLAGS="-n32" LDFLAGS="$LDFLAGS -n32" fi ;; IRIX64-6.*) SHLIB_CFLAGS="" SHLIB_LD="ld -n32 -shared -rdata_shared" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="" CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = "yes" ; then if test "$GCC" = "yes" ; then AC_MSG_WARN([64bit mode not supported by gcc]) else do64bit_ok=yes SHLIB_LD="ld -64 -shared -rdata_shared" EXTRA_CFLAGS="-64" LDFLAGS="-64" CFLAGS="$CFLAGS -64" LDFLAGS="$LDFLAGS -64" fi fi ;; Linux*) SHLIB_CFLAGS="-fPIC" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".so" CFLAGS_OPTIMIZE=-O2 # egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings # when you inline the string and math operations. Turn this off to # get rid of the warnings. CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES" #CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES" if test "$have_dl" = yes; then SHLIB_LD="${CC} -shared" SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}' DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="-rdynamic" LDFLAGS="$LDFLAGS -Wl,--export-dynamic" CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} else AC_CHECK_HEADER(dld.h, [ SHLIB_LD="ld -shared" DL_OBJS="tclLoadDld.o" DL_LIBS="-ldld" LDFLAGS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS=""]) fi if test "`uname -m`" = "alpha" ; then CFLAGS="$CFLAGS -mieee" fi if test $do64bit = yes; then AC_CACHE_CHECK([if compiler accepts -m64 flag], tcl_cv_cc_m64, [ hold_cflags=$CFLAGS EXTRA_CFLAGS="-mieee" CFLAGS="$CFLAGS -m64" AC_TRY_LINK(,, tcl_cv_cc_m64=yes, tcl_cv_cc_m64=no) CFLAGS=$hold_cflags]) if test $tcl_cv_cc_m64 = yes; then CFLAGS="$CFLAGS -m64" do64bit_ok=yes fi fi # The combo of gcc + glibc has a bug related # to inlining of functions like strtod(). The # -fno-builtin flag should address this problem # but it does not work. The -fno-inline flag # is kind of overkill but it works. # Disable inlining only when one of the # files in compat/*.c is being linked in. if test x"${LIBOBJS}" != x ; then EXTRA_CFLAGS="${EXTRA_CFLAGS} -fno-inline" CFLAGS="$CFLAGS -fno-inline" fi # XIM peeking works under XFree86. AC_DEFINE(PEEK_XCLOSEIM) ;; GNU*) SHLIB_CFLAGS="-fPIC" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".so" if test "$have_dl" = yes; then SHLIB_LD="${CC} -shared" DL_OBJS="" DL_LIBS="-ldl" LDFLAGS="-rdynamic" LDFLAGS="$LDFLAGS -Wl,--export-dynamic" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" else AC_CHECK_HEADER(dld.h, [ SHLIB_LD="ld -shared" DL_OBJS="" DL_LIBS="-ldld" LDFLAGS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS=""]) fi if test "`uname -m`" = "alpha" ; then EXTRA_CFLAGS="-mieee" CFLAGS="$CFLAGS -mieee" fi ;; Lynx*) SHLIB_CFLAGS="-fPIC" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".so" CFLAGS_OPTIMIZE=-02 SHLIB_LD="${CC} -shared " DL_OBJS="tclLoadDl.o" DL_LIBS="-mshared -ldl" LD_FLAGS="-Wl,--export-dynamic" CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' ;; MP-RAS-02*) SHLIB_CFLAGS="-K PIC" SHLIB_LD="cc -G" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; MP-RAS-*) SHLIB_CFLAGS="-K PIC" SHLIB_LD="cc -G" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="-Wl,-Bexport" LDFLAGS="$LDFLAGS -Wl,-Bexport" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; NetBSD-*|FreeBSD-[[1-2]].*|OpenBSD-*) NetBSD-*|FreeBSD-[[1-2]].*) # Not available on all versions: check for include file. AC_CHECK_HEADER(dlfcn.h, [ # NetBSD/SPARC needs -fPIC, -fpic will not do. SHLIB_CFLAGS="-fPIC" SHLIB_LD="ld -Bshareable -x" SHLIB_LD_LIBS="" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="" CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' AC_MSG_CHECKING(for ELF) AC_EGREP_CPP(yes, [ AC_CACHE_CHECK([for ELF], tcl_cv_ld_elf, [ AC_EGREP_CPP(yes, [ #ifdef __ELF__ yes #endif ], AC_MSG_RESULT(yes) SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so', AC_MSG_RESULT(no) SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1.0' ) ], [ ], tcl_cv_ld_elf=yes, tcl_cv_ld_elf=no)]) if test $tcl_cv_ld_elf = yes; then SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so' else SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1.0' fi ], [ SHLIB_CFLAGS="" SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".a" DL_OBJS="tclLoadAout.o" DL_LIBS="" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a' ]) # FreeBSD doesn't handle version numbers with dots. UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a' TCL_LIB_VERSIONS_OK=nodots ;; OpenBSD-*) case `arch -s` in m88k|vax) SHLIB_CFLAGS="" SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".a" DL_OBJS="tclLoadAout.o" DL_LIBS="" LDFLAGS="" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a' ]) ;; *) # OpenBSD/SPARC[64] needs -fPIC, -fpic will not do. case `machine` in sparc|sparc64) SHLIB_CFLAGS="-fPIC";; *) SHLIB_CFLAGS="-fpic";; esac SHLIB_LD="${CC} -shared ${SHLIB_CFLAGS}" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1.0' AC_CACHE_CHECK([for ELF], tcl_cv_ld_elf, [ AC_EGREP_CPP(yes, [ #ifdef __ELF__ yes #endif ], tcl_cv_ld_elf=yes, tcl_cv_ld_elf=no)]) if test $tcl_cv_ld_elf = yes; then LDFLAGS=-Wl,-export-dynamic else LDFLAGS="" fi ;; esac # FreeBSD doesn't handle version numbers with dots. # OpenBSD doesn't do version numbers with dots. UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a' TCL_LIB_VERSIONS_OK=nodots ;; FreeBSD-*) # FreeBSD 3.* and greater have ELF. SHLIB_CFLAGS="-fPIC" SHLIB_LD="ld -Bshareable -x" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="-export-dynamic" LDFLAGS="$LDFLAGS -export-dynamic" CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' if test "${TCL_THREADS}" = "1" ; then # The -pthread needs to go in the CFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` EXTRA_CFLAGS="-pthread" CFLAGS="$CFLAGS -pthread" LDFLAGS="$LDFLAGS -pthread" fi case $system in FreeBSD-3.*) # FreeBSD-3 doesn't handle version numbers with dots. UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a' SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so' TCL_LIB_VERSIONS_OK=nodots ;; esac ;; Rhapsody-*|Darwin-*) Darwin-*) CFLAGS_OPTIMIZE="-Os" SHLIB_CFLAGS="-fno-common" # To avoid discrepancies between what headers configure sees during # preprocessing tests and compiling tests, move any -isysroot and # -mmacosx-version-min flags from CFLAGS to CPPFLAGS: CPPFLAGS="${CPPFLAGS} `echo " ${CFLAGS}" | \ awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ if ([$]i~/^(isysroot|mmacosx-version-min)/) print "-"[$]i}'`" CFLAGS="`echo " ${CFLAGS}" | \ awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ if (!([$]i~/^(isysroot|mmacosx-version-min)/)) print "-"[$]i}'`" if test $do64bit = yes; then case `arch` in ppc) AC_CACHE_CHECK([if compiler accepts -arch ppc64 flag], tcl_cv_cc_arch_ppc64, [ hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" AC_TRY_LINK(,, tcl_cv_cc_arch_ppc64=yes, tcl_cv_cc_arch_ppc64=no) CFLAGS=$hold_cflags]) if test $tcl_cv_cc_arch_ppc64 = yes; then CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" do64bit_ok=yes fi;; i386) AC_CACHE_CHECK([if compiler accepts -arch x86_64 flag], tcl_cv_cc_arch_x86_64, [ hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch x86_64" AC_TRY_LINK(,, tcl_cv_cc_arch_x86_64=yes, tcl_cv_cc_arch_x86_64=no) CFLAGS=$hold_cflags]) if test $tcl_cv_cc_arch_x86_64 = yes; then CFLAGS="$CFLAGS -arch x86_64" do64bit_ok=yes fi;; *) AC_MSG_WARN([Don't know how enable 64-bit on architecture `arch`]);; esac else # Check for combined 32-bit and 64-bit fat build echo "$CFLAGS " | grep -E -q -- '-arch (ppc64|x86_64) ' && \ echo "$CFLAGS " | grep -E -q -- '-arch (ppc|i386) ' && \ fat_32_64=yes fi SHLIB_LD="cc -dynamiclib \${LDFLAGS}" SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS}' TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version \${VERSION} -install_name \${DYLIB_INSTALL_DIR}/\${TCL_LIB_FILE} -prebind -seg1addr 0xa000000" TK_SHLIB_LD_EXTRAS="-compatibility_version ${TK_VERSION} -current_version \${VERSION} -install_name \${DYLIB_INSTALL_DIR}/\${TK_LIB_FILE} -prebind -seg1addr 0xb000000" AC_CACHE_CHECK([if ld accepts -single_module flag], tcl_cv_ld_single_module, [ hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module" AC_TRY_LINK(, [int i;], tcl_cv_ld_single_module=yes, tcl_cv_ld_single_module=no) LDFLAGS=$hold_ldflags]) if test $tcl_cv_ld_single_module = yes; then SHLIB_LD="${SHLIB_LD} -Wl,-single_module" fi SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".dylib" DL_OBJS="tclLoadDyld.o" PLAT_OBJS="tclMacOSXBundle.o" DL_LIBS="" # Don't use -prebind when building for Mac OS X 10.4 or later only: test "`echo "${MACOSX_DEPLOYMENT_TARGET}" | awk -F '10\\.' '{print int([$]2)}'`" -lt 4 -a \ "`echo "${CPPFLAGS}" | awk -F '-mmacosx-version-min=10\\.' '{print int([$]2)}'`" -lt 4 && \ LDFLAGS="-prebind" LDFLAGS="$LDFLAGS -prebind" LDFLAGS="$LDFLAGS -headerpad_max_install_names" AC_CACHE_CHECK([if ld accepts -search_paths_first flag], tcl_cv_ld_search_paths_first, [ hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-search_paths_first" AC_TRY_LINK(, [int i;], tcl_cv_ld_search_paths_first=yes, tcl_cv_ld_search_paths_first=no) LDFLAGS=$hold_ldflags]) if test $tcl_cv_ld_search_paths_first = yes; then LDFLAGS="$LDFLAGS -Wl,-search_paths_first" fi CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" CFLAGS_OPTIMIZE="-Os" LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH" # for compatibility with autoconf vers 2.13 : HACK="" EXTRA_CFLAGS="-DMA${HACK}C_OSX_TCL -DHAVE_CFBUNDLE -DUSE_VFORK -DTCL_DEFAULT_ENCODING=\\\"utf-8\\\"" LIBS="$LIBS -framework CoreFoundation" PLAT_OBJS=\$\(MAC\_OSX_OBJS\) PLAT_SRCS=\$\(MAC\_OSX_SRCS\) AC_MSG_CHECKING([whether to use CoreFoundation]) AC_ARG_ENABLE(corefoundation, [ --enable-corefoundation use CoreFoundation API [--enable-corefoundation]], [tcl_corefoundation=$enableval], [tcl_corefoundation=yes]) AC_MSG_RESULT([$tcl_corefoundation]) if test $tcl_corefoundation = yes; then AC_CACHE_CHECK([for CoreFoundation.framework], tcl_cv_lib_corefoundation, [ hold_libs=$LIBS if test "$fat_32_64" = yes; then for v in CFLAGS CPPFLAGS LDFLAGS; do # On Tiger there is no 64-bit CF, so remove 64-bit archs # from CFLAGS et al. while testing for presence of CF. # 64-bit CF is disabled in tclUnixPort.h if necessary. eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' done; fi LIBS="$LIBS -framework CoreFoundation" AC_TRY_LINK([#include <CoreFoundation/CoreFoundation.h>], [CFBundleRef b = CFBundleGetMainBundle();], tcl_cv_lib_corefoundation=yes, tcl_cv_lib_corefoundation=no) if test "$fat_32_64" = yes; then for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done; fi; LIBS=$hold_libs]) if test $tcl_cv_lib_corefoundation = yes; then LIBS="$LIBS -framework CoreFoundation" AC_DEFINE(HAVE_COREFOUNDATION) else tcl_corefoundation=no fi if test "$fat_32_64" = yes -a $tcl_corefoundation = yes; then AC_CACHE_CHECK([for 64-bit CoreFoundation], tcl_cv_lib_corefoundation_64, [ for v in CFLAGS CPPFLAGS LDFLAGS; do eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' done AC_TRY_LINK([#include <CoreFoundation/CoreFoundation.h>], [CFBundleRef b = CFBundleGetMainBundle();], tcl_cv_lib_corefoundation_64=yes, tcl_cv_lib_corefoundation_64=no) for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' done]) if test $tcl_cv_lib_corefoundation_64 = no; then AC_DEFINE(NO_COREFOUNDATION_64) fi fi fi AC_DEFINE(MAC_OSX_TCL) ;; NEXTSTEP-*) SHLIB_CFLAGS="" SHLIB_LD="cc -nostdlib -r" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadNext.o" DL_LIBS="" LDFLAGS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OS/390-*) CFLAGS_OPTIMIZE="" # Optimizer is buggy AC_DEFINE(_OE_SOCKETS) # needed in sys/socket.h CFLAGS_OPTIMIZE="" # Optimizer is buggy AC_DEFINE(_OE_SOCKETS) # needed in sys/socket.h ;; OSF1-1.0|OSF1-1.1|OSF1-1.2) # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1 SHLIB_CFLAGS="" # Hack: make package name same as library name SHLIB_LD='ld -R -export $@:' SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadOSF.o" DL_LIBS="" LDFLAGS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OSF1-1.*) # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2 SHLIB_CFLAGS="-fPIC" if test "$SHARED_BUILD" = "1" ; then SHLIB_LD="ld -shared" else SHLIB_LD="ld -non_shared" fi SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; OSF1-V*) # Digital OSF/1 SHLIB_CFLAGS="" if test "$SHARED_BUILD" = "1" ; then SHLIB_LD='ld -shared -expect_unresolved "*"' else SHLIB_LD='ld -non_shared -expect_unresolved "*"' fi SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="" CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' if test "$GCC" != "yes" ; then EXTRA_CFLAGS="-DHAVE_TZSET -std1" if test "$GCC" = "yes" ; then CFLAGS="$CFLAGS -mieee" else CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee" fi # see pthread_intro(3) for pthread support on osf1, k.furukawa if test "${TCL_THREADS}" = "1" ; then EXTRA_CFLAGS="${EXTRA_CFLAGS} -DHAVE_PTHREAD_ATTR_SETSTACKSIZE" EXTRA_CFLAGS="${EXTRA_CFLAGS} -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64" CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE" CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64" LIBS=`echo $LIBS | sed s/-lpthreads//` if test "$GCC" = "yes" ; then LIBS="$LIBS -lpthread -lmach -lexc" else EXTRA_CFLAGS="${EXTRA_CFLAGS} -pthread" LDFLAGS="-pthread" CFLAGS="$CFLAGS -pthread" LDFLAGS="$LDFLAGS -pthread" fi fi ;; QNX-6*) # QNX RTP # This may work for all QNX, but it was only reported for v6. SHLIB_CFLAGS="-fPIC" SHLIB_LD="ld -Bshareable -x" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" # dlopen is in -lc on QNX DL_LIBS="" LDFLAGS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; RISCos-*) SHLIB_CFLAGS="-G 0" SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0" SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".a" DL_OBJS="tclLoadAout.o" DL_LIBS="" LDFLAGS="-Wl,-D,08000000" LDFLAGS="$LDFLAGS -Wl,-D,08000000" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ;; SCO_SV-3.2*) # Note, dlopen is available only on SCO 3.2.5 and greater. However, # this test works, since "uname -s" was non-standard in 3.2.4 and # below. if test "$GCC" = "yes" ; then SHLIB_CFLAGS="-fPIC -melf" LDFLAGS="-melf -Wl,-Bexport" LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" else SHLIB_CFLAGS="-Kpic -belf" LDFLAGS="-belf -Wl,-Bexport" LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" fi SHLIB_LD="ld -G" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SINIX*5.4*) SHLIB_CFLAGS="-K PIC" SHLIB_LD="cc -G" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; SunOS-4*) SHLIB_CFLAGS="-PIC" SHLIB_LD="ld" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} # SunOS can't handle version numbers with dots in them in library # specs, like -ltcl7.5, so use -ltcl75 instead. Also, it # requires an extra version number at the end of .so file names. # So, the library has to have a name like libtcl75.so.1.0 SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1.0' UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a' TCL_LIB_VERSIONS_OK=nodots ;; SunOS-5.[[0-6]]*) SunOS-5.[[0-6]]) # Careful to not let 5.10+ fall into this case # Note: If _REENTRANT isn't defined, then Solaris # won't define thread-safe library routines. AC_DEFINE(_REENTRANT) AC_DEFINE(_POSIX_PTHREAD_SEMANTICS) SHLIB_CFLAGS="-KPIC" # Note: need the LIBS below, otherwise Tk won't find Tcl's # symbols when dynamically loaded into tclsh. SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="" if test "$GCC" = "yes" ; then SHLIB_LD="$CC -shared" CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} else SHLIB_LD="/usr/ccs/bin/ld -G -z text" CC_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} fi ;; SunOS-5*) # Note: If _REENTRANT isn't defined, then Solaris # won't define thread-safe library routines. AC_DEFINE(_REENTRANT) AC_DEFINE(_POSIX_PTHREAD_SEMANTICS) SHLIB_CFLAGS="-KPIC" LDFLAGS="" # Check to enable 64-bit flags for compiler/linker if test "$do64bit" = "yes" ; then arch=`isainfo` if test "$arch" = "sparcv9 sparc" ; then if test "$GCC" = "yes" ; then if test "`gcc -dumpversion | awk -F. '{print [$]1}'`" -lt "3" ; then AC_MSG_WARN("64bit mode not supported with GCC on $system") else do64bit_ok=yes AC_MSG_WARN([64bit mode not supported with GCC < 3.2 on $system]) else do64bit_ok=yes CFLAGS="$CFLAGS -m64 -mcpu=v9" LDFLAGS="$LDFLAGS -m64 -mcpu=v9" SHLIB_CFLAGS="-fPIC" fi else do64bit_ok=yes if test "$do64bitVIS" = "yes" ; then EXTRA_CFLAGS="-xarch=v9a" LDFLAGS="-xarch=v9a" CFLAGS="$CFLAGS -xarch=v9a" LDFLAGS="$LDFLAGS -xarch=v9a" else EXTRA_CFLAGS="-xarch=v9" LDFLAGS="-xarch=v9" CFLAGS="$CFLAGS -xarch=v9" LDFLAGS="$LDFLAGS -xarch=v9" fi # Solaris 64 uses this as well #LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH_64" fi elif test "$arch" = "amd64 i386" ; then if test "$GCC" = "yes" ; then AC_MSG_WARN([64bit mode not supported with GCC on $system]) else AC_MSG_WARN("64bit mode only supported sparcv9 system") else do64bit_ok=yes CFLAGS="$CFLAGS -xarch=amd64" LDFLAGS="$LDFLAGS -xarch=amd64" fi else AC_MSG_WARN([64bit mode not supported for $arch]) fi fi # Note: need the LIBS below, otherwise Tk won't find Tcl's # symbols when dynamically loaded into tclsh. SHLIB_LD_LIBS='${LIBS}' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" if test "$GCC" = "yes" ; then SHLIB_LD="$CC -shared" CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} if test "$do64bit_ok" = "yes" ; then # We need to specify -static-libgcc or we need to # add the path to the sparv9 libgcc. SHLIB_LD="$SHLIB_LD -m64 -mcpu=v9 -static-libgcc" # for finding sparcv9 libgcc, get the regular libgcc # path, remove so name and append 'sparcv9' #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..." #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" fi else SHLIB_LD="/usr/ccs/bin/ld -G -z text" CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' fi ;; ULTRIX-4.*) SHLIB_CFLAGS="-G 0" SHLIB_SUFFIX=".a" SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0" SHLIB_LD_LIBS='${LIBS}' DL_OBJS="tclLoadAout.o" DL_LIBS="" LDFLAGS="-Wl,-D,08000000" LDFLAGS="$LDFLAGS -Wl,-D,08000000" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} if test "$GCC" != "yes" ; then EXTRA_CFLAGS="-DHAVE_TZSET -std1" CFLAGS="$CFLAGS -DHAVE_TZSET -std1" fi ;; UNIX_SV* | UnixWare-5*) SHLIB_CFLAGS="-KPIC" SHLIB_LD="cc -G" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers # that don't grok the -Bexport option. Test that it does. AC_CACHE_CHECK([for ld accepts -Bexport flag], tcl_cv_ld_Bexport, [ hold_ldflags=$LDFLAGS hold_ldflags=$LDFLAGS AC_MSG_CHECKING(for ld accepts -Bexport flag) LDFLAGS="${LDFLAGS} -Wl,-Bexport" AC_TRY_LINK(, [int i;], found=yes, found=no) LDFLAGS=$hold_ldflags LDFLAGS="$LDFLAGS -Wl,-Bexport" AC_TRY_LINK(, [int i;], tcl_cv_ld_Bexport=yes, tcl_cv_ld_Bexport=no) LDFLAGS=$hold_ldflags]) AC_MSG_RESULT($found) if test $found = yes; then if test $tcl_cv_ld_Bexport = yes; then LDFLAGS="-Wl,-Bexport" else LDFLAGS="" LDFLAGS="$LDFLAGS -Wl,-Bexport" fi CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; esac if test "$do64bit" = "yes" -a "$do64bit_ok" = "no" ; then AC_MSG_WARN("64bit support being disabled -- don\'t know magic for this platform") AC_MSG_WARN([64bit support being disabled -- don't know magic for this platform]) fi dnl # Add any CPPFLAGS set in the environment to our CFLAGS, but delay doing so dnl # until the end of configure, as configure's compile and link tests use dnl # both CPPFLAGS and CFLAGS (unlike our compile and link) but configure's dnl # preprocessing tests use only CPPFLAGS. SC_CONFIG_COMMANDS_PRE([CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS=""]) # Step 4: If pseudo-static linking is in use (see K. B. Kenny, "Dynamic # Loading for Tcl -- What Became of It?". Proc. 2nd Tcl/Tk Workshop, # New Orleans, LA, Computerized Processes Unlimited, 1994), then we need # to determine which of several header files defines the a.out file # format (a.out.h, sys/exec.h, or sys/exec_aout.h). At present, we # support only a file format that is more or less version-7-compatible.
︙
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	1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 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	- + - + - - + - + - + - - + - + - + - - +	# or a.out.h is usable for the purpose. # # Note that the modified COFF format used on MIPS Ultrix 4.x is usable; the # `struct exec' includes a second header that contains information that # duplicates the v7 fields that are needed. if test "x$DL_OBJS" = "xtclLoadAout.o" ; then AC_MSG_CHECKING(sys/exec.h) AC_CACHE_CHECK([sys/exec.h], tcl_cv_sysexec_h, [ AC_TRY_COMPILE([#include <sys/exec.h>],[ struct exec foo; unsigned long seek; int flag; #if defined(__mips) || defined(mips) seek = N_TXTOFF (foo.ex_f, foo.ex_o); #else seek = N_TXTOFF (foo); #endif flag = (foo.a_magic == OMAGIC); return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry; ], tcl_ok=usable, tcl_ok=unusable) ], tcl_cv_sysexec_h=usable, tcl_cv_sysexec_h=unusable)]) AC_MSG_RESULT($tcl_ok) if test $tcl_ok = usable; then if test $tcl_cv_sysexec_h = usable; then AC_DEFINE(USE_SYS_EXEC_H) else AC_MSG_CHECKING(a.out.h) AC_CACHE_CHECK([a.out.h], tcl_cv_aout_h, [ AC_TRY_COMPILE([#include <a.out.h>],[ struct exec foo; unsigned long seek; int flag; #if defined(__mips) || defined(mips) seek = N_TXTOFF (foo.ex_f, foo.ex_o); #else seek = N_TXTOFF (foo); #endif flag = (foo.a_magic == OMAGIC); return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry; ], tcl_ok=usable, tcl_ok=unusable) ], tcl_cv_aout_h=usable, tcl_cv_aout_h=unusable)]) AC_MSG_RESULT($tcl_ok) if test $tcl_ok = usable; then if test $tcl_cv_aout_h = usable; then AC_DEFINE(USE_A_OUT_H) else AC_MSG_CHECKING(sys/exec_aout.h) AC_CACHE_CHECK([sys/exec_aout.h], tcl_cv_sysexecaout_h, [ AC_TRY_COMPILE([#include <sys/exec_aout.h>],[ struct exec foo; unsigned long seek; int flag; #if defined(__mips) || defined(mips) seek = N_TXTOFF (foo.ex_f, foo.ex_o); #else seek = N_TXTOFF (foo); #endif flag = (foo.a_midmag == OMAGIC); return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry; ], tcl_ok=usable, tcl_ok=unusable) ], tcl_cv_sysexecaout_h=usable, tcl_cv_sysexecaout_h=unusable)]) AC_MSG_RESULT($tcl_ok) if test $tcl_ok = usable; then if test $tcl_cv_sysexecaout_h = usable; then AC_DEFINE(USE_SYS_EXEC_AOUT_H) else DL_OBJS="" fi fi fi fi
︙
1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671	2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098	- + - +	echo "Can't figure out how to do dynamic loading or shared libraries" echo "on this system." SHLIB_CFLAGS="" SHLIB_LD="" SHLIB_SUFFIX="" DL_OBJS="tclLoadNone.o" DL_LIBS="" LDFLAGS="" LDFLAGS="$LDFLAGS_ORIG" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" BUILD_DLTEST="" fi # If we're running gcc, then change the C flags for compiling shared # libraries to the right flags for gcc, instead of those for the # standard manufacturer compiler. if test "$DL_OBJS" != "tclLoadNone.o" ; then if test "$GCC" = "yes" ; then case $system in AIX-*) ;; BSD/OS*) ;; IRIX*) ;; NetBSD-*|FreeBSD-*|OpenBSD-*) ;; Rhapsody-*|Darwin-*) Darwin-*) ;; RISCos-*) ;; SCO_SV-3.2*) ;; ULTRIX-4.*) ;;
︙
1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695	2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122	- +	fi if test "$UNSHARED_LIB_SUFFIX" = "" ; then UNSHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a' fi if test "${SHARED_BUILD}" = "1" && test "${SHLIB_SUFFIX}" != "" ; then LIB_SUFFIX=${SHARED_LIB_SUFFIX} MAKE_LIB='${SHLIB_LD} -o [$]@ ${SHLIB_LD_FLAGS} ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) $(LIB_INSTALL_DIR)/$(LIB_FILE)' else LIB_SUFFIX=${UNSHARED_LIB_SUFFIX} if test "$RANLIB" = "" ; then MAKE_LIB='$(STLIB_LD) [$]@ ${OBJS}' INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) $(LIB_INSTALL_DIR)/$(LIB_FILE)'
︙
1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754	2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180	+ - -	fi AC_SUBST(DL_LIBS) AC_SUBST(DL_OBJS) AC_SUBST(PLAT_OBJS) AC_SUBST(PLAT_SRCS) AC_SUBST(CFLAGS) AC_SUBST(CFLAGS_DEBUG) AC_SUBST(CFLAGS_OPTIMIZE) AC_SUBST(CFLAGS_WARNING) AC_SUBST(EXTRA_CFLAGS) AC_SUBST(LDFLAGS) AC_SUBST(LDFLAGS_DEBUG) AC_SUBST(LDFLAGS_OPTIMIZE) AC_SUBST(CC_SEARCH_FLAGS) AC_SUBST(LD_SEARCH_FLAGS) AC_SUBST(STLIB_LD) AC_SUBST(SHLIB_LD) AC_SUBST(TCL_SHLIB_LD_EXTRAS) AC_SUBST(TK_SHLIB_LD_EXTRAS) AC_SUBST(SHLIB_LD_FLAGS) AC_SUBST(SHLIB_LD_LIBS) AC_SUBST(SHLIB_CFLAGS) AC_SUBST(SHLIB_SUFFIX) AC_SUBST(MAKE_LIB) AC_SUBST(MAKE_STUB_LIB) AC_SUBST(INSTALL_LIB)
︙
1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791	2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216	- + - + -	# HAVE_SYS_MODEM_H # USE_TERMIOS # USE_TERMIO # USE_SGTTY # #-------------------------------------------------------------------- AC_DEFUN(SC_SERIAL_PORT, [ AC_DEFUN([SC_SERIAL_PORT], [ AC_CHECK_HEADERS(sys/modem.h) AC_MSG_CHECKING([termios vs. termio vs. sgtty]) AC_CACHE_CHECK([termios vs. termio vs. sgtty], tcl_cv_api_serial, [ AC_CACHE_VAL(tcl_cv_api_serial, [ AC_TRY_RUN([ #include <termios.h> int main() { struct termios t; if (tcgetattr(0, &t) == 0) { cfsetospeed(&t, 0);
︙
1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883	2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307	-	}], tcl_cv_api_serial=sgtty, tcl_cv_api_serial=none, tcl_cv_api_serial=none) fi]) case $tcl_cv_api_serial in termios) AC_DEFINE(USE_TERMIOS);; termio) AC_DEFINE(USE_TERMIO);; sgtty) AC_DEFINE(USE_SGTTY);; esac AC_MSG_RESULT($tcl_cv_api_serial) ]) #-------------------------------------------------------------------- # SC_MISSING_POSIX_HEADERS # # Supply substitutes for missing POSIX header files. Special # notes:
︙
1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948	2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372	- + - - + + - + - + - - + +	# # Results: # # Defines some of the following vars: # NO_DIRENT_H # NO_ERRNO_H # NO_VALUES_H # NO_LIMITS_H # HAVE_LIMITS_H or NO_LIMITS_H # NO_STDLIB_H # NO_STRING_H # NO_SYS_WAIT_H # NO_DLFCN_H # HAVE_UNISTD_H # HAVE_SYS_PARAM_H # # HAVE_STRING_H ? # #-------------------------------------------------------------------- AC_DEFUN(SC_MISSING_POSIX_HEADERS, [ AC_MSG_CHECKING(dirent.h) AC_DEFUN([SC_MISSING_POSIX_HEADERS], [ AC_CACHE_CHECK([dirent.h], tcl_cv_dirent_h, [ AC_TRY_LINK([#include <sys/types.h> #include <dirent.h>], [ #ifndef _POSIX_SOURCE # ifdef __Lynx__ /* * Generate compilation error to make the test fail: Lynx headers * are only valid if really in the POSIX environment. */ missing_procedure(); # endif #endif DIR *d; struct dirent *entryPtr; char *p; d = opendir("foobar"); entryPtr = readdir(d); p = entryPtr->d_name; closedir(d); ], tcl_ok=yes, tcl_ok=no) ], tcl_cv_dirent_h=yes, tcl_cv_dirent_h=no)]) if test $tcl_ok = no; then if test $tcl_cv_dirent_h = no; then AC_DEFINE(NO_DIRENT_H) fi AC_MSG_RESULT($tcl_ok) AC_CHECK_HEADER(errno.h, , [AC_DEFINE(NO_ERRNO_H)]) AC_CHECK_HEADER(float.h, , [AC_DEFINE(NO_FLOAT_H)]) AC_CHECK_HEADER(values.h, , [AC_DEFINE(NO_VALUES_H)]) AC_CHECK_HEADER(limits.h, , [AC_DEFINE(NO_LIMITS_H)]) AC_CHECK_HEADER(limits.h, [AC_DEFINE(HAVE_LIMITS_H)], [AC_DEFINE(NO_LIMITS_H)]) AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0) AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0) AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0) AC_EGREP_HEADER(strtod, stdlib.h, , tcl_ok=0) if test $tcl_ok = 0; then AC_DEFINE(NO_STDLIB_H) fi
︙
1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973	2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395	- -	AC_DEFINE(NO_STRING_H) fi AC_CHECK_HEADER(sys/wait.h, , [AC_DEFINE(NO_SYS_WAIT_H)]) AC_CHECK_HEADER(dlfcn.h, , [AC_DEFINE(NO_DLFCN_H)]) # OS/390 lacks sys/param.h (and doesn't need it, by chance). AC_HAVE_HEADERS(unistd.h sys/param.h) ]) #-------------------------------------------------------------------- # SC_PATH_X # # Locate the X11 header files and the X11 library archive. Try # the ac_path_x macro first, but if it doesn't find the X stuff
︙
1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 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 2053 2054 2055 2056 2057 2058 2059 2060	2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 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 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483	- + - + - + - + - + - + - + +	# # Sets the the following vars: # XINCLUDES # XLIBSW # #-------------------------------------------------------------------- AC_DEFUN(SC_PATH_X, [ AC_DEFUN([SC_PATH_X], [ AC_PATH_X not_really_there="" if test "$no_x" = ""; then if test "$x_includes" = ""; then AC_TRY_CPP([#include <X11/XIntrinsic.h>], , not_really_there="yes") else if test ! -r $x_includes/X11/Intrinsic.h; then not_really_there="yes" fi fi fi if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then AC_MSG_CHECKING(for X11 header files) AC_MSG_CHECKING([for X11 header files]) found_xincludes="no" AC_TRY_CPP([#include <X11/Intrinsic.h>], found_xincludes="yes", found_xincludes="no") if test "$found_xincludes" = "no"; then dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include" for i in $dirs ; do if test -r $i/X11/Intrinsic.h; then AC_MSG_RESULT($i) AC_MSG_RESULT([$i]) XINCLUDES=" -I$i" found_xincludes="yes" break fi done fi else if test "$x_includes" != ""; then XINCLUDES="-I$x_includes" found_xincludes="yes" fi fi if test found_xincludes = "no"; then AC_MSG_RESULT(couldn't find any!) AC_MSG_RESULT([couldn't find any!]) fi if test "$no_x" = yes; then AC_MSG_CHECKING(for X11 libraries) AC_MSG_CHECKING([for X11 libraries]) XLIBSW=nope dirs="/usr/unsupported/lib /usr/local/lib /usr/X386/lib /usr/X11R6/lib /usr/X11R5/lib /usr/lib/X11R5 /usr/lib/X11R4 /usr/openwin/lib /usr/X11/lib /usr/sww/X11/lib" for i in $dirs ; do if test -r $i/libX11.a -o -r $i/libX11.so -o -r $i/libX11.sl; then AC_MSG_RESULT($i) AC_MSG_RESULT([$i]) XLIBSW="-L$i -lX11" x_libraries="$i" break fi done else if test "$x_libraries" = ""; then XLIBSW=-lX11 else XLIBSW="-L$x_libraries -lX11" fi fi if test "$XLIBSW" = nope ; then AC_CHECK_LIB(Xwindow, XCreateWindow, XLIBSW=-lXwindow) fi if test "$XLIBSW" = nope ; then AC_MSG_RESULT(couldn't find any! Using -lX11.) AC_MSG_RESULT([could not find any! Using -lX11.]) XLIBSW=-lX11 fi ]) #-------------------------------------------------------------------- # SC_BLOCKING_STYLE # # The statements below check for systems where POSIX-style # non-blocking I/O (O_NONBLOCK) doesn't work or is unimplemented. # On these systems (mostly older ones), use the old BSD-style # FIONBIO approach instead.
︙
2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123	2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529	- + + - - - - - - - - - - - - - - - - - - - + - + - + - +	# HAVE_SYS_IOCTL_H # HAVE_SYS_FILIO_H # USE_FIONBIO # O_NONBLOCK # #-------------------------------------------------------------------- AC_DEFUN(SC_BLOCKING_STYLE, [ AC_DEFUN([SC_BLOCKING_STYLE], [ AC_CHECK_HEADERS(sys/ioctl.h) AC_CHECK_HEADERS(sys/filio.h) SC_CONFIG_SYSTEM AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O]) if test -f /usr/lib/NextStep/software_version; then system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version` else system=`uname -s`-`uname -r` if test "$?" -ne 0 ; then system=unknown else # Special check for weird MP-RAS system (uname returns weird # results, and the version is kept in special file). if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then system=MP-RAS-`awk '{print $3}' /etc/.relid'` fi if test "`uname -s`" = "AIX" ; then system=AIX-`uname -v`.`uname -r` fi fi fi case $system in # There used to be code here to use FIONBIO under AIX. However, it # was reported that FIONBIO doesn't work under AIX 3.2.5. Since # using O_NONBLOCK seems fine under AIX 4.*, I removed the FIONBIO # code (JO, 5/31/97). OSF*) AC_DEFINE(USE_FIONBIO) AC_MSG_RESULT(FIONBIO) AC_MSG_RESULT([FIONBIO]) ;; SunOS-4*) AC_DEFINE(USE_FIONBIO) AC_MSG_RESULT(FIONBIO) AC_MSG_RESULT([FIONBIO]) ;; ULTRIX-4.*) AC_DEFINE(USE_FIONBIO) AC_MSG_RESULT(FIONBIO) AC_MSG_RESULT([FIONBIO]) ;; *) AC_MSG_RESULT(O_NONBLOCK) AC_MSG_RESULT([O_NONBLOCK]) ;; esac ]) #-------------------------------------------------------------------- # SC_TIME_HANLDER #
︙
2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197	2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595	- + - + - - + - - + - - + - - + - - + - - + - - + -	# USE_DELTA_FOR_TZ # HAVE_TM_GMTOFF # HAVE_TM_TZADJ # HAVE_TIMEZONE_VAR # #-------------------------------------------------------------------- AC_DEFUN(SC_TIME_HANDLER, [ AC_DEFUN([SC_TIME_HANDLER], [ AC_CHECK_HEADERS(sys/time.h) AC_HEADER_TIME AC_STRUCT_TIMEZONE AC_CHECK_FUNCS(gmtime_r localtime_r) AC_MSG_CHECKING([tm_tzadj in struct tm]) AC_CACHE_CHECK([tm_tzadj in struct tm], tcl_cv_member_tm_tzadj, [ AC_CACHE_VAL(tcl_cv_member_tm_tzadj, AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_tzadj;], tcl_cv_member_tm_tzadj=yes, tcl_cv_member_tm_tzadj=no)) tcl_cv_member_tm_tzadj=yes, tcl_cv_member_tm_tzadj=no)]) AC_MSG_RESULT($tcl_cv_member_tm_tzadj) if test $tcl_cv_member_tm_tzadj = yes ; then AC_DEFINE(HAVE_TM_TZADJ) fi AC_MSG_CHECKING([tm_gmtoff in struct tm]) AC_CACHE_CHECK([tm_gmtoff in struct tm], tcl_cv_member_tm_gmtoff, [ AC_CACHE_VAL(tcl_cv_member_tm_gmtoff, AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_gmtoff;], tcl_cv_member_tm_gmtoff=yes, tcl_cv_member_tm_gmtoff=no)) tcl_cv_member_tm_gmtoff=yes, tcl_cv_member_tm_gmtoff=no)]) AC_MSG_RESULT($tcl_cv_member_tm_gmtoff) if test $tcl_cv_member_tm_gmtoff = yes ; then AC_DEFINE(HAVE_TM_GMTOFF) fi # # Its important to include time.h in this check, as some systems # (like convex) have timezone functions, etc. # AC_MSG_CHECKING([long timezone variable]) AC_CACHE_CHECK([long timezone variable], tcl_cv_timezone_long, [ AC_CACHE_VAL(tcl_cv_var_timezone, AC_TRY_COMPILE([#include <time.h>], [extern long timezone; timezone += 1; exit (0);], tcl_cv_timezone_long=yes, tcl_cv_timezone_long=no)) tcl_cv_timezone_long=yes, tcl_cv_timezone_long=no)]) AC_MSG_RESULT($tcl_cv_timezone_long) if test $tcl_cv_timezone_long = yes ; then AC_DEFINE(HAVE_TIMEZONE_VAR) else # # On some systems (eg IRIX 6.2), timezone is a time_t and not a long. # AC_MSG_CHECKING([time_t timezone variable]) AC_CACHE_CHECK([time_t timezone variable], tcl_cv_timezone_time, [ AC_CACHE_VAL(tcl_cv_timezone_time, AC_TRY_COMPILE([#include <time.h>], [extern time_t timezone; timezone += 1; exit (0);], tcl_cv_timezone_time=yes, tcl_cv_timezone_time=no)) tcl_cv_timezone_time=yes, tcl_cv_timezone_time=no)]) AC_MSG_RESULT($tcl_cv_timezone_time) if test $tcl_cv_timezone_time = yes ; then AC_DEFINE(HAVE_TIMEZONE_VAR) fi fi ]) #--------------------------------------------------------------------
︙
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	2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647	- + - + - + - - + + - - -	# Results: # # Might defines some of the following vars: # strtod (=fixstrtod) # #-------------------------------------------------------------------- AC_DEFUN(SC_BUGGY_STRTOD, [ AC_DEFUN([SC_BUGGY_STRTOD], [ AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0) if test "$tcl_strtod" = 1; then AC_MSG_CHECKING([for Solaris2.4/Tru64 strtod bugs]) AC_CACHE_CHECK([for Solaris2.4/Tru64 strtod bugs], tcl_cv_strtod_buggy,[ AC_CACHE_VAL(tcl_cv_strtod_buggy,[ AC_TRY_RUN([ extern double strtod(); int main() { char *infString="Inf", *nanString="NaN", *spaceString=" "; char *term; double value; value = strtod(infString, &term); if ((term != infString) && (term[-1] == 0)) { exit(1); } value = strtod(nanString, &term); if ((term != nanString) && (term[-1] == 0)) { exit(1); } value = strtod(spaceString, &term); if (term == (spaceString+1)) { exit(1); } exit(0); }], tcl_cv_strtod_buggy=ok, tcl_cv_strtod_buggy=buggy, }], tcl_cv_strtod_buggy=1, tcl_cv_strtod_buggy=0, tcl_cv_strtod_buggy=0)]) if test "$tcl_cv_strtod_buggy" = 1; then tcl_cv_strtod_buggy=buggy)]) if test "$tcl_cv_strtod_buggy" = buggy; then AC_MSG_RESULT(ok) else AC_MSG_RESULT(buggy) LIBOBJS="$LIBOBJS fixstrtod.o" AC_DEFINE(strtod, fixstrtod) fi fi ]) #--------------------------------------------------------------------
︙
2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286	2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681	- +	# LIBS # # Might define the following vars: # HAVE_NET_ERRNO_H # #-------------------------------------------------------------------- AC_DEFUN(SC_TCL_LINK_LIBS, [ AC_DEFUN([SC_TCL_LINK_LIBS], [ #-------------------------------------------------------------------- # On a few very rare systems, all of the libm.a stuff is # already in libc.a. Set compiler flags accordingly. # Also, Linux requires the "ieee" library for math to work # right (and it must appear before "-lm"). #--------------------------------------------------------------------
︙
2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 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	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 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 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 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 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 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 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 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235	+ - + - + + - + + + - + - - + + + - + - - - + + + - + - + - - + - - - + - + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + + + +	# None # # Results: # # Might define the following vars: # _ISOC99_SOURCE # _LARGEFILE64_SOURCE # _LARGEFILE_SOURCE64 # #-------------------------------------------------------------------- AC_DEFUN(SC_TCL_EARLY_FLAG,[ AC_DEFUN([SC_TCL_EARLY_FLAG],[ AC_CACHE_VAL([tcl_cv_flag_]translit($1,[A-Z],[a-z]), AC_TRY_COMPILE([$2], $3, [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no, AC_TRY_COMPILE([[#define ]$1[ 1 ]$2], $3, [tcl_cv_flag_]translit($1,[A-Z],[a-z])=yes, [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no))) if test ["x${tcl_cv_flag_]translit($1,[A-Z],[a-z])[}" = "xyes"] ; then AC_DEFINE($1) tcl_flags="$tcl_flags $1" fi]) fi ]) AC_DEFUN(SC_TCL_EARLY_FLAGS,[ AC_DEFUN([SC_TCL_EARLY_FLAGS],[ AC_MSG_CHECKING([for required early compiler flags]) tcl_flags="" SC_TCL_EARLY_FLAG(_ISOC99_SOURCE,[#include <stdlib.h>], [char *p = (char *)strtoll; char *q = (char *)strtoull;]) SC_TCL_EARLY_FLAG(_LARGEFILE64_SOURCE,[#include <sys/stat.h>], [struct stat64 buf; int i = stat64("/", &buf);]) SC_TCL_EARLY_FLAG(_LARGEFILE_SOURCE64,[#include <sys/stat.h>], [char *p = (char *)open64;]) if test "x${tcl_flags}" = "x" ; then AC_MSG_RESULT(none) AC_MSG_RESULT([none]) else AC_MSG_RESULT(${tcl_flags}) fi]) AC_MSG_RESULT([${tcl_flags}]) fi ]) #-------------------------------------------------------------------- # SC_TCL_64BIT_FLAGS # # Check for what is defined in the way of 64-bit features. # # Arguments: # None # # Results: # # Might define the following vars: # TCL_WIDE_INT_IS_LONG # TCL_WIDE_INT_TYPE # HAVE_STRUCT_DIRENT64 # HAVE_STRUCT_STAT64 # HAVE_TYPE_OFF64_T # #-------------------------------------------------------------------- AC_DEFUN(SC_TCL_64BIT_FLAGS, [ AC_DEFUN([SC_TCL_64BIT_FLAGS], [ AC_MSG_CHECKING([for 64-bit integer type]) AC_CACHE_VAL(tcl_cv_type_64bit,[ tcl_cv_type_64bit=none # See if the compiler knows natively about __int64 AC_TRY_COMPILE(,[__int64 value = (__int64) 0;], tcl_type_64bit=__int64, tcl_type_64bit="long long") # See if we should use long anyway Note that we substitute in the # type that is our current guess for a 64-bit type inside this check # program, so it should be modified only carefully... AC_TRY_RUN([#include <unistd.h> int main() {exit(!(sizeof(]${tcl_type_64bit}[) > sizeof(long)));} ], tcl_cv_type_64bit=${tcl_type_64bit},:,:)]) AC_TRY_COMPILE(,[switch (0) { case 1: case (sizeof(]${tcl_type_64bit}[)==sizeof(long)): ; }],tcl_cv_type_64bit=${tcl_type_64bit})]) if test "${tcl_cv_type_64bit}" = none ; then AC_DEFINE(TCL_WIDE_INT_IS_LONG) AC_MSG_RESULT(using long) AC_MSG_RESULT([using long]) else AC_DEFINE_UNQUOTED(TCL_WIDE_INT_TYPE,${tcl_cv_type_64bit}) AC_MSG_RESULT(${tcl_cv_type_64bit}) AC_MSG_RESULT([${tcl_cv_type_64bit}]) # Now check for auxiliary declarations AC_MSG_CHECKING([for struct dirent64]) AC_CACHE_VAL(tcl_cv_struct_dirent64,[ AC_CACHE_CHECK([for struct dirent64], tcl_cv_struct_dirent64,[ AC_TRY_COMPILE([#include <sys/types.h> #include <sys/dirent.h>],[struct dirent64 p;], tcl_cv_struct_dirent64=yes,tcl_cv_struct_dirent64=no)]) if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then AC_DEFINE(HAVE_STRUCT_DIRENT64) fi AC_MSG_RESULT(${tcl_cv_struct_dirent64}) AC_MSG_CHECKING([for struct stat64]) AC_CACHE_VAL(tcl_cv_struct_stat64,[ AC_CACHE_CHECK([for struct stat64], tcl_cv_struct_stat64,[ AC_TRY_COMPILE([#include <sys/stat.h>],[struct stat64 p; ], tcl_cv_struct_stat64=yes,tcl_cv_struct_stat64=no)]) if test "x${tcl_cv_struct_stat64}" = "xyes" ; then AC_DEFINE(HAVE_STRUCT_STAT64) fi AC_MSG_RESULT(${tcl_cv_struct_stat64}) AC_CHECK_FUNCS(open64 lseek64) AC_MSG_CHECKING([for off64_t]) AC_CACHE_VAL(tcl_cv_type_off64_t,[ AC_TRY_COMPILE([#include <sys/types.h>],[off64_t offset; ], tcl_cv_type_off64_t=yes,tcl_cv_type_off64_t=no)]) dnl Define HAVE_TYPE_OFF64_T only when the off64_t type and the dnl functions lseek64 and open64 are defined. if test "x${tcl_cv_type_off64_t}" = "xyes" ; then if test "x${tcl_cv_type_off64_t}" = "xyes" && \ test "x${ac_cv_func_lseek64}" = "xyes" && \ test "x${ac_cv_func_open64}" = "xyes" ; then AC_DEFINE(HAVE_TYPE_OFF64_T) AC_MSG_RESULT([yes]) else AC_MSG_RESULT([no]) fi fi ]) #-------------------------------------------------------------------- # SC_TCL_GETHOSTBYADDR_R # # Check if we have MT-safe variant of gethostbyaddr(). # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETHOSTBYADDR_R # HAVE_GETHOSTBYADDR_R_7 # HAVE_GETHOSTBYADDR_R_8 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETHOSTBYADDR_R], [AC_CHECK_FUNC(gethostbyaddr_r, [ AC_CACHE_CHECK([for gethostbyaddr_r with 7 args], tcl_cv_api_gethostbyaddr_r_7, [ AC_TRY_COMPILE([ #include <netdb.h> ], [ char *addr; int length; int type; struct hostent *result; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, &h_errnop); ], tcl_cv_api_gethostbyaddr_r_7=yes, tcl_cv_api_gethostbyaddr_r_7=no)]) tcl_ok=$tcl_cv_api_gethostbyaddr_r_7 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYADDR_R_7) else AC_CACHE_CHECK([for gethostbyaddr_r with 8 args], tcl_cv_api_gethostbyaddr_r_8, [ AC_TRY_COMPILE([ #include <netdb.h> ], [ char *addr; int length; int type; struct hostent *result, *resultp; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen, &resultp, &h_errnop); ], tcl_cv_api_gethostbyaddr_r_8=yes, tcl_cv_api_gethostbyaddr_r_8=no)]) tcl_ok=$tcl_cv_api_gethostbyaddr_r_8 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYADDR_R_8) fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYADDR_R) fi ])]) #-------------------------------------------------------------------- # SC_TCL_GETHOSTBYNAME_R # # Check to see what variant of gethostbyname_r() we have. # Based on David Arnold's example from the comp.programming.threads # FAQ Q213 # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETHOSTBYADDR_R # HAVE_GETHOSTBYADDR_R_3 # HAVE_GETHOSTBYADDR_R_5 # HAVE_GETHOSTBYADDR_R_6 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETHOSTBYNAME_R], [AC_CHECK_FUNC(gethostbyname_r, [ AC_CACHE_CHECK([for gethostbyname_r with 6 args], tcl_cv_api_gethostbyname_r_6, [ AC_TRY_COMPILE([ #include <netdb.h> ], [ char *name; struct hostent *he, *res; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyname_r(name, he, buffer, buflen, &res, &h_errnop); ], tcl_cv_api_gethostbyname_r_6=yes, tcl_cv_api_gethostbyname_r_6=no)]) tcl_ok=$tcl_cv_api_gethostbyname_r_6 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYNAME_R_6) else AC_CACHE_CHECK([for gethostbyname_r with 5 args], tcl_cv_api_gethostbyname_r_5, [ AC_TRY_COMPILE([ #include <netdb.h> ], [ char *name; struct hostent *he; char buffer[2048]; int buflen = 2048; int h_errnop; (void) gethostbyname_r(name, he, buffer, buflen, &h_errnop); ], tcl_cv_api_gethostbyname_r_5=yes, tcl_cv_api_gethostbyname_r_5=no)]) tcl_ok=$tcl_cv_api_gethostbyname_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYNAME_R_5) else AC_CACHE_CHECK([for gethostbyname_r with 3 args], tcl_cv_api_gethostbyname_r_3, [ AC_TRY_COMPILE([ #include <netdb.h> ], [ char *name; struct hostent *he; struct hostent_data data; (void) gethostbyname_r(name, he, &data); ], tcl_cv_api_gethostbyname_r_3=yes, tcl_cv_api_gethostbyname_r_3=no)]) tcl_ok=$tcl_cv_api_gethostbyname_r_3 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYNAME_R_3) fi fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETHOSTBYNAME_R) fi ])]) #-------------------------------------------------------------------- # SC_TCL_GETPWUID_R # # Check if we have MT-safe variant of getpwuid() and if yes, # which one exactly. # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETPWUID_R # HAVE_GETPWUID_R_4 # HAVE_GETPWUID_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETPWUID_R], [AC_CHECK_FUNC(getpwuid_r, [ AC_CACHE_CHECK([for getpwuid_r with 5 args], tcl_cv_api_getpwuid_r_5, [ AC_TRY_COMPILE([ #include <sys/types.h> #include <pwd.h> ], [ uid_t uid; struct passwd pw, *pwp; char buf[512]; int buflen = 512; (void) getpwuid_r(uid, &pw, buf, buflen, &pwp); ], tcl_cv_api_getpwuid_r_5=yes, tcl_cv_api_getpwuid_r_5=no)]) tcl_ok=$tcl_cv_api_getpwuid_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWUID_R_5) else AC_CACHE_CHECK([for getpwuid_r with 4 args], tcl_cv_api_getpwuid_r_4, [ AC_TRY_COMPILE([ #include <sys/types.h> #include <pwd.h> ], [ uid_t uid; struct passwd pw; char buf[512]; int buflen = 512; (void)getpwnam_r(uid, &pw, buf, buflen); ], tcl_cv_api_getpwuid_r_4=yes, tcl_cv_api_getpwuid_r_4=no)]) tcl_ok=$tcl_cv_api_getpwuid_r_4 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWUID_R_4) fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWUID_R) fi ])]) #-------------------------------------------------------------------- # SC_TCL_GETPWNAM_R # # Check if we have MT-safe variant of getpwnam() and if yes, # which one exactly. # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETPWNAM_R # HAVE_GETPWNAM_R_4 # HAVE_GETPWNAM_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETPWNAM_R], [AC_CHECK_FUNC(getpwnam_r, [ AC_CACHE_CHECK([for getpwnam_r with 5 args], tcl_cv_api_getpwnam_r_5, [ AC_TRY_COMPILE([ #include <sys/types.h> #include <pwd.h> ], [ char *name; struct passwd pw, *pwp; char buf[512]; int buflen = 512; (void) getpwnam_r(name, &pw, buf, buflen, &pwp); ], tcl_cv_api_getpwnam_r_5=yes, tcl_cv_api_getpwnam_r_5=no)]) tcl_ok=$tcl_cv_api_getpwnam_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWNAM_R_5) else AC_CACHE_CHECK([for getpwnam_r with 4 args], tcl_cv_api_getpwnam_r_4, [ AC_TRY_COMPILE([ #include <sys/types.h> #include <pwd.h> ], [ char *name; struct passwd pw; char buf[512]; int buflen = 512; (void)getpwnam_r(name, &pw, buf, buflen); ], tcl_cv_api_getpwnam_r_4=yes, tcl_cv_api_getpwnam_r_4=no)]) tcl_ok=$tcl_cv_api_getpwnam_r_4 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWNAM_R_4) fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETPWNAM_R) fi ])]) #-------------------------------------------------------------------- # SC_TCL_GETGRGID_R # # Check if we have MT-safe variant of getgrgid() and if yes, # which one exactly. # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETGRGID_R # HAVE_GETGRGID_R_4 # HAVE_GETGRGID_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETGRGID_R], [AC_CHECK_FUNC(getgrgid_r, [ AC_CACHE_CHECK([for getgrgid_r with 5 args], tcl_cv_api_getgrgid_r_5, [ AC_TRY_COMPILE([ #include <sys/types.h> #include <grp.h> ], [ gid_t gid; struct group gr, *grp; char buf[512]; int buflen = 512; (void) getgrgid_r(gid, &gr, buf, buflen, &grp); ], tcl_cv_api_getgrgid_r_5=yes, tcl_cv_api_getgrgid_r_5=no)]) tcl_ok=$tcl_cv_api_getgrgid_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRGID_R_5) else AC_CACHE_CHECK([for getgrgid_r with 4 args], tcl_cv_api_getgrgid_r_4, [ AC_TRY_COMPILE([ #include <sys/types.h> #include <grp.h> ], [ gid_t gid; struct group gr; char buf[512]; int buflen = 512; (void)getgrgid_r(gid, &gr, buf, buflen); ], tcl_cv_api_getgrgid_r_4=yes, tcl_cv_api_getgrgid_r_4=no)]) tcl_ok=$tcl_cv_api_getgrgid_r_4 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRGID_R_4) fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRGID_R) fi ])]) #-------------------------------------------------------------------- # SC_TCL_GETGRNAM_R # # Check if we have MT-safe variant of getgrnam() and if yes, # which one exactly. # # Arguments: # None # # Results: # # Might define the following vars: # HAVE_GETGRNAM_R # HAVE_GETGRNAM_R_4 # HAVE_GETGRNAM_R_5 # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_GETGRNAM_R], [AC_CHECK_FUNC(getgrnam_r, [ AC_CACHE_CHECK([for getgrnam_r with 5 args], tcl_cv_api_getgrnam_r_5, [ AC_TRY_COMPILE([ #include <sys/types.h> #include <grp.h> ], [ char *name; struct group gr, *grp; char buf[512]; int buflen = 512; (void) getgrnam_r(name, &gr, buf, buflen, &grp); ], tcl_cv_api_getgrnam_r_5=yes, tcl_cv_api_getgrnam_r_5=no)]) tcl_ok=$tcl_cv_api_getgrnam_r_5 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRNAM_R_5) else AC_CACHE_CHECK([for getgrnam_r with 4 args], tcl_cv_api_getgrnam_r_4, [ AC_TRY_COMPILE([ #include <sys/types.h> #include <grp.h> ], [ char *name; struct group gr; char buf[512]; int buflen = 512; (void)getgrnam_r(name, &gr, buf, buflen); ], tcl_cv_api_getgrnam_r_4=yes, tcl_cv_api_getgrnam_r_4=no)]) tcl_ok=$tcl_cv_api_getgrnam_r_4 if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRNAM_R_4) fi fi if test "$tcl_ok" = yes; then AC_DEFINE(HAVE_GETGRNAM_R) fi ])]) AC_MSG_RESULT(${tcl_cv_type_off64_t}) fi]) #-------------------------------------------------------------------- # SC_CONFIG_COMMANDS_PRE(CMDS) # # Replacement for autoconf 2.5x AC_COMMANDS_PRE: # Commands to run right before config.status is # created. Accumulates. # # Requires presence of SC_OUTPUT_COMMANDS_PRE at the end # of configure.in (right before AC_OUTPUT). # #-------------------------------------------------------------------- AC_DEFUN([SC_CONFIG_COMMANDS_PRE], [ define([SC_OUTPUT_COMMANDS_PRE], defn([SC_OUTPUT_COMMANDS_PRE])[$1 ])]) AC_DEFUN([SC_OUTPUT_COMMANDS_PRE])

1 2 3 4 5 6 7 8 9 10 11	1 2 3 4 5 6 7 8 9 10 11	- + - +	# $Id: tcl.spec,v 1.16 2003/02/15 02:16:33 hobbs Exp $ # $Id: tcl.spec,v 1.16.2.16 2007/05/30 14:05:21 dgp Exp $ # This file is the basis for a binary Tcl RPM for Linux. %define version 8.4.2 %define version 8.4.16 %define directory /usr/local Summary: Tcl scripting language development environment Name: tcl Version: %{version} Release: 1 Copyright: BSD
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	# tclConfig.sh -- # # This shell script (for sh) is generated automatically by Tcl's # configure script. It will create shell variables for most of # the configuration options discovered by the configure script. # This script is intended to be included by the configure scripts # for Tcl extensions so that they don't have to figure this all # out for themselves. # # The information in this file is specific to a single platform. # # RCS: @(#) $Id: tclConfig.sh.in,v 1.17 2002/07/28 03:15:11 mdejong Exp $ # RCS: @(#) $Id: tclConfig.sh.in,v 1.17.2.1 2004/07/20 11:13:10 das Exp $ # Tcl's version number. TCL_VERSION='@TCL_VERSION@' TCL_MAJOR_VERSION='@TCL_MAJOR_VERSION@' TCL_MINOR_VERSION='@TCL_MINOR_VERSION@' TCL_PATCH_LEVEL='@TCL_PATCH_LEVEL@'
︙
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78	64 65 66 67 68 69 70 71 72 73 74 75 76 77 78	- +	# Flags to pass to cc when compiling the components of a shared library: TCL_SHLIB_CFLAGS='@SHLIB_CFLAGS@' # Flags to pass to cc to get warning messages TCL_CFLAGS_WARNING='@CFLAGS_WARNING@' # Extra flags to pass to cc: TCL_EXTRA_CFLAGS='@EXTRA_CFLAGS@' TCL_EXTRA_CFLAGS='@CFLAGS@' # Base command to use for combining object files into a shared library: TCL_SHLIB_LD='@SHLIB_LD@' # Base command to use for combining object files into a static library: TCL_STLIB_LD='@STLIB_LD@'
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclLoadDl.c -- * * This procedure provides a version of the TclLoadFile that * works with the "dlopen" and "dlsym" library procedures for * dynamic loading. * * Copyright (c) 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. * * RCS: @(#) $Id: tclLoadDl.c,v 1.13 2002/10/10 12:25:53 vincentdarley Exp $ * RCS: @(#) $Id: tclLoadDl.c,v 1.13.2.1 2006/06/13 22:54:01 dkf Exp $ */ #include "tclInt.h" #ifdef NO_DLFCN_H # include "../compat/dlfcn.h" #else # include <dlfcn.h>
︙
86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102	86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108	+ + + + + + + - + -	char *fileName = Tcl_GetString(pathPtr); native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL); Tcl_DStringFree(&ds); } if (handle == NULL) { /* * Write the string to a variable first to work around a compiler bug * in the Sun Forte 6 compiler. [Bug 1503729] */ CONST char *errorStr = dlerror(); Tcl_AppendResult(interp, "couldn't load file \"", Tcl_GetString(pathPtr), Tcl_GetString(pathPtr), "\": ", errorStr, (char *) NULL); "\": ", dlerror(), (char *) NULL); return TCL_ERROR; } *unloadProcPtr = &TclpUnloadFile; *loadHandle = (Tcl_LoadHandle)handle; return TCL_OK; }
︙

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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233

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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580

- + - - - + + + + - + - - + + - + + + + + + + + + + + - + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - - + + - + - - - - + + + + - - + + - + - - + + - + + + - - - - + + + + + - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - - - + + + + - - - - - + + + + + - + + - + + + - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - + - - - + + + - + - - + + + - - - - - + + + + + - - - + + + + - - - - + + + + - + - + - - + + - - - - + + + + - + - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

/* /* * tclLoadDyld.c -- * * This procedure provides a version of the TclLoadFile that * works with Apple's dyld dynamic loading. This file * provided by Wilfredo Sanchez (wsanchez@apple.com). * This procedure provides a version of the TclLoadFile that works with * Apple's dyld dynamic loading. * Original version of his file (now superseded long ago) provided by * Wilfredo Sanchez (wsanchez@apple.com). * This works on Mac OS X. * * Copyright (c) 1995 Apple Computer, Inc. * Copyright (c) 2001-2007 Daniel A. Steffen <das@users.sourceforge.net> * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclLoadDyld.c,v 1.14 2002/10/29 00:04:08 das Exp $ * RCS: @(#) $Id: tclLoadDyld.c,v 1.14.2.9 2007/04/29 02:20:16 das Exp $ */ #include "tclInt.h" #include "tclPort.h" #include <mach-o/dyld.h> #include <mach-o/fat.h> #include <mach-o/swap.h> #include <mach-o/arch.h> #include <libkern/OSByteOrder.h> #undef panic #include <mach/mach.h> #ifndef MODULE_SCOPE #define MODULE_SCOPE extern #endif typedef struct Tcl_DyldModuleHandle { struct Tcl_DyldModuleHandle *nextModuleHandle; struct Tcl_DyldModuleHandle *nextPtr; NSModule module; } Tcl_DyldModuleHandle; typedef struct Tcl_DyldLoadHandle { const struct mach_header *dyld_lib; Tcl_DyldModuleHandle *firstModuleHandle; CONST struct mach_header *dyldLibHeader; Tcl_DyldModuleHandle *modulePtr; } Tcl_DyldLoadHandle; #ifdef TCL_LOAD_FROM_MEMORY MODULE_SCOPE long tclMacOSXDarwinRelease; #endif  /* *---------------------------------------------------------------------- * * DyldOFIErrorMsg -- * * Converts a numerical NSObjectFileImage error into an error message * string. * * Results: * Error message string. * * Side effects: * None. * *---------------------------------------------------------------------- */ static CONST char* DyldOFIErrorMsg( int err) { switch(err) { case NSObjectFileImageSuccess: return NULL; case NSObjectFileImageFailure: return "object file setup failure"; case NSObjectFileImageInappropriateFile: return "not a Mach-O MH_BUNDLE file"; case NSObjectFileImageArch: return "no object for this architecture"; case NSObjectFileImageFormat: return "bad object file format"; case NSObjectFileImageAccess: return "can't read object file"; default: return "unknown error"; } }  /* *---------------------------------------------------------------------- * * TclpDlopen -- * * Dynamically loads a binary code file into memory and returns * a handle to the new code. * Dynamically loads a binary code file into memory and returns a handle * to the new code. * * Results: * A standard Tcl completion code. If an error occurs, an error * message is left in the interpreter's result. * A standard Tcl completion code. If an error occurs, an error message * is left in the interpreter's result. * * Side effects: * New code suddenly appears in memory. * New code suddenly appears in memory. * *---------------------------------------------------------------------- */ int TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) Tcl_Interp *interp; /* Used for error reporting. */ Tcl_Obj *pathPtr; /* Name of the file containing the desired MODULE_SCOPE int TclpDlopen( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *pathPtr, /* Name of the file containing the desired * code (UTF-8). */ Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded * file which will be passed back to Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr; Tcl_FSUnloadFileProc **unloadProcPtr) /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for * this file. */ * function which should be used for this * file. */ { Tcl_DyldLoadHandle *dyldLoadHandle; const struct mach_header *dyld_lib; CONST struct mach_header *dyldLibHeader; NSObjectFileImage dyldObjFileImage = NULL; Tcl_DyldModuleHandle *modulePtr = NULL; CONST char *native; /* * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load * using a relative path. /* * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load using a * relative path. */ native = Tcl_FSGetNativePath(pathPtr); dyld_lib = NSAddImage(native, NSADDIMAGE_OPTION_WITH_SEARCHING | NSADDIMAGE_OPTION_RETURN_ON_ERROR); if (!dyld_lib) { /* * Let the OS loader examine the binary search path for * whatever string the user gave us which hopefully refers * to a file on the binary path */ Tcl_DString ds; char *fileName = Tcl_GetString(pathPtr); native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); dyld_lib = NSAddImage(native, NSADDIMAGE_OPTION_WITH_SEARCHING | NSADDIMAGE_OPTION_RETURN_ON_ERROR); Tcl_DStringFree(&ds); } if (!dyld_lib) { NSLinkEditErrors editError; char *name, *msg; dyldLibHeader = NSAddImage(native, NSADDIMAGE_OPTION_RETURN_ON_ERROR); if (!dyldLibHeader) { NSLinkEditErrors editError; int errorNumber; CONST char *name, *msg, *objFileImageErrMsg = NULL; NSLinkEditError(&editError, &errorNumber, &name, &msg); if (editError == NSLinkEditFileAccessError) { /* * The requested file was not found. Let the OS loader examine the * binary search path for whatever string the user gave us which * hopefully refers to a file on the binary path. */ Tcl_DString ds; char *fileName = Tcl_GetString(pathPtr); CONST char *native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); dyldLibHeader = NSAddImage(native, NSADDIMAGE_OPTION_WITH_SEARCHING | NSADDIMAGE_OPTION_RETURN_ON_ERROR); Tcl_DStringFree(&ds); if (!dyldLibHeader) { NSLinkEditError(&editError, &errorNumber, &name, &msg); } } else if ((editError == NSLinkEditFileFormatError && errorNumber == EBADMACHO) || editError == NSLinkEditOtherError){ /* * The requested file was found but was not of type MH_DYLIB, * attempt to load it as a MH_BUNDLE. */ NSObjectFileImageReturnCode err = NSCreateObjectFileImageFromFile(native, &dyldObjFileImage); objFileImageErrMsg = DyldOFIErrorMsg(err); } NSLinkEditError(&editError, &errno, &name, &msg); Tcl_AppendResult(interp, msg, (char *) NULL); return TCL_ERROR; } dyldLoadHandle = (Tcl_DyldLoadHandle *) ckalloc(sizeof(Tcl_DyldLoadHandle)); if (!dyldLoadHandle) return TCL_ERROR; dyldLoadHandle->dyld_lib = dyld_lib; dyldLoadHandle->firstModuleHandle = NULL; if (!dyldLibHeader && !dyldObjFileImage) { Tcl_AppendResult(interp, msg, NULL); if (msg && *msg) { Tcl_AppendResult(interp, "\n", NULL); } if (objFileImageErrMsg) { Tcl_AppendResult(interp, "NSCreateObjectFileImageFromFile() error: ", objFileImageErrMsg, NULL); } return TCL_ERROR; } } if (dyldObjFileImage) { NSModule module; module = NSLinkModule(dyldObjFileImage, native, NSLINKMODULE_OPTION_BINDNOW | NSLINKMODULE_OPTION_RETURN_ON_ERROR); NSDestroyObjectFileImage(dyldObjFileImage); if (!module) { NSLinkEditErrors editError; int errorNumber; CONST char *name, *msg; NSLinkEditError(&editError, &errorNumber, &name, &msg); Tcl_AppendResult(interp, msg, NULL); return TCL_ERROR; } modulePtr = (Tcl_DyldModuleHandle *) ckalloc(sizeof(Tcl_DyldModuleHandle)); modulePtr->module = module; modulePtr->nextPtr = NULL; } dyldLoadHandle = (Tcl_DyldLoadHandle *) ckalloc(sizeof(Tcl_DyldLoadHandle)); dyldLoadHandle->dyldLibHeader = dyldLibHeader; dyldLoadHandle->modulePtr = modulePtr; *loadHandle = (Tcl_LoadHandle) dyldLoadHandle; *unloadProcPtr = &TclpUnloadFile; return TCL_OK; }  /* *---------------------------------------------------------------------- * * TclpFindSymbol -- * * Looks up a symbol, by name, through a handle associated with * a previously loaded piece of code (shared library). * Looks up a symbol, by name, through a handle associated with a * previously loaded piece of code (shared library). * * Results: * Returns a pointer to the function associated with 'symbol' if * it is found. Otherwise returns NULL and may leave an error * message in the interp's result. * Returns a pointer to the function associated with 'symbol' if it is * found. Otherwise returns NULL and may leave an error message in the * interp's result. * *---------------------------------------------------------------------- */ Tcl_PackageInitProc* TclpFindSymbol(interp, loadHandle, symbol) Tcl_Interp *interp; Tcl_LoadHandle loadHandle; CONST char *symbol; MODULE_SCOPE Tcl_PackageInitProc * TclpFindSymbol( Tcl_Interp *interp, /* For error reporting. */ Tcl_LoadHandle loadHandle, /* Handle from TclpDlopen. */ CONST char *symbol) /* Symbol name to look up. */ { NSSymbol nsSymbol; CONST char *native; Tcl_DString newName, ds; Tcl_PackageInitProc* proc = NULL; Tcl_PackageInitProc *proc = NULL; Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *) loadHandle; /* /* * dyld adds an underscore to the beginning of symbol names. */ native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds); Tcl_DStringInit(&newName); Tcl_DStringAppend(&newName, "_", 1); native = Tcl_DStringAppend(&newName, native, -1); if (dyldLoadHandle->dyldLibHeader) { nsSymbol = NSLookupSymbolInImage(dyldLoadHandle->dyld_lib, native, NSLOOKUPSYMBOLINIMAGE_OPTION_BIND_NOW | NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR); if(nsSymbol) { Tcl_DyldModuleHandle *dyldModuleHandle; proc = NSAddressOfSymbol(nsSymbol); dyldModuleHandle = (Tcl_DyldModuleHandle *) ckalloc(sizeof(Tcl_DyldModuleHandle)); if (dyldModuleHandle) { dyldModuleHandle->module = NSModuleForSymbol(nsSymbol); dyldModuleHandle->nextModuleHandle = dyldLoadHandle->firstModuleHandle; dyldLoadHandle->firstModuleHandle = dyldModuleHandle; } } else { NSLinkEditErrors editError; char *name, *msg; NSLinkEditError(&editError, &errno, &name, &msg); Tcl_AppendResult(interp, msg, (char *) NULL); nsSymbol = NSLookupSymbolInImage(dyldLoadHandle->dyldLibHeader, native, NSLOOKUPSYMBOLINIMAGE_OPTION_BIND_NOW | NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR); if (nsSymbol) { /* * Until dyld supports unloading of MY_DYLIB binaries, the * following is not needed. */ #ifdef DYLD_SUPPORTS_DYLIB_UNLOADING NSModule module = NSModuleForSymbol(nsSymbol); Tcl_DyldModuleHandle *modulePtr = dyldLoadHandle->modulePtr; while (modulePtr != NULL) { if (module == modulePtr->module) { break; } modulePtr = modulePtr->nextPtr; } if (modulePtr == NULL) { modulePtr = (Tcl_DyldModuleHandle *) ckalloc(sizeof(Tcl_DyldModuleHandle)); modulePtr->module = module; modulePtr->nextPtr = dyldLoadHandle->modulePtr; dyldLoadHandle->modulePtr = modulePtr; } #endif /* DYLD_SUPPORTS_DYLIB_UNLOADING */ } else { NSLinkEditErrors editError; int errorNumber; CONST char *name, *msg; NSLinkEditError(&editError, &errorNumber, &name, &msg); Tcl_AppendResult(interp, msg, NULL); } } else { nsSymbol = NSLookupSymbolInModule(dyldLoadHandle->modulePtr->module, native); } if (nsSymbol) { proc = NSAddressOfSymbol(nsSymbol); } Tcl_DStringFree(&newName); Tcl_DStringFree(&ds); return proc; }  /* *---------------------------------------------------------------------- * * TclpUnloadFile -- * * Unloads a dynamically loaded binary code file from memory. * Code pointers in the formerly loaded file are no longer valid * after calling this function. * Unloads a dynamically loaded binary code file from memory. Code * pointers in the formerly loaded file are no longer valid after calling * this function. * * Results: * None. * None. * * Side effects: * Code dissapears from memory. * Note that this is a no-op on older (OpenStep) versions of dyld. * Code dissapears from memory. Note that dyld currently only supports * unloading of binaries of type MH_BUNDLE loaded with NSLinkModule() in * TclpDlopen() above. * *---------------------------------------------------------------------- */ void TclpUnloadFile(loadHandle) Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call * to TclpDlopen(). The loadHandle is * a token that represents the loaded MODULE_SCOPE void TclpUnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ * file. */ { Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *) loadHandle; Tcl_DyldModuleHandle *dyldModuleHandle = dyldLoadHandle->firstModuleHandle; void *ptr; Tcl_DyldModuleHandle *modulePtr = dyldLoadHandle->modulePtr; while (modulePtr != NULL) { void *ptr; while (dyldModuleHandle) { NSUnLinkModule(dyldModuleHandle->module, NSUNLINKMODULE_OPTION_NONE); ptr = dyldModuleHandle; dyldModuleHandle = dyldModuleHandle->nextModuleHandle; NSUnLinkModule(modulePtr->module, NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES); ptr = modulePtr; modulePtr = modulePtr->nextPtr; ckfree(ptr); } ckfree(dyldLoadHandle); ckfree((char*) dyldLoadHandle); }  /* *---------------------------------------------------------------------- * * TclGuessPackageName -- * * If the "load" command is invoked without providing a package * name, this procedure is invoked to try to figure it out. * If the "load" command is invoked without providing a package name, * this procedure is invoked to try to figure it out. * * Results: * Always returns 0 to indicate that we couldn't figure out a * package name; generic code will then try to guess the package * from the file name. A return value of 1 would have meant that * we figured out the package name and put it in bufPtr. * Always returns 0 to indicate that we couldn't figure out a package * name; generic code will then try to guess the package from the file * name. A return value of 1 would have meant that we figured out the * package name and put it in bufPtr. * * Side effects: * None. * None. * *---------------------------------------------------------------------- */ int TclGuessPackageName(fileName, bufPtr) CONST char *fileName; /* Name of file containing package (already * translated to local form if needed). */ Tcl_DString *bufPtr; /* Initialized empty dstring. Append * package name to this if possible. */ TclGuessPackageName( CONST char *fileName, /* Name of file containing package (already * translated to local form if needed). */ Tcl_DString *bufPtr) /* Initialized empty dstring. Append package * name to this if possible. */ { return 0; }  #ifdef TCL_LOAD_FROM_MEMORY /* *---------------------------------------------------------------------- * * TclpLoadMemoryGetBuffer -- * * Allocate a buffer that can be used with TclpLoadMemory() below. * * Results: * Pointer to allocated buffer or NULL if an error occurs. * * Side effects: * Buffer is allocated. * *---------------------------------------------------------------------- */ MODULE_SCOPE void * TclpLoadMemoryGetBuffer( Tcl_Interp *interp, /* Used for error reporting. */ int size) /* Size of desired buffer. */ { void *buffer = NULL; /* * NSCreateObjectFileImageFromMemory is available but always fails * prior to Darwin 7. */ if (tclMacOSXDarwinRelease >= 7) { /* * We must allocate the buffer using vm_allocate, because * NSCreateObjectFileImageFromMemory will dispose of it using * vm_deallocate. */ if (vm_allocate(mach_task_self(), (vm_address_t *) &buffer, size, 1)) { buffer = NULL; } } return buffer; }  /* *---------------------------------------------------------------------- * * TclpLoadMemory -- * * Dynamically loads binary code file from memory and returns a handle to * the new code. * * Results: * A standard Tcl completion code. If an error occurs, an error message * is left in the interpreter's result. * * Side effects: * New code is loaded from memory. * *---------------------------------------------------------------------- */ MODULE_SCOPE int TclpLoadMemory( Tcl_Interp *interp, /* Used for error reporting. */ void *buffer, /* Buffer containing the desired code * (allocated with TclpLoadMemoryGetBuffer). */ int size, /* Allocation size of buffer. */ int codeSize, /* Size of code data read into buffer or -1 if * an error occurred and the buffer should * just be freed. */ Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr) /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ { Tcl_DyldLoadHandle *dyldLoadHandle; NSObjectFileImage dyldObjFileImage = NULL; Tcl_DyldModuleHandle *modulePtr; NSModule module; CONST char *objFileImageErrMsg = NULL; /* * Try to create an object file image that we can load from. */ if (codeSize >= 0) { NSObjectFileImageReturnCode err = NSObjectFileImageSuccess; CONST struct fat_header *fh = buffer; uint32_t ms = 0; #ifndef __LP64__ CONST struct mach_header *mh = NULL; #define mh_magic OSSwapHostToBigInt32(MH_MAGIC) #define mh_size sizeof(struct mach_header) #else CONST struct mach_header_64 *mh = NULL; #define mh_magic OSSwapHostToBigInt32(MH_MAGIC_64) #define mh_size sizeof(struct mach_header_64) #endif if ((size_t) codeSize >= sizeof(struct fat_header) && fh->magic == OSSwapHostToBigInt32(FAT_MAGIC)) { /* * Fat binary, try to find mach_header for our architecture */ uint32_t fh_nfat_arch = OSSwapBigToHostInt32(fh->nfat_arch); if ((size_t) codeSize >= sizeof(struct fat_header) + fh_nfat_arch * sizeof(struct fat_arch)) { void *fatarchs = (char*)buffer + sizeof(struct fat_header); CONST NXArchInfo *arch = NXGetLocalArchInfo(); struct fat_arch *fa; if (fh->magic != FAT_MAGIC) { swap_fat_arch(fatarchs, fh_nfat_arch, arch->byteorder); } fa = NXFindBestFatArch(arch->cputype, arch->cpusubtype, fatarchs, fh_nfat_arch); if (fa) { mh = (void*)((char*)buffer + fa->offset); ms = fa->size; } else { err = NSObjectFileImageInappropriateFile; } if (fh->magic != FAT_MAGIC) { swap_fat_arch(fatarchs, fh_nfat_arch, arch->byteorder); } } else { err = NSObjectFileImageInappropriateFile; } } else { /* * Thin binary */ mh = buffer; ms = codeSize; } if (ms && !(ms >= mh_size && mh->magic == mh_magic && mh->filetype == OSSwapHostToBigInt32(MH_BUNDLE))) { err = NSObjectFileImageInappropriateFile; } if (err == NSObjectFileImageSuccess) { err = NSCreateObjectFileImageFromMemory(buffer, codeSize, &dyldObjFileImage); } objFileImageErrMsg = DyldOFIErrorMsg(err); } /* * If it went wrong (or we were asked to just deallocate), get rid of the * memory block and create an error message. */ if (dyldObjFileImage == NULL) { vm_deallocate(mach_task_self(), (vm_address_t) buffer, size); if (objFileImageErrMsg != NULL) { Tcl_AppendResult(interp, "NSCreateObjectFileImageFromMemory() error: ", objFileImageErrMsg, NULL); } return TCL_ERROR; } /* * Extract the module we want from the image of the object file. */ module = NSLinkModule(dyldObjFileImage, "[Memory Based Bundle]", NSLINKMODULE_OPTION_BINDNOW | NSLINKMODULE_OPTION_RETURN_ON_ERROR); NSDestroyObjectFileImage(dyldObjFileImage); if (!module) { NSLinkEditErrors editError; int errorNumber; CONST char *name, *msg; NSLinkEditError(&editError, &errorNumber, &name, &msg); Tcl_AppendResult(interp, msg, NULL); return TCL_ERROR; } /* * Stash the module reference within the load handle we create and return. */ modulePtr = (Tcl_DyldModuleHandle *) ckalloc(sizeof(Tcl_DyldModuleHandle)); modulePtr->module = module; modulePtr->nextPtr = NULL; dyldLoadHandle = (Tcl_DyldLoadHandle *) ckalloc(sizeof(Tcl_DyldLoadHandle)); dyldLoadHandle->dyldLibHeader = NULL; dyldLoadHandle->modulePtr = modulePtr; *loadHandle = (Tcl_LoadHandle) dyldLoadHandle; *unloadProcPtr = &TclpUnloadFile; return TCL_OK; } #endif  /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclLoadShl.c -- * * This procedure provides a version of the TclLoadFile that works * with the "shl_load" and "shl_findsym" library procedures for * dynamic loading (e.g. for HP machines). * * Copyright (c) 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. * * RCS: @(#) $Id: tclLoadShl.c,v 1.13 2002/10/10 12:25:53 vincentdarley Exp $ * RCS: @(#) $Id: tclLoadShl.c,v 1.13.2.1 2005/10/05 04:23:56 hobbs Exp $ */ #include <dl.h> /* * On some HP machines, dl.h defines EXTERN; remove that definition. */
︙
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	67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90	- + - + - - + - +	* and allows to load libtk8.0.sl into tclsh8.0 without problems. * In general, this delays resolving symbols until they are actually * needed. Shared libs do no longer need all libraries linked in * when they are build." */ /* /* * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load * using a relative path. */ native = Tcl_FSGetNativePath(pathPtr); handle = shl_load(native, handle = shl_load(native, BIND_DEFERRED|BIND_VERBOSE, 0L); BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH, 0L); if (handle == NULL) { /* /* * Let the OS loader examine the binary search path for * whatever string the user gave us which hopefully refers * to a file on the binary path */ Tcl_DString ds; native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); handle = shl_load(native,
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclUnixChan.c * * Common channel driver for Unix channels based on files, command * pipes and TCP sockets. * * Copyright (c) 1995-1997 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. * * RCS: @(#) $Id: tclUnixChan.c,v 1.42 2003/02/21 02:36:27 hobbs Exp $ * RCS: @(#) $Id: tclUnixChan.c,v 1.42.2.10 2006/11/28 16:29:48 kennykb Exp $ */ #include "tclInt.h" /* Internal definitions for Tcl. */ #include "tclPort.h" /* Portability features for Tcl. */ #include "tclIO.h" /* To get Channel type declaration. */ /*
︙
246 247 248 249 250 251 252 253 254 255 256 257 258 259	246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263	+ + + +	static int FileInputProc _ANSI_ARGS_((ClientData instanceData, char *buf, int toRead, int *errorCode)); static int FileOutputProc _ANSI_ARGS_(( ClientData instanceData, CONST char *buf, int toWrite, int *errorCode)); static int FileSeekProc _ANSI_ARGS_((ClientData instanceData, long offset, int mode, int *errorCode)); #ifdef DEPRECATED static void FileThreadActionProc _ANSI_ARGS_ (( ClientData instanceData, int action)); #endif static Tcl_WideInt FileWideSeekProc _ANSI_ARGS_((ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCode)); static void FileWatchProc _ANSI_ARGS_((ClientData instanceData, int mask)); static void TcpAccept _ANSI_ARGS_((ClientData data, int mask)); static int TcpBlockModeProc _ANSI_ARGS_((ClientData data, int mode));
︙
301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378	305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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	- + + + + + + - + + + - + + +	/* * This structure describes the channel type structure for file based IO: */ static Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_3, /* v3 channel */ TCL_CHANNEL_VERSION_4, /* v4 channel */ FileCloseProc, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ FileSeekProc, /* Seek proc. */ NULL, /* Set option proc. */ NULL, /* Get option proc. */ FileWatchProc, /* Initialize notifier. */ FileGetHandleProc, /* Get OS handles out of channel. */ NULL, /* close2proc. */ FileBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ FileWideSeekProc, /* wide seek proc. */ #ifdef DEPRECATED FileThreadActionProc, /* thread actions */ #else NULL, #endif }; #ifdef SUPPORTS_TTY /* * This structure describes the channel type structure for serial IO. * Note that this type is a subclass of the "file" type. */ static Tcl_ChannelType ttyChannelType = { "tty", /* Type name. */ TCL_CHANNEL_VERSION_2, /* v2 channel */ TCL_CHANNEL_VERSION_4, /* v4 channel */ TtyCloseProc, /* Close proc. */ FileInputProc, /* Input proc. */ #if BAD_TIP35_FLUSH TtyOutputProc, /* Output proc. */ #else /* !BAD_TIP35_FLUSH */ FileOutputProc, /* Output proc. */ #endif /* BAD_TIP35_FLUSH */ NULL, /* Seek proc. */ TtySetOptionProc, /* Set option proc. */ TtyGetOptionProc, /* Get option proc. */ FileWatchProc, /* Initialize notifier. */ FileGetHandleProc, /* Get OS handles out of channel. */ NULL, /* close2proc. */ FileBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc. */ NULL, /* thread action proc. */ }; #endif /* SUPPORTS_TTY */ /* * This structure describes the channel type structure for TCP socket * based IO: */ static Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_2, /* v2 channel */ TCL_CHANNEL_VERSION_4, /* v4 channel */ TcpCloseProc, /* Close proc. */ TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ NULL, /* Set option proc. */ TcpGetOptionProc, /* Get option proc. */ TcpWatchProc, /* Initialize notifier. */ TcpGetHandleProc, /* Get OS handles out of channel. */ NULL, /* close2proc. */ TcpBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc. */ NULL, /* thread action proc. */ };  /* *---------------------------------------------------------------------- * * FileBlockModeProc --
︙
965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981	978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996	+ +	iostate.c_cc[VSTOP] = argv[1][0]; } else { if (interp) { Tcl_AppendResult(interp, "bad value for -xchar: should be a list of two elements", (char *) NULL); } ckfree((char *) argv); return TCL_ERROR; } SETIOSTATE(fsPtr->fd, &iostate); ckfree((char *) argv); return TCL_OK; } /* * Option -timeout msec */ if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) {
︙
991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062	1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084	+ + - - + + + - + + - + + - + + - - + + + - - + +	return TCL_OK; } /* * Option -ttycontrol {DTR 1 RTS 0 BREAK 0} */ if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) { int i; if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } if ((argc % 2) == 1) { if (interp) { Tcl_AppendResult(interp, "bad value for -ttycontrol: should be a list of", "signal,value pairs", (char *) NULL); } ckfree((char *) argv); return TCL_ERROR; } GETCONTROL(fsPtr->fd, &control); while (argc > 1) { if (Tcl_GetBoolean(interp, argv[1], &flag) == TCL_ERROR) { for (i = 0; i < argc-1; i += 2) { if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) { ckfree((char *) argv); return TCL_ERROR; } if (strncasecmp(argv[0], "DTR", strlen(argv[0])) == 0) { if (strncasecmp(argv[i], "DTR", strlen(argv[i])) == 0) { #ifdef TIOCM_DTR if (flag) { control |= TIOCM_DTR; } else { control &= ~TIOCM_DTR; } #else /* !TIOCM_DTR */ UNSUPPORTED_OPTION("-ttycontrol DTR"); ckfree((char *) argv); return TCL_ERROR; #endif /* TIOCM_DTR */ } else if (strncasecmp(argv[0], "RTS", strlen(argv[0])) == 0) { } else if (strncasecmp(argv[i], "RTS", strlen(argv[i])) == 0) { #ifdef TIOCM_RTS if (flag) { control |= TIOCM_RTS; } else { control &= ~TIOCM_RTS; } #else /* !TIOCM_RTS*/ UNSUPPORTED_OPTION("-ttycontrol RTS"); ckfree((char *) argv); return TCL_ERROR; #endif /* TIOCM_RTS*/ } else if (strncasecmp(argv[0], "BREAK", strlen(argv[0])) == 0) { } else if (strncasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) { #ifdef SETBREAK SETBREAK(fsPtr->fd, flag); #else /* !SETBREAK */ UNSUPPORTED_OPTION("-ttycontrol BREAK"); ckfree((char *) argv); return TCL_ERROR; #endif /* SETBREAK */ } else { if (interp) { Tcl_AppendResult(interp, "bad signal for -ttycontrol: must be ", Tcl_AppendResult(interp, "bad signal \"", argv[i], "\" for -ttycontrol: must be ", "DTR, RTS or BREAK", (char *) NULL); } ckfree((char *) argv); return TCL_ERROR; } argc -= 2, argv += 2; } /* while (argc > 1) */ } /* -ttycontrol options loop */ SETCONTROL(fsPtr->fd, &control); ckfree((char *) argv); return TCL_OK; } return Tcl_BadChannelOption(interp, optionName, "mode handshake timeout ttycontrol xchar "); #else /* !USE_TERMIOS */
︙
1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842	1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867	+ + + + - + -	translation = NULL; channelTypePtr = &fileChannelType; fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState)); } #ifdef DEPRECATED if (channelTypePtr == &fileChannelType) { /* TIP #218. Removed the code inserting the new structure * into the global list. This is now handled in the thread * action callbacks, and only there. */ fsPtr->nextPtr = tsdPtr->firstFilePtr; fsPtr->nextPtr = NULL; tsdPtr->firstFilePtr = fsPtr; } #endif /* DEPRECATED */ fsPtr->validMask = channelPermissions | TCL_EXCEPTION; fsPtr->fd = fd; fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName, (ClientData) fsPtr, channelPermissions);
︙
1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934	1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962	- - + + + + - - - + + + + - - - + + +	FileState *fsPtr; char channelName[16 + TCL_INTEGER_SPACE]; int fd = (int) handle; Tcl_ChannelType *channelTypePtr; #ifdef DEPRECATED ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #endif /* DEPRECATED */ int socketType = 0; socklen_t argLength = sizeof(int); struct sockaddr sockaddr; socklen_t sockaddrLen = sizeof(sockaddr); if (mode == 0) { return NULL; } /* * Look to see if a channel with this fd and the same mode already exists. * If the fd is used, but the mode doesn't match, return NULL. */ #ifdef DEPRECATED for (fsPtr = tsdPtr->firstFilePtr; fsPtr != NULL; fsPtr = fsPtr->nextPtr) { if (fsPtr->fd == fd) { return ((mode|TCL_EXCEPTION) == fsPtr->validMask) ? fsPtr->channel : NULL; } } #endif /* DEPRECATED */ sockaddr.sa_family = AF_UNSPEC; #ifdef SUPPORTS_TTY if (isatty(fd)) { fsPtr = TtyInit(fd, 0); channelTypePtr = &ttyChannelType; sprintf(channelName, "serial%d", fd); } else #endif /* SUPPORTS_TTY */ if (getsockopt(fd, SOL_SOCKET, SO_TYPE, (VOID *)&socketType, &argLength) == 0 && socketType == SOCK_STREAM) { return MakeTcpClientChannelMode((ClientData) fd, mode); if (getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0 && sockaddrLen > 0 && sockaddr.sa_family == AF_INET) { return MakeTcpClientChannelMode((ClientData) fd, mode); } else { channelTypePtr = &fileChannelType; fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState)); sprintf(channelName, "file%d", fd); channelTypePtr = &fileChannelType; fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState)); sprintf(channelName, "file%d", fd); } #ifdef DEPRECATED if (channelTypePtr == &fileChannelType) { fsPtr->nextPtr = tsdPtr->firstFilePtr; tsdPtr->firstFilePtr = fsPtr; }
︙
2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295	2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324	- + - + +	if (getpeername(statePtr->fd, (struct sockaddr *) &peername, &size) >= 0) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-peername"); Tcl_DStringStartSublist(dsPtr); } Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr)); hostEntPtr = gethostbyaddr( /* INTL: Native. */ hostEntPtr = TclpGetHostByAddr( /* INTL: Native. */ (char *) &peername.sin_addr, sizeof(peername.sin_addr), AF_INET); if (hostEntPtr != NULL) { if (hostEntPtr != (struct hostent *) NULL) { Tcl_DString ds; Tcl_ExternalToUtfDString(NULL, hostEntPtr->h_name, -1, &ds); Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); } else { Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr)); } TclFormatInt(buf, ntohs(peername.sin_port)); Tcl_DStringAppendElement(dsPtr, buf); if (len == 0) { Tcl_DStringEndSublist(dsPtr);
︙
2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341	2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371	- + +	if (getsockname(statePtr->fd, (struct sockaddr *) &sockname, &size) >= 0) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-sockname"); Tcl_DStringStartSublist(dsPtr); } Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr)); hostEntPtr = gethostbyaddr( /* INTL: Native. */ hostEntPtr = TclpGetHostByAddr( /* INTL: Native. */ (char *) &sockname.sin_addr, sizeof(sockname.sin_addr), AF_INET); if (hostEntPtr != (struct hostent *) NULL) { Tcl_DString ds; Tcl_ExternalToUtfDString(NULL, hostEntPtr->h_name, -1, &ds); Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); } else { Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr)); } TclFormatInt(buf, ntohs(sockname.sin_port)); Tcl_DStringAppendElement(dsPtr, buf); if (len == 0) { Tcl_DStringEndSublist(dsPtr);
︙
2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667	2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697	- - + +	} addr.s_addr = inet_addr(native); /* INTL: Native. */ /* * This is 0xFFFFFFFF to ensure that it compares as a 32bit -1 * on either 32 or 64 bits systems. */ if (addr.s_addr == 0xFFFFFFFF) { hostent = gethostbyname(native); /* INTL: Native. */ if (hostent != NULL) { hostent = TclpGetHostByName(native); /* INTL: Native. */ if (hostent != (struct hostent *) NULL) { memcpy((VOID *) &addr, (VOID *) hostent->h_addr_list[0], (size_t) hostent->h_length); } else { #ifdef EHOSTUNREACH errno = EHOSTUNREACH; #else /* !EHOSTUNREACH */
︙
3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165	3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196	- + - + +	* TCL_EXCEPTION. */ int timeout; /* Maximum amount of time to wait for one * of the conditions in mask to occur, in * milliseconds. A value of 0 means don't * wait at all, and a value of -1 means * wait forever. */ { Tcl_Time abortTime, now; Tcl_Time abortTime = {0, 0}, now; /* silence gcc 4 warning */ struct timeval blockTime, *timeoutPtr; int index, bit, numFound, result = 0; int index, numFound, result = 0; fd_mask bit; fd_mask readyMasks[3*MASK_SIZE]; /* This array reflects the readable/writable * conditions that were found to exist by the * last call to select. */ /* * If there is a non-zero finite timeout, compute the time when
︙
3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202	3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233	- +	*/ if (fd >= FD_SETSIZE) { panic("TclWaitForFile can't handle file id %d", fd); } memset((VOID *) readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask)); index = fd/(NBBY*sizeof(fd_mask)); bit = 1 << (fd%(NBBY*sizeof(fd_mask))); bit = ((fd_mask) 1) << (fd%(NBBY*sizeof(fd_mask))); /* * Loop in a mini-event loop of our own, waiting for either the * file to become ready or a timeout to occur. */ while (1) {
︙
3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362	3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357	+ + + + - + - + - - - + + - - - + + - - - - - + + + + + + + + - - - - - - - - - - - - - + + + + + + + + - - - - - + + + + + - - - + + + - - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +	if (result) { break; } } if (timeout == 0) { break; } if (timeout < 0) { continue; } /* * The select returned early, so we need to recompute the timeout. */ Tcl_GetTime(&now); if ((abortTime.sec < now.sec) || ((abortTime.sec == now.sec) && (abortTime.usec <= now.usec))) { break; } } return result; }  #ifdef DEPRECATED /* *---------------------------------------------------------------------- * * TclpCutFileChannel -- * FileThreadActionProc -- * * Remove any thread local refs to this channel. See * Insert or remove any thread local refs to this channel. * Tcl_CutChannel for more info. * * Results: * None. * * Side effects: * Changes thread local list of valid channels. * *---------------------------------------------------------------------- */ void TclpCutFileChannel(chan) static void FileThreadActionProc (instanceData, action) Tcl_Channel chan; /* The channel being removed. Must * not be referenced in any * interpreter. */ ClientData instanceData; int action; { #ifdef DEPRECATED ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Channel *chanPtr = (Channel *) chan; FileState *fsPtr; FileState **nextPtrPtr; int removed = 0; FileState *fsPtr = (FileState *) instanceData; if (action == TCL_CHANNEL_THREAD_INSERT) { fsPtr->nextPtr = tsdPtr->firstFilePtr; tsdPtr->firstFilePtr = fsPtr; } else { FileState **nextPtrPtr; int removed = 0; if (chanPtr->typePtr != &fileChannelType) return; fsPtr = (FileState *) chanPtr->instanceData; for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL; nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { if ((*nextPtrPtr) == fsPtr) { (*nextPtrPtr) = fsPtr->nextPtr; removed = 1; break; } } for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL; nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { if ((*nextPtrPtr) == fsPtr) { (*nextPtrPtr) = fsPtr->nextPtr; removed = 1; break; } } /* * This could happen if the channel was created in one thread * and then moved to another without updating the thread * local data in each thread. */ /* * This could happen if the channel was created in one * thread and then moved to another without updating * the thread local data in each thread. */ if (!removed) panic("file info ptr not on thread channel list"); if (!removed) { panic("file info ptr not on thread channel list"); } #endif /* DEPRECATED */ }  } } /* *---------------------------------------------------------------------- * * TclpSpliceFileChannel -- * * Insert thread local ref for this channel. * Tcl_SpliceChannel for more info. * * Results: * None. * * Side effects: * Changes thread local list of valid channels. * *---------------------------------------------------------------------- */ void TclpSpliceFileChannel(chan) Tcl_Channel chan; /* The channel being removed. Must * not be referenced in any * interpreter. */ { #ifdef DEPRECATED ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Channel *chanPtr = (Channel *) chan; FileState *fsPtr; if (chanPtr->typePtr != &fileChannelType) return; fsPtr = (FileState *) chanPtr->instanceData; fsPtr->nextPtr = tsdPtr->firstFilePtr; tsdPtr->firstFilePtr = fsPtr; #endif /* DEPRECATED */ }

	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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	/* * tclUnixCompat.c * * Written by: Zoran Vasiljevic (vasiljevic@users.sourceforge.net). * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclUnixCompat.c,v 1.1.2.10 2006/09/12 22:05:03 andreas_kupries Exp $ * */ #include "tclInt.h" #include "tclPort.h" #include <pwd.h> #include <grp.h> #include <errno.h> #include <string.h> /* * Used to pad structures at size'd boundaries * * This macro assumes that the pointer 'buffer' was created from an * aligned pointer by adding the 'length'. If this 'length' was not a * multiple of the 'size' the result is unaligned and PadBuffer * corrects both the pointer, _and_ the 'length'. The latter means * that future increments of 'buffer' by 'length' stay aligned. */ #define PadBuffer(buffer, length, size) \ if (((length) % (size))) { \ (buffer) += ((size) - ((length) % (size))); \ (length) += ((size) - ((length) % (size))); \ } /* * Per-thread private storage used to store values * returned from MT-unsafe library calls. */ #ifdef TCL_THREADS typedef struct ThreadSpecificData { struct passwd pwd; char pbuf[2048]; struct group grp; char gbuf[2048]; #if !defined(HAVE_MTSAFE_GETHOSTBYNAME) || !defined(HAVE_MTSAFE_GETHOSTBYADDR) struct hostent hent; char hbuf[2048]; #endif } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; #if ((!defined(HAVE_GETHOSTBYNAME_R) || !defined(HAVE_GETHOSTBYADDR_R)) && \ (!defined(HAVE_MTSAFE_GETHOSTBYNAME) || !defined(HAVE_MTSAFE_GETHOSTBYADDR))) || \ !defined(HAVE_GETPWNAM_R) || !defined(HAVE_GETPWUID_R) || \ !defined(HAVE_GETGRNAM_R) || !defined(HAVE_GETGRGID_R) /* * Mutex to lock access to MT-unsafe calls. This is just to protect * our own usage. It does not protect us from others calling the * same functions without (or using some different) lock. */ static Tcl_Mutex compatLock;  /* *--------------------------------------------------------------------------- * * CopyArray -- * * Copies array of NULL-terminated or fixed-length strings * to the private buffer, honouring the size of the buffer. * * Results: * Number of bytes copied on success or -1 on error (errno = ERANGE) * * Side effects: * None. * *--------------------------------------------------------------------------- */ static int CopyArray(char **src, int elsize, char *buf, int buflen) { int i, j, len = 0; char *p, **new; if (src == NULL) { return 0; } for (i = 0; src[i] != NULL; i++) { /* Empty loop to count howmany */ } if ((sizeof(char *)*(i + 1)) > buflen) { return -1; } len = (sizeof(char *)*(i + 1)); /* Leave place for the array */ new = (char **)buf; p = buf + (sizeof(char *)*(i + 1)); for (j = 0; j < i; j++) { if (elsize < 0) { len += strlen(src[j]) + 1; } else { len += elsize; } if (len > buflen) { return -1; } if (elsize < 0) { strcpy(p, src[j]); } else { memcpy(p, src[j], elsize); } new[j] = p; p = buf + len; } new[j] = NULL; return len; }  /* *--------------------------------------------------------------------------- * * CopyString -- * * Copies a NULL-terminated string to the private buffer, * honouring the size of the buffer * * Results: * 0 success or -1 on error (errno = ERANGE) * * Side effects: * None * *--------------------------------------------------------------------------- */ static int CopyString(char *src, char *buf, int buflen) { int len = 0; if (src != NULL) { len += strlen(src) + 1; if (len > buflen) { return -1; } strcpy(buf, src); } return len; } #endif /* ((!defined(HAVE_GETHOSTBYNAME_R) || !defined(HAVE_GETHOSTBYADDR_R)) && \ (!defined(HAVE_MTSAFE_GETHOSTBYNAME) || !defined(HAVE_MTSAFE_GETHOSTBYADDR))) || \ !defined(HAVE_GETPWNAM_R) || !defined(HAVE_GETPWUID_R) || \ !defined(HAVE_GETGRNAM_R) || !defined(HAVE_GETGRGID_R) */ #if (!defined(HAVE_GETHOSTBYNAME_R) || !defined(HAVE_GETHOSTBYADDR_R)) && \ (!defined(HAVE_MTSAFE_GETHOSTBYNAME) || !defined(HAVE_MTSAFE_GETHOSTBYADDR))  /* *--------------------------------------------------------------------------- * * CopyHostnent -- * * Copies string fields of the hostnent structure to the * private buffer, honouring the size of the buffer. * * Results: * Number of bytes copied on success or -1 on error (errno = ERANGE) * * Side effects: * None * *--------------------------------------------------------------------------- */ static int CopyHostent(struct hostent *tgtPtr, char *buf, int buflen) { char *p = buf; int copied, len = 0; copied = CopyString(tgtPtr->h_name, p, buflen - len); if (copied == -1) { range: errno = ERANGE; return -1; } tgtPtr->h_name = (copied > 0) ? p : NULL; len += copied; p = buf + len; PadBuffer(p, len, sizeof(char *)); copied = CopyArray(tgtPtr->h_aliases, -1, p, buflen - len); if (copied == -1) { goto range; } tgtPtr->h_aliases = (copied > 0) ? (char **)p : NULL; len += copied; p += len; PadBuffer(p, len, sizeof(char *)); copied = CopyArray(tgtPtr->h_addr_list, tgtPtr->h_length, p, buflen - len); if (copied == -1) { goto range; } tgtPtr->h_addr_list = (copied > 0) ? (char **)p : NULL; return 0; } #endif /* (!defined(HAVE_GETHOSTBYNAME_R) || !defined(HAVE_GETHOSTBYADDR_R)) && \ (!defined(HAVE_MTSAFE_GETHOSTBYNAME) || !defined(HAVE_MTSAFE_GETHOSTBYADDR)) */ #if !defined(HAVE_GETPWNAM_R) || !defined(HAVE_GETPWUID_R)  /* *--------------------------------------------------------------------------- * * CopyPwd -- * * Copies string fields of the passwd structure to the * private buffer, honouring the size of the buffer. * * Results: * 0 on success or -1 on error (errno = ERANGE) * * Side effects: * We are not copying the gecos field as it may not be supported * on all platforms. * *--------------------------------------------------------------------------- */ static int CopyPwd(struct passwd *tgtPtr, char *buf, int buflen) { char *p = buf; int copied, len = 0; copied = CopyString(tgtPtr->pw_name, p, buflen - len); if (copied == -1) { range: errno = ERANGE; return -1; } tgtPtr->pw_name = (copied > 0) ? p : NULL; len += copied; p = buf + len; copied = CopyString(tgtPtr->pw_passwd, p, buflen - len); if (copied == -1) { goto range; } tgtPtr->pw_passwd = (copied > 0) ? p : NULL; len += copied; p = buf + len; copied = CopyString(tgtPtr->pw_dir, p, buflen - len); if (copied == -1) { goto range; } tgtPtr->pw_dir = (copied > 0) ? p : NULL; len += copied; p = buf + len; copied = CopyString(tgtPtr->pw_shell, p, buflen - len); if (copied == -1) { goto range; } tgtPtr->pw_shell = (copied > 0) ? p : NULL; return 0; } #endif /* !defined(HAVE_GETPWNAM_R) || !defined(HAVE_GETPWUID_R) */ #if !defined(HAVE_GETGRNAM_R) || !defined(HAVE_GETGRGID_R)  /* *--------------------------------------------------------------------------- * * CopyGrp -- * * Copies string fields of the group structure to the * private buffer, honouring the size of the buffer. * * Results: * 0 on success or -1 on error (errno = ERANGE) * * Side effects: * None. * *--------------------------------------------------------------------------- */ static int CopyGrp(struct group *tgtPtr, char *buf, int buflen) { register char *p = buf; register int copied, len = 0; /* Copy username */ copied = CopyString(tgtPtr->gr_name, p, buflen - len); if (copied == -1) { range: errno = ERANGE; return -1; } tgtPtr->gr_name = (copied > 0) ? p : NULL; len += copied; p = buf + len; /* Copy password */ copied = CopyString(tgtPtr->gr_passwd, p, buflen - len); if (copied == -1) { goto range; } tgtPtr->gr_passwd = (copied > 0) ? p : NULL; len += copied; p = buf + len; /* Copy group members */ PadBuffer(p, len, sizeof(char *)); copied = CopyArray((char **)tgtPtr->gr_mem, -1, p, buflen - len); if (copied == -1) { goto range; } tgtPtr->gr_mem = (copied > 0) ? (char **)p : NULL; return 0; } #endif /* !defined(HAVE_GETGRNAM_R) || !defined(HAVE_GETGRGID_R) */ #endif /* TCL_THREADS */  /* *--------------------------------------------------------------------------- * * TclpGetPwNam -- * * Thread-safe wrappers for getpwnam(). * See "man getpwnam" for more details. * * Results: * Pointer to struct passwd on success or NULL on error. * * Side effects: * None. * *--------------------------------------------------------------------------- */ struct passwd * TclpGetPwNam(const char *name) { #if !defined(TCL_THREADS) return getpwnam(name); #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if defined(HAVE_GETPWNAM_R_5) struct passwd *pwPtr = NULL; return (getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf), &pwPtr) == 0 && pwPtr != NULL) ? &tsdPtr->pwd : NULL; #elif defined(HAVE_GETPWNAM_R_4) return getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)); #else struct passwd *pwPtr; Tcl_MutexLock(&compatLock); pwPtr = getpwnam(name); if (pwPtr != NULL) { tsdPtr->pwd = *pwPtr; pwPtr = &tsdPtr->pwd; if (CopyPwd(&tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)) == -1) { pwPtr = NULL; } } Tcl_MutexUnlock(&compatLock); return pwPtr; #endif return NULL; /* Not reached */ #endif /* TCL_THREADS */ }  /* *--------------------------------------------------------------------------- * * TclpGetPwUid -- * * Thread-safe wrappers for getpwuid(). * See "man getpwuid" for more details. * * Results: * Pointer to struct passwd on success or NULL on error. * * Side effects: * None. * *--------------------------------------------------------------------------- */ struct passwd * TclpGetPwUid(uid_t uid) { #if !defined(TCL_THREADS) return getpwuid(uid); #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if defined(HAVE_GETPWUID_R_5) struct passwd *pwPtr = NULL; return (getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf), &pwPtr) == 0 && pwPtr != NULL) ? &tsdPtr->pwd : NULL; #elif defined(HAVE_GETPWUID_R_4) return getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)); #else struct passwd *pwPtr; Tcl_MutexLock(&compatLock); pwPtr = getpwuid(uid); if (pwPtr != NULL) { tsdPtr->pwd = *pwPtr; pwPtr = &tsdPtr->pwd; if (CopyPwd(&tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)) == -1) { pwPtr = NULL; } } Tcl_MutexUnlock(&compatLock); return pwPtr; #endif return NULL; /* Not reached */ #endif /* TCL_THREADS */ }  /* *--------------------------------------------------------------------------- * * TclpGetGrNam -- * * Thread-safe wrappers for getgrnam(). * See "man getgrnam" for more details. * * Results: * Pointer to struct group on success or NULL on error. * * Side effects: * None. * *--------------------------------------------------------------------------- */ struct group * TclpGetGrNam(const char *name) { #if !defined(TCL_THREADS) return getgrnam(name); #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if defined(HAVE_GETGRNAM_R_5) struct group *grPtr = NULL; return (getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf), &grPtr) == 0 && grPtr != NULL) ? &tsdPtr->grp : NULL; #elif defined(HAVE_GETGRNAM_R_4) return getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)); #else struct group *grPtr; Tcl_MutexLock(&compatLock); grPtr = getgrnam(name); if (grPtr != NULL) { tsdPtr->grp = *grPtr; grPtr = &tsdPtr->grp; if (CopyGrp(&tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)) == -1) { grPtr = NULL; } } Tcl_MutexUnlock(&compatLock); return grPtr; #endif return NULL; /* Not reached */ #endif /* TCL_THREADS */ }  /* *--------------------------------------------------------------------------- * * TclpGetGrGid -- * * Thread-safe wrappers for getgrgid(). * See "man getgrgid" for more details. * * Results: * Pointer to struct group on success or NULL on error. * * Side effects: * None. * *--------------------------------------------------------------------------- */ struct group * TclpGetGrGid(gid_t gid) { #if !defined(TCL_THREADS) return getgrgid(gid); #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if defined(HAVE_GETGRGID_R_5) struct group *grPtr = NULL; return (getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf), &grPtr) == 0 && grPtr != NULL) ? &tsdPtr->grp : NULL; #elif defined(HAVE_GETGRGID_R_4) return getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)); #else struct group *grPtr; Tcl_MutexLock(&compatLock); grPtr = getgrgid(gid); if (grPtr != NULL) { tsdPtr->grp = *grPtr; grPtr = &tsdPtr->grp; if (CopyGrp(&tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)) == -1) { grPtr = NULL; } } Tcl_MutexUnlock(&compatLock); return grPtr; #endif return NULL; /* Not reached */ #endif /* TCL_THREADS */ }  /* *--------------------------------------------------------------------------- * * TclpGetHostByName -- * * Thread-safe wrappers for gethostbyname(). * See "man gethostbyname" for more details. * * Results: * Pointer to struct hostent on success or NULL on error. * * Side effects: * None. * *--------------------------------------------------------------------------- */ struct hostent * TclpGetHostByName(const char *name) { #if !defined(TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYNAME) return gethostbyname(name); #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if defined(HAVE_GETHOSTBYNAME_R_5) int h_errno; return gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf, sizeof(tsdPtr->hbuf), &h_errno); #elif defined(HAVE_GETHOSTBYNAME_R_6) struct hostent *hePtr; int h_errno; return (gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf, sizeof(tsdPtr->hbuf), &hePtr, &h_errno) == 0) ? &tsdPtr->hent : NULL; #elif defined(HAVE_GETHOSTBYNAME_R_3) struct hostent_data data; return (gethostbyname_r(name, &tsdPtr->hent, &data) == 0) ? &tsdPtr->hent : NULL; #else struct hostent *hePtr; Tcl_MutexLock(&compatLock); hePtr = gethostbyname(name); if (hePtr != NULL) { tsdPtr->hent = *hePtr; hePtr = &tsdPtr->hent; if (CopyHostent(&tsdPtr->hent, tsdPtr->hbuf, sizeof(tsdPtr->hbuf)) == -1) { hePtr = NULL; } } Tcl_MutexUnlock(&compatLock); return hePtr; #endif return NULL; /* Not reached */ #endif /* TCL_THREADS */ }  /* *--------------------------------------------------------------------------- * * TclpGetHostByAddr -- * * Thread-safe wrappers for gethostbyaddr(). * See "man gethostbyaddr" for more details. * * Results: * Pointer to struct hostent on success or NULL on error. * * Side effects: * None. * *--------------------------------------------------------------------------- */ struct hostent * TclpGetHostByAddr(const char *addr, int length, int type) { #if !defined(TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYADDR) return gethostbyaddr(addr, length, type); #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if defined(HAVE_GETHOSTBYADDR_R_7) int h_errno; return gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf, sizeof(tsdPtr->hbuf), &h_errno); #elif defined(HAVE_GETHOSTBYADDR_R_8) struct hostent *hePtr; int h_errno; return (gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf, sizeof(tsdPtr->hbuf), &hePtr, &h_errno) == 0) ? &tsdPtr->hent : NULL; #else struct hostent *hePtr; Tcl_MutexLock(&compatLock); hePtr = gethostbyaddr(addr, length, type); if (hePtr != NULL) { tsdPtr->hent = *hePtr; hePtr = &tsdPtr->hent; if (CopyHostent(&tsdPtr->hent, tsdPtr->hbuf, sizeof(tsdPtr->hbuf)) == -1) { hePtr = NULL; } } Tcl_MutexUnlock(&compatLock); return hePtr; #endif return NULL; /* Not reached */ #endif /* TCL_THREADS */ }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclUnixFCmd.c * * This file implements the unix specific portion of file manipulation * subcommands of the "file" command. All filename arguments should * already be translated to native format. * * Copyright (c) 1996-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclUnixFCmd.c,v 1.28 2003/02/10 12:50:31 vincentdarley Exp $ * RCS: @(#) $Id: tclUnixFCmd.c,v 1.28.2.15 2007/04/29 02:19:51 das Exp $ * * Portions of this code were derived from NetBSD source code which has * the following copyright notice: * * Copyright (c) 1988, 1993, 1994 * The Regents of the University of California. All rights reserved. *
︙
52 53 54 55 56 57 58 59 60 61 62 63 64 65	52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68	+ + +	#include <utime.h> #include <grp.h> #ifndef HAVE_ST_BLKSIZE #ifndef NO_FSTATFS #include <sys/statfs.h> #endif #endif #ifdef HAVE_FTS #include <fts.h> #endif /* * The following constants specify the type of callback when * TraverseUnixTree() calls the traverseProc() */ #define DOTREE_PRED 1 /* pre-order directory */
︙
119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157	122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175	+ + + + + + + + + + + + + + + - + - +	CONST TclFileAttrProcs tclpFileAttrProcs[] = { {GetGroupAttribute, SetGroupAttribute}, {GetOwnerAttribute, SetOwnerAttribute}, {GetPermissionsAttribute, SetPermissionsAttribute} }; /* * This is the maximum number of consecutive readdir/unlink calls that can be * made (with no intervening rewinddir or closedir/opendir) before triggering * a bug that makes readdir return NULL even though some directory entries * have not been processed. The bug afflicts SunOS's readdir when applied to * ufs file systems and Darwin 6.5's (and OSX v.10.3.8's) HFS+. JH found the * Darwin readdir to reset at 147, so 130 is chosen to be conservative. We * can't do a general rewind on failure as NFS can create special files that * recreate themselves when you try and delete them. 8.4.8 added a solution * that was affected by a single such NFS file, this solution should not be * affected by less than THRESHOLD such files. [Bug 1034337] */ #define MAX_READDIR_UNLINK_THRESHOLD 130 /* * Declarations for local procedures defined in this file: */ static int CopyFile _ANSI_ARGS_((CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr)); static int CopyFileAtts _ANSI_ARGS_((CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr)); static int DoCopyFile _ANSI_ARGS_((CONST char *srcPtr, CONST char *dstPtr)); CONST char *dstPtr, CONST Tcl_StatBuf *statBufPtr)); static int DoCreateDirectory _ANSI_ARGS_((CONST char *pathPtr)); static int DoRemoveDirectory _ANSI_ARGS_((Tcl_DString *pathPtr, int recursive, Tcl_DString *errorPtr)); static int DoRenameFile _ANSI_ARGS_((CONST char *src, CONST char *dst)); static int TraversalCopy _ANSI_ARGS_((Tcl_DString *srcPtr, Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr)); static int TraversalDelete _ANSI_ARGS_((Tcl_DString *srcPtr, Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr)); static int TraverseUnixTree _ANSI_ARGS_(( TraversalProc *traversalProc, Tcl_DString *sourcePtr, Tcl_DString *destPtr, Tcl_DString *errorPtr)); Tcl_DString *errorPtr, int doRewind)); #ifdef PURIFY /* * realpath and purify don't mix happily. It has been noted that realpath * should not be used with purify because of bogus warnings, but just * memset'ing the resolved path will squelch those. This assumes we are * passing the standard MAXPATHLEN size resolved arg.
︙
167 168 169 170 171 172 173 174 175 176 177 178 179 180	185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	memset(resolved, 0, MAXPATHLEN); return realpath(path, resolved); } #else #define Realpath realpath #endif #ifndef NO_REALPATH #if defined(__APPLE__) && defined(TCL_THREADS) && \ defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ MAC_OS_X_VERSION_MIN_REQUIRED < 1030 /* * prior to Darwin 7, realpath is not threadsafe, c.f. bug 711232; * if we might potentially be running on pre-10.3 OSX, * check Darwin release at runtime before using realpath. */ extern long tclMacOSXDarwinRelease; #define haveRealpath (tclMacOSXDarwinRelease >= 7) #else #define haveRealpath 1 #endif #endif /* NO_REALPATH */ #ifdef HAVE_FTS #ifdef HAVE_STRUCT_STAT64 /* fts doesn't do stat64 */ #define noFtsStat 1 #elif defined(__APPLE__) && defined(__LP64__) && \ defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ MAC_OS_X_VERSION_MIN_REQUIRED < 1050 /* * prior to Darwin 9, 64bit fts_open() without FTS_NOSTAT may crash (due to a * 64bit-unsafe ALIGN macro); if we could be running on pre-10.5 OSX, check * Darwin release at runtime and do a separate stat() if necessary. */ extern long tclMacOSXDarwinRelease; #define noFtsStat (tclMacOSXDarwinRelease < 9) #else #define noFtsStat 0 #endif #endif /* HAVE_FTS */  /* *--------------------------------------------------------------------------- * * TclpObjRenameFile, DoRenameFile -- * * Changes the name of an existing file or directory, from src to dst.
︙
244 245 246 247 248 249 250 251 252 253 254 255 256 257 258	297 298 299 300 301 302 303 304 305 306 307 308 309 310 311	- +	/* * SunOS 4.1.4 reports overwriting a non-empty directory with a * directory as EINVAL instead of EEXIST (first rule out the correct * EINVAL result code for moving a directory into itself). Must be * conditionally compiled because realpath() not defined on all systems. */ if (errno == EINVAL) { if (errno == EINVAL && haveRealpath) { char srcPath[MAXPATHLEN], dstPath[MAXPATHLEN]; DIR *dirPtr; Tcl_DirEntry *dirEntPtr; if ((Realpath((char *) src, srcPath) != NULL) /* INTL: Native. */ && (Realpath((char *) dst, dstPath) != NULL) /* INTL: Native. */ && (strncmp(srcPath, dstPath, strlen(srcPath)) != 0)) {
︙
324 325 326 327 328 329 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 355 356	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 402 403 404 405 406 407 408 409 410	- - + + + + + + + + - + - - - + + - - - - - + + - - - + +	*/ int TclpObjCopyFile(srcPathPtr, destPathPtr) Tcl_Obj *srcPathPtr; Tcl_Obj *destPathPtr; { return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), Tcl_FSGetNativePath(destPathPtr)); CONST char *src = Tcl_FSGetNativePath(srcPathPtr); Tcl_StatBuf srcStatBuf; if (TclOSlstat(src, &srcStatBuf) != 0) { /* INTL: Native. */ return TCL_ERROR; } return DoCopyFile(src, Tcl_FSGetNativePath(destPathPtr), &srcStatBuf); } static int DoCopyFile(src, dst) DoCopyFile(src, dst, statBufPtr) CONST char *src; /* Pathname of file to be copied (native). */ CONST char *dst; /* Pathname of file to copy to (native). */ { Tcl_StatBuf srcStatBuf, dstStatBuf; CONST Tcl_StatBuf *statBufPtr; /* Used to determine filetype. */ /* * Have to do a stat() to determine the filetype. */ if (TclOSlstat(src, &srcStatBuf) != 0) { /* INTL: Native. */ { Tcl_StatBuf dstStatBuf; return TCL_ERROR; } if (S_ISDIR(srcStatBuf.st_mode)) { if (S_ISDIR(statBufPtr->st_mode)) { errno = EISDIR; return TCL_ERROR; } /* * symlink, and some of the other calls will fail if the target * exists, so we remove it first
︙
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 402 403 404 405 406 407 408 409 410	418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470	- + + + + + + + - - + + - + - + - + - +	} if (unlink(dst) != 0) { /* INTL: Native. */ if (errno != ENOENT) { return TCL_ERROR; } } switch ((int) (srcStatBuf.st_mode & S_IFMT)) { switch ((int) (statBufPtr->st_mode & S_IFMT)) { #ifndef DJGPP case S_IFLNK: { char link[MAXPATHLEN]; int length; length = readlink(src, link, sizeof(link)); /* INTL: Native. */ if (length == -1) { return TCL_ERROR; } link[length] = '\0'; if (symlink(link, dst) < 0) { /* INTL: Native. */ return TCL_ERROR; } #ifdef HAVE_COPYFILE #ifdef WEAK_IMPORT_COPYFILE if (copyfile != NULL) #endif copyfile(src, dst, NULL, COPYFILE_XATTR|COPYFILE_NOFOLLOW_SRC); #endif break; } #endif case S_IFBLK: case S_IFCHR: { if (mknod(dst, srcStatBuf.st_mode, /* INTL: Native. */ srcStatBuf.st_rdev) < 0) { if (mknod(dst, statBufPtr->st_mode, /* INTL: Native. */ statBufPtr->st_rdev) < 0) { return TCL_ERROR; } return CopyFileAtts(src, dst, &srcStatBuf); return CopyFileAtts(src, dst, statBufPtr); } case S_IFIFO: { if (mkfifo(dst, srcStatBuf.st_mode) < 0) { /* INTL: Native. */ if (mkfifo(dst, statBufPtr->st_mode) < 0) { /* INTL: Native. */ return TCL_ERROR; } return CopyFileAtts(src, dst, &srcStatBuf); return CopyFileAtts(src, dst, statBufPtr); } default: { return CopyFile(src, dst, &srcStatBuf); return CopyFile(src, dst, statBufPtr); } } return TCL_OK; }  /* *----------------------------------------------------------------------
︙
429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444	489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504	- - + +	CONST char *dst; /* Pathname of file to create/overwrite * (native). */ CONST Tcl_StatBuf *statBufPtr; /* Used to determine mode and blocksize. */ { int srcFd; int dstFd; u_int blockSize; /* Optimal I/O blocksize for filesystem */ char *buffer; /* Data buffer for copy */ unsigned blockSize; /* Optimal I/O blocksize for filesystem */ char *buffer; /* Data buffer for copy */ size_t nread; if ((srcFd = TclOSopen(src, O_RDONLY, 0)) < 0) { /* INTL: Native. */ return TCL_ERROR; } dstFd = TclOSopen(dst, O_CREAT|O_TRUNC|O_WRONLY, /* INTL: Native. */
︙
461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486	521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556	+ + + + + + + + + + - +	} } #else blockSize = 4096; #endif #endif /* [SF Tcl Bug 1586470] Even if we HAVE_ST_BLKSIZE, there are * filesystems which report a bogus value for the blocksize. An * example is the Andrew Filesystem (afs), reporting a blocksize * of 0. When detecting such a situation we now simply fall back * to a hardwired default size. */ if (blockSize <= 0) { blockSize = 4096; } buffer = ckalloc(blockSize); while (1) { nread = read(srcFd, buffer, blockSize); if ((nread == -1) || (nread == 0)) { break; } if (write(dstFd, buffer, nread) != nread) { nread = (size_t) -1; break; } } ckfree(buffer); close(srcFd); if ((close(dstFd) != 0) || (nread == -1)) { unlink(dst); /* INTL: Native. */ return TCL_ERROR; } if (CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) {
︙
620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642	690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721	+ - + + - + + + + + - + + + - - + + +	Tcl_Obj *srcPathPtr; Tcl_Obj *destPathPtr; Tcl_Obj **errorPtr; { Tcl_DString ds; Tcl_DString srcString, dstString; int ret; Tcl_Obj *transPtr; transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr); Tcl_UtfToExternalDString(NULL, Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr), (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), -1, &srcString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr); Tcl_UtfToExternalDString(NULL, Tcl_FSGetTranslatedStringPath(NULL,destPathPtr), (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), -1, &dstString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds); } ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds, 0); Tcl_DStringFree(&srcString); Tcl_DStringFree(&dstString); if (ret != TCL_OK) { *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); Tcl_DStringFree(&ds);
︙
677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693	756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777	+ - + + + + +	Tcl_Obj *pathPtr; int recursive; Tcl_Obj **errorPtr; { Tcl_DString ds; Tcl_DString pathString; int ret; Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); Tcl_UtfToExternalDString(NULL, Tcl_FSGetTranslatedStringPath(NULL, pathPtr), Tcl_UtfToExternalDString(NULL, (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), -1, &pathString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } ret = DoRemoveDirectory(&pathString, recursive, &ds); Tcl_DStringFree(&pathString); if (ret != TCL_OK) { *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); Tcl_DStringFree(&ds); Tcl_IncrRefCount(*errorPtr);
︙
742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765	826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849	- + - +	/* * The directory is nonempty, but the recursive flag has been * specified, so we recursively remove all the files in the directory. */ if (result == TCL_OK) { result = TraverseUnixTree(TraversalDelete, pathPtr, NULL, errorPtr); result = TraverseUnixTree(TraversalDelete, pathPtr, NULL, errorPtr, 1); } if ((result != TCL_OK) && (recursive != 0)) { /* Try to restore permissions */ chmod(path, oldPerm); } return result; }   /* *--------------------------------------------------------------------------- * * TraverseUnixTree -- * * Traverse directory tree specified by sourcePtr, calling the function * traverseProc for each file and directory encountered. If destPtr
︙
775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905	859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082	- + + + + + + + + + + + + + + + - + - + - + - + + + - + + + + + + + + + - + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + +	* traverseProc() may change state. If an error occurs, the error will * be returned immediately, and remaining files will not be processed. * *--------------------------------------------------------------------------- */ static int TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr) TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) TraversalProc *traverseProc;/* Function to call for every file and * directory in source hierarchy. */ Tcl_DString *sourcePtr; /* Pathname of source directory to be * traversed (native). */ Tcl_DString *targetPtr; /* Pathname of directory to traverse in * parallel with source directory (native). */ Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free * DString filled with UTF-8 name of file * causing error. */ int doRewind; /* Flag indicating that to ensure complete * traversal of source hierarchy, the readdir * loop should be rewound whenever * traverseProc has returned TCL_OK; this is * required when traverseProc modifies the * source hierarchy, e.g. by deleting files. */ { Tcl_StatBuf statBuf; CONST char *source, *errfile; int result, sourceLen; int targetLen; #ifndef HAVE_FTS int numProcessed = 0; Tcl_DirEntry *dirEntPtr; DIR *dirPtr; #else CONST char *paths[2] = {NULL, NULL}; FTS *fts = NULL; FTSENT *ent; #endif errfile = NULL; result = TCL_OK; targetLen = 0; /* lint. */ source = Tcl_DStringValue(sourcePtr); if (TclOSlstat(source, &statBuf) != 0) { /* INTL: Native. */ errfile = source; goto end; } if (!S_ISDIR(statBuf.st_mode)) { /* * Process the regular file */ return (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_F, errorPtr); } #ifndef HAVE_FTS dirPtr = opendir(source); /* INTL: Native. */ if (dirPtr == NULL) { /* * Can't read directory */ errfile = source; goto end; } result = (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_PRED, errorPtr); if (result != TCL_OK) { closedir(dirPtr); return result; } Tcl_DStringAppend(sourcePtr, "/", 1); sourceLen = Tcl_DStringLength(sourcePtr); sourceLen = Tcl_DStringLength(sourcePtr); if (targetPtr != NULL) { Tcl_DStringAppend(targetPtr, "/", 1); targetLen = Tcl_DStringLength(targetPtr); } while ((dirEntPtr = TclOSreaddir(dirPtr)) != NULL) { /* INTL: Native. */ if ((dirEntPtr->d_name[0] == '.') && ((dirEntPtr->d_name[1] == '\0') || (strcmp(dirEntPtr->d_name, "..") == 0))) { continue; } /* /* * Append name after slash, and recurse on the file. */ Tcl_DStringAppend(sourcePtr, dirEntPtr->d_name, -1); if (targetPtr != NULL) { Tcl_DStringAppend(targetPtr, dirEntPtr->d_name, -1); } result = TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr); errorPtr, doRewind); if (result != TCL_OK) { break; } else { numProcessed++; } /* * Remove name after slash. */ Tcl_DStringSetLength(sourcePtr, sourceLen); if (targetPtr != NULL) { Tcl_DStringSetLength(targetPtr, targetLen); } if (doRewind && (numProcessed > MAX_READDIR_UNLINK_THRESHOLD)) { /* * Call rewinddir if we've called unlink or rmdir so many times * (since the opendir or the previous rewinddir), to avoid * a NULL-return that may a symptom of a buggy readdir. */ rewinddir(dirPtr); numProcessed = 0; } } } closedir(dirPtr); /* * Strip off the trailing slash we added */ Tcl_DStringSetLength(sourcePtr, sourceLen - 1); if (targetPtr != NULL) { Tcl_DStringSetLength(targetPtr, targetLen - 1); } if (result == TCL_OK) { /* * Call traverseProc() on a directory after visiting all the * files in that directory. */ result = (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_POSTD, errorPtr); } #else /* HAVE_FTS */ paths[0] = source; fts = fts_open((char**)paths, FTS_PHYSICAL | FTS_NOCHDIR | (noFtsStat || doRewind ? FTS_NOSTAT : 0), NULL); if (fts == NULL) { errfile = source; goto end; } sourceLen = Tcl_DStringLength(sourcePtr); if (targetPtr != NULL) { targetLen = Tcl_DStringLength(targetPtr); } while ((ent = fts_read(fts)) != NULL) { unsigned short info = ent->fts_info; char * path = ent->fts_path + sourceLen; unsigned short pathlen = ent->fts_pathlen - sourceLen; int type; Tcl_StatBuf *statBufPtr = NULL; if (info == FTS_DNR || info == FTS_ERR || info == FTS_NS) { errfile = ent->fts_path; break; } Tcl_DStringAppend(sourcePtr, path, pathlen); if (targetPtr != NULL) { Tcl_DStringAppend(targetPtr, path, pathlen); } switch (info) { case FTS_D: type = DOTREE_PRED; break; case FTS_DP: type = DOTREE_POSTD; break; default: type = DOTREE_F; break; } if (!doRewind) { /* no need to stat for delete */ if (noFtsStat) { statBufPtr = &statBuf; if (TclOSlstat(ent->fts_path, statBufPtr) != 0) { errfile = ent->fts_path; break; } } else { statBufPtr = ent->fts_statp; } } result = (*traverseProc)(sourcePtr, targetPtr, statBufPtr, type, errorPtr); if (result != TCL_OK) { break; } Tcl_DStringSetLength(sourcePtr, sourceLen); if (targetPtr != NULL) { Tcl_DStringSetLength(targetPtr, targetLen); } } #endif /* HAVE_FTS */ end: if (errfile != NULL) { if (errorPtr != NULL) { Tcl_ExternalToUtfDString(NULL, errfile, -1, errorPtr); } result = TCL_ERROR; } #ifdef HAVE_FTS if (fts != NULL) { fts_close(fts); } #endif /* HAVE_FTS */ return result; }  /* *---------------------------------------------------------------------- * * TraversalCopy
︙
926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941	1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118	- - + +	int type; /* Reason for call - see TraverseUnixTree(). */ Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free * DString filled with UTF-8 name of file * causing error. */ { switch (type) { case DOTREE_F: if (DoCopyFile(Tcl_DStringValue(srcPtr), Tcl_DStringValue(dstPtr)) == TCL_OK) { if (DoCopyFile(Tcl_DStringValue(srcPtr), Tcl_DStringValue(dstPtr), statBufPtr) == TCL_OK) { return TCL_OK; } break; case DOTREE_PRED: if (DoCreateDirectory(Tcl_DStringValue(dstPtr)) == TCL_OK) { return TCL_OK;
︙
1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080	1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263	+ + + + + +	tval.actime = statBufPtr->st_atime; tval.modtime = statBufPtr->st_mtime; if (utime(dst, &tval)) { /* INTL: Native. */ return TCL_ERROR; } #ifdef HAVE_COPYFILE #ifdef WEAK_IMPORT_COPYFILE if (copyfile != NULL) #endif copyfile(src, dst, NULL, COPYFILE_XATTR|COPYFILE_ACL); #endif return TCL_OK; }  /* *---------------------------------------------------------------------- *
︙
1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123	1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307	- - + + +	if (result != 0) { Tcl_AppendResult(interp, "could not read \"", Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } groupPtr = getgrgid(statBuf.st_gid); /* INTL: Native. */ if (groupPtr == NULL) { groupPtr = TclpGetGrGid(statBuf.st_gid); if (result == -1 || groupPtr == NULL) { *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_gid); } else { Tcl_DString ds; CONST char *utf; utf = Tcl_ExternalToUtfDString(NULL, groupPtr->gr_name, -1, &ds); *attributePtrPtr = Tcl_NewStringObj(utf, -1);
︙
1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175	1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360	- - + + +	if (result != 0) { Tcl_AppendResult(interp, "could not read \"", Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } pwPtr = getpwuid(statBuf.st_uid); /* INTL: Native. */ if (pwPtr == NULL) { pwPtr = TclpGetPwUid(statBuf.st_uid); if (result == -1 || pwPtr == NULL) { *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid); } else { Tcl_DString ds; CONST char *utf; utf = Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds); *attributePtrPtr = Tcl_NewStringObj(utf, Tcl_DStringLength(&ds));
︙
1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269	1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453	- - +	if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) { Tcl_DString ds; struct group *groupPtr; CONST char *string; int length; string = Tcl_GetStringFromObj(attributePtr, &length); native = Tcl_UtfToExternalDString(NULL, string, length, &ds); groupPtr = getgrnam(native); /* INTL: Native. */ groupPtr = TclpGetGrNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (groupPtr == NULL) { endgrent(); Tcl_AppendResult(interp, "could not set group for file \"", Tcl_GetString(fileName), "\": group \"", string, "\" does not exist",
︙
1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347	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	- - + + - + +	if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) { Tcl_DString ds; struct passwd *pwPtr; CONST char *string; int length; string = Tcl_GetStringFromObj(attributePtr, &length); native = Tcl_UtfToExternalDString(NULL, string, length, &ds); pwPtr = getpwnam(native); /* INTL: Native. */ pwPtr = TclpGetPwNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (pwPtr == NULL) { endpwent(); Tcl_AppendResult(interp, "could not set owner for file \"", Tcl_GetString(fileName), "\": user \"", string, "\" does not exist", (char *) NULL); return TCL_ERROR; } uid = pwPtr->pw_uid; } native = Tcl_FSGetNativePath(fileName); result = chown(native, (uid_t) uid, (gid_t) -1); /* INTL: Native. */ endpwent(); if (result != 0) { Tcl_AppendResult(interp, "could not set owner for file \"", Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } return TCL_OK;
︙
1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597	1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781	-	continue; case '=' : op = 3; op_found = 1; continue; default : return TCL_ERROR; break; } } /* what */ switch (*(modeStringPtr+n+i)) { case 'r' : what |= 0x124; continue;
︙
1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621	1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804	-	case 't' : what |= 0x200; continue; case ',' : break; default : return TCL_ERROR; break; } if (*(modeStringPtr+n+i) == ',') { i++; break; } } switch (op) {
︙
1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698	1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889	- + + + + + + + - - - + + + + +	currentPathEndPosition = path + nextCheckpoint; if (*currentPathEndPosition == '/') { currentPathEndPosition++; } #ifndef NO_REALPATH /* For speed, try to get the entire path in one go */ if (nextCheckpoint == 0) { if (nextCheckpoint == 0 && haveRealpath) { char *lastDir = strrchr(currentPathEndPosition, '/'); if (lastDir != NULL) { nativePath = Tcl_UtfToExternalDString(NULL, path, lastDir - path, &ds); if (Realpath(nativePath, normPath) != NULL) { if (*nativePath != '/' && *normPath == '/') { /* * realpath has transformed a relative path into an * absolute path, we do not know how to handle this. */ } else { nextCheckpoint = lastDir - path; goto wholeStringOk; } nextCheckpoint = lastDir - path; goto wholeStringOk; } } Tcl_DStringFree(&ds); } } /* Else do it the slow way */ #endif while (1) { cur = *currentPathEndPosition;
︙
1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786	1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976	+ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - -	* We should really now convert this to a canonical path. We do * that with 'realpath' if we have it available. Otherwise we could * step through every single path component, checking whether it is a * symlink, but that would be a lot of work, and most modern OSes * have 'realpath'. */ #ifndef NO_REALPATH if (haveRealpath) { /* * If we only had '/foo' or '/' then we never increment nextCheckpoint * and we don't need or want to go through 'Realpath'. Also, on some * platforms, passing an empty string to 'Realpath' will give us the * normalized pwd, which is not what we want at all! */ if (nextCheckpoint == 0) return 0; nativePath = Tcl_UtfToExternalDString(NULL, path, nextCheckpoint, &ds); if (Realpath(nativePath, normPath) != NULL) { int newNormLen; wholeStringOk: newNormLen = strlen(normPath); if ((newNormLen == Tcl_DStringLength(&ds)) && (strcmp(normPath, nativePath) == 0)) { /* String is unchanged */ Tcl_DStringFree(&ds); if (path[nextCheckpoint] != '\0') { nextCheckpoint++; } return nextCheckpoint; } /* * Free up the native path and put in its place the * converted, normalized path. */ Tcl_DStringFree(&ds); Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds); if (path[nextCheckpoint] != '\0') { /* not at end, append remaining path */ int normLen = Tcl_DStringLength(&ds); Tcl_DStringAppend(&ds, path + nextCheckpoint, pathLen - nextCheckpoint); /* * We recognise up to and including the directory * separator. */ nextCheckpoint = normLen + 1; } else { /* We recognise the whole string */ nextCheckpoint = Tcl_DStringLength(&ds); } /* * Overwrite with the normalized path. */ Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); } Tcl_DStringFree(&ds); /* * If we only had '/foo' or '/' then we never increment nextCheckpoint * and we don't need or want to go through 'Realpath'. Also, on some * platforms, passing an empty string to 'Realpath' will give us the * normalized pwd, which is not what we want at all! */ if (nextCheckpoint == 0) return 0; nativePath = Tcl_UtfToExternalDString(NULL, path, nextCheckpoint, &ds); if (Realpath(nativePath, normPath) != NULL) { int newNormLen; wholeStringOk: newNormLen = strlen(normPath); if ((newNormLen == Tcl_DStringLength(&ds)) && (strcmp(normPath, nativePath) == 0)) { /* String is unchanged */ Tcl_DStringFree(&ds); if (path[nextCheckpoint] != '\0') { nextCheckpoint++; } return nextCheckpoint; } /* * Free up the native path and put in its place the * converted, normalized path. */ Tcl_DStringFree(&ds); Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds); if (path[nextCheckpoint] != '\0') { /* not at end, append remaining path */ int normLen = Tcl_DStringLength(&ds); Tcl_DStringAppend(&ds, path + nextCheckpoint, pathLen - nextCheckpoint); /* * We recognise up to and including the directory * separator. */ nextCheckpoint = normLen + 1; } else { /* We recognise the whole string */ nextCheckpoint = Tcl_DStringLength(&ds); } /* * Overwrite with the normalized path. */ Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); } Tcl_DStringFree(&ds); } #endif /* !NO_REALPATH */ return nextCheckpoint; }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	/* * tclUnixFile.c -- * * This file contains wrappers around UNIX file handling functions. * These wrappers mask differences between Windows and UNIX. * * Copyright (c) 1995-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclUnixFile.c,v 1.32 2003/02/12 18:57:52 vincentdarley Exp $ * RCS: @(#) $Id: tclUnixFile.c,v 1.32.2.2 2003/10/31 08:46:41 vincentdarley Exp $ */ #include "tclInt.h" #include "tclPort.h" static int NativeMatchType(CONST char* nativeName, Tcl_GlobTypeData *types);
︙
217 218 219 220 221 222 223 224 225 226 227 228 229 230	217 218 219 220 221 222 223 224 225 226 227 228 229 230 231	+	if (pattern == NULL || (*pattern == '\0')) { /* Match a file directly */ native = (CONST char*) Tcl_FSGetNativePath(pathPtr); if (NativeMatchType(native, types)) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); } Tcl_DecrRefCount(fileNamePtr); return TCL_OK; } else { DIR *d; Tcl_DirEntry *entryPtr; CONST char *dirName; int dirLength; int matchHidden;
︙
251 252 253 254 255 256 257 258 259 260 261 262 263 264 265	252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267	+ - +	dirName = Tcl_DStringValue(&dsOrig); /* Make sure we have a trailing directory delimiter */ if (dirName[dirLength-1] != '/') { dirName = Tcl_DStringAppend(&dsOrig, "/", 1); dirLength++; } } Tcl_DecrRefCount(fileNamePtr); /* * Now open the directory for reading and iterate over the contents. */ native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds); if ((TclOSstat(native, &statBuf) != 0) /* INTL: Native. */
︙
741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758	743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764	+ - - + + + + +	return toPtr; } else { Tcl_Obj* linkPtr = NULL; char link[MAXPATHLEN]; int length; Tcl_DString ds; Tcl_Obj *transPtr; if (Tcl_FSGetTranslatedPath(NULL, pathPtr) == NULL) { transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); if (transPtr == NULL) { return NULL; } Tcl_DecrRefCount(transPtr); length = readlink(Tcl_FSGetNativePath(pathPtr), link, sizeof(link)); if (length < 0) { return NULL; } Tcl_ExternalToUtfDString(NULL, link, length, &ds); linkPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
︙

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	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	- + - + - + + + + + + + + - +	/* * tclUnixInit.c -- * * Contains the Unix-specific interpreter initialization functions. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation. * All rights reserved. * * RCS: @(#) $Id: tclUnixInit.c,v 1.34 2002/10/22 16:41:28 das Exp $ * RCS: @(#) $Id: tclUnixInit.c,v 1.34.2.15 2007/04/29 02:19:51 das Exp $ */ #if defined(HAVE_CFBUNDLE) #if defined(HAVE_COREFOUNDATION) #include <CoreFoundation/CoreFoundation.h> #endif #include "tclInt.h" #include "tclPort.h" #include <locale.h> #ifdef HAVE_LANGINFO #include <langinfo.h> # include <langinfo.h> # ifdef __APPLE__ # if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030 /* Support for weakly importing nl_langinfo on Darwin. */ # define WEAK_IMPORT_NL_LANGINFO extern char *nl_langinfo(nl_item) WEAK_IMPORT_ATTRIBUTE; # endif # endif #endif #if defined(__FreeBSD__) #if defined(__FreeBSD__) && defined(__GNUC__) # include <floatingpoint.h> #endif #if defined(__bsdi__) # include <sys/param.h> # if _BSDI_VERSION > 199501 # include <dlfcn.h> # endif
︙
77 78 79 80 81 82 83 84 85 86 87 88 89 90	84 85 86 87 88 89 90 91 92 93 94 95 96 97 98	+	CONST char *lang; CONST char *encoding; } LocaleTable; static CONST LocaleTable localeTable[] = { #ifdef HAVE_LANGINFO {"gb2312-1980", "gb2312"}, {"ansi-1251", "cp1251"}, /* Solaris gets this wrong. */ #ifdef __hpux {"SJIS", "shiftjis"}, {"eucjp", "euc-jp"}, {"euckr", "euc-kr"}, {"euctw", "euc-cn"}, {"greek8", "cp869"}, {"iso88591", "iso8859-1"},
︙
132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152	140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179	+ + + + + - - - + + + + + + + + + + + + + + + + +	{"korean", "euc-kr"}, {"ru", "iso8859-5"}, {"ru_RU", "iso8859-5"}, {"ru_SU", "iso8859-5"}, {"zh", "cp936"}, {"zh_CN.gb2312", "euc-cn"}, {"zh_CN.GB2312", "euc-cn"}, {"zh_CN.GBK", "euc-cn"}, {"zh_TW.Big5", "big5"}, {"zh_TW", "euc-tw"}, {NULL, NULL} }; #ifdef HAVE_CFBUNDLE static int Tcl_MacOSXGetLibraryPath(Tcl_Interp *interp, int maxPathLen, char *tclLibPath); #endif /* HAVE_CFBUNDLE */ #ifdef HAVE_COREFOUNDATION static int MacOSXGetLibraryPath _ANSI_ARGS_(( Tcl_Interp *interp, int maxPathLen, char *tclLibPath)); #endif /* HAVE_COREFOUNDATION */ #if defined(__APPLE__) && (defined(TCL_LOAD_FROM_MEMORY) || ( \ defined(TCL_THREADS) && defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || ( \ defined(__LP64__) && defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ MAC_OS_X_VERSION_MIN_REQUIRED < 1050)) /* * Need to check Darwin release at runtime in tclUnixFCmd.c and tclLoadDyld.c: * initialize release global at startup from uname(). */ #define GET_DARWIN_RELEASE 1 long tclMacOSXDarwinRelease = 0; #endif  /* *--------------------------------------------------------------------------- * * TclpInitPlatform -- *
︙
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203	191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259	+ + + + + + + + + + + + + - + + + + + + + + + + + + + + + + +	*--------------------------------------------------------------------------- */ void TclpInitPlatform() { tclPlatform = TCL_PLATFORM_UNIX; /* * Make sure, that the standard FDs exist. [Bug 772288] */ if (TclOSseek(0, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { open("/dev/null", O_RDONLY); } if (TclOSseek(1, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { open("/dev/null", O_WRONLY); } if (TclOSseek(2, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { open("/dev/null", O_WRONLY); } /* * The code below causes SIGPIPE (broken pipe) errors to * be ignored. This is needed so that Tcl processes don't * die if they create child processes (e.g. using "exec" or * "open") that terminate prematurely. The signal handler * is only set up when the first interpreter is created; * after this the application can override the handler with * a different one of its own, if it wants. */ #ifdef SIGPIPE (void) signal(SIGPIPE, SIG_IGN); #endif /* SIGPIPE */ #ifdef __FreeBSD__ #if defined(__FreeBSD__) && defined(__GNUC__) /* * Adjust the rounding mode to be more conventional. Note that FreeBSD * only provides the __fpsetreg() used by the following two for the GNU * Compiler. When using, say, Intel's icc they break. (Partially based on * patch in BSD ports system from root@celsius.bychok.com) */ fpsetround(FP_RN); fpsetmask(0L); #endif #if defined(__bsdi__) && (_BSDI_VERSION > 199501) /* * Find local symbols. Don't report an error if we fail. */ (void) dlopen (NULL, RTLD_NOW); /* INTL: Native. */ #endif #ifdef GET_DARWIN_RELEASE { struct utsname name; if (!uname(&name)) { tclMacOSXDarwinRelease = strtol(name.release, NULL, 10); } } #endif }  /* *--------------------------------------------------------------------------- * * TclpInitLibraryPath -- *
︙
225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247	281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304	+ - + - +	* encoding. TclpSetInitialEncodings() will translate the library * path from the native encoding to UTF-8 as soon as it determines * what the native encoding actually is. * * Called at process initialization time. * * Results: * Return 1, indicating that the UTF may be dirty and require "cleanup" * None. * after encodings are initialized. * * Side effects: * None. * *--------------------------------------------------------------------------- */ void int TclpInitLibraryPath(path) CONST char *path; /* Path to the executable in native * multi-byte encoding. */ { #define LIBRARY_SIZE 32 Tcl_Obj *pathPtr, *objPtr; CONST char *str;
︙
334 335 336 337 338 339 340 341 342 343 344 345 346 347 348	391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423	+ + + - + + + + + + + + + + + + + + + +	/* * The variable path holds an absolute path. Take care not to * overwrite pathv[0] since that might produce a relative path. */ if (path != NULL) { int i, origc; CONST char **origv; Tcl_SplitPath(path, &pathc, &pathv); Tcl_SplitPath(path, &origc, &origv); pathc = 0; pathv = (CONST char **) ckalloc((unsigned int)(origc * sizeof(char *))); for (i=0; i< origc; i++) { if (origv[i][0] == '.') { if (strcmp(origv[i], ".") == 0) { /* do nothing */ } else if (strcmp(origv[i], "..") == 0) { pathc--; } else { pathv[pathc++] = origv[i]; } } else { pathv[pathc++] = origv[i]; } } if (pathc > 2) { str = pathv[pathc - 2]; pathv[pathc - 2] = installLib; path = Tcl_JoinPath(pathc - 1, pathv, &ds); pathv[pathc - 2] = str; objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
︙
389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430	464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508	+ - + - + - - + + - + + +	pathv[pathc - 4] = developLib; path = Tcl_JoinPath(pathc - 3, pathv, &ds); pathv[pathc - 4] = str; objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } ckfree((char *) origv); ckfree((char *) pathv); } /* * Finally, look for the library relative to the compiled-in path. * This is needed when users install Tcl with an exec-prefix that * is different from the prtefix. */ { #ifdef HAVE_CFBUNDLE #ifdef HAVE_COREFOUNDATION char tclLibPath[MAXPATHLEN + 1]; if (Tcl_MacOSXGetLibraryPath(NULL, MAXPATHLEN, tclLibPath) == TCL_OK) { if (MacOSXGetLibraryPath(NULL, MAXPATHLEN, tclLibPath) == TCL_OK) { str = tclLibPath; } else #endif /* HAVE_CFBUNDLE */ #endif /* HAVE_COREFOUNDATION */ { str = defaultLibraryDir; } if (str[0] != '\0') { objPtr = Tcl_NewStringObj(str, -1); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); } } TclSetLibraryPath(pathPtr); Tcl_DStringFree(&buffer); return 1; /* 1 indicates that pathPtr may be dirty utf (needs cleaning) */ }  /* *--------------------------------------------------------------------------- * * TclpSetInitialEncodings -- *
︙
446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471	524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552	- + + + + - +	* *--------------------------------------------------------------------------- */ void TclpSetInitialEncodings() { if (libraryPathEncodingFixed == 0) { CONST char *encoding = NULL; int i, setSysEncCode = TCL_ERROR; Tcl_Obj *pathPtr; /* * Determine the current encoding from the LC_* or LANG environment * variables. We previously used setlocale() to determine the locale, * but this does not work on some systems (e.g. Linux/i386 RH 5.0). */ #ifdef HAVE_LANGINFO if ( #ifdef WEAK_IMPORT_NL_LANGINFO nl_langinfo != NULL && #endif if (setlocale(LC_CTYPE, "") != NULL) { setlocale(LC_CTYPE, "") != NULL) { Tcl_DString ds; /* * Use a DString so we can overwrite it in name compatability * checks below. */
︙
610 611 612 613 614 615 616 617 618 619 620 621 622 623	691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706	+ +	* processing is done in "C" locale regardless. This is needed because * Tcl relies on routines like strtod, but should not have locale * dependent behavior. */ setlocale(LC_NUMERIC, "C"); if ((libraryPathEncodingFixed == 0) && strcmp("identity", Tcl_GetEncodingName(Tcl_GetEncoding(NULL, NULL))) ) { /* * Until the system encoding was actually set, the library path was * actually in the native multi-byte encoding, and not really UTF-8 * as advertised. We cheated as follows: * * 1. It was safe to allow the Tcl_SetSystemEncoding() call to * append the ASCII chars that make up the encoding's filename to
︙
695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712	778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819	- + - - + + + + + + + + + + + + + + + + + + + + + + + + + +	#ifndef NO_UNAME struct utsname name; #endif int unameOK; CONST char *user; Tcl_DString ds; #ifdef HAVE_CFBUNDLE #ifdef HAVE_COREFOUNDATION char tclLibPath[MAXPATHLEN + 1]; if (Tcl_MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) { #if MAC_OS_X_VERSION_MAX_ALLOWED > 1020 /* * Set msgcat fallback locale to current CFLocale identifier. */ CFLocaleRef localeRef; if (CFLocaleCopyCurrent != NULL && CFLocaleGetIdentifier != NULL && (localeRef = CFLocaleCopyCurrent())) { CFStringRef locale = CFLocaleGetIdentifier(localeRef); if (locale) { char loc[256]; if (CFStringGetCString(locale, loc, 256, kCFStringEncodingUTF8)) { if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) { Tcl_ResetResult(interp); } Tcl_SetVar(interp, "::tcl::mac::locale", loc, TCL_GLOBAL_ONLY); } } CFRelease(localeRef); } #endif if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) { CONST char *str; Tcl_DString ds; CFBundleRef bundleRef; Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
︙
727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767	834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874	- + - + - +	Tcl_DStringFree(&ds); } if ((bundleRef = CFBundleGetMainBundle())) { CFURLRef frameworksURL; Tcl_StatBuf statBuf; if((frameworksURL = CFBundleCopyPrivateFrameworksURL(bundleRef))) { if(CFURLGetFileSystemRepresentation(frameworksURL, TRUE, tclLibPath, MAXPATHLEN) && (unsigned char*) tclLibPath, MAXPATHLEN) && ! TclOSstat(tclLibPath, &statBuf) && S_ISDIR(statBuf.st_mode)) { Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); Tcl_SetVar(interp, "tcl_pkgPath", " ", TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); } CFRelease(frameworksURL); } if((frameworksURL = CFBundleCopySharedFrameworksURL(bundleRef))) { if(CFURLGetFileSystemRepresentation(frameworksURL, TRUE, tclLibPath, MAXPATHLEN) && (unsigned char*) tclLibPath, MAXPATHLEN) && ! TclOSstat(tclLibPath, &statBuf) && S_ISDIR(statBuf.st_mode)) { Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); Tcl_SetVar(interp, "tcl_pkgPath", " ", TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); } CFRelease(frameworksURL); } } Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); } else #endif /* HAVE_CFBUNDLE */ #endif /* HAVE_COREFOUNDATION */ { Tcl_SetVar(interp, "tclDefaultLibrary", defaultLibraryDir, TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY); } #ifdef DJGPP
︙
916 917 918 919 920 921 922 923 924 925 926 927 928 929 930	1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039	+ +	}; } pathPtr = TclGetLibraryPath(); if (pathPtr == NULL) { pathPtr = Tcl_NewObj(); } Tcl_IncrRefCount(pathPtr); Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(pathPtr); return Tcl_Eval(interp, initScript); }  /* *---------------------------------------------------------------------- * * Tcl_SourceRCFile --
︙
1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044	1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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	- - + - + + + + - + - - - + + + - + - + -	/* * This function is unimplemented on Unix platforms. */ return 1; }  #ifdef HAVE_CFBUNDLE /* *---------------------------------------------------------------------- * * Tcl_MacOSXGetLibraryPath -- * MacOSXGetLibraryPath -- * * If we have a bundle structure for the Tcl installation, * then check there first to see if we can find the libraries * there. * * Results: * TCL_OK if we have found the tcl library; TCL_ERROR otherwise. * * Side effects: * Same as for Tcl_MacOSXOpenBundleResources. * Same as for Tcl_MacOSXOpenVersionedBundleResources. * *---------------------------------------------------------------------- */ #ifdef HAVE_COREFOUNDATION static int static int Tcl_MacOSXGetLibraryPath(Tcl_Interp *interp, int maxPathLen, char *tclLibPath) MacOSXGetLibraryPath(Tcl_Interp *interp, int maxPathLen, char *tclLibPath) { int foundInFramework = TCL_ERROR; if (strcmp(defaultLibraryDir, "@TCL_IN_FRAMEWORK@") == 0) { foundInFramework = Tcl_MacOSXOpenBundleResources(interp, "com.tcltk.tcllibrary", 0, maxPathLen, tclLibPath); #ifdef TCL_FRAMEWORK foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp, "com.tcltk.tcllibrary", TCL_FRAMEWORK_VERSION, 0, maxPathLen, tclLibPath); } #endif return foundInFramework; } #endif /* HAVE_CFBUNDLE */ #endif /* HAVE_COREFOUNDATION */

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	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	- + + + +	/* * tclUnixNotify.c -- * * This file contains the implementation of the select-based * Unix-specific notifier, which is the lowest-level part of the * Tcl event loop. This file works together with * ../generic/tclNotify.c. * * Copyright (c) 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. * * RCS: @(#) $Id: tclUnixNotfy.c,v 1.11 2002/08/31 06:09:46 das Exp $ * RCS: @(#) $Id: tclUnixNotfy.c,v 1.11.2.16 2006/08/22 17:45:02 andreas_kupries Exp $ */ #include "tclInt.h" #include "tclPort.h" #ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier * is in tclMacOSXNotify.c */ #include <signal.h> extern TclStubs tclStubs; extern Tcl_NotifierProcs tclOriginalNotifier; /* * This structure is used to keep track of the notifier info for a * a registered file. */ typedef struct FileHandler {
︙
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	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	+ + + + + + + + + + + + - - + + - - +	int fd; /* File descriptor that is ready. Used * to find the FileHandler structure for * the file (can't point directly to the * FileHandler structure because it could * go away while the event is queued). */ } FileHandlerEvent; /* * * The following structure contains a set of select() masks to track * readable, writable, and exceptional conditions. */ typedef struct SelectMasks { fd_set readable; fd_set writable; fd_set exceptional; } SelectMasks; /* * The following static structure contains the state information for the * select based implementation of the Tcl notifier. One of these structures * is created for each thread that is using the notifier. */ typedef struct ThreadSpecificData { FileHandler *firstFileHandlerPtr; /* Pointer to head of file handler list. */ fd_mask checkMasks[3*MASK_SIZE]; /* This array is used to build up the masks SelectMasks checkMasks; /* This structure is used to build up the masks * to be used in the next call to select. * Bits are set in response to calls to * Tcl_CreateFileHandler. */ fd_mask readyMasks[3*MASK_SIZE]; /* This array reflects the readable/writable SelectMasks readyMasks; /* This array reflects the readable/writable * conditions that were found to exist by the * last call to select. */ int numFdBits; /* Number of valid bits in checkMasks * (one more than highest fd for which * Tcl_WatchFile has been called). */ #ifdef TCL_THREADS int onList; /* True if it is in this list */
︙
203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218	217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232	- - + +	/* * Start the Notifier thread if necessary. */ Tcl_MutexLock(&notifierMutex); if (notifierCount == 0) { if (Tcl_CreateThread(&notifierThread, NotifierThreadProc, NULL, TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS) != TCL_OK) { if (TclpThreadCreate(&notifierThread, NotifierThreadProc, NULL, TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) { panic("Tcl_InitNotifier: unable to start notifier thread"); } } notifierCount++; /* * Wait for the notifier pipe to be created.
︙
257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288	271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309	+ - + - + + - - + + + + + + +	/* * If this is the last thread to use the notifier, close the notifier * pipe and wait for the background thread to terminate. */ if (notifierCount == 0) { int result; if (triggerPipe < 0) { panic("Tcl_FinalizeNotifier: notifier pipe not initialized"); } /* /* * Send "q" message to the notifier thread so that it will * terminate. The notifier will return from its call to select() * and notice that a "q" message has arrived, it will then close * its side of the pipe and terminate its thread. Note the we can * not just close the pipe and check for EOF in the notifier * thread because if a background child process was created with * exec, select() would not register the EOF on the pipe until the * child processes had terminated. [Bug: 4139] * child processes had terminated. [Bug: 4139] [Bug: 1222872] */ write(triggerPipe, "q", 1); close(triggerPipe); Tcl_ConditionWait(&notifierCV, &notifierMutex, NULL); while(triggerPipe >= 0) { Tcl_ConditionWait(&notifierCV, &notifierMutex, NULL); } result = Tcl_JoinThread(notifierThread, NULL); if (result) { Tcl_Panic("Tcl_FinalizeNotifier: unable to join notifier thread"); } } /* * Clean up any synchronization objects in the thread local storage. */ Tcl_ConditionFinalize(&(tsdPtr->waitCV));
︙
349 350 351 352 353 354 355 356 357 358 359 360 361 362 363	370 371 372 373 374 375 376 377 378 379 380 381 382 383 384	- +	{ /* * The interval timer doesn't do anything in this implementation, * because the only event loop is via Tcl_DoOneEvent, which passes * timeout values to Tcl_WaitForEvent. */ if (tclStubs.tcl_SetTimer != Tcl_SetTimer) { if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) { tclStubs.tcl_SetTimer(timePtr); } }  /* *---------------------------------------------------------------------- *
︙
406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422	427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442	- - +	* proc should be called. */ Tcl_FileProc *proc; /* Procedure to call for each * selected event. */ ClientData clientData; /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr; int index, bit; if (tclStubs.tcl_CreateFileHandler != Tcl_CreateFileHandler) { if (tclStubs.tcl_CreateFileHandler != tclOriginalNotifier.createFileHandlerProc) { tclStubs.tcl_CreateFileHandler(fd, mask, proc, clientData); return; } for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL; filePtr = filePtr->nextPtr) { if (filePtr->fd == fd) {
︙
434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463	454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481	- - - - + + - - - - + + + + - + - - + + - +	filePtr->clientData = clientData; filePtr->mask = mask; /* * Update the check masks for this file. */ index = fd/(NBBY*sizeof(fd_mask)); bit = 1 << (fd%(NBBY*sizeof(fd_mask))); if (mask & TCL_READABLE) { tsdPtr->checkMasks[index] |= bit; if ( mask & TCL_READABLE ) { FD_SET( fd, &(tsdPtr->checkMasks.readable) ); } else { tsdPtr->checkMasks[index] &= ~bit; } if (mask & TCL_WRITABLE) { (tsdPtr->checkMasks+MASK_SIZE)[index] |= bit; FD_CLR( fd, &(tsdPtr->checkMasks.readable) ); } if ( mask & TCL_WRITABLE ) { FD_SET( fd, &(tsdPtr->checkMasks.writable) ); } else { (tsdPtr->checkMasks+MASK_SIZE)[index] &= ~bit; FD_CLR( fd, &(tsdPtr->checkMasks.writable) ); } if (mask & TCL_EXCEPTION) { (tsdPtr->checkMasks+2*(MASK_SIZE))[index] |= bit; if ( mask & TCL_EXCEPTION ) { FD_SET( fd, &(tsdPtr->checkMasks.exceptional) ); } else { (tsdPtr->checkMasks+2*(MASK_SIZE))[index] &= ~bit; FD_CLR( fd, &(tsdPtr->checkMasks.exceptional) ); } if (tsdPtr->numFdBits <= fd) { tsdPtr->numFdBits = fd+1; } }  /*
︙
478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496	496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513	- + - - +	*/ void Tcl_DeleteFileHandler(fd) int fd; /* Stream id for which to remove callback procedure. */ { FileHandler *filePtr, *prevPtr; int index, bit, i; int i; unsigned long flags; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tclStubs.tcl_DeleteFileHandler != Tcl_DeleteFileHandler) { if (tclStubs.tcl_DeleteFileHandler != tclOriginalNotifier.deleteFileHandlerProc) { tclStubs.tcl_DeleteFileHandler(fd); return; } /* * Find the entry for the given file (and return if there isn't one). */
︙
505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547	522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556	- - - - + - + - + - - - - + + + + + - - - - - - - +	} } /* * Update the check masks for this file. */ index = fd/(NBBY*sizeof(fd_mask)); bit = 1 << (fd%(NBBY*sizeof(fd_mask))); if (filePtr->mask & TCL_READABLE) { tsdPtr->checkMasks[index] &= ~bit; FD_CLR( fd, &(tsdPtr->checkMasks.readable) ); } if (filePtr->mask & TCL_WRITABLE) { (tsdPtr->checkMasks+MASK_SIZE)[index] &= ~bit; FD_CLR( fd, &(tsdPtr->checkMasks.writable) ); } if (filePtr->mask & TCL_EXCEPTION) { (tsdPtr->checkMasks+2*(MASK_SIZE))[index] &= ~bit; FD_CLR( fd, &(tsdPtr->checkMasks.exceptional) ); } /* * Find current max fd. */ if (fd+1 == tsdPtr->numFdBits) { for (tsdPtr->numFdBits = 0; index >= 0; index--) { flags = tsdPtr->checkMasks[index] | (tsdPtr->checkMasks+MASK_SIZE)[index] | (tsdPtr->checkMasks+2*(MASK_SIZE))[index]; tsdPtr->numFdBits = 0; for (i = fd-1; i >= 0; i--) { if ( FD_ISSET( i, &(tsdPtr->checkMasks.readable) ) || FD_ISSET( i, &(tsdPtr->checkMasks.writable) ) || FD_ISSET( i, &(tsdPtr->checkMasks.exceptional ) ) ) { if (flags) { for (i = (NBBY*sizeof(fd_mask)); i > 0; i--) { if (flags & (((unsigned long)1) << (i-1))) { break; } } tsdPtr->numFdBits = index * (NBBY*sizeof(fd_mask)) + i; tsdPtr->numFdBits = i+1; break; } } } /* * Clean up information in the callback record.
︙
649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711	658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734	- - + + + + + + - + + - - + - + + + + + + + + + + +	int Tcl_WaitForEvent(timePtr) Tcl_Time *timePtr; /* Maximum block time, or NULL. */ { FileHandler *filePtr; FileHandlerEvent *fileEvPtr; struct timeval timeout, *timeoutPtr; int bit, index, mask; int mask; #ifdef TCL_THREADS int waitForFiles; #else /* Impl. notes: timeout & timeoutPtr are used if, and only if * threads are not enabled. They are the arguments for the regular * select() used when the core is not thread-enabled. */ struct timeval timeout, *timeoutPtr; int numFound; #endif ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tclStubs.tcl_WaitForEvent != Tcl_WaitForEvent) { if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) { return tclStubs.tcl_WaitForEvent(timePtr); } #ifndef TCL_THREADS /* * Set up the timeout structure. Note that if there are no events to * check for, we return with a negative result rather than blocking * forever. */ if (timePtr) { timeout.tv_sec = timePtr->sec; timeout.tv_usec = timePtr->usec; timeoutPtr = &timeout; #ifndef TCL_THREADS } else if (tsdPtr->numFdBits == 0) { /* * If there are no threads, no timeout, and no fds registered, * then there are no events possible and we must avoid deadlock. * Note that this is not entirely correct because there might * be a signal that could interrupt the select call, but we * don't handle that case if we aren't using threads. */ return -1; #endif } else { timeoutPtr = NULL; } #endif #ifdef TCL_THREADS /* * Place this thread on the list of interested threads, signal the * notifier thread, and wait for a response or a timeout. */ Tcl_MutexLock(&notifierMutex); waitForFiles = (tsdPtr->numFdBits > 0); if (timePtr != NULL && timePtr->sec == 0 && timePtr->usec == 0) { if (timePtr != NULL && timePtr->sec == 0 && (timePtr->usec == 0 #if defined(__APPLE__) && defined(__LP64__) /* * On 64-bit Darwin, pthread_cond_timedwait() appears to have a bug * that causes it to wait forever when passed an absolute time which * has already been exceeded by the system time; as a workaround, * when given a very brief timeout, just do a poll. [Bug 1457797] */ || timePtr->usec < 10 #endif )) { /* * Cannot emulate a polling select with a polling condition variable. * Instead, pretend to wait for files and tell the notifier * thread what we are doing. The notifier thread makes sure * it goes through select with its select mask in the same state * as ours currently is. We block until that happens. */
︙
732 733 734 735 736 737 738 739 740 741 742 743 744 745 746	755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771	- + + +	tsdPtr->prevPtr = 0; waitingListPtr = tsdPtr; tsdPtr->onList = 1; write(triggerPipe, "", 1); } memset((VOID *) tsdPtr->readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask)); FD_ZERO( &(tsdPtr->readyMasks.readable) ); FD_ZERO( &(tsdPtr->readyMasks.writable) ); FD_ZERO( &(tsdPtr->readyMasks.exceptional) ); if (!tsdPtr->eventReady) { Tcl_ConditionWait(&tsdPtr->waitCV, &notifierMutex, timePtr); } tsdPtr->eventReady = 0; if (waitForFiles && tsdPtr->onList) {
︙
762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809	787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834	- + - - - - - + + + + + - + + + - + - - + - - + - +	tsdPtr->nextPtr = tsdPtr->prevPtr = NULL; tsdPtr->onList = 0; write(triggerPipe, "", 1); } #else memcpy((VOID *) tsdPtr->readyMasks, (VOID *) tsdPtr->checkMasks, tsdPtr->readyMasks = tsdPtr->checkMasks; 3*MASK_SIZE*sizeof(fd_mask)); numFound = select(tsdPtr->numFdBits, (SELECT_MASK *) &tsdPtr->readyMasks[0], (SELECT_MASK *) &tsdPtr->readyMasks[MASK_SIZE], (SELECT_MASK *) &tsdPtr->readyMasks[2*MASK_SIZE], timeoutPtr); numFound = select( tsdPtr->numFdBits, &(tsdPtr->readyMasks.readable), &(tsdPtr->readyMasks.writable), &(tsdPtr->readyMasks.exceptional), timeoutPtr ); /* * Some systems don't clear the masks after an error, so * we have to do it here. */ if (numFound == -1) { memset((VOID *) tsdPtr->readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask)); FD_ZERO( &(tsdPtr->readyMasks.readable ) ); FD_ZERO( &(tsdPtr->readyMasks.writable ) ); FD_ZERO( &(tsdPtr->readyMasks.exceptional ) ); } #endif /* * Queue all detected file events before returning. */ for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL); filePtr = filePtr->nextPtr) { index = filePtr->fd / (NBBY*sizeof(fd_mask)); bit = 1 << (filePtr->fd % (NBBY*sizeof(fd_mask))); mask = 0; if ( FD_ISSET( filePtr->fd, &(tsdPtr->readyMasks.readable) ) ) { if (tsdPtr->readyMasks[index] & bit) { mask |= TCL_READABLE; } if ((tsdPtr->readyMasks+MASK_SIZE)[index] & bit) { if ( FD_ISSET( filePtr->fd, &(tsdPtr->readyMasks.writable) ) ) { mask |= TCL_WRITABLE; } if ((tsdPtr->readyMasks+2*(MASK_SIZE))[index] & bit) { if ( FD_ISSET( filePtr->fd, &(tsdPtr->readyMasks.exceptional) ) ) { mask |= TCL_EXCEPTION; } if (!mask) { continue; }
︙
854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873	879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899	- - + + + - + + -	*/ static void NotifierThreadProc(clientData) ClientData clientData; /* Not used. */ { ThreadSpecificData *tsdPtr; fd_mask masks[3*MASK_SIZE]; long *maskPtr = (long *)masks; /* masks[] cast to type long[] */ fd_set readableMask; fd_set writableMask; fd_set exceptionalMask; int fds[2]; int i, status, index, bit, numFdBits, found, receivePipe, word; int i, status, numFdBits = 0, receivePipe; long found; struct timeval poll = {0., 0.}, *timePtr; int maskSize = 3 * ((MASK_SIZE) / sizeof(long)) * sizeof(fd_mask); char buf[2]; if (pipe(fds) != 0) { panic("NotifierThreadProc: could not create trigger pipe."); } receivePipe = fds[0];
︙
907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014	933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063	- - - - - - - - + + + + - + - + - - - - - - + + + + + + + + + + + + + + - + + + + - - - + + + + + + - - + + - - - - - + + + + + + + + + + + + + + + + + + - + - + - +	Tcl_MutexUnlock(&notifierMutex); /* * Look for file events and report them to interested threads. */ while (1) { /* * Set up the select mask to include the receive pipe. */ memset((VOID *)masks, 0, 3*MASK_SIZE*sizeof(fd_mask)); numFdBits = receivePipe + 1; index = receivePipe / (NBBY*sizeof(fd_mask)); bit = 1 << (receivePipe % (NBBY*sizeof(fd_mask))); masks[index] |= bit; FD_ZERO( &readableMask ); FD_ZERO( &writableMask ); FD_ZERO( &exceptionalMask ); /* * Compute the logical OR of the select masks from all the * Add in the check masks from all of the waiting notifiers. * waiting notifiers. */ Tcl_MutexLock(&notifierMutex); timePtr = NULL; for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) { for (i = 0; i < maskSize; i++) { maskPtr[i] |= ((long*)tsdPtr->checkMasks)[i]; } if (tsdPtr->numFdBits > numFdBits) { numFdBits = tsdPtr->numFdBits; } for ( i = tsdPtr->numFdBits-1; i >= 0; --i ) { if ( FD_ISSET( i, &(tsdPtr->checkMasks.readable) ) ) { FD_SET( i, &readableMask ); } if ( FD_ISSET( i, &(tsdPtr->checkMasks.writable) ) ) { FD_SET( i, &writableMask ); } if ( FD_ISSET( i, &(tsdPtr->checkMasks.exceptional) ) ) { FD_SET( i, &exceptionalMask ); } } if ( tsdPtr->numFdBits > numFdBits ) { numFdBits = tsdPtr->numFdBits; } if (tsdPtr->pollState & POLL_WANT) { /* * Here we make sure we go through select() with the same * mask bits that were present when the thread tried to poll. */ tsdPtr->pollState |= POLL_DONE; timePtr = &poll; } } } Tcl_MutexUnlock(&notifierMutex); /* * Set up the select mask to include the receive pipe. */ maskSize = 3 * ((MASK_SIZE) / sizeof(long)) * sizeof(fd_mask); if (select(numFdBits, (SELECT_MASK *) &masks[0], if ( receivePipe >= numFdBits ) { numFdBits = receivePipe + 1; } FD_SET( receivePipe, &readableMask ); (SELECT_MASK *) &masks[MASK_SIZE], (SELECT_MASK *) &masks[2*MASK_SIZE], timePtr) == -1) { if ( select( numFdBits, &readableMask, &writableMask, &exceptionalMask, timePtr) == -1 ) { /* * Try again immediately on an error. */ continue; } /* * Alert any threads that are waiting on a ready file descriptor. */ Tcl_MutexLock(&notifierMutex); for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) { found = 0; for (i = 0; i < maskSize; i++) { word = maskPtr[i] & ((long*)tsdPtr->checkMasks)[i]; found |= word; (((long*)(tsdPtr->readyMasks))[i]) = word; } for ( i = tsdPtr->numFdBits-1; i >= 0; --i ) { if ( FD_ISSET( i, &(tsdPtr->checkMasks.readable) ) && FD_ISSET( i, &readableMask ) ) { FD_SET( i, &(tsdPtr->readyMasks.readable) ); found = 1; } if ( FD_ISSET( i, &(tsdPtr->checkMasks.writable) ) && FD_ISSET( i, &writableMask ) ) { FD_SET( i, &(tsdPtr->readyMasks.writable) ); found = 1; } if ( FD_ISSET( i, &(tsdPtr->checkMasks.exceptional) ) && FD_ISSET( i, &exceptionalMask ) ) { FD_SET( i, &(tsdPtr->readyMasks.exceptional) ); found = 1; } } if (found || (tsdPtr->pollState & POLL_DONE)) { tsdPtr->eventReady = 1; if (tsdPtr->onList) { /* * Remove the ThreadSpecificData structure of this * thread from the waiting list. This prevents us from * continuously spining on select until the other * threads runs and services the file event. */ if (tsdPtr->prevPtr) { tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr; } else { waitingListPtr = tsdPtr->nextPtr; } if (tsdPtr->nextPtr) { tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; } tsdPtr->nextPtr = tsdPtr->prevPtr = NULL; tsdPtr->onList = 0; tsdPtr->pollState = 0; } Tcl_ConditionNotify(&tsdPtr->waitCV); } } Tcl_MutexUnlock(&notifierMutex); /* * Consume the next byte from the notifier pipe if the pipe was * readable. Note that there may be multiple bytes pending, but * to avoid a race condition we only read one at a time. */ if (masks[index] & bit) { if ( FD_ISSET( receivePipe, &readableMask ) ) { i = read(receivePipe, buf, 1); if ((i == 0) || ((i == 1) && (buf[0] == 'q'))) { /* * Someone closed the write end of the pipe or sent us a * Quit message [Bug: 4139] and then closed the write end * of the pipe so we need to shut down the notifier thread.
︙
1025 1026 1027 1028 1029 1030 1031 1032 1033	1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086	- + + + + +	*/ close(receivePipe); Tcl_MutexLock(&notifierMutex); triggerPipe = -1; Tcl_ConditionNotify(&notifierCV); Tcl_MutexUnlock(&notifierMutex); } TclpThreadExit (0); } #endif #endif /* HAVE_COREFOUNDATION */

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclUnixPipe.c -- * * This file implements the UNIX-specific exec pipeline functions, * the "pipe" channel driver, and the "pid" Tcl command. * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-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. * * RCS: @(#) $Id: tclUnixPipe.c,v 1.23 2003/02/21 14:15:58 das Exp $ * RCS: @(#) $Id: tclUnixPipe.c,v 1.23.2.7 2006/08/02 20:04:40 das Exp $ */ #include "tclInt.h" #include "tclPort.h" #ifdef USE_VFORK #define fork vfork
︙
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	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	- + + +	/* * This structure describes the channel type structure for command pipe * based IO: */ static Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ TCL_CHANNEL_VERSION_2, /* v2 channel */ TCL_CHANNEL_VERSION_4, /* v4 channel */ PipeCloseProc, /* Close proc. */ PipeInputProc, /* Input proc. */ PipeOutputProc, /* Output proc. */ NULL, /* Seek proc. */ NULL, /* Set option proc. */ NULL, /* Get option proc. */ PipeWatchProc, /* Initialize notifier. */ PipeGetHandleProc, /* Get OS handles out of channel. */ NULL, /* close2proc. */ PipeBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc */ NULL, /* thread action proc */ };  /* *---------------------------------------------------------------------- * * TclpMakeFile -- *
︙
150 151 152 153 154 155 156 157 158 159 160 161 162 163 164	152 153 154 155 156 157 158 159 160 161 162 163 164 165 166	- +	fcntl(fd, F_SETFD, FD_CLOEXEC); /* * If the file is being opened for writing, seek to the end * so we can append to any data already in the file. */ if (mode & O_WRONLY) { if ((mode & O_WRONLY) && !(mode & O_APPEND)) { TclOSseek(fd, (Tcl_SeekOffset) 0, SEEK_END); } /* * Increment the fd so it can't be 0, which would conflict with * the NULL return for errors. */
︙
392 393 394 395 396 397 398 399 400 401 402 403 404 405 406	394 395 396 397 398 399 400 401 402 403 404 405 406 407 408	- +	* errors from the child will be discarded. * errorFile may be the same as outputFile. */ Tcl_Pid *pidPtr; /* If this procedure is successful, pidPtr * is filled with the process id of the child * process. */ { TclFile errPipeIn, errPipeOut; int joinThisError, count, status, fd; int count, status, fd; char errSpace[200 + TCL_INTEGER_SPACE]; Tcl_DString *dsArray; char **newArgv; int pid, i; errPipeIn = NULL; errPipeOut = NULL;
︙
424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440	426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460	+ + + + + + + + + + - + + + + + + + + +	dsArray = (Tcl_DString *) ckalloc(argc * sizeof(Tcl_DString)); newArgv = (char **) ckalloc((argc+1) * sizeof(char *)); newArgv[argc] = NULL; for (i = 0; i < argc; i++) { newArgv[i] = Tcl_UtfToExternalDString(NULL, argv[i], -1, &dsArray[i]); } #ifdef USE_VFORK /* * After vfork(), do not call code in the child that changes global state, * because it is using the parent's memory space at that point and writes * might corrupt the parent: so ensure standard channels are initialized in * the parent, otherwise SetupStdFile() might initialize them in the child. */ if (!inputFile) { Tcl_GetStdChannel(TCL_STDIN); } joinThisError = errorFile && (errorFile == outputFile); if (!outputFile) { Tcl_GetStdChannel(TCL_STDOUT); } if (!errorFile) { Tcl_GetStdChannel(TCL_STDERR); } #endif pid = fork(); if (pid == 0) { int joinThisError = errorFile && (errorFile == outputFile); fd = GetFd(errPipeOut); /* * Set up stdio file handles for the child process. */ if (!SetupStdFile(inputFile, TCL_STDIN)
︙
656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677	676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695	- - - +	* Must clear the close-on-exec flag for the target FD, since * some systems (e.g. Ultrix) do not clear the CLOEXEC flag on * the target FD. */ fcntl(targetFd, F_SETFD, 0); } else { int result; /* * Since we aren't dup'ing the file, we need to explicitly clear * the close-on-exec flag. */ result = fcntl(fd, F_SETFD, 0); fcntl(fd, F_SETFD, 0); } } else { close(targetFd); } return 1; }
︙
1243 1244 1245 1246 1247 1248 1249	1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288	+ + + + + + + + + + + + + + + + + + + + +	for (i = 0; i < pipePtr->numPids; i++) { longObjPtr = Tcl_NewLongObj((long) TclpGetPid(pipePtr->pidPtr[i])); Tcl_ListObjAppendElement(NULL, resultPtr, longObjPtr); } } return TCL_OK; }  /* *---------------------------------------------------------------------- * * TclpFinalizePipes -- * * Cleans up the pipe subsystem from Tcl_FinalizeThread * * Results: * None. * * This procedure carries out no operation on Unix. * *---------------------------------------------------------------------- */ void TclpFinalizePipes() { }

︙
15 16 17 18 19 20 21 22 23 24 25 26 27 28 29	15 16 17 18 19 20 21 22 23 24 25 26 27 28 29	- +	* * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-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. * * RCS: @(#) $Id: tclUnixPort.h,v 1.27 2003/02/20 00:34:09 hobbs Exp $ * RCS: @(#) $Id: tclUnixPort.h,v 1.27.2.18 2007/04/21 22:42:49 kennykb Exp $ */ #ifndef _TCLUNIXPORT #define _TCLUNIXPORT #ifndef _TCLINT # include "tclInt.h"
︙
56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74	56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72	- -	# include <dirent.h> #endif #endif #ifdef HAVE_STRUCT_DIRENT64 typedef struct dirent64 Tcl_DirEntry; # define TclOSreaddir readdir64 # define TclOSreaddir_r readdir64_r #else typedef struct dirent Tcl_DirEntry; # define TclOSreaddir readdir # define TclOSreaddir_r readdir_r #endif #ifdef HAVE_TYPE_OFF64_T typedef off64_t Tcl_SeekOffset; # define TclOSseek lseek64 # define TclOSopen open64 #else
︙
93 94 95 96 97 98 99 100 101 102 103 104 105 106	91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112	+ + + + + + + +	#endif #include <sys/file.h> #ifdef HAVE_SYS_SELECT_H # include <sys/select.h> #endif #include <sys/stat.h> #ifdef __CYGWIN__ # define timezone _timezone typedef long TIMEZONE_t; #else /* !__CYGWIN__ */ typedef int TIMEZONE_t; #endif /* !__CYGWIN__ */ #if TIME_WITH_SYS_TIME # include <sys/time.h> # include <time.h> #else #if HAVE_SYS_TIME_H # include <sys/time.h> #else
︙
460 461 462 463 464 465 466 467 468 469 470 471 472 473 474	466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482	+ +	/* * Not all systems declare the errno variable in errno.h. so this * file does it explicitly. The list of system error messages also * isn't generally declared in a header file anywhere. */ #ifdef NO_ERRNO extern int errno; #endif /* * Not all systems declare all the errors that Tcl uses! Provide some * work-arounds... */ #ifndef EOVERFLOW
︙
500 501 502 503 504 505 506 507 508 509 510 511 512 513	508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	/* * There is no platform-specific panic routine for Unix in the Tcl internals. */ #define TclpPanic ((Tcl_PanicProc *) NULL) /* * Darwin specifc configure overrides. */ #ifdef __APPLE__ /* * Support for fat compiles: configure runs only once for multiple architectures */ # if defined(__LP64__) && defined (NO_COREFOUNDATION_64) # undef HAVE_COREFOUNDATION # endif /* __LP64__ && NO_COREFOUNDATION_64 */ # include <sys/cdefs.h> # ifdef __DARWIN_UNIX03 # if __DARWIN_UNIX03 # undef HAVE_PUTENV_THAT_COPIES # else # define HAVE_PUTENV_THAT_COPIES 1 # endif # endif /* __DARWIN_UNIX03 */ /* * The termios configure test program relies on the configure script being run * from a terminal, which is not the case e.g. when configuring from Xcode. * Since termios is known to be present on all Mac OS X releases since 10.0, * override the configure defines for serial API here. [Bug 497147] */ # define USE_TERMIOS 1 # undef USE_TERMIO # undef USE_SGTTY /* * Include AvailabilityMacros.h here (when available) to ensure any symbolic * MAC_OS_X_VERSION_* constants passed on the command line are translated. */ # ifdef HAVE_AVAILABILITYMACROS_H # include <AvailabilityMacros.h> # endif /* * Support for weak import. */ # ifdef HAVE_WEAK_IMPORT # if !defined(HAVE_AVAILABILITYMACROS_H) || !defined(MAC_OS_X_VERSION_MIN_REQUIRED) # undef HAVE_WEAK_IMPORT # else # ifndef WEAK_IMPORT_ATTRIBUTE # define WEAK_IMPORT_ATTRIBUTE __attribute__((weak_import)) # endif # endif # endif /* HAVE_WEAK_IMPORT */ /* * Support for MAC_OS_X_VERSION_MAX_ALLOWED define from AvailabilityMacros.h: * only use API available in the indicated OS version or earlier. */ # ifdef MAC_OS_X_VERSION_MAX_ALLOWED # if MAC_OS_X_VERSION_MAX_ALLOWED < 1050 && defined(__LP64__) # undef HAVE_COREFOUNDATION # endif # if MAC_OS_X_VERSION_MAX_ALLOWED < 1040 # undef HAVE_OSSPINLOCKLOCK # undef HAVE_PTHREAD_ATFORK # undef HAVE_COPYFILE # endif # if MAC_OS_X_VERSION_MAX_ALLOWED < 1030 # ifdef TCL_THREADS /* prior to 10.3, realpath is not threadsafe, c.f. bug 711232 */ # define NO_REALPATH 1 # endif # undef HAVE_LANGINFO # endif # endif /* MAC_OS_X_VERSION_MAX_ALLOWED */ # if defined(HAVE_COREFOUNDATION) && defined(__LP64__) && \ defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050 # warning "Weak import of 64-bit CoreFoundation is not supported, will not run on Mac OS X < 10.5." # endif /* * At present, using vfork() instead of fork() causes execve() to fail * intermittently on Darwin x86_64. rdar://4685553 */ # if defined(__x86_64__) && !defined(FIXED_RDAR_4685553) # undef USE_VFORK # endif /* __x86_64__ */ #endif /* __APPLE__ */ /* * Darwin 8 copyfile API. */ #ifdef HAVE_COPYFILE #ifdef HAVE_COPYFILE_H #include <copyfile.h> #if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040 /* Support for weakly importing copyfile. */ #define WEAK_IMPORT_COPYFILE extern int copyfile(const char *from, const char *to, copyfile_state_t state, copyfile_flags_t flags) WEAK_IMPORT_ATTRIBUTE; #endif /* HAVE_WEAK_IMPORT */ #else /* HAVE_COPYFILE_H */ int copyfile(const char *from, const char *to, void *state, uint32_t flags); #define COPYFILE_ACL (1<<0) #define COPYFILE_XATTR (1<<2) #define COPYFILE_NOFOLLOW_SRC (1<<18) #if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040 /* Support for weakly importing copyfile. */ #define WEAK_IMPORT_COPYFILE extern int copyfile(const char *from, const char *to, void *state, uint32_t flags) WEAK_IMPORT_ATTRIBUTE; #endif /* HAVE_WEAK_IMPORT */ #endif /* HAVE_COPYFILE_H */ #endif /* HAVE_COPYFILE */ /* *--------------------------------------------------------------------------- * The following macros and declarations represent the interface between * generic and unix-specific parts of Tcl. Some of the macros may override * functions declared in tclInt.h. *--------------------------------------------------------------------------- */
︙
558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584	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 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718	+ - - + + + + + - - - - - + + + + + + + + + + + + + + + + + + +	#ifdef TCL_THREADS #include <pthread.h> typedef pthread_mutex_t TclpMutex; EXTERN void TclpMutexInit _ANSI_ARGS_((TclpMutex *mPtr)); EXTERN void TclpMutexLock _ANSI_ARGS_((TclpMutex *mPtr)); EXTERN void TclpMutexUnlock _ANSI_ARGS_((TclpMutex *mPtr)); EXTERN Tcl_DirEntry * TclpReaddir(DIR *); #ifndef TclpLocaltime EXTERN struct tm * TclpLocaltime(time_t *); EXTERN struct tm * TclpGmtime(time_t *); EXTERN struct tm * TclpLocaltime(TclpTime_t_CONST); #endif #ifndef TclpGmtime EXTERN struct tm * TclpGmtime(TclpTime_t_CONST); #endif EXTERN char * TclpInetNtoa(struct in_addr); #define readdir(x) TclpReaddir(x) #define localtime(x) TclpLocaltime(x) #define gmtime(x) TclpGmtime(x) #define inet_ntoa(x) TclpInetNtoa(x) #undef TclOSreaddir #define TclOSreaddir(x) TclpReaddir(x) #else typedef int TclpMutex; #define TclpMutexInit(a) #define TclpMutexLock(a) #define TclpMutexUnlock(a) #endif /* TCL_THREADS */ /* * Set of MT-safe implementations of some * known-to-be-MT-unsafe library calls. * Instead of returning pointers to the * static storage, those return pointers * to the TSD data. */ #include <pwd.h> #include <grp.h> EXTERN struct passwd* TclpGetPwNam(const char *name); EXTERN struct group* TclpGetGrNam(const char *name); EXTERN struct passwd* TclpGetPwUid(uid_t uid); EXTERN struct group* TclpGetGrGid(gid_t gid); EXTERN struct hostent* TclpGetHostByName(const char *name); EXTERN struct hostent* TclpGetHostByAddr(const char *addr, int length, int type); #include "tclPlatDecls.h" #include "tclIntPlatDecls.h" #endif /* _TCLUNIXPORT */

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	- +	/* * tclUnixSock.c -- * * This file contains Unix-specific socket related code. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclUnixSock.c,v 1.6 2002/02/27 01:16:43 hobbs Exp $ * RCS: @(#) $Id: tclUnixSock.c,v 1.6.2.4 2006/09/07 09:01:07 vasiljevic Exp $ */ #include "tcl.h" #include "tclPort.h" /* * There is no portable macro for the maximum length
︙
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	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	- + - +	return hostname; } native = NULL; #ifndef NO_UNAME (VOID *) memset((VOID *) &u, (int) 0, sizeof(struct utsname)); if (uname(&u) > -1) { /* INTL: Native. */ hp = gethostbyname(u.nodename); /* INTL: Native. */ hp = TclpGetHostByName(u.nodename); /* INTL: Native. */ if (hp == NULL) { /* * Sometimes the nodename is fully qualified, but gets truncated * as it exceeds SYS_NMLN. See if we can just get the immediate * nodename and get a proper answer that way. */ char *dot = strchr(u.nodename, '.'); if (dot != NULL) { char *node = ckalloc((unsigned) (dot - u.nodename + 1)); memcpy(node, u.nodename, (size_t) (dot - u.nodename)); node[dot - u.nodename] = '\0'; hp = gethostbyname(node); hp = TclpGetHostByName(node); ckfree(node); } } if (hp != NULL) { native = hp->h_name; } else { native = u.nodename;
︙
144 145 146 147 148 149 150	144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172	+ + + + + + + + + + + + + + + + + + + + + +	int TclpHasSockets(interp) Tcl_Interp *interp; /* Not used. */ { return TCL_OK; }  /* *---------------------------------------------------------------------- * * TclpFinalizeSockets -- * * Performs per-thread socket subsystem finalization. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclpFinalizeSockets() { return; }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	/* * tclUnixTest.c -- * * Contains platform specific test commands for the Unix platform. * * Copyright (c) 1996-1997 Sun Microsystems, Inc. * Copyright (c) 1998 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclUnixTest.c,v 1.14 2003/02/15 22:30:29 kennykb Exp $ * RCS: @(#) $Id: tclUnixTest.c,v 1.14.2.2 2006/03/19 22:47:30 vincentdarley Exp $ */ #include "tclInt.h" #include "tclPort.h" /* * The headers are needed for the testalarm command that verifies the
︙
79 80 81 82 83 84 85 86 87 88 89 90 91 92	79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94	+ +	Tcl_Interp *interp, int argc, CONST char **argv)); int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp)); static int TestalarmCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static int TestgotsigCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static void AlarmHandler _ANSI_ARGS_(()); static int TestchmodCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv));  /* *---------------------------------------------------------------------- * * TclplatformtestInit -- * * Defines commands that test platform specific functionality for
︙
101 102 103 104 105 106 107 108 109 110 111 112 113 114	103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118	+ +	*---------------------------------------------------------------------- */ int TclplatformtestInit(interp) Tcl_Interp *interp; /* Interpreter to add commands to. */ { Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
︙
643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660	647 648 649 650 651 652 653 654 655 656 657 658 659 660 661	- + - - -	memset((void *)&action.sa_mask, 0, sizeof(sigset_t)); action.sa_flags = SA_RESTART; if (sigaction(SIGALRM, &action, NULL) < 0) { Tcl_AppendResult(interp, "sigaction: ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } if (alarm(sec) < 0) { (void)alarm(sec); Tcl_AppendResult(interp, "alarm: ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } return TCL_OK; #else Tcl_AppendResult(interp, "warning: sigaction SA_RESTART not support on this platform", NULL); return TCL_ERROR; #endif }
︙
702 703 704 705 706 707 708	703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	int argc; /* Number of arguments. */ CONST char **argv; /* Argument strings. */ { Tcl_AppendResult(interp, gotsig, (char *) NULL); gotsig = "0"; return TCL_OK; }  /* *--------------------------------------------------------------------------- * * TestchmodCmd -- * * Implements the "testchmod" cmd. Used when testing "file" command. * The only attribute used by the Windows platform is the user write * flag; if this is not set, the file is made read-only. Otehrwise, the * file is made read-write. * * Results: * A standard Tcl result. * * Side effects: * Changes permissions of specified files. * *--------------------------------------------------------------------------- */ static int TestchmodCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ CONST char **argv; /* Argument strings. */ { int i, mode; char *rest; if (argc < 2) { usage: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " mode file ?file ...?", NULL); return TCL_ERROR; } mode = (int) strtol(argv[1], &rest, 8); if ((rest == argv[1]) || (*rest != '\0')) { goto usage; } for (i = 2; i < argc; i++) { Tcl_DString buffer; CONST char *translated; translated = Tcl_TranslateFileName(interp, argv[i], &buffer); if (translated == NULL) { return TCL_ERROR; } if (chmod(translated, (unsigned) mode) != 0) { Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } Tcl_DStringFree(&buffer); } return TCL_OK; }

︙
16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36	16 17 18 19 20 21 22 23 24 25 26 27 28 29 30	- + - - - - - -	#include "tclPort.h" #ifdef TCL_THREADS #include "pthread.h" typedef struct ThreadSpecificData { char nabuf[16]; char nabuf[16]; struct tm gtbuf; struct tm ltbuf; struct { Tcl_DirEntry ent; char name[MAXNAMLEN+1]; } rdbuf; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * masterLock is used to serialize creation of mutexes, condition * variables, and thread local storage.
︙
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	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	- + - + +	#endif /* TCL_THREADS */  /* *---------------------------------------------------------------------- * * Tcl_CreateThread -- * TclpThreadCreate -- * * This procedure creates a new thread. * * Results: * TCL_OK if the thread could be created. The thread ID is * returned in a parameter. * * Side effects: * A new thread is created. * *---------------------------------------------------------------------- */ int Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags) TclpThreadCreate(idPtr, proc, clientData, stackSize, flags) Tcl_ThreadId *idPtr; /* Return, the ID of the thread */ Tcl_ThreadCreateProc proc; /* Main() function of the thread */ ClientData clientData; /* The one argument to Main() */ int stackSize; /* Size of stack for the new thread */ int flags; /* Flags controlling behaviour of * the new thread */ { #ifdef TCL_THREADS pthread_attr_t attr; pthread_t theThread; int result; pthread_attr_init(&attr); pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM); #ifdef HAVE_PTHREAD_ATTR_SETSTACKSIZE if (stackSize != TCL_THREAD_STACK_DEFAULT) {
︙
124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143	119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139	- + - + +	} #endif if (! (flags & TCL_THREAD_JOINABLE)) { pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED); } if (pthread_create((pthread_t *)idPtr, &attr, if (pthread_create(&theThread, &attr, (void * (*)())proc, (void *)clientData) && pthread_create((pthread_t *)idPtr, NULL, pthread_create(&theThread, NULL, (void * (*)())proc, (void *)clientData)) { result = TCL_ERROR; } else { *idPtr = (Tcl_ThreadId)theThread; result = TCL_OK; } pthread_attr_destroy(&attr); return result; #else return TCL_ERROR; #endif /* TCL_THREADS */
︙
157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180	153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180	- - - - - + + + + + + - + + + +	* The result area is set to the exit code of the thread we * waited upon. * *---------------------------------------------------------------------- */ int Tcl_JoinThread(id, state) Tcl_ThreadId id; /* Id of the thread to wait upon */ int* state; /* Reference to the storage the result * of the thread we wait upon will be * written into. */ Tcl_JoinThread(threadId, state) Tcl_ThreadId threadId; /* Id of the thread to wait upon */ int* state; /* Reference to the storage the result * of the thread we wait upon will be * written into. */ { #ifdef TCL_THREADS int result; unsigned long retcode; result = pthread_join ((pthread_t) id, (VOID**) state); result = pthread_join((pthread_t) threadId, (void**) &retcode); if (state) { *state = (int) retcode; } return (result == 0) ? TCL_OK : TCL_ERROR; #else return TCL_ERROR; #endif }  #ifdef TCL_THREADS
︙
251 252 253 254 255 256 257 258 259 260 261 262 263 264 265	251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295	- + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	void TclpInitLock() { #ifdef TCL_THREADS pthread_mutex_lock(&initLock); #endif }  /* *---------------------------------------------------------------------- * * TclpFinalizeLock * * This procedure is used to destroy all private resources used in * this file. * * Results: * None. * * Side effects: * Destroys everything private. TclpInitLock must be held * entering this function. * *---------------------------------------------------------------------- */ void TclFinalizeLock () { #ifdef TCL_THREADS /* * You do not need to destroy mutexes that were created with the * PTHREAD_MUTEX_INITIALIZER macro. These mutexes do not need * any destruction: masterLock, allocLock, and initLock. */ pthread_mutex_unlock(&initLock); #endif }  /* *---------------------------------------------------------------------- * * TclpInitUnlock * * This procedure is used to release a lock that serializes initialization
︙
462 463 464 465 466 467 468 469 470 471 472 473 474 475	492 493 494 495 496 497 498 499 500 501 502 503 504 505 506	+	void TclpFinalizeMutex(mutexPtr) Tcl_Mutex *mutexPtr; { pthread_mutex_t *pmutexPtr = *(pthread_mutex_t **)mutexPtr; if (pmutexPtr != NULL) { pthread_mutex_destroy(pmutexPtr); ckfree((char *)pmutexPtr); *mutexPtr = NULL; } }  /*
︙
784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951	815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924	+ + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - + - - + - + - + - + + + + + - - - - + - + - - + + + + + + + + + - - - - + + + + + + + + + + + + + + + + - + + + + + +	* * Results: * See documentation of C functions. * * Side effects: * See documentation of C functions. * * Notes: * TclpReaddir is no longer used by the core (see 1095909), * but it appears in the internal stubs table (see #589526). *---------------------------------------------------------------------- */ #if defined(TCL_THREADS) && !defined(HAVE_READDIR_R) TCL_DECLARE_MUTEX( rdMutex ) #undef readdir #endif Tcl_DirEntry * TclpReaddir(DIR * dir) { Tcl_DirEntry *ent; #ifdef TCL_THREADS ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #ifdef HAVE_READDIR_R ent = &tsdPtr->rdbuf.ent; if (TclOSreaddir_r(dir, ent, &ent) != 0) { ent = NULL; } #else /* !HAVE_READDIR_R */ Tcl_MutexLock(&rdMutex); # ifdef HAVE_STRUCT_DIRENT64 ent = readdir64(dir); # else /* !HAVE_STRUCT_DIRENT64 */ ent = readdir(dir); # endif /* HAVE_STRUCT_DIRENT64 */ if (ent != NULL) { memcpy((VOID *) &tsdPtr->rdbuf.ent, (VOID *) ent, sizeof(&tsdPtr->rdbuf)); ent = &tsdPtr->rdbuf.ent; } Tcl_MutexUnlock(&rdMutex); #endif /* HAVE_READDIR_R */ #else # ifdef HAVE_STRUCT_DIRENT64 ent = readdir64(dir); # else /* !HAVE_STRUCT_DIRENT64 */ ent = readdir(dir); # endif /* HAVE_STRUCT_DIRENT64 */ #endif return ent; return TclOSreaddir(dir); } #if defined(TCL_THREADS) && (!defined(HAVE_GMTIME_R) || !defined(HAVE_LOCALTIME_R)) TCL_DECLARE_MUTEX( tmMutex ) #undef localtime #undef gmtime #endif struct tm * TclpLocaltime(time_t * clock) { #ifdef TCL_THREADS ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #ifdef HAVE_LOCALTIME_R return localtime_r(clock, &tsdPtr->ltbuf); #else Tcl_MutexLock( &tmMutex ); memcpy( (VOID *) &tsdPtr->ltbuf, (VOID *) localtime( clock ), sizeof (struct tm) ); Tcl_MutexUnlock( &tmMutex ); return &tsdPtr->ltbuf; #endif #else return localtime(clock); #endif } struct tm * TclpGmtime(time_t * clock) { #ifdef TCL_THREADS ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #ifdef HAVE_GMTIME_R return gmtime_r(clock, &tsdPtr->gtbuf); #else Tcl_MutexLock( &tmMutex ); memcpy( (VOID *) &tsdPtr->gtbuf, (VOID *) gmtime( clock ), sizeof (struct tm) ); Tcl_MutexUnlock( &tmMutex ); return &tsdPtr->gtbuf; #endif #else return gmtime(clock); #endif } char * TclpInetNtoa(struct in_addr addr) { #ifdef TCL_THREADS ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); union { unsigned long l; unsigned char b[4]; unsigned char *b = (unsigned char*) &addr.s_addr; } u; u.l = (unsigned long) addr.s_addr; sprintf(tsdPtr->nabuf, "%u.%u.%u.%u", u.b[0], u.b[1], u.b[2], u.b[3]); sprintf(tsdPtr->nabuf, "%u.%u.%u.%u", b[0], b[1], b[2], b[3]); return tsdPtr->nabuf; #else return inet_ntoa(addr); #endif } #ifdef TCL_THREADS #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG) /* * Additions by AOL for specialized thread memory allocator. */ #ifdef USE_THREAD_ALLOC static int initialized = 0; static volatile int initialized = 0; static pthread_key_t key; static pthread_once_t once = PTHREAD_ONCE_INIT; typedef struct allocMutex { Tcl_Mutex tlock; pthread_mutex_t plock; } allocMutex; Tcl_Mutex * TclpNewAllocMutex(void) { struct lock { Tcl_Mutex tlock; pthread_mutex_t plock; } *lockPtr; struct allocMutex *lockPtr; lockPtr = malloc(sizeof(struct lock)); lockPtr = malloc(sizeof(struct allocMutex)); if (lockPtr == NULL) { panic("could not allocate lock"); } lockPtr->tlock = (Tcl_Mutex) &lockPtr->plock; pthread_mutex_init(&lockPtr->plock, NULL); return &lockPtr->tlock; } static void InitKey(void) void TclpFreeAllocMutex(mutex) Tcl_Mutex *mutex; /* The alloc mutex to free. */ { allocMutex* lockPtr = (allocMutex*) mutex; if (!lockPtr) return; pthread_mutex_destroy(&lockPtr->plock); free(lockPtr); } extern void TclFreeAllocCache(void *); pthread_key_create(&key, TclFreeAllocCache); initialized = 1; void TclpFreeAllocCache(ptr) void *ptr; { if (ptr != NULL) { /* * Called by the pthread lib when a thread exits */ TclFreeAllocCache(ptr); } else if (initialized) { /* * Called by us in TclFinalizeThreadAlloc() during * the library finalization initiated from Tcl_Finalize() */ pthread_key_delete(key); initialized = 0; } } void * TclpGetAllocCache(void) { if (!initialized) { pthread_once(&once, InitKey); pthread_mutex_lock(allocLockPtr); if (!initialized) { pthread_key_create(&key, TclpFreeAllocCache); initialized = 1; } pthread_mutex_unlock(allocLockPtr); } return pthread_getspecific(key); } void TclpSetAllocCache(void *arg) { pthread_setspecific(key, arg); } #endif /* USE_THREAD_ALLOC */ #endif /* TCL_THREADS */

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	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	- + + + + + - - + + + + + - - + - - - + +	/* * tclUnixTime.c -- * * Contains Unix specific versions of Tcl functions that * obtain time values from the operating system. * * Copyright (c) 1995 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclUnixTime.c,v 1.15 2002/07/19 12:31:10 dkf Exp $ * RCS: @(#) $Id: tclUnixTime.c,v 1.15.2.6 2007/04/21 19:52:15 kennykb Exp $ */ #include "tclInt.h" #include "tclPort.h" #include <locale.h> #define TM_YEAR_BASE 1900 #define IsLeapYear(x) ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0)) /* * TclpGetDate is coded to return a pointer to a 'struct tm'. For * thread safety, this structure must be in thread-specific data. * The 'tmKey' variable is the key to this buffer. */ static Tcl_ThreadDataKey tmKey; typedef struct ThreadSpecificData { struct tm gmtime_buf; struct tm localtime_buf; } ThreadSpecificData; /* * If we fall back on the thread-unsafe versions of gmtime and localtime, * use this mutex to try to protect them. */ #if !defined(HAVE_GMTIME_R) || !defined(HAVE_LOCALTIME_R) TCL_DECLARE_MUTEX(tmMutex) #endif static char* lastTZ = NULL; /* Holds the last setting of the * TZ environment variable, or an * empty string if the variable was * not set. */ /* * Forward declarations for procedures defined later in this file. /* Static functions declared in this file */ */ static struct tm *ThreadSafeGMTime _ANSI_ARGS_(( CONST time_t* )); static struct tm *ThreadSafeLocalTime _ANSI_ARGS_(( CONST time_t* )); static void SetTZIfNecessary _ANSI_ARGS_((void)); static void CleanupMemory _ANSI_ARGS_((ClientData));  /* *----------------------------------------------------------------------------- * * TclpGetSeconds -- * * This procedure returns the number of seconds from the epoch. On
︙
122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243	127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233	- + - - - - - - + + + + + + + + + + - + + + + + - + - - - - - - - - - - - - - - - - - - - - - - - - + - + - - - - - - - - + + - + - + - - - - + + + + + + - + - - - + + + + + + - - + + - + +	* None. * *---------------------------------------------------------------------- */ int TclpGetTimeZone (currentTime) unsigned long currentTime; Tcl_WideInt currentTime; { /* * Determine how a timezone is obtained from "struct tm". If there is no * time zone in this struct (very lame) then use the timezone variable. * This is done in a way to make the timezone variable the method of last * resort, as some systems have it in addition to a field in "struct tm". * The gettimeofday system call can also be used to determine the time * zone. * We prefer first to use the time zone in "struct tm" if the * structure contains such a member. Following that, we try * to locate the external 'timezone' variable and use its value. * If both of those methods fail, we attempt to convert a known * time to local time and use the difference from UTC as the local * time zone. In all cases, we need to undo any Daylight Saving Time * adjustment. */ #if defined(HAVE_TM_TZADJ) # define TCL_GOT_TIMEZONE /* Struct tm contains tm_tzadj - that value may be used. */ time_t curTime = (time_t) currentTime; struct tm *timeDataPtr = ThreadSafeLocalTime(&curTime); struct tm *timeDataPtr = TclpLocaltime((TclpTime_t) &curTime); int timeZone; timeZone = timeDataPtr->tm_tzadj / 60; if (timeDataPtr->tm_isdst) { timeZone += 60; } return timeZone; #endif #if defined(HAVE_TM_GMTOFF) && !defined (TCL_GOT_TIMEZONE) # define TCL_GOT_TIMEZONE /* Struct tm contains tm_gmtoff - that value may be used. */ time_t curTime = (time_t) currentTime; struct tm *timeDataPtr = ThreadSafeLocalTime(&curTime); struct tm *timeDataPtr = TclpLocaltime((TclpTime_t) &curTime); int timeZone; timeZone = -(timeDataPtr->tm_gmtoff / 60); if (timeDataPtr->tm_isdst) { timeZone += 60; } return timeZone; #endif #if defined(USE_DELTA_FOR_TZ) #define TCL_GOT_TIMEZONE 1 /* * This hack replaces using global var timezone or gettimeofday * in situations where they are buggy such as on AIX when libbsd.a * is linked in. */ int timeZone; time_t tt; struct tm *stm; tt = 849268800L; /* 1996-11-29 12:00:00 GMT */ stm = ThreadSafeLocalTime(&tt); /* eg 1996-11-29 6:00:00 CST6CDT */ /* The calculation below assumes a max of +12 or -12 hours from GMT */ timeZone = (12 - stm->tm_hour)*60 + (0 - stm->tm_min); return timeZone; /* eg +360 for CST6CDT */ #endif /* * Must prefer timezone variable over gettimeofday, as gettimeofday does * not return timezone information on many systems that have moved this * information outside of the kernel. */ #if defined(HAVE_TIMEZONE_VAR) && !defined (TCL_GOT_TIMEZONE) #if defined(HAVE_TIMEZONE_VAR) && !defined(TCL_GOT_TIMEZONE) && !defined(USE_DELTA_FOR_TZ) # define TCL_GOT_TIMEZONE static int setTZ = 0; #ifdef TCL_THREADS static Tcl_Mutex tzMutex; #endif int timeZone; Tcl_MutexLock(&tzMutex); if (!setTZ) { tzset(); setTZ = 1; } /* The 'timezone' external var is present and may be used. */ Tcl_MutexUnlock(&tzMutex); SetTZIfNecessary(); /* * Note: this is not a typo in "timezone" below! See tzset * documentation for details. */ timeZone = timezone / 60; return timeZone; #endif #if !defined(NO_GETTOD) && !defined (TCL_GOT_TIMEZONE) # define TCL_GOT_TIMEZONE struct timeval tv; struct timezone tz; #if !defined(TCL_GOT_TIMEZONE) #define TCL_GOT_TIMEZONE 1 /* * Fallback - determine time zone with a known reference time. */ int timeZone; time_t tt; gettimeofday(&tv, &tz); timeZone = tz.tz_minuteswest; if (tz.tz_dsttime) { struct tm *stm; tt = 849268800L; /* 1996-11-29 12:00:00 GMT */ stm = TclpLocaltime((TclpTime_t) &tt); /* eg 1996-11-29 6:00:00 CST6CDT */ /* The calculation below assumes a max of +12 or -12 hours from GMT */ timeZone = (12 - stm->tm_hour)*60 + (0 - stm->tm_min); if ( stm -> tm_isdst ) { timeZone += 60; } return timeZone; return timeZone; /* eg +360 for CST6CDT */ #endif #ifndef TCL_GOT_TIMEZONE /* * Cause compile error, we don't know how to get timezone. */ error: autoconf did not figure out how to determine the timezone. #error autoconf did not figure out how to determine the timezone. #endif }  /* *---------------------------------------------------------------------- *
︙
286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305	276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293	- - - + - +	*/ struct tm * TclpGetDate(time, useGMT) TclpTime_t time; int useGMT; { CONST time_t *tp = (CONST time_t *)time; if (useGMT) { return ThreadSafeGMTime(tp); return TclpGmtime(time); } else { return ThreadSafeLocalTime(tp); return TclpLocaltime(time); } }  /* *---------------------------------------------------------------------- * * TclpStrftime --
︙
336 337 338 339 340 341 342 343 344 345 346 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418	324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492	- + - - - - + + + + + + + - - - + - - + - - - + + + + + + + + + + + + + + - + - + - - - - + + + + + + + - - - - - + + - + - - - + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	setlocale(LC_TIME, ""); return strftime(s, maxsize, format, t); }  /* *---------------------------------------------------------------------- * * ThreadSafeGMTime -- * TclpGmtime -- * * Wrapper around the 'gmtime' library function to make it thread * safe. * * Results: * Returns a pointer to a 'struct tm' in thread-specific data. * * Side effects: * Invokes gmtime or gmtime_r as appropriate. * *---------------------------------------------------------------------- */ static struct tm * ThreadSafeGMTime(timePtr) CONST time_t *timePtr; /* Pointer to the number of seconds * since the local system's epoch struct tm * TclpGmtime( tt ) TclpTime_t_CONST tt; { CONST time_t *timePtr = (CONST time_t *) tt; /* Pointer to the number of seconds * since the local system's epoch */ */ { /* * Get a thread-local buffer to hold the returned time. */ struct tm *tmPtr = (struct tm *) ThreadSpecificData *tsdPtr = TCL_TSD_INIT( &tmKey ); Tcl_GetThreadData(&tmKey, sizeof(struct tm)); #ifdef HAVE_GMTIME_R gmtime_r(timePtr, tmPtr); gmtime_r(timePtr, &( tsdPtr->gmtime_buf )); #else Tcl_MutexLock(&tmMutex); memcpy((VOID *) tmPtr, (VOID *) gmtime(timePtr), sizeof(struct tm)); Tcl_MutexUnlock(&tmMutex); Tcl_MutexLock( &tmMutex ); memcpy( (VOID *) &( tsdPtr->gmtime_buf ), (VOID *) gmtime( timePtr ), sizeof( struct tm ) ); Tcl_MutexUnlock( &tmMutex ); #endif return &( tsdPtr->gmtime_buf ); } /* * Forwarder for obsolete item in Stubs */ struct tm* TclpGmtime_unix( timePtr ) TclpTime_t_CONST timePtr; { return tmPtr; return TclpGmtime( timePtr ); }  /* *---------------------------------------------------------------------- * * ThreadSafeLocalTime -- * TclpLocaltime -- * * Wrapper around the 'localtime' library function to make it thread * safe. * * Results: * Returns a pointer to a 'struct tm' in thread-specific data. * * Side effects: * Invokes localtime or localtime_r as appropriate. * *---------------------------------------------------------------------- */ static struct tm * ThreadSafeLocalTime(timePtr) CONST time_t *timePtr; /* Pointer to the number of seconds * since the local system's epoch struct tm * TclpLocaltime( tt ) TclpTime_t_CONST tt; { CONST time_t *timePtr = (CONST time_t *) tt; /* Pointer to the number of seconds * since the local system's epoch */ */ { /* * Get a thread-local buffer to hold the returned time. */ struct tm *tmPtr = (struct tm *) Tcl_GetThreadData(&tmKey, sizeof(struct tm)); ThreadSpecificData *tsdPtr = TCL_TSD_INIT( &tmKey ); SetTZIfNecessary(); #ifdef HAVE_LOCALTIME_R localtime_r(timePtr, tmPtr); localtime_r( timePtr, &( tsdPtr->localtime_buf ) ); #else Tcl_MutexLock(&tmMutex); memcpy((VOID *) tmPtr, (VOID *) localtime(timePtr), sizeof(struct tm)); Tcl_MutexUnlock(&tmMutex); Tcl_MutexLock( &tmMutex ); memcpy( (VOID *) &( tsdPtr -> localtime_buf ), (VOID *) localtime( timePtr ), sizeof( struct tm ) ); Tcl_MutexUnlock( &tmMutex ); #endif return &( tsdPtr->localtime_buf ); } /* * Forwarder for obsolete item in Stubs */ struct tm* TclpLocaltime_unix( timePtr ) TclpTime_t_CONST timePtr; { return tmPtr; return TclpLocaltime( timePtr ); } /* *---------------------------------------------------------------------- * * SetTZIfNecessary -- * * Determines whether a call to 'tzset' is needed prior to the * next call to 'localtime' or examination of the 'timezone' variable. * * Results: * None. * * Side effects: * If 'tzset' has never been called in the current process, or if * the value of the environment variable TZ has changed since the * last call to 'tzset', then 'tzset' is called again. * *---------------------------------------------------------------------- */ static void SetTZIfNecessary() { CONST char* newTZ = getenv( "TZ" ); Tcl_MutexLock(&tmMutex); if ( newTZ == NULL ) { newTZ = ""; } if ( lastTZ == NULL || strcmp( lastTZ, newTZ ) ) { tzset(); if ( lastTZ == NULL ) { Tcl_CreateExitHandler( CleanupMemory, (ClientData) NULL ); } else { Tcl_Free( lastTZ ); } lastTZ = ckalloc( strlen( newTZ ) + 1 ); strcpy( lastTZ, newTZ ); } Tcl_MutexUnlock(&tmMutex); } /* *---------------------------------------------------------------------- * * CleanupMemory -- * * Releases the private copy of the TZ environment variable * upon exit from Tcl. * * Results: * None. * * Side effects: * Frees allocated memory. * *---------------------------------------------------------------------- */ static void CleanupMemory( ClientData ignored ) { ckfree( lastTZ ); }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- +	# # This file is a Makefile for Tcl. If it has the name "Makefile.in" # then it is a template for a Makefile; to generate the actual Makefile, # run "./configure", which is a configuration script generated by the # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # # RCS: @(#) $Id: Makefile.in,v 1.68 2003/01/28 11:03:53 mdejong Exp $ # RCS: @(#) $Id: Makefile.in,v 1.68.2.7 2007/01/30 23:21:12 hobbs Exp $ VERSION = @TCL_VERSION@ #---------------------------------------------------------------- # Things you can change to personalize the Makefile for your own # site (you can make these changes in either Makefile.in or # Makefile, but changes to Makefile will get lost if you re-run
︙
52 53 54 55 56 57 58 59 60 61 62 63 64 65	52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68	+ + +	# Path name to use when installing library scripts. SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY) # Directory in which to install the include file tcl.h: INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir) # Directory in which to (optionally) install the private tcl headers: PRIVATE_INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir) # Top-level directory in which to install manual entries: MAN_INSTALL_DIR = $(INSTALL_ROOT)$(mandir) # Directory in which to install manual entry for tclsh: MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1 # Directory in which to install manual entries for Tcl's C library
︙
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 116 117 118 119	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 116 117 118 119 120 121 122	- + - + - - - + + + - +	CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ # To change the compiler switches, for example to change from optimization to # debugging symbols, change the following line: #CFLAGS = $(CFLAGS_DEBUG) #CFLAGS = $(CFLAGS_OPTIMIZE) #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DTCL_DBGX=$(TCL_DBGX) CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ # To enable compilation debugging reverse the comment characters on # one of the following lines. COMPILE_DEBUG_FLAGS = #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS # Special compiler flags to use when building man2tcl on Windows. MAN2TCLFLAGS = @MAN2TCLFLAGS@ MAN2TCLFLAGS = @MAN2TCLFLAGS@ SRC_DIR = @srcdir@ ROOT_DIR = @srcdir@/.. GENERIC_DIR = @srcdir@/../generic WIN_DIR = @srcdir@ COMPAT_DIR = @srcdir@/../compat # Converts a POSIX path to a Windows native path. CYGPATH = @CYGPATH@ GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)') WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)') ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)') GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)' | sed 's!\\!/!g') WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)' | sed 's!\\!/!g') ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)' | sed 's!\\!/!g') LIBRARY_DIR = $(shell echo '$(ROOT_DIR_NATIVE)/library' | sed 's/\\/\//g' ) LIBRARY_DIR = $(ROOT_DIR_NATIVE)/library DLLSUFFIX = @DLLSUFFIX@ LIBSUFFIX = @LIBSUFFIX@ EXESUFFIX = @EXESUFFIX@ TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ TCL_DLL_FILE = @TCL_DLL_FILE@
︙
325 326 327 328 329 330 331 332 333 334 335 336 337 338 339	328 329 330 331 332 333 334 335 336 337 338 339 340 341 342	- +	$(CC) $(CFLAGS) $(TCLTEST_OBJS) $(TCL_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) $(CAT32): cat32.$(OBJEXT) $(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LDFLAGS_CONSOLE) $(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LIBS) $(LDFLAGS_CONSOLE) # The following targets are configured by autoconf to generate either # a shared library or static library ${TCL_STUB_LIB_FILE}: ${STUB_OBJS} @$(RM) ${TCL_STUB_LIB_FILE} @MAKE_LIB@ ${STUB_OBJS}
︙
379 380 381 382 383 384 385 386 387 388 389 390 391 392	382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399	+ + + +	.SUFFIXES: .rc # Special case object targets tclWinInit.${OBJEXT}: tclWinInit.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinPipe.${OBJEXT}: tclWinPipe.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_PIPE_DLL=\"$(PIPE_DLL_FILE)\" \ $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) testMain.${OBJEXT}: tclAppInit.c $(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME) tclTest.${OBJEXT}: tclTest.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) tclTestObj.${OBJEXT}: tclTestObj.c
︙
482 483 484 485 486 487 488 489 490 491 492 493 494 495 496	489 490 491 492 493 494 495 496 497 498 499 500 501 502 503	- +	do \ if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ $(MKDIR) $$i; \ else true; \ fi; \ done; @for i in http1.0 http2.4 opt0.4 encoding msgcat1.3 tcltest2.2; \ @for i in http1.0 http2.5 opt0.4 encoding msgcat1.3 tcltest2.2; \ do \ if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ $(MKDIR) $(SCRIPT_INSTALL_DIR)/$$i; \ else true; \ fi; \ done;
︙
506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523	513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530	- + - +	$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \ done; @echo "Installing library http1.0 directory"; @for j in $(ROOT_DIR)/library/http1.0/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; @echo "Installing library http2.4 directory"; @echo "Installing library http2.5 directory"; @for j in $(ROOT_DIR)/library/http/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http2.4"; \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http2.5"; \ done; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; @echo "Installing library msgcat1.3 directory";
︙
532 533 534 535 536 537 538 539 540 541 542 543 544 545	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 568 569 570 571	+ + + + + + + + + + + + + + + + + + +	done; @echo "Installing encodings"; @for i in $(ROOT_DIR)/library/encoding/*.enc ; do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \ done; install-doc: doc # Optional target to install private headers install-private-headers: libraries @for i in $(PRIVATE_INCLUDE_INSTALL_DIR); \ do \ if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ $(MKDIR) $$i; \ chmod 755 $$i; \ else true; \ fi; \ done; @echo "Installing private header files to $(PRIVATE_INCLUDE_INSTALL_DIR)/"; @for i in "$(GENERIC_DIR)/tclInt.h" "$(GENERIC_DIR)/tclIntDecls.h" \ "$(GENERIC_DIR)/tclIntPlatDecls.h" "$(GENERIC_DIR)/tclPort.h" \ "$(WIN_DIR)/tclWinPort.h" ; \ do \ $(COPY) "$$i" "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \ done; # Specifying TESTFLAGS on the command line is the standard way to pass # args to tcltest, ie: # % make test TESTFLAGS="-verbose bps -file fileName.test" test: binaries $(TCLTEST) TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
︙

1 2 3 4 5 6 7 8 9 10	1 2 3 4 5 6 7 8 9 10	- +	Tcl 8.4 for Windows RCS: @(#) $Id: README,v 1.30 2003/01/27 03:34:04 mdejong Exp $ RCS: @(#) $Id: README,v 1.30.2.1 2005/07/29 03:50:51 mdejong Exp $ 1. Introduction --------------- This is the directory where you configure and compile the Windows version of Tcl. This directory also contains source files for Tcl that are specific to Microsoft Windows.
︙
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	26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49	- + - - - - - - - - - - -	Visual C++ 5 or newer or Msys + Mingw http://prdownloads.sourceforge.net/tcl/msys_mingw6.zip http://prdownloads.sourceforge.net/tcl/msys_mingw8.zip This Msys + Mingw download is the minimal environment needed to build Tcl/Tk under Windows. It includes a shell environment and gcc. The release is designed to make it as easy a possible to build Tcl/Tk. To install, you just download the zip file and extract the files into a directory. The README.TXT file describes how to launch the msys shell, you then run the configure script in the tcl/win directory. or Cygwin 1.1 or newer (See http://sources.redhat.com/cygwin) Mingw 2.0 (http://prdownloads.sourceforge.net/mingw/MinGW-2.0.0-3.exe) Extract the contents of the archive file into /usr/local/mingw and place /usr/local/mingw/bin at the front of your PATH env var before running the configure script in the tcl/win directory. In practice, this release is built with Visual C++ 6.0 and the TEA Makefile. If you are building with Visual C++, in the "win" subdirectory of the source release, you will find "makefile.vc". This is the makefile for the Visual C++ compiler and uses the stock NMAKE tool. Detailed
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15	- + - +	Tcl/Tk 8.4 for Windows, Binary Distribution RCS: @(#) $Id: README.binary,v 1.33 2003/02/15 02:16:33 hobbs Exp $ RCS: @(#) $Id: README.binary,v 1.33.2.16 2007/05/30 14:05:21 dgp Exp $ 1. Introduction --------------- This directory contains the binary distribution of Tcl/Tk 8.4.2 for This directory contains the binary distribution of Tcl/Tk 8.4.16 for Windows. It was compiled with Microsoft Visual C++ 6.0 using Win32 API, so that it will run under Windows NT, 95, 98 and 2000. Tcl provides a powerful platform for creating integration applications that tie together diverse applications, protocols, devices, and frameworks. When paired with the Tk toolkit, Tcl provides the fastest and most powerful way to create GUI applications that run on PCs, Unix,
︙

︙
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25	8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27	- + + +	; relocations (NT supported only). It is assumed extension authors will contribute ; their modules to this grand-master list. You can use the dumpbin utility with ; the /headers option to get the "size of image" data (already in hex). If the ; maximum size is too small a linker warning will occur. Modules can overlap when ; they're mutually exclusive. This info is placed in the DLL's PE header by the ; linker with the `-base:@$(TCLDIR)\win\coffbase.txt,<key>` option. ; ; RCS: @(#) $Id: coffbase.txt,v 1.5 2002/09/12 22:31:27 davygrvy Exp $ ; RCS: @(#) $Id: coffbase.txt,v 1.5.2.1 2004/05/06 01:03:33 davygrvy Exp $ tcl 0x10000000 0x00200000 tcldde 0x10200000 0x00010000 tclreg 0x10210000 0x00010000 tk 0x10220000 0x00200000 expect 0x10480000 0x00080000 itcl 0x10500000 0x00080000 itk 0x10580000 0x00080000 bltlite 0x10600000 0x00080000 blt 0x10680000 0x00080000 iocpsock 0x10700000 0x00080000 tls 0x10780000 0x00080000

︙
12 13 14 15 16 17 18 19 20 21 22 23 24 25 26	12 13 14 15 16 17 18 19 20 21 22 23 24 25 26	- +	ac_default_prefix=/usr/local # Any additions from configure.in: ac_help="$ac_help --enable-threads build with threads" ac_help="$ac_help --enable-shared build and link with shared libraries [--enable-shared]" ac_help="$ac_help --enable-64bit enable 64bit support (where applicable)" --enable-64bit enable 64bit support (where applicable = amd64|ia64)" ac_help="$ac_help --enable-symbols build with debugging symbols [--disable-symbols]" # Initialize some variables set by options. # The variables have the same names as the options, with # dashes changed to underlines. build=NONE
︙
530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556	530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554	- + - -	TCL_VERSION=8.4 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=4 TCL_PATCH_LEVEL=".2" TCL_PATCH_LEVEL=".16" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.2 TCL_DDE_MAJOR_VERSION=1 TCL_DDE_MINOR_VERSION=2 TCL_DDE_PATCH_LEVEL="" DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION TCL_REG_VERSION=1.1 TCL_REG_MAJOR_VERSION=1 TCL_REG_MINOR_VERSION=1 TCL_REG_PATCH_LEVEL="" REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION #------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ if test "${prefix}" = "NONE"; then
︙
571 572 573 574 575 576 577 578 579 580 581 582 583 584 585	569 570 571 572 573 574 575 576 577 578 579 580 581 582 583	- +	if test "${CFLAGS+set}" != "set" ; then CFLAGS="" fi # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:579: checking for $ac_word" >&5 echo "configure:577: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
︙
601 602 603 604 605 606 607 608 609 610 611 612 613 614 615	599 600 601 602 603 604 605 606 607 608 609 610 611 612 613	- +	echo "$ac_t""no" 1>&6 fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:609: checking for $ac_word" >&5 echo "configure:607: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
︙
652 653 654 655 656 657 658 659 660 661 662 663 664 665 666	650 651 652 653 654 655 656 657 658 659 660 661 662 663 664	- +	if test -z "$CC"; then case "`uname -s`" in *win32* | *WIN32*) # Extract the first word of "cl", so it can be a program name with args. set dummy cl; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:660: checking for $ac_word" >&5 echo "configure:658: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
︙
684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714	682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712	- + - + - +	;; esac fi test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 echo "configure:692: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 echo "configure:690: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' cross_compiling=$ac_cv_prog_cc_cross cat > conftest.$ac_ext << EOF #line 703 "configure" #line 701 "configure" #include "confdefs.h" main(){return(0);} EOF if { (eval echo configure:708: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then if { (eval echo configure:706: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then ac_cv_prog_cc_cross=no else ac_cv_prog_cc_cross=yes fi
︙
726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773	724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771	- + - + - + - +	cross_compiling=$ac_cv_prog_cc_cross echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 if test $ac_cv_prog_cc_works = no; then { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 echo "configure:734: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "configure:732: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 echo "configure:739: checking whether we are using GNU C" >&5 echo "configure:737: checking whether we are using GNU C" >&5 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.c <<EOF #ifdef __GNUC__ yes; #endif EOF if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:748: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:746: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no fi fi echo "$ac_t""$ac_cv_prog_gcc" 1>&6 if test $ac_cv_prog_gcc = yes; then GCC=yes else GCC= fi ac_test_CFLAGS="${CFLAGS+set}" ac_save_CFLAGS="$CFLAGS" CFLAGS= echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 echo "configure:767: checking whether ${CC-cc} accepts -g" >&5 echo "configure:765: checking whether ${CC-cc} accepts -g" >&5 if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else echo 'void f(){}' > conftest.c if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then ac_cv_prog_cc_g=yes else
︙
802 803 804 805 806 807 808 809 810 811 812 813 814 815 816	800 801 802 803 804 805 806 807 808 809 810 811 812 813 814	- +	# the CC, AR, RANLIB, and RC environment # variables if you want to cross compile. if test "${GCC}" = "yes" ; then # Extract the first word of "ar", so it can be a program name with args. set dummy ar; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:810: checking for $ac_word" >&5 echo "configure:808: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_AR'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$AR"; then ac_cv_prog_AR="$AR" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
︙
831 832 833 834 835 836 837 838 839 840 841 842 843 844 845	829 830 831 832 833 834 835 836 837 838 839 840 841 842 843	- +	else echo "$ac_t""no" 1>&6 fi # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:839: checking for $ac_word" >&5 echo "configure:837: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
︙
860 861 862 863 864 865 866 867 868 869 870 871 872 873 874	858 859 860 861 862 863 864 865 866 867 868 869 870 871 872	- +	else echo "$ac_t""no" 1>&6 fi # Extract the first word of "windres", so it can be a program name with args. set dummy windres; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:868: checking for $ac_word" >&5 echo "configure:866: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_RC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$RC"; then ac_cv_prog_RC="$RC" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
︙
903 904 905 906 907 908 909 910 911 912 913 914 915 916 917	901 902 903 904 905 906 907 908 909 910 911 912 913 914 915	- +	fi #-------------------------------------------------------------------- # Checks to see if the make progeam sets the $MAKE variable. #-------------------------------------------------------------------- echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 echo "configure:911: checking whether ${MAKE-make} sets \${MAKE}" >&5 echo "configure:909: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftestmake <<\EOF all: @echo 'ac_maketemp="${MAKE}"'
︙
935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965	933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963	- + - + - +	#-------------------------------------------------------------------- # Perform additinal compiler tests. #-------------------------------------------------------------------- echo $ac_n "checking for Cygwin environment""... $ac_c" 1>&6 echo "configure:943: checking for Cygwin environment" >&5 echo "configure:941: checking for Cygwin environment" >&5 if eval "test \"`echo '$''{'ac_cv_cygwin'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF #line 948 "configure" #line 946 "configure" #include "confdefs.h" int main() { #ifndef __CYGWIN__ #define __CYGWIN__ __CYGWIN32__ #endif return __CYGWIN__; ; return 0; } EOF if { (eval echo configure:959: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then if { (eval echo configure:957: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_cygwin=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* ac_cv_cygwin=no
︙
976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017	974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015	- + - + - +	{ echo "configure: error: Compiling under Cygwin is not currently supported. A maintainer for the Cygwin port of Tcl/Tk is needed. See the README file for information about building with Mingw." 1>&2; exit 1; } fi echo $ac_n "checking for SEH support in compiler""... $ac_c" 1>&6 echo "configure:984: checking for SEH support in compiler" >&5 echo "configure:982: checking for SEH support in compiler" >&5 if eval "test \"`echo '$''{'tcl_cv_seh'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test "$cross_compiling" = yes; then tcl_cv_seh=no else cat > conftest.$ac_ext <<EOF #line 992 "configure" #line 990 "configure" #include "confdefs.h" #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN int main(int argc, char** argv) { int a, b = 0; __try { a = 666 / b; } __except (EXCEPTION_EXECUTE_HANDLER) { return 0; } return 1; } EOF if { (eval echo configure:1011: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null if { (eval echo configure:1009: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then tcl_cv_seh=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -fr conftest* tcl_cv_seh=no
︙
1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065	1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063	- + - + - +	# # Check to see if the excpt.h include file provided contains the # definition for EXCEPTION_DISPOSITION; if not, which is the case # with Cygwin's version as of 2002-04-10, define it to be int, # sufficient for getting the current code to work. # echo $ac_n "checking for EXCEPTION_DISPOSITION support in include files""... $ac_c" 1>&6 echo "configure:1041: checking for EXCEPTION_DISPOSITION support in include files" >&5 echo "configure:1039: checking for EXCEPTION_DISPOSITION support in include files" >&5 if eval "test \"`echo '$''{'tcl_cv_eh_disposition'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF #line 1046 "configure" #line 1044 "configure" #include "confdefs.h" #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN int main() { EXCEPTION_DISPOSITION x; ; return 0; } EOF if { (eval echo configure:1059: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then if { (eval echo configure:1057: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* tcl_cv_eh_disposition=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* tcl_cv_eh_disposition=no
︙
1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110	1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108	- + - + - +	fi # Check to see if the winsock2.h include file provided contains # typedefs like LPFN_ACCEPT and friends. # echo $ac_n "checking for LPFN_ACCEPT support in winsock2.h""... $ac_c" 1>&6 echo "configure:1085: checking for LPFN_ACCEPT support in winsock2.h" >&5 echo "configure:1083: checking for LPFN_ACCEPT support in winsock2.h" >&5 if eval "test \"`echo '$''{'tcl_cv_lpfn_decls'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF #line 1090 "configure" #line 1088 "configure" #include "confdefs.h" #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN #include <winsock2.h> int main() { LPFN_ACCEPT accept; ; return 0; } EOF if { (eval echo configure:1104: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then if { (eval echo configure:1102: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* tcl_cv_lpfn_decls=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* tcl_cv_lpfn_decls=no
︙
1122 1123 1124 1125 1126 1127 1128 1129 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	1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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	- + - + - +	fi # Check to see if winnt.h defines CHAR, SHORT, and LONG # even if VOID has already been #defined. The win32api # used by mingw and cygwin is known to do this. echo $ac_n "checking for winnt.h that ignores VOID define""... $ac_c" 1>&6 echo "configure:1130: checking for winnt.h that ignores VOID define" >&5 echo "configure:1128: checking for winnt.h that ignores VOID define" >&5 if eval "test \"`echo '$''{'tcl_cv_winnt_ignore_void'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF #line 1135 "configure" #line 1133 "configure" #include "confdefs.h" #define VOID void #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN int main() { CHAR c; SHORT s; LONG l; ; return 0; } EOF if { (eval echo configure:1151: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then if { (eval echo configure:1149: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* tcl_cv_winnt_ignore_void=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* tcl_cv_winnt_ignore_void=no
︙
1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208	1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206	- + - + - +	# If we add the function declaration ourselves, it # would not compile correctly because the _alloca # function expects the argument to be passed in a # register and not on the stack. Instead, we just # call it from inline asm code. echo $ac_n "checking for alloca declaration in malloc.h""... $ac_c" 1>&6 echo "configure:1183: checking for alloca declaration in malloc.h" >&5 echo "configure:1181: checking for alloca declaration in malloc.h" >&5 if eval "test \"`echo '$''{'tcl_cv_malloc_decl_alloca'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF #line 1188 "configure" #line 1186 "configure" #include "confdefs.h" #include <malloc.h> int main() { size_t arg = 0; void* ptr; ptr = alloca; ptr = alloca(arg); ; return 0; } EOF if { (eval echo configure:1202: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then if { (eval echo configure:1200: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* tcl_cv_malloc_decl_alloca=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* tcl_cv_malloc_decl_alloca=no
︙
1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250	1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248	- + - + - +	fi # See if the compiler supports casting to a union type. # This is used to stop gcc from printing a compiler # warning when initializing a union member. echo $ac_n "checking for cast to union support""... $ac_c" 1>&6 echo "configure:1229: checking for cast to union support" >&5 echo "configure:1227: checking for cast to union support" >&5 if eval "test \"`echo '$''{'tcl_cv_cast_to_union'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF #line 1234 "configure" #line 1232 "configure" #include "confdefs.h" int main() { union foo { int i; double d; }; union foo f = (union foo) (int) 0; ; return 0; } EOF if { (eval echo configure:1244: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then if { (eval echo configure:1242: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* tcl_cv_cast_to_union=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* tcl_cv_cast_to_union=no
︙
1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342	1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340	- + - + - + - + - + - + - +	#-------------------------------------------------------------------- # Determines the correct binary file extension (.o, .obj, .exe etc.) #-------------------------------------------------------------------- echo $ac_n "checking for object suffix""... $ac_c" 1>&6 echo "configure:1271: checking for object suffix" >&5 echo "configure:1269: checking for object suffix" >&5 if eval "test \"`echo '$''{'ac_cv_objext'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else rm -f conftest* echo 'int i = 1;' > conftest.$ac_ext if { (eval echo configure:1277: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then if { (eval echo configure:1275: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then for ac_file in conftest.*; do case $ac_file in *.c) ;; *) ac_cv_objext=`echo $ac_file | sed -e s/conftest.//` ;; esac done else { echo "configure: error: installation or configuration problem; compiler does not work" 1>&2; exit 1; } fi rm -f conftest* fi echo "$ac_t""$ac_cv_objext" 1>&6 OBJEXT=$ac_cv_objext ac_objext=$ac_cv_objext echo $ac_n "checking for mingw32 environment""... $ac_c" 1>&6 echo "configure:1295: checking for mingw32 environment" >&5 echo "configure:1293: checking for mingw32 environment" >&5 if eval "test \"`echo '$''{'ac_cv_mingw32'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF #line 1300 "configure" #line 1298 "configure" #include "confdefs.h" int main() { return __MINGW32__; ; return 0; } EOF if { (eval echo configure:1307: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then if { (eval echo configure:1305: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_mingw32=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* ac_cv_mingw32=no fi rm -f conftest* rm -f conftest* fi echo "$ac_t""$ac_cv_mingw32" 1>&6 MINGW32= test "$ac_cv_mingw32" = yes && MINGW32=yes echo $ac_n "checking for executable suffix""... $ac_c" 1>&6 echo "configure:1326: checking for executable suffix" >&5 echo "configure:1324: checking for executable suffix" >&5 if eval "test \"`echo '$''{'ac_cv_exeext'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test "$CYGWIN" = yes || test "$MINGW32" = yes; then ac_cv_exeext=.exe else rm -f conftest* echo 'int main () { return 0; }' > conftest.$ac_ext ac_cv_exeext= if { (eval echo configure:1336: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then if { (eval echo configure:1334: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then for file in conftest.*; do case $file in *.c | *.o | *.obj) ;; *) ac_cv_exeext=`echo $file | sed -e s/conftest//` ;; esac done else
︙
1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369	1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367	- +	#-------------------------------------------------------------------- # Check whether --enable-threads or --disable-threads was given. #-------------------------------------------------------------------- echo $ac_n "checking for building with threads""... $ac_c" 1>&6 echo "configure:1363: checking for building with threads" >&5 echo "configure:1361: checking for building with threads" >&5 # Check whether --enable-threads or --disable-threads was given. if test "${enable_threads+set}" = set; then enableval="$enable_threads" tcl_ok=$enableval else tcl_ok=no fi
︙
1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406	1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404	- +	#-------------------------------------------------------------------- # The statements below define a collection of symbols related to # building libtcl as a shared library instead of a static library. #-------------------------------------------------------------------- echo $ac_n "checking how to build libraries""... $ac_c" 1>&6 echo "configure:1400: checking how to build libraries" >&5 echo "configure:1398: checking how to build libraries" >&5 # Check whether --enable-shared or --disable-shared was given. if test "${enable_shared+set}" = set; then enableval="$enable_shared" tcl_ok=$enableval else tcl_ok=yes fi
︙
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	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	- + - +	#-------------------------------------------------------------------- # Step 0: Enable 64 bit support? echo $ac_n "checking if 64bit support is requested""... $ac_c" 1>&6 echo "configure:1441: checking if 64bit support is requested" >&5 echo "configure:1439: checking if 64bit support is requested" >&5 # Check whether --enable-64bit or --disable-64bit was given. if test "${enable_64bit+set}" = set; then enableval="$enable_64bit" do64bit=$enableval else do64bit=no fi echo "$ac_t""$do64bit" 1>&6 # Set some defaults (may get changed below) EXTRA_CFLAGS="" # Extract the first word of "cygpath", so it can be a program name with args. set dummy cygpath; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 echo "configure:1458: checking for $ac_word" >&5 echo "configure:1456: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CYGPATH'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CYGPATH"; then ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
︙
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	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	+ + + + - + - + - + - +	echo "$ac_t""$CYGPATH" 1>&6 else echo "$ac_t""no" 1>&6 fi SHLIB_SUFFIX=".dll" # MACHINE is IX86 for LINK, but this is used by the manifest, # which requires x86|amd64|ia64. MACHINE="X86" # Check for a bug in gcc's windres that causes the # compile to fail when a Windows native path is # passed into windres. The mingw toolchain requires # Windows native paths while Cygwin should work # with both. Avoid the bug by passing a POSIX # path when using the Cygwin toolchain. if test "$GCC" = "yes" && test "$CYGPATH" != "echo" ; then conftest=/tmp/conftest.rc echo "STRINGTABLE BEGIN" > $conftest echo "101 \"name\"" >> $conftest echo "END" >> $conftest echo $ac_n "checking for Windows native path bug in windres""... $ac_c" 1>&6 echo "configure:1502: checking for Windows native path bug in windres" >&5 echo "configure:1504: checking for Windows native path bug in windres" >&5 cyg_conftest=`$CYGPATH $conftest` if { ac_try='$RC -o conftest.res.o $cyg_conftest'; { (eval echo configure:1504: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } ; then if { ac_try='$RC -o conftest.res.o $cyg_conftest'; { (eval echo configure:1506: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } ; then echo "$ac_t""no" 1>&6 else echo "$ac_t""yes" 1>&6 CYGPATH=echo fi conftest= cyg_conftest= fi if test "$CYGPATH" = "echo" || test "$ac_cv_cygwin" = "yes"; then DEPARG='"$<"' else DEPARG='"$(shell $(CYGPATH) $<)"' fi # set various compiler flags depending on whether we are using gcc or cl echo $ac_n "checking compiler flags""... $ac_c" 1>&6 echo "configure:1523: checking compiler flags" >&5 echo "configure:1525: checking compiler flags" >&5 if test "${GCC}" = "yes" ; then if test "$do64bit" = "yes" ; then if test "$do64bit" != "no" ; then echo "configure: warning: "64bit mode not supported with GCC on Windows"" 1>&2 fi SHLIB_LD="" SHLIB_LD_LIBS="" LIBS="" LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32" STLIB_LD='${AR} cr'
︙
1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580	1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583	+	if test "${SHARED_BUILD}" = "0" ; then # static echo "$ac_t""using static flags" 1>&6 runtime= MAKE_DLL="echo " LIBSUFFIX="s\${DBGX}.a" LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" else # dynamic echo "$ac_t""using shared flags" 1>&6 # ad-hoc check to see if CC supports -shared.
︙
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	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	+ - +	SHLIB_LD='${CC} -shared ${CFLAGS}' SHLIB_LD_LIBS='${LIBS}' # Add SHLIB_LD_LIBS to the Make rule, not here. MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \ -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)" LIBSUFFIX="\${DBGX}.a" LIBFLAGSUFFIX="\${DBGX}" EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" fi # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" SHLIB_SUFFIX=.dll EXTRA_CFLAGS="${extra_cflags}" CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE=-O CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" CFLAGS_WARNING="-Wall -Wconversion" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= # Specify the CC output file names based on the target name CC_OBJNAME="-o \$@" CC_EXENAME="-o \$@"
︙
1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717	1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741	+ + + - + - + - - - - - + + + + + + + + + + + + + + + + + + + + - + - - - - - + - - - + + + - + - - + - - + + + + + + + - - - + + + + - - + + + - + - +	else if test "${SHARED_BUILD}" = "0" ; then # static echo "$ac_t""using static flags" 1>&6 runtime=-MT MAKE_DLL="echo " LIBSUFFIX="s\${DBGX}.lib" LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" SHLIB_LD_LIBS="" else # dynamic echo "$ac_t""using shared flags" 1>&6 runtime=-MD # Add SHLIB_LD_LIBS to the Make rule, not here. MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@" LIBSUFFIX="\${DBGX}.lib" LIBFLAGSUFFIX="\${DBGX}" EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" SHLIB_LD_LIBS='${LIBS}' fi # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" # This is a 2-stage check to make sure we have the 64-bit SDK # We have to know where the SDK is installed. # This magic is based on MS Platform SDK for Win2003 SP1 - hobbs if test "$do64bit" = "yes" ; then if test "$do64bit" != "no" ; then if test "x${MSSDK}x" = "xx" ; then MSSDK="C:/Progra~1/Microsoft SDK" MSSDK="C:/Progra~1/Microsoft Platform SDK" fi # In order to work in the tortured autoconf environment, # we need to ensure that this path has no spaces MSSDK=$(cygpath -w -s "$MSSDK" | sed -e 's!\\!/!g') if test ! -d "${MSSDK}/bin/win64" ; then echo "configure: warning: "could not find 64-bit SDK to enable 64bit mode"" 1>&2 MSSDK=`echo "$MSSDK" | sed -e 's!\\\!/!g'` PATH64="" case "$do64bit" in amd64|x64|yes) MACHINE="AMD64" ; # default to AMD64 64-bit build PATH64="${MSSDK}/Bin/Win64/x86/AMD64" ;; ia64) MACHINE="IA64" PATH64="${MSSDK}/Bin/Win64" ;; esac if test ! -d "${PATH64}" ; then echo "configure: warning: Could not find 64-bit $MACHINE SDK to enable 64bit mode" 1>&2 echo "configure: warning: Ensure latest Platform SDK is installed" 1>&2 do64bit="no" else echo "$ac_t"" Using 64-bit $MACHINE mode" 1>&6 fi fi if test "$do64bit" != "no" ; then # The space-based-path will work for the Makefile, but will # not work if AC_TRY_COMPILE is called. if test "$do64bit" = "yes" ; then # All this magic is necessary for the Win64 SDK RC1 - hobbs CC="${MSSDK}/Bin/Win64/cl.exe \ -I${MSSDK}/Include/prerelease \ -I${MSSDK}/Include/Win64/crt \ CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \ -I${MSSDK}/Include/Win64/crt/sys \ -I${MSSDK}/Include" RC="${MSSDK}/bin/rc.exe" -I\"${MSSDK}/Include/crt\" -I\"${MSSDK}/Include/crt/sys\"" RC="\"${MSSDK}/bin/rc.exe\"" CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d" # Do not use -O2 for Win64 - this has proved buggy in code gen. CFLAGS_OPTIMIZE="-nologo -O2 -Gs ${runtime}" CFLAGS_OPTIMIZE="-nologo -O1 ${runtime}" lflags="-MACHINE:IA64 -LIBPATH:${MSSDK}/Lib/IA64 \ -LIBPATH:${MSSDK}/Lib/Prerelease/IA64" lflags="-nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" STLIB_LD="${MSSDK}/bin/win64/lib.exe -nologo ${lflags}" LINKBIN="${MSSDK}/bin/win64/link.exe ${lflags}" LINKBIN="\"${PATH64}/link.exe\"" # Avoid 'unresolved external symbol __security_cookie' errors. # c.f. http://support.microsoft.com/?id=894573 LIBS="user32.lib advapi32.lib bufferoverflowU.lib" else RC="rc" # -Od - no optimization # -WX - warnings as errors CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d" # -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy) CFLAGS_OPTIMIZE="-nologo -Oti -Gs -GD ${runtime}" STLIB_LD="lib -nologo" LINKBIN="link -link50compat" CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}" lflags="-nologo" LINKBIN="link" LIBS="user32.lib advapi32.lib" fi SHLIB_LD="${LINKBIN} -dll -nologo -incremental:no" LIBS="user32.lib advapi32.lib" LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib" SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}" # link -lib only works when -lib is the first arg STLIB_LD="${LINKBIN} -lib ${lflags}" RC_OUT=-fo RC_TYPE=-r RC_INCLUDE=-i RC_DEFINE=-d RES=res MAKE_LIB="\${STLIB_LD} -out:\$@" POST_MAKE_LIB= MAKE_EXE="\${CC} -Fe\$@" LIBPREFIX="" EXTRA_CFLAGS="-YX" EXTRA_CFLAGS="" CFLAGS_WARNING="-W3" LDFLAGS_DEBUG="-debug:full -debugtype:both" LDFLAGS_DEBUG="-debug:full" LDFLAGS_OPTIMIZE="-release" # Specify the CC output file names based on the target name CC_OBJNAME="-Fo\$@" CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\$@')\"" # Specify linker flags depending on the type of app being
︙
1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745	1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769	- +	# Set the default compiler switches based on the --enable-symbols # option. This macro depends on C flags, and should be called # after SC_CONFIG_CFLAGS macro is called. #-------------------------------------------------------------------- echo $ac_n "checking for build with symbols""... $ac_c" 1>&6 echo "configure:1739: checking for build with symbols" >&5 echo "configure:1763: checking for build with symbols" >&5 # Check whether --enable-symbols or --disable-symbols was given. if test "${enable_symbols+set}" = set; then enableval="$enable_symbols" tcl_ok=$enableval else tcl_ok=no fi
︙
1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860	1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884	- + - + - + - + - + - + - +	TCL_DBGX=${DBGX} #-------------------------------------------------------------------- # man2tcl needs this so that it can use errno.h #-------------------------------------------------------------------- echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 echo "configure:1799: checking how to run the C preprocessor" >&5 echo "configure:1823: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else # This must be in double quotes, not single quotes, because CPP may get # substituted into the Makefile and "${CC-cc}" will confuse make. CPP="${CC-cc} -E" # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext <<EOF #line 1814 "configure" #line 1838 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" { (eval echo configure:1820: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } { (eval echo configure:1844: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else echo "$ac_err" >&5 echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext <<EOF #line 1831 "configure" #line 1855 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" { (eval echo configure:1837: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } { (eval echo configure:1861: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else echo "$ac_err" >&5 echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* CPP="${CC-cc} -nologo -E" cat > conftest.$ac_ext <<EOF #line 1848 "configure" #line 1872 "configure" #include "confdefs.h" #include <assert.h> Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" { (eval echo configure:1854: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } { (eval echo configure:1878: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else echo "$ac_err" >&5 echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5
︙
1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896	1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920	- + - + - +	else ac_cv_prog_CPP="$CPP" fi echo "$ac_t""$CPP" 1>&6 ac_safe=`echo "errno.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for errno.h""... $ac_c" 1>&6 echo "configure:1880: checking for errno.h" >&5 echo "configure:1904: checking for errno.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF #line 1885 "configure" #line 1909 "configure" #include "confdefs.h" #include <errno.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" { (eval echo configure:1890: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } { (eval echo configure:1914: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 echo "configure: failed program was:" >&5
︙
1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945	1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969	- - - - + + + + - +	TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}" eval "TCL_SRC_DIR=\"`cd $srcdir/..; pwd`\"" eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}" eval "TCL_LIB_FILE=${LIBPREFIX}tcl$VER${LIBSUFFIX}" # FIMXE: These variables decls are missing #TCL_LIB_FLAG #TCL_BUILD_LIB_SPEC #TCL_LIB_SPEC eval "TCL_LIB_FLAG=\"-ltcl${VER}${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_LIB_SPEC=\"-L`pwd` ${TCL_LIB_FLAG}\"" eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\"" eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${TCL_DBGX}\"" eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`pwd` ${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\"" eval "TCL_BUILD_STUB_LIB_PATH=\"`pwd`/${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\"" # Install time header dir can be set via --includedir eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""
︙
1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982	1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018	+ + + + + + + + + + + +	if test "${DBGX}" = "g"; then RC_DEFINES="${RC_DEFINE} DEBUG" else RC_DEFINES="" fi fi #-------------------------------------------------------------------- # The statements below define the symbol TCL_PACKAGE_PATH, which # gives a list of directories that may contain packages. The list # consists of one directory for machine-dependent binaries and # another for platform-independent scripts. #-------------------------------------------------------------------- if test "$prefix" != "$exec_prefix"; then TCL_PACKAGE_PATH="${libdir} ${prefix}/lib" else TCL_PACKAGE_PATH="${prefix}/lib" fi
︙
2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073	2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107	- -	trap '' 1 2 15 cat > confcache <<\EOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs. It is not useful on other systems. # If it contains results you don't want to keep, you may remove or edit it. #
︙
2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148	2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201	+ + + + - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + +	fi trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that # take arguments), then we branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. cat > conftest.defs <<\EOF s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g s%\[%\\&%g s%\]%\\&%g s%\$%$$%g EOF DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '` rm -f conftest.defs cat >confdef2opt.sed <<\_ACEOF t clear : clear s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g t quote s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g t quote d : quote s,[ `~#$^&*(){}\\|;'"<>?],\\&,g s,\[,\\&,g s,\],\\&,g s,\$,$$,g p _ACEOF # We use echo to avoid assuming a particular line-breaking character. # The extra dot is to prevent the shell from consuming trailing # line-breaks from the sub-command output. A line-break within # single-quotes doesn't work because, if this script is created in a # platform that uses two characters for line-breaks (e.g., DOS), tr # would break. ac_LF_and_DOT=`echo; echo .` DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` rm -f confdef2opt.sed # Without the "./", some shells look in PATH for config.status. : ${CONFIG_STATUS=./config.status} echo creating $CONFIG_STATUS rm -f $CONFIG_STATUS
︙
2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295	2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346	- -	s%@TCL_EXP_FILE@%$TCL_EXP_FILE%g s%@LIBOBJS@%$LIBOBJS%g s%@TCL_LIB_VERSIONS_OK@%$TCL_LIB_VERSIONS_OK%g s%@TCL_PACKAGE_PATH@%$TCL_PACKAGE_PATH%g s%@TCL_DDE_VERSION@%$TCL_DDE_VERSION%g s%@TCL_DDE_MAJOR_VERSION@%$TCL_DDE_MAJOR_VERSION%g s%@TCL_DDE_MINOR_VERSION@%$TCL_DDE_MINOR_VERSION%g s%@TCL_DDE_PATCH_LEVEL@%$TCL_DDE_PATCH_LEVEL%g s%@TCL_REG_VERSION@%$TCL_REG_VERSION%g s%@TCL_REG_MAJOR_VERSION@%$TCL_REG_MAJOR_VERSION%g s%@TCL_REG_MINOR_VERSION@%$TCL_REG_MINOR_VERSION%g s%@TCL_REG_PATCH_LEVEL@%$TCL_REG_PATCH_LEVEL%g s%@RC_OUT@%$RC_OUT%g s%@RC_TYPE@%$RC_TYPE%g s%@RC_INCLUDE@%$RC_INCLUDE%g s%@RC_DEFINE@%$RC_DEFINE%g s%@RC_DEFINES@%$RC_DEFINES%g s%@RES@%$RES%g
︙

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	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	- + - + - -	#! /bin/bash -norc # This file is an input file used by the GNU "autoconf" program to # generate the file "configure", which is run during Tcl installation # to configure the system for the local environment. # # RCS: @(#) $Id: configure.in,v 1.68 2003/03/01 01:22:46 hobbs Exp $ # RCS: @(#) $Id: configure.in,v 1.68.2.20 2007/05/30 14:05:22 dgp Exp $ AC_INIT(../generic/tcl.h) AC_PREREQ(2.13) TCL_VERSION=8.4 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=4 TCL_PATCH_LEVEL=".2" TCL_PATCH_LEVEL=".16" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.2 TCL_DDE_MAJOR_VERSION=1 TCL_DDE_MINOR_VERSION=2 TCL_DDE_PATCH_LEVEL="" DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION TCL_REG_VERSION=1.1 TCL_REG_MAJOR_VERSION=1 TCL_REG_MINOR_VERSION=1 TCL_REG_PATCH_LEVEL="" REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION #------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ if test "${prefix}" = "NONE"; then
︙
305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325	303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323	- - - - + + + + - +	TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}" eval "TCL_SRC_DIR=\"`cd $srcdir/..; pwd`\"" eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}" eval "TCL_LIB_FILE=${LIBPREFIX}tcl$VER${LIBSUFFIX}" # FIMXE: These variables decls are missing #TCL_LIB_FLAG #TCL_BUILD_LIB_SPEC #TCL_LIB_SPEC eval "TCL_LIB_FLAG=\"-ltcl${VER}${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_LIB_SPEC=\"-L`pwd` ${TCL_LIB_FLAG}\"" eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\"" eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${TCL_DBGX}\"" eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`pwd` ${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\"" eval "TCL_BUILD_STUB_LIB_PATH=\"`pwd`/${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\"" # Install time header dir can be set via --includedir eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""
︙
349 350 351 352 353 354 355 356 357 358 359 360 361 362	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	+ + + + + + + + + + + +	if test "${DBGX}" = "g"; then RC_DEFINES="${RC_DEFINE} DEBUG" else RC_DEFINES="" fi fi #-------------------------------------------------------------------- # The statements below define the symbol TCL_PACKAGE_PATH, which # gives a list of directories that may contain packages. The list # consists of one directory for machine-dependent binaries and # another for platform-independent scripts. #-------------------------------------------------------------------- if test "$prefix" != "$exec_prefix"; then TCL_PACKAGE_PATH="${libdir} ${prefix}/lib" else TCL_PACKAGE_PATH="${prefix}/lib" fi AC_SUBST(TCL_VERSION) AC_SUBST(TCL_MAJOR_VERSION) AC_SUBST(TCL_MINOR_VERSION) AC_SUBST(TCL_PATCH_LEVEL) AC_SUBST(TCL_LIB_FILE)
︙
426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447	436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455	- -	AC_SUBST(TCL_LIB_VERSIONS_OK) AC_SUBST(TCL_PACKAGE_PATH) # win only AC_SUBST(TCL_DDE_VERSION) AC_SUBST(TCL_DDE_MAJOR_VERSION) AC_SUBST(TCL_DDE_MINOR_VERSION) AC_SUBST(TCL_DDE_PATCH_LEVEL) AC_SUBST(TCL_REG_VERSION) AC_SUBST(TCL_REG_MAJOR_VERSION) AC_SUBST(TCL_REG_MINOR_VERSION) AC_SUBST(TCL_REG_PATCH_LEVEL) AC_SUBST(RC) AC_SUBST(RC_OUT) AC_SUBST(RC_TYPE) AC_SUBST(RC_INCLUDE) AC_SUBST(RC_DEFINE) AC_SUBST(RC_DEFINES) AC_SUBST(RES) AC_OUTPUT(Makefile tclConfig.sh tcl.hpj)

︙
396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413	396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413	- - - - + + + +	-@$(MKDIR) "$(LIB_INSTALL_DIR)" -@$(MKDIR) "$(INCLUDE_INSTALL_DIR)" -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)" @echo installing http1.0 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http1.0" -@copy "$(ROOT)\library\http1.0\http.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0" -@copy "$(ROOT)\library\http1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0" @echo installing http2.4 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.4" -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.4" -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.4" @echo installing http2.5 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.5" -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.5" -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.5" @echo installing opt0.4 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4" -@copy "$(ROOT)\library\opt\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4" -@copy "$(ROOT)\library\opt\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4" @echo installing msgcat1.3 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.3" -@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.3"
︙

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	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	- + - + + + - + + - - + + + - - - - + + + + + - - - + + + - - + +	#------------------------------------------------------------------------------ # makefile.vc -- # # Microsoft Visual C++ makefile for use with nmake.exe v1.62+ (VC++ 5.0+) # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. # Copyright (c) 2001 ActiveState Corporation. # Copyright (c) 2001-2005 ActiveState Corporation. # Copyright (c) 2001-2002 David Gravereaux. # #------------------------------------------------------------------------------ # RCS: @(#) $Id: makefile.vc,v 1.100 2003/03/03 18:14:39 kennykb Exp $ # RCS: @(#) $Id: makefile.vc,v 1.100.2.9 2006/09/26 21:40:36 patthoyts Exp $ #------------------------------------------------------------------------------ # Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR) # or with the MS Platform SDK (MSSDK). Visual Studio .NET 2003 and 2005 define !if "$(MSVCDIR)" == "" # VCINSTALLDIR instead. !if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(MSSDK) && !defined(VCINSTALLDIR) MSG = ^ You'll need to run vcvars32.bat from Developer Studio, first, to setup^ the environment. Jump to this line to read the new instructions. You need to run vcvars32.bat from Developer Studio or setenv.bat from the^ Platform SDK first to setup the environment. Jump to this line to read^ the build instructions. !error $(MSG) !endif #------------------------------------------------------------------------------ # HOW TO USE this makefile: # # 1) It is now necessary to have %MSVCDir% set in the environment. This is used # as a check to see if vcvars32.bat had been run prior to running nmake or # during the installation of Microsoft Visual C++, MSVCDir had been set # globally and the PATH adjusted. Either way is valid. # 1) It is now necessary to have MSVCDir, MSDevDir or MSSDK set in the # environment. This is used as a check to see if vcvars32.bat had been # run prior to running nmake or during the installation of Microsoft # Visual C++, MSVCDir had been set globally and the PATH adjusted. # Either way is valid. # # You'll need to run vcvars32.bat contained in the MsDev's vc(98)/bin # directory to setup the proper environment, if needed, for your current # setup. This is a needed bootstrap requirement and allows the swapping of # different environments to be easier. # directory to setup the proper environment, if needed, for your # current setup. This is a needed bootstrap requirement and allows the # swapping of different environments to be easier. # # 2) To use the Platform SDK (not expressly needed), run setenv.bat after # vcvars32.bat according to the instructions for it. This can also turn on # the 64-bit compiler, if your SDK has it. # vcvars32.bat according to the instructions for it. This can also # turn on the 64-bit compiler, if your SDK has it. # # 3) Targets are: # release -- Builds the core, the shell and the dlls. (default) # dlls -- Just builds the windows extensions and the 16-bit DOS # pipe/thunk helper app. # shell -- Just builds the shell and the core. # core -- Only builds the core [tclXX.(dll|lib)].
︙
172 173 174 175 176 177 178 179 180 181 182 183 184 185 186	177 178 179 180 181 182 183 184 185 186 187 188 189 190 191	- +	TCLLIB = $(OUT_DIR)\$(TCLLIBNAME) TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME) TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe TCLSH = $(OUT_DIR)\$(TCLSHNAME) TCLPIPEDLLNAME = $(PROJECT)pip$(VERSION).dll TCLPIPEDLLNAME = $(PROJECT)pip$(VERSION)$(SUFX:t=).dll TCLPIPEDLL = $(OUT_DIR)\$(TCLPIPEDLLNAME) TCLREGLIBNAME = $(PROJECT)reg$(REGVERSION)$(SUFX:t=).$(EXT) TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME) TCLDDELIBNAME = $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT) TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME)
︙
314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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	319 320 321 322 323 324 325 326 327 328 329 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 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	- + - + - + + - + - - - + + + - - - + - + + - + - + + + + +	#--------------------------------------------------------------------- # Compile flags #--------------------------------------------------------------------- !if !$(DEBUG) !if $(OPTIMIZING) ### This cranks the optimization level to maximize speed cdebug = -O2 -Op -Gs cdebug = -O2 $(OPTIMIZATIONS) !else cdebug = !endif !else if "$(MACHINE)" == "IA64" ### Warnings are too many, can't support warnings into errors. cdebug = -Z7 -Od cdebug = -Z7 -Od $(DEBUGFLAGS) !else cdebug = -Z7 -WX -Od cdebug = -Z7 -WX $(DEBUGFLAGS) !endif ### Declarations common to all compiler options cwarn = -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE cflags = -nologo -c -W3 -YX -Fp$(TMP_DIR)^\ cflags = -nologo -c $(COMPILERFLAGS) $(cwarn) -Fp$(TMP_DIR)^\ !if $(PENT_0F_ERRATA) cflags = $(cflags) -QI0f !endif !if $(FULLWARNINGS) cflags = $(cflags) -W4 !else !if $(ITAN_B_ERRATA) cflags = $(cflags) -QIA64_Bx cflags = $(cflags) -W3 !endif !if $(MSVCRT) !if "$(DBGX)" == "" crt = -MD !else crt = -MDd !endif !else !if "$(DBGX)" == "" crt = -MT !else crt = -MTd !endif !endif TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" BASE_CLFAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) \ -DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\" CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE TCL_CFLAGS = $(BASE_CLFAGS) $(OPTDEFINES) TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES) #--------------------------------------------------------------------- # Link flags #--------------------------------------------------------------------- !if $(DEBUG) ldebug = -debug:full -debugtype:cv !else ldebug = -release -opt:ref -opt:icf,3 !endif ### Declarations common to all linker options lflags = -nologo -machine:$(MACHINE) $(ldebug) lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug) !if $(FULLWARNINGS) lflags = $(lflags) -warn:3 !endif !if $(PROFILE) lflags = $(lflags) -profile !endif !if $(ALIGN98_HACK) && !$(STATIC_BUILD) ### Align sections for PE size savings.
︙
389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404	398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417	- - + + + + + +	lflags = $(lflags) -ws:aggressive !endif dlllflags = $(lflags) -dll conlflags = $(lflags) -subsystem:console guilflags = $(lflags) -subsystem:windows baselibs = kernel32.lib advapi32.lib user32.lib baselibs = kernel32.lib advapi32.lib user32.lib # Avoid 'unresolved external symbol __security_cookie' errors. # c.f. http://support.microsoft.com/?id=894573 !if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64" baselibs = $(baselibs) bufferoverflowU.lib !endif #--------------------------------------------------------------------- # TclTest flags #--------------------------------------------------------------------- !IF "$(TESTPAT)" != "" TESTFLAGS = -file $(TESTPAT)
︙
417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433	430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446	- + - +	tcltest: setup $(TCLTEST) dlls $(CAT32) install: install-binaries install-libraries install-docs test: setup $(TCLTEST) dlls $(CAT32) set TCL_LIBRARY=$(ROOT)/library !if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE" $(TCLTEST) $(ROOT)/tests/all.tcl $(TESTFLAGS) $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) !else $(TCLTEST) $(ROOT)/tests/all.tcl $(TESTFLAGS) > tests.log $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) > tests.log type tests.log | more !endif runtest: setup $(TCLTEST) dlls $(CAT32) set TCL_LIBRARY=$(ROOT)/library $(TCLTEST)
︙
445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501	458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520	+ + + + + + - +	$** << !else $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcl -out:$@ \ $(baselibs) @<< $** << $(_VC_MANIFEST_EMBED_DLL) -@del $*.exp !endif $(TCLSTUBLIB): $(TCLSTUBOBJS) $(lib32) -nologo -out:$@ $(TCLSTUBOBJS) $(TCLSH): $(TCLSHOBJS) $(TCLIMPLIB) $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $** $(_VC_MANIFEST_EMBED_EXE) $(TCLTEST): $(TCLTESTOBJS) $(TCLIMPLIB) $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $** $(_VC_MANIFEST_EMBED_EXE) $(TCLPIPEDLL): $(WINDIR)\stub16.c $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $(WINDIR)\stub16.c $(link32) $(conlflags) -out:$@ $(TMP_DIR)\stub16.obj $(baselibs) $(_VC_MANIFEST_EMBED_DLL) !if $(STATIC_BUILD) $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(lib32) -nologo -out:$@ $(TMP_DIR)\tclWinDde.obj !else $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB) $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcldde -out:$@ \ $** $(baselibs) $(_VC_MANIFEST_EMBED_DLL) -@del $*.exp -@del $*.lib !endif !if $(STATIC_BUILD) $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(lib32) -nologo -out:$@ $(TMP_DIR)\tclWinReg.obj !else $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB) $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tclreg -out:$@ \ $** $(baselibs) $(_VC_MANIFEST_EMBED_DLL) -@del $*.exp -@del $*.lib !endif $(CAT32): $(WINDIR)\cat.c $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $? $(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj \ $(baselibs) $(_VC_MANIFEST_EMBED_EXE) #--------------------------------------------------------------------- # Regenerate the stubs files. [Development use only] #--------------------------------------------------------------------- genstubs: !if !exist($(TCLSH))
︙
615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645	634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664	- + - + - + - + - +	!endif ### The following objects should be built using the stub interfaces ### *ALL* extensions need to built with -DTCL_THREADS=1 $(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c !if $(STATIC_BUILD) $(cc32) $(BASE_CLFAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $? $(cc32) $(BASE_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $? !else $(cc32) $(BASE_CLFAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $? $(cc32) $(BASE_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $? !endif $(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c !if $(STATIC_BUILD) $(cc32) $(BASE_CLFAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $? $(cc32) $(BASE_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $? !else $(cc32) $(BASE_CLFAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $? $(cc32) $(BASE_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $? !endif ### The following objects are part of the stub library and should not ### be built as DLL objects. -Zl is used to avoid a dependancy on any ### specific c-runtime. ### specific C run-time. $(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c $(cc32) $(cdebug) $(cflags) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? #--------------------------------------------------------------------- # Dedependency rules
︙
733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749	752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768	- + - +	@echo installing $(TCLSTUBLIBNAME) @$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\" install-libraries: @echo installing http1.0 @$(CPY) "$(ROOT)\library\http1.0\*.tcl" \ "$(SCRIPT_INSTALL_DIR)\http1.0\" @echo installing http2.4 @echo installing http2.5 @$(CPY) "$(ROOT)\library\http\*.tcl" \ "$(SCRIPT_INSTALL_DIR)\http2.4\" "$(SCRIPT_INSTALL_DIR)\http2.5\" @echo installing opt0.4 @$(CPY) "$(ROOT)\library\opt\*.tcl" \ "$(SCRIPT_INSTALL_DIR)\opt0.4\" @echo installing msgcat1.3 @$(CPY) "$(ROOT)\library\msgcat\*.tcl" \ "$(SCRIPT_INSTALL_DIR)\msgcat1.3\" @echo installing tcltest2.2
︙

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 95	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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154	+ - + - + + + + + + + + + + + + + + + + - - - - + + + + + + + + - + - - + + + + - + + - + + + + + + + + + + + + + + + - + - + + + - + - + + + - - - - + + + + + + - + + + + + + + + + + + + + - - - + + + + + + - + - + +	/* /* ---------------------------------------------------------------------------- * ---------------------------------------------------------------------------- * nmakehlp.c -- * * This is used to fix limitations within nmake and the environment. * * Copyright (c) 2002 by David Gravereaux. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * ---------------------------------------------------------------------------- * RCS: @(#) $Id: nmakehlp.c,v 1.1 2002/03/27 21:15:43 davygrvy Exp $ * RCS: @(#) $Id: nmakehlp.c,v 1.1.4.4 2006/10/18 08:49:33 patthoyts Exp $ * ---------------------------------------------------------------------------- */ #define _CRT_SECURE_NO_DEPRECATE #include <windows.h> #pragma comment (lib, "user32.lib") #pragma comment (lib, "kernel32.lib") #include <stdio.h> #include <math.h> #if defined(_M_IA64) || defined(_M_AMD64) #pragma comment(lib, "bufferoverflowU") #endif /* ISO hack for dumb VC++ */ #ifdef _MSC_VER #define snprintf _snprintf #endif /* protos */ int CheckForCompilerFeature (const char *option); int CheckForLinkerFeature (const char *option); int IsIn (const char *string, const char *substring); DWORD WINAPI ReadFromPipe (LPVOID args); int CheckForCompilerFeature(const char *option); int CheckForLinkerFeature(const char *option); int IsIn(const char *string, const char *substring); int GrepForDefine(const char *file, const char *string); DWORD WINAPI ReadFromPipe(LPVOID args); /* globals */ #define CHUNK 25 #define STATICBUFFERSIZE 1000 typedef struct { HANDLE pipe; char buffer[1000]; char buffer[STATICBUFFERSIZE]; } pipeinfo; pipeinfo Out = {INVALID_HANDLE_VALUE, '\0'}; pipeinfo Err = {INVALID_HANDLE_VALUE, '\0'};  /* * exitcodes: 0 == no, 1 == yes, 2 == error */ /* exitcodes: 0 == no, 1 == yes, 2 == error */ int main( int argc, main (int argc, char *argv[]) char *argv[]) { char msg[300]; DWORD dwWritten; int chars; /* * Make sure children (cl.exe and link.exe) are kept quiet. */ SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOOPENFILEERRORBOX); /* * Make sure the compiler and linker aren't effected by the outside world. */ SetEnvironmentVariable("CL", ""); SetEnvironmentVariable("LINK", ""); if (argc > 1 && *argv[1] == '-') { switch (*(argv[1]+1)) { case 'c': if (argc != 3) { chars = snprintf(msg, sizeof(msg) - 1, chars = wsprintf(msg, "usage: %s -c <compiler option>\n" "usage: %s -c <compiler option>\n" "Tests for whether cl.exe supports an option\n" "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } return CheckForCompilerFeature(argv[2]); case 'l': if (argc != 3) { chars = snprintf(msg, sizeof(msg) - 1, chars = wsprintf(msg, "usage: %s -l <linker option>\n" "usage: %s -l <linker option>\n" "Tests for whether link.exe supports an option\n" "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } return CheckForLinkerFeature(argv[2]); case 'f': if (argc == 2) { chars = snprintf(msg, sizeof(msg) - 1, chars = wsprintf(msg, "usage: %s -f <string> <substring>\n" "Find a substring within another\n" "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); "usage: %s -f <string> <substring>\n" "Find a substring within another\n" "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } else if (argc == 3) { /* /* if the string is blank, there is no match */ * If the string is blank, there is no match. */ return 0; } else { return IsIn(argv[2], argv[3]); } case 'g': if (argc == 2) { chars = snprintf(msg, sizeof(msg) - 1, "usage: %s -g <file> <string>\n" "grep for a #define\n" "exitcodes: integer of the found string (no decimals)\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } } chars = wsprintf(msg, "usage: %s -c|-l|-f ...\n" } return GrepForDefine(argv[2], argv[3]); } } chars = snprintf(msg, sizeof(msg) - 1, "usage: %s -c|-l|-f ...\n" "This is a little helper app to equalize shell differences between WinNT and\n" "Win9x and get nmake.exe to accomplish its job.\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; }  int CheckForCompilerFeature (const char *option) CheckForCompilerFeature( const char *option) { STARTUPINFO si; PROCESS_INFORMATION pi; SECURITY_ATTRIBUTES sa; DWORD threadID; char msg[300]; BOOL ok;
︙
105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190	164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286	+ - + + + + - - - + + + + + + - + + + - - + + + - - - - - - + + + + + + + + + + + + + + + + + - + - - + + - + + - + + + + - + + + + - + + + - - - - - + + + + + - - + + + + + + + + - + - + +	si.hStdInput = INVALID_HANDLE_VALUE; ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES)); sa.nLength = sizeof(SECURITY_ATTRIBUTES); sa.lpSecurityDescriptor = NULL; sa.bInheritHandle = FALSE; /* /* create a non-inheritible pipe. */ * Create a non-inheritible pipe. */ CreatePipe(&Out.pipe, &h, &sa, 0); /* /* dupe the write side, make it inheritible, and close the original. */ DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); * Dupe the write side, make it inheritible, and close the original. */ DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); /* /* Same as above, but for the error side. */ * Same as above, but for the error side. */ CreatePipe(&Err.pipe, &h, &sa, 0); DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); /* /* base command line */ strcpy(cmdline, "cl.exe -nologo -c -TC -Fdtemp "); /* append our option for testing */ strcat(cmdline, option); /* filename to compile, which exists, but is nothing and empty. */ strcat(cmdline, " nul"); * Base command line. */ lstrcpy(cmdline, "cl.exe -nologo -c -TC -Zs -X "); /* * Append our option for testing */ lstrcat(cmdline, option); /* * Filename to compile, which exists, but is nothing and empty. */ lstrcat(cmdline, " .\\nul"); ok = CreateProcess( NULL, /* Module name. */ cmdline, /* Command line. */ NULL, /* Process handle not inheritable. */ NULL, /* Thread handle not inheritable. */ TRUE, /* yes, inherit handles. */ DETACHED_PROCESS, /* No console for you. */ NULL, /* Use parent's environment block. */ NULL, /* Use parent's starting directory. */ &si, /* Pointer to STARTUPINFO structure. */ &pi); /* Pointer to PROCESS_INFORMATION structure. */ if (!ok) { DWORD err = GetLastError(); int chars = snprintf(msg, sizeof(msg) - 1, int chars = wsprintf(msg, "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID) &msg[chars], FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars], (300-chars), 0); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, strlen(msg), &err, NULL); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); return 2; } /* /* close our references to the write handles that have now been inherited. */ * Close our references to the write handles that have now been inherited. */ CloseHandle(si.hStdOutput); CloseHandle(si.hStdError); WaitForInputIdle(pi.hProcess, 5000); CloseHandle(pi.hThread); /* /* start the pipe reader threads. */ * Start the pipe reader threads. */ pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID); pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID); /* /* block waiting for the process to end. */ * Block waiting for the process to end. */ WaitForSingleObject(pi.hProcess, INFINITE); CloseHandle(pi.hProcess); /* clean up temporary files before returning */ DeleteFile("temp.idb"); DeleteFile("temp.pdb"); /* wait for our pipe to get done reading, should it be a little slow. */ /* * Wait for our pipe to get done reading, should it be a little slow. */ WaitForMultipleObjects(2, pipeThreads, TRUE, 500); CloseHandle(pipeThreads[0]); CloseHandle(pipeThreads[1]); /* /* look for the commandline warning code in both streams. */ return !(strstr(Out.buffer, "D4002") != NULL || strstr(Err.buffer, "D4002") != NULL); * Look for the commandline warning code in both streams. * - in MSVC 6 & 7 we get D4002, in MSVC 8 we get D9002. */ return !(strstr(Out.buffer, "D4002") != NULL || strstr(Err.buffer, "D4002") != NULL || strstr(Out.buffer, "D9002") != NULL || strstr(Err.buffer, "D9002") != NULL); }  int CheckForLinkerFeature (const char *option) CheckForLinkerFeature( const char *option) { STARTUPINFO si; PROCESS_INFORMATION pi; SECURITY_ATTRIBUTES sa; DWORD threadID; char msg[300]; BOOL ok;
︙
200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297	296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490	+ - + + + + - - - + + + + + + - + + + - - + + + - - - - + + + + + + + + + + - - + - + - - + + - + + - + + + + - + + + + - + + + + - + + + + - - + + + + + + + - + - + + - - + + + + + + - + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	si.hStdInput = INVALID_HANDLE_VALUE; ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES)); sa.nLength = sizeof(SECURITY_ATTRIBUTES); sa.lpSecurityDescriptor = NULL; sa.bInheritHandle = TRUE; /* /* create a non-inheritible pipe. */ * Create a non-inheritible pipe. */ CreatePipe(&Out.pipe, &h, &sa, 0); /* /* dupe the write side, make it inheritible, and close the original. */ DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); * Dupe the write side, make it inheritible, and close the original. */ DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); /* /* Same as above, but for the error side. */ * Same as above, but for the error side. */ CreatePipe(&Err.pipe, &h, &sa, 0); DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); /* /* base command line */ strcpy(cmdline, "link.exe -nologo "); /* append our option for testing */ strcat(cmdline, option); * Base command line. */ lstrcpy(cmdline, "link.exe -nologo "); /* * Append our option for testing. */ lstrcat(cmdline, option); /* filename to compile, which exists, but is nothing and empty. */ // strcat(cmdline, " nul"); ok = CreateProcess( NULL, /* Module name. */ cmdline, /* Command line. */ NULL, /* Process handle not inheritable. */ NULL, /* Thread handle not inheritable. */ TRUE, /* yes, inherit handles. */ DETACHED_PROCESS, /* No console for you. */ NULL, /* Use parent's environment block. */ NULL, /* Use parent's starting directory. */ &si, /* Pointer to STARTUPINFO structure. */ &pi); /* Pointer to PROCESS_INFORMATION structure. */ if (!ok) { DWORD err = GetLastError(); int chars = snprintf(msg, sizeof(msg) - 1, int chars = wsprintf(msg, "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID) &msg[chars], FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars], (300-chars), 0); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, strlen(msg), &err, NULL); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); return 2; } /* /* close our references to the write handles that have now been inherited. */ * Close our references to the write handles that have now been inherited. */ CloseHandle(si.hStdOutput); CloseHandle(si.hStdError); WaitForInputIdle(pi.hProcess, 5000); CloseHandle(pi.hThread); /* /* start the pipe reader threads. */ * Start the pipe reader threads. */ pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID); pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID); /* /* block waiting for the process to end. */ * Block waiting for the process to end. */ WaitForSingleObject(pi.hProcess, INFINITE); CloseHandle(pi.hProcess); /* /* wait for our pipe to get done reading, should it be a little slow. */ * Wait for our pipe to get done reading, should it be a little slow. */ WaitForMultipleObjects(2, pipeThreads, TRUE, 500); CloseHandle(pipeThreads[0]); CloseHandle(pipeThreads[1]); /* /* look for the commandline warning code in the stderr stream. */ return !(strstr(Out.buffer, "LNK1117") != NULL || strstr(Err.buffer, "LNK1117") != NULL); * Look for the commandline warning code in the stderr stream. */ return !(strstr(Out.buffer, "LNK1117") != NULL || strstr(Err.buffer, "LNK1117") != NULL || strstr(Out.buffer, "LNK4044") != NULL || strstr(Err.buffer, "LNK4044") != NULL); }  DWORD WINAPI ReadFromPipe (LPVOID args) ReadFromPipe( LPVOID args) { pipeinfo *pi = (pipeinfo *) args; char *lastBuf = pi->buffer; DWORD dwRead; BOOL ok; again: ok = ReadFile(pi->pipe, lastBuf, 25, &dwRead, 0L); again: if (lastBuf - pi->buffer + CHUNK > STATICBUFFERSIZE) { CloseHandle(pi->pipe); return (DWORD)-1; } ok = ReadFile(pi->pipe, lastBuf, CHUNK, &dwRead, 0L); if (!ok || dwRead == 0) { CloseHandle(pi->pipe); return 0; } lastBuf += dwRead; goto again; return 0; /* makes the compiler happy */ }  int IsIn( const char *string, IsIn (const char *string, const char *substring) const char *substring) { return (strstr(string, substring) != NULL); }  /* * Find a specified #define by name. * * If the line is '#define TCL_VERSION "8.5"', it returns 85 as the result. */ int GrepForDefine( const char *file, const char *string) { FILE *f; char s1[51], s2[51], s3[51]; int r = 0; double d1; f = fopen(file, "rt"); if (f == NULL) { return 0; } do { r = fscanf(f, "%50s", s1); if (r == 1 && !strcmp(s1, "#define")) { /* * Get next two words. */ r = fscanf(f, "%50s %50s", s2, s3); if (r != 2) { continue; } /* * Is the first word what we're looking for? */ if (!strcmp(s2, string)) { fclose(f); /* * Add 1 past first double quote char. "8.5" */ d1 = atof(s3 + 1); /* 8.5 */ while (floor(d1) != d1) { d1 *= 10.0; } return ((int) d1); /* 85 */ } } } while (!feof(f)); fclose(f); return 0; }

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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135	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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215	- + + - + - + + + + + + + + - + - + + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + - + + + + + + + + + + + - - - - + + + - - - - - - + + + + + + + + + + + + + + + + + + - + +	#------------------------------------------------------------------------------ # rules.vc -- # # Microsoft Visual C++ makefile include for decoding the commandline # macros. This file does not need editing to build Tcl. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # Copyright (c) 2001-2002 David Gravereaux. # Copyright (c) 2001-2003 David Gravereaux. # Copyright (c) 2003-2006 Patrick Thoyts # #------------------------------------------------------------------------------ # RCS: @(#) $Id: rules.vc,v 1.11 2003/03/01 01:22:46 hobbs Exp $ # RCS: @(#) $Id: rules.vc,v 1.11.2.6 2006/10/31 15:17:20 patthoyts Exp $ #------------------------------------------------------------------------------ !ifndef _RULES_VC _RULES_VC = 1 cc32 = $(CC) # built-in default. link32 = link lib32 = lib rc32 = $(RC) # built-in default. !ifndef INSTALLDIR ### Assume the normal default. _INSTALLDIR = C:\Program Files\Tcl !else ### Fix the path seperators. ### Fix the path separators. _INSTALLDIR = $(INSTALLDIR:/=\) !endif !ifndef MACHINE !if "$(CPU)" == "" || "$(CPU)" == "i386" MACHINE = IX86 !else MACHINE = $(CPU) !endif !endif !ifndef CFG_ENCODING CFG_ENCODING = \"cp1252\" !endif #---------------------------------------------------------- # Set the proper copy method to avoid overwrite questions # to the user when copying files and selecting the right # "delete all" method. #---------------------------------------------------------- !if "$(OS)" == "Windows_NT" RMDIR = rmdir /S /Q !if ![ver | find "4.0" > nul] CPY = echo y | xcopy /i !else CPY = xcopy /i /y CPY = xcopy /i /y >NUL !endif !else CPY = xcopy /i RMDIR = deltree /Y !endif MKDIR = mkdir COPY = copy /y >NUL !message =============================================================================== #---------------------------------------------------------- # build the helper app we need to overcome nmake's limiting # environment. #---------------------------------------------------------- !if !exist(nmakehlp.exe) !if [$(cc32) -nologo -ML nmakehlp.c -link -subsystem:console > nul] !if [$(cc32) -nologo nmakehlp.c -link -subsystem:console > nul] !endif !endif #---------------------------------------------------------- # Test for compiler features #---------------------------------------------------------- ### test for optimizations !if [nmakehlp -c -Otip] !if [nmakehlp -c -Ot] !message *** Compiler has 'Optimizations' OPTIMIZING = 1 !else !message *** Compiler doesn't have 'Optimizations' OPTIMIZING = 0 !endif OPTIMIZATIONS = !if [nmakehlp -c -Ot] OPTIMIZATIONS = $(OPTIMIZATIONS) -Ot !endif !if [nmakehlp -c -Oi] OPTIMIZATIONS = $(OPTIMIZATIONS) -Oi !endif !if [nmakehlp -c -Op] OPTIMIZATIONS = $(OPTIMIZATIONS) -Op !endif !if [nmakehlp -c -fp:strict] OPTIMIZATIONS = $(OPTIMIZATIONS) -fp:strict !endif !if [nmakehlp -c -Gs] OPTIMIZATIONS = $(OPTIMIZATIONS) -Gs !endif !if [nmakehlp -c -GS] OPTIMIZATIONS = $(OPTIMIZATIONS) -GS !endif !if [nmakehlp -c -GL] OPTIMIZATIONS = $(OPTIMIZATIONS) -GL !endif DEBUGFLAGS = !if [nmakehlp -c -RTC1] DEBUGFLAGS = $(DEBUGFLAGS) -RTC1 !elseif [nmakehlp -c -GZ] DEBUGFLAGS = $(DEBUGFLAGS) -GZ !endif COMPILERFLAGS =-W3 # In v13 -GL and -YX are incompatible. !if [nmakehlp -c -YX] !if ![nmakehlp -c -GL] OPTIMIZATIONS = $(OPTIMIZATIONS) -YX !endif !endif !if "$(MACHINE)" == "IX86" ### test for pentium errata !if [nmakehlp -c -QI0f] !message *** Compiler has 'Pentium 0x0f fix' PENT_0F_ERRATA = 1 COMPILERFLAGS = $(COMPILERFLAGSS) -QI0f !else !message *** Compiler doesn't have 'Pentium 0x0f fix' !endif !endif PENT_0F_ERRATA = 0 !if "$(MACHINE)" == "IA64" ### test for Itanium errata !if [nmakehlp -c -QIA64_Bx] !message *** Compiler has 'B-stepping errata workarounds' COMPILERFLAGS = $(COMPILERFLAGS) -QIA64_Bx !else !message *** Compiler does not have 'B-stepping errata workarounds' !endif !endif !if "$(MACHINE)" == "IX86" ### test for -align:4096, when align:512 will do. !if [nmakehlp -l -opt:nowin98] !message *** Linker has 'Win98 alignment problem' ALIGN98_HACK = 1 !else !message *** Linker doesn't have 'Win98 alignment problem' ALIGN98_HACK = 0 !endif !else PENT_0F_ERRATA = 0 ALIGN98_HACK = 0 !endif !if "$(MACHINE)" == "IA64" ### test for Itanium errata !if [nmakehlp -c -QIA64_Bx] LINKERFLAGS = !if [nmakehlp -l -ltcg] !message *** Compiler has 'B-stepping errata workarounds' ITAN_B_ERRATA = 1 !else !message *** Compiler doesn't have 'B-stepping errata workarounds' ITAN_B_ERRATA = 0 !endif LINKERFLAGS =-ltcg !endif #---------------------------------------------------------- # MSVC8 (ships with Visual Studio 2005) generates a manifest # file that we should link into the binaries. This is how. #---------------------------------------------------------- _VC_MANIFEST_EMBED_EXE= _VC_MANIFEST_EMBED_DLL= !if ![cl /Zs /Tc NUL 2>&1 | find "Version 12" > NUL] VCVER=6 !elseif ![cl /Zs /Tc NUL 2>&1 | find "Version 13" > NUL] VCVER=7 !elseif ![cl /Zs /Tc NUL 2>&1 | find "Version 14" > NUL] VCVER=8 _VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1 _VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2 !else ITAN_B_ERRATA = 0 VCVER=0 !endif #---------------------------------------------------------- # Decode the options requested. #---------------------------------------------------------- !if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"] STATIC_BUILD = 0 TCL_THREADS = 0 DEBUG = 0 PROFILE = 0 MSVCRT = 0 LOIMPACT = 0 TCL_USE_STATIC_PACKAGES = 0 USE_THREAD_ALLOC = 0 UNCHECKED = 0 !else !if [nmakehlp -f $(OPTS) "static"] !message *** Doing static STATIC_BUILD = 1 !else STATIC_BUILD = 0 !endif
︙
171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211	251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314	+ + + + + + + + + + + + + + + + + + + + + + +	!endif !if [nmakehlp -f $(OPTS) "thrdalloc"] !message *** Doing thrdalloc USE_THREAD_ALLOC = 1 !else USE_THREAD_ALLOC = 0 !endif !if [nmakehlp -f $(OPTS) "unchecked"] !message *** Doing unchecked UNCHECKED = 1 !else UNCHECKED = 0 !endif !endif !if !$(STATIC_BUILD) # Make sure we don't build overly fat DLLs. MSVCRT = 1 # We shouldn't statically put the extensions inside the shell when dynamic. TCL_USE_STATIC_PACKAGES = 0 !endif #---------------------------------------------------------- # Figure-out how to name our intermediate and output directories. # We wouldn't want different builds to use the same .obj files # by accident. #---------------------------------------------------------- #---------------------------------------- # Naming convention: # t = full thread support. # s = static library (as opposed to an # import library) # g = linked to the debug enabled C # run-time. # x = special static build when it # links to the dynamic C run-time. #---------------------------------------- SUFX = tsgx !if $(DEBUG) BUILDDIRTOP = Debug DBGX = g !else BUILDDIRTOP = Release DBGX = SUFX = $(SUFX:g=) !endif !if "$(MACHINE)" != "IX86" BUILDDIRTOP =$(BUILDDIRTOP)_$(MACHINE) !endif !if $(VCVER) > 6 BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER) !endif TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX !if !$(STATIC_BUILD) TMP_DIRFULL = $(TMP_DIRFULL:Static=) SUFX = $(SUFX:s=) EXT = dll
︙
257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317	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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457	+ + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + - + + + - +	!message *** Doing compdbg TCL_COMPILE_DEBUG = 1 !else TCL_COMPILE_DEBUG = 0 !endif !endif #---------------------------------------------------------- # Decode the checks requested. #---------------------------------------------------------- !if "$(CHECKS)" == "" || [nmakehlp -f "$(CHECKS)" "none"] TCL_NO_DEPRECATED = 0 FULLWARNINGS = 0 !else !if [nmakehlp -f $(CHECKS) "nodep"] !message *** Doing nodep check TCL_NO_DEPRECATED = 1 !else TCL_NO_DEPRECATED = 0 !endif !if [nmakehlp -f $(CHECKS) "fullwarn"] !message *** Doing full warnings check FULLWARNINGS = 1 !else FULLWARNINGS = 0 !endif !endif #---------------------------------------------------------- # Set our defines now armed with our options. #---------------------------------------------------------- OPTDEFINES = !if $(TCL_MEM_DEBUG) OPTDEFINES = -DTCL_MEM_DEBUG OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG !endif !if $(TCL_COMPILE_DEBUG) OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS !endif !if $(TCL_THREADS) OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1 !if $(USE_THREAD_ALLOC) OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1 !endif !endif !if $(STATIC_BUILD) OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD !endif !if $(DEBUG) OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DEBUG !elseif $(OPTIMIZING) OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_OPTIMIZED !endif !if $(PROFILE) OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_PROFILED !endif !if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64" OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DO64BIT !endif #---------------------------------------------------------- # Get common info used when building extensions. #---------------------------------------------------------- !if "$(PROJECT)" != "tcl" !if !defined(TCLDIR) !if exist("$(_INSTALLDIR)\include\tcl.h") TCLH = "$(_INSTALLDIR)\include\tcl.h" TCLINSTALL = 1 _TCLDIR = $(_INSTALLDIR) !else MSG=^ Don't know where tcl.h is. Set the TCLDIR macro. Failed to find tcl.h. Set the TCLDIR macro. !error $(MSG) !endif !else _TCLDIR = $(TCLDIR:/=\) !if exist("$(_TCLDIR)\include\tcl.h") TCLH = "$(_TCLDIR)\include\tcl.h" TCLINSTALL = 1 !elseif exist("$(_TCLDIR)\generic\tcl.h") TCLH = "$(_TCLDIR)\generic\tcl.h" TCLINSTALL = 0 !else MSG =^ Don't know where tcl.h is. The TCLDIR macro doesn't appear correct. Failed to find tcl.h. The TCLDIR macro does not appear correct. !error $(MSG) !endif !endif ### TODO: add a command to nmakehlp.c to grep for Tcl's version from tcl.h. ### Because nmake can't return a string, we'll need to play games with return ### codes. It might look something like this:
︙
352 353 354 355 356 357 358 359 360	492 493 494 495 496 497 498 499 500 501 502 503	+ + +	# Display stats being used. #---------------------------------------------------------- !message *** Intermediate directory will be '$(TMP_DIR)' !message *** Output directory will be '$(OUT_DIR)' !message *** Suffix for binaries will be '$(SUFX)' !message *** Optional defines are '$(OPTDEFINES)' !message *** Compiler version $(VCVER) !message *** Compiler options '$(OPTIMIZATIONS) $(DEBUGFLAGS)' !message *** Link options '$(LINKERFLAGS)' !endif

︙
13 14 15 16 17 18 19 20 21 22 23 24 25 26 27	13 14 15 16 17 18 19 20 21 22 23 24 25 26 27	- +	# Adds the following arguments to configure: # --with-tcl=... # # Sets the following vars: # TCL_BIN_DIR Full path to the tclConfig.sh file #------------------------------------------------------------------------ AC_DEFUN(SC_PATH_TCLCONFIG, [ AC_DEFUN([SC_PATH_TCLCONFIG], [ AC_MSG_CHECKING([the location of tclConfig.sh]) if test -d ../../tcl8.4$1/win; then TCL_BIN_DIR_DEFAULT=../../tcl8.4$1/win elif test -d ../../tcl8.4/win; then TCL_BIN_DIR_DEFAULT=../../tcl8.4/win else
︙
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67	53 54 55 56 57 58 59 60 61 62 63 64 65 66 67	- +	# Adds the following arguments to configure: # --with-tk=... # # Sets the following vars: # TK_BIN_DIR Full path to the tkConfig.sh file #------------------------------------------------------------------------ AC_DEFUN(SC_PATH_TKCONFIG, [ AC_DEFUN([SC_PATH_TKCONFIG], [ AC_MSG_CHECKING([the location of tkConfig.sh]) if test -d ../../tk8.4$1/win; then TK_BIN_DIR_DEFAULT=../../tk8.4$1/win elif test -d ../../tk8.4/win; then TK_BIN_DIR_DEFAULT=../../tk8.4/win else
︙
95 96 97 98 99 100 101 102 103 104 105 106 107 108 109	95 96 97 98 99 100 101 102 103 104 105 106 107 108 109	- +	# Subst the following vars: # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE # #------------------------------------------------------------------------ AC_DEFUN(SC_LOAD_TCLCONFIG, [ AC_DEFUN([SC_LOAD_TCLCONFIG], [ AC_MSG_CHECKING([for existence of $TCL_BIN_DIR/tclConfig.sh]) if test -f "$TCL_BIN_DIR/tclConfig.sh" ; then AC_MSG_RESULT([loading]) . $TCL_BIN_DIR/tclConfig.sh else AC_MSG_RESULT([file not found])
︙
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178	164 165 166 167 168 169 170 171 172 173 174 175 176 177 178	- +	# # Results: # # Sets the following vars that should be in tkConfig.sh: # TK_BIN_DIR #------------------------------------------------------------------------ AC_DEFUN(SC_LOAD_TKCONFIG, [ AC_DEFUN([SC_LOAD_TKCONFIG], [ AC_MSG_CHECKING([for existence of $TK_BIN_DIR/tkConfig.sh]) if test -f "$TK_BIN_DIR/tkConfig.sh" ; then AC_MSG_RESULT([loading]) . $TK_BIN_DIR/tkConfig.sh else AC_MSG_RESULT([could not find $TK_BIN_DIR/tkConfig.sh])
︙
201 202 203 204 205 206 207 208 209 210 211 212 213 214 215	201 202 203 204 205 206 207 208 209 210 211 212 213 214 215	- +	# STATIC_BUILD Used for building import/export libraries # on Windows. # # Sets the following vars: # SHARED_BUILD Value of 1 or 0 #------------------------------------------------------------------------ AC_DEFUN(SC_ENABLE_SHARED, [ AC_DEFUN([SC_ENABLE_SHARED], [ AC_MSG_CHECKING([how to build libraries]) AC_ARG_ENABLE(shared, [ --enable-shared build and link with shared libraries [--enable-shared]], [tcl_ok=$enableval], [tcl_ok=yes]) if test "${enable_shared+set}" = set; then enableval="$enable_shared"
︙
241 242 243 244 245 246 247 248 249 250 251 252 253 254 255	241 242 243 244 245 246 247 248 249 250 251 252 253 254 255	- +	# Adds the following arguments to configure: # --enable-threads=yes|no # # Defines the following vars: # TCL_THREADS #------------------------------------------------------------------------ AC_DEFUN(SC_ENABLE_THREADS, [ AC_DEFUN([SC_ENABLE_THREADS], [ AC_MSG_CHECKING(for building with threads) AC_ARG_ENABLE(threads, [ --enable-threads build with threads], [tcl_ok=$enableval], [tcl_ok=no]) if test "$tcl_ok" = "yes"; then AC_MSG_RESULT(yes) TCL_THREADS=1
︙
288 289 290 291 292 293 294 295 296 297 298 299 300 301 302	288 289 290 291 292 293 294 295 296 297 298 299 300 301 302	- +	# Sets to $(CFLAGS_OPTIMIZE) if false # LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true # Sets to $(LDFLAGS_OPTIMIZE) if false # DBGX Debug library extension # #------------------------------------------------------------------------ AC_DEFUN(SC_ENABLE_SYMBOLS, [ AC_DEFUN([SC_ENABLE_SYMBOLS], [ AC_MSG_CHECKING([for build with symbols]) AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols [--disable-symbols]], [tcl_ok=$enableval], [tcl_ok=no]) # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' DBGX=""
︙
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	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 402 403 404	- + - + + + + +	# LIBPREFIX # LIBRARIES # EXESUFFIX # DLLSUFFIX # #-------------------------------------------------------------------- AC_DEFUN(SC_CONFIG_CFLAGS, [ AC_DEFUN([SC_CONFIG_CFLAGS], [ # Step 0: Enable 64 bit support? AC_MSG_CHECKING([if 64bit support is requested]) AC_ARG_ENABLE(64bit,[ --enable-64bit enable 64bit support (where applicable)], [do64bit=$enableval], [do64bit=no]) AC_ARG_ENABLE(64bit,[ --enable-64bit enable 64bit support (where applicable = amd64|ia64)], [do64bit=$enableval], [do64bit=no]) AC_MSG_RESULT($do64bit) # Set some defaults (may get changed below) EXTRA_CFLAGS="" AC_CHECK_PROG(CYGPATH, cygpath, cygpath -w, echo) SHLIB_SUFFIX=".dll" # MACHINE is IX86 for LINK, but this is used by the manifest, # which requires x86|amd64|ia64. MACHINE="X86" # Check for a bug in gcc's windres that causes the # compile to fail when a Windows native path is # passed into windres. The mingw toolchain requires # Windows native paths while Cygwin should work # with both. Avoid the bug by passing a POSIX # path when using the Cygwin toolchain.
︙
423 424 425 426 427 428 429 430 431 432 433 434 435 436 437	427 428 429 430 431 432 433 434 435 436 437 438 439 440 441	- +	DEPARG='"$(shell $(CYGPATH) $<)"' fi # set various compiler flags depending on whether we are using gcc or cl AC_MSG_CHECKING([compiler flags]) if test "${GCC}" = "yes" ; then if test "$do64bit" = "yes" ; then if test "$do64bit" != "no" ; then AC_MSG_WARN("64bit mode not supported with GCC on Windows") fi SHLIB_LD="" SHLIB_LD_LIBS="" LIBS="" LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32" STLIB_LD='${AR} cr'
︙
473 474 475 476 477 478 479 480 481 482 483 484 485 486	477 478 479 480 481 482 483 484 485 486 487 488 489 490 491	+	if test "${SHARED_BUILD}" = "0" ; then # static AC_MSG_RESULT([using static flags]) runtime= MAKE_DLL="echo " LIBSUFFIX="s\${DBGX}.a" LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" else # dynamic AC_MSG_RESULT([using shared flags]) # ad-hoc check to see if CC supports -shared.
︙
496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521	501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527	+ - +	SHLIB_LD='${CC} -shared ${CFLAGS}' SHLIB_LD_LIBS='${LIBS}' # Add SHLIB_LD_LIBS to the Make rule, not here. MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \ -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)" LIBSUFFIX="\${DBGX}.a" LIBFLAGSUFFIX="\${DBGX}" EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" fi # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" SHLIB_SUFFIX=.dll EXTRA_CFLAGS="${extra_cflags}" CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE=-O CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" CFLAGS_WARNING="-Wall -Wconversion" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= # Specify the CC output file names based on the target name CC_OBJNAME="-o \[$]@" CC_EXENAME="-o \[$]@"
︙
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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623	545 546 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 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649	+ + + - + - + - - - - - + + + + + + + + + + + + + + + + + + + + - + - - - - - + - - - + + + - + - - + - - + + + + + + + - - - + + + + - - + + + - + - +	else if test "${SHARED_BUILD}" = "0" ; then # static AC_MSG_RESULT([using static flags]) runtime=-MT MAKE_DLL="echo " LIBSUFFIX="s\${DBGX}.lib" LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" SHLIB_LD_LIBS="" else # dynamic AC_MSG_RESULT([using shared flags]) runtime=-MD # Add SHLIB_LD_LIBS to the Make rule, not here. MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@" LIBSUFFIX="\${DBGX}.lib" LIBFLAGSUFFIX="\${DBGX}" EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" SHLIB_LD_LIBS='${LIBS}' fi # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" # This is a 2-stage check to make sure we have the 64-bit SDK # We have to know where the SDK is installed. # This magic is based on MS Platform SDK for Win2003 SP1 - hobbs if test "$do64bit" = "yes" ; then if test "$do64bit" != "no" ; then if test "x${MSSDK}x" = "xx" ; then MSSDK="C:/Progra~1/Microsoft SDK" MSSDK="C:/Progra~1/Microsoft Platform SDK" fi # In order to work in the tortured autoconf environment, # we need to ensure that this path has no spaces MSSDK=$(cygpath -w -s "$MSSDK" | sed -e 's!\\!/!g') if test ! -d "${MSSDK}/bin/win64" ; then AC_MSG_WARN("could not find 64-bit SDK to enable 64bit mode") MSSDK=`echo "$MSSDK" | sed -e 's!\\\!/!g'` PATH64="" case "$do64bit" in amd64|x64|yes) MACHINE="AMD64" ; # default to AMD64 64-bit build PATH64="${MSSDK}/Bin/Win64/x86/AMD64" ;; ia64) MACHINE="IA64" PATH64="${MSSDK}/Bin/Win64" ;; esac if test ! -d "${PATH64}" ; then AC_MSG_WARN([Could not find 64-bit $MACHINE SDK to enable 64bit mode]) AC_MSG_WARN([Ensure latest Platform SDK is installed]) do64bit="no" else AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) fi fi if test "$do64bit" != "no" ; then # The space-based-path will work for the Makefile, but will # not work if AC_TRY_COMPILE is called. if test "$do64bit" = "yes" ; then # All this magic is necessary for the Win64 SDK RC1 - hobbs CC="${MSSDK}/Bin/Win64/cl.exe \ -I${MSSDK}/Include/prerelease \ -I${MSSDK}/Include/Win64/crt \ CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \ -I${MSSDK}/Include/Win64/crt/sys \ -I${MSSDK}/Include" RC="${MSSDK}/bin/rc.exe" -I\"${MSSDK}/Include/crt\" -I\"${MSSDK}/Include/crt/sys\"" RC="\"${MSSDK}/bin/rc.exe\"" CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d" # Do not use -O2 for Win64 - this has proved buggy in code gen. CFLAGS_OPTIMIZE="-nologo -O2 -Gs ${runtime}" CFLAGS_OPTIMIZE="-nologo -O1 ${runtime}" lflags="-MACHINE:IA64 -LIBPATH:${MSSDK}/Lib/IA64 \ -LIBPATH:${MSSDK}/Lib/Prerelease/IA64" lflags="-nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" STLIB_LD="${MSSDK}/bin/win64/lib.exe -nologo ${lflags}" LINKBIN="${MSSDK}/bin/win64/link.exe ${lflags}" LINKBIN="\"${PATH64}/link.exe\"" # Avoid 'unresolved external symbol __security_cookie' errors. # c.f. http://support.microsoft.com/?id=894573 LIBS="user32.lib advapi32.lib bufferoverflowU.lib" else RC="rc" # -Od - no optimization # -WX - warnings as errors CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d" # -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy) CFLAGS_OPTIMIZE="-nologo -Oti -Gs -GD ${runtime}" STLIB_LD="lib -nologo" LINKBIN="link -link50compat" CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}" lflags="-nologo" LINKBIN="link" LIBS="user32.lib advapi32.lib" fi SHLIB_LD="${LINKBIN} -dll -nologo -incremental:no" LIBS="user32.lib advapi32.lib" LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib" SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}" # link -lib only works when -lib is the first arg STLIB_LD="${LINKBIN} -lib ${lflags}" RC_OUT=-fo RC_TYPE=-r RC_INCLUDE=-i RC_DEFINE=-d RES=res MAKE_LIB="\${STLIB_LD} -out:\[$]@" POST_MAKE_LIB= MAKE_EXE="\${CC} -Fe\[$]@" LIBPREFIX="" EXTRA_CFLAGS="-YX" EXTRA_CFLAGS="" CFLAGS_WARNING="-W3" LDFLAGS_DEBUG="-debug:full -debugtype:both" LDFLAGS_DEBUG="-debug:full" LDFLAGS_OPTIMIZE="-release" # Specify the CC output file names based on the target name CC_OBJNAME="-Fo\[$]@" CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\[$]@')\"" # Specify linker flags depending on the type of app being
︙
646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724	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 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771	- + - - - - - - - - + + + + + + + + - - + - + - + - - + + - - - + + - - + + + + + + + + + + + + + + + + + + + + + + + + +	# Adds the following arguments to configure: # --with-tcl=... # # Defines the following vars: # TCL_BIN_DIR Full path to the tcl build dir. #------------------------------------------------------------------------ AC_DEFUN(SC_WITH_TCL, [ AC_DEFUN([SC_WITH_TCL], [ if test -d ../../tcl8.4$1/win; then TCL_BIN_DEFAULT=../../tcl8.4$1/win else TCL_BIN_DEFAULT=../../tcl8.4/win fi AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.4 binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`) if test ! -d $TCL_BIN_DIR; then AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist) fi if test ! -f $TCL_BIN_DIR/Makefile; then AC_MSG_ERROR(There is no Makefile in $TCL_BIN_DIR: perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?) else echo "building against Tcl binaries in: $TCL_BIN_DIR" fi AC_SUBST(TCL_BIN_DIR) ]) # FIXME : SC_PROG_TCLSH should really look for the installed tclsh and # not the build version. If we want to use the build version in the # tk script, it is better to hardcode that! #------------------------------------------------------------------------ # SC_PROG_TCLSH # Locate a tclsh shell in the following directories: # ${exec_prefix}/bin # ${prefix}/bin # ${TCL_BIN_DIR} # Locate a tclsh shell installed on the system path. This macro # will only find a Tcl shell that already exists on the system. # It will not find a Tcl shell in the Tcl build directory or # a Tcl shell that has been installed from the Tcl build directory. # If a Tcl shell can't be located on the PATH, then TCLSH_PROG will # be set to "". Extensions should take care not to create Makefile # rules that are run by default and depend on TCLSH_PROG. An # extension can't assume that an executable Tcl shell exists at # ${TCL_BIN_DIR}/../bin # ${PATH} # build time. # # Arguments # none # # Results # Subst's the following values: # TCLSH_PROG #------------------------------------------------------------------------ AC_DEFUN(SC_PROG_TCLSH, [ AC_DEFUN([SC_PROG_TCLSH], [ AC_MSG_CHECKING([for tclsh]) AC_CACHE_VAL(ac_cv_path_tclsh, [ search_path=`echo ${exec_prefix}/bin:${prefix}/bin:${TCL_BIN_DIR}:${TCL_BIN_DIR}/../bin:${PATH} | sed -e 's/:/ /g'` search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/tclsh[[8-9]]*.exe 2> /dev/null` \ `ls -r $dir/tclsh* 2> /dev/null` ; do if test x"$ac_cv_path_tclsh" = x ; then if test -f "$j" ; then ac_cv_path_tclsh=$j break fi fi done done ]) if test -f "$ac_cv_path_tclsh" ; then TCLSH_PROG="$ac_cv_path_tclsh" AC_MSG_RESULT($TCLSH_PROG) elif test -f "$TCL_BIN_DIR/tclConfig.sh" ; then # One-tree build. else # It is not an error if an installed version of Tcl can't be located. ac_cv_path_tclsh="$TCL_BIN_DIR/tclsh" TCLSH_PROG="$ac_cv_path_tclsh" AC_MSG_RESULT($TCLSH_PROG) TCLSH_PROG="" AC_MSG_RESULT([No tclsh found on PATH]) else AC_MSG_ERROR(No tclsh found in PATH: $search_path) fi AC_SUBST(TCLSH_PROG) ]) #------------------------------------------------------------------------ # SC_BUILD_TCLSH # Determine the fully qualified path name of the tclsh executable # in the Tcl build directory. This macro will correctly determine # the name of the tclsh executable even if tclsh has not yet # been built in the build directory. The build tclsh must be used # when running tests from an extension build directory. It is not # correct to use the TCLSH_PROG in cases like this. # # Arguments # none # # Results # Subst's the following values: # BUILD_TCLSH #------------------------------------------------------------------------ AC_DEFUN([SC_BUILD_TCLSH], [ AC_MSG_CHECKING([for tclsh in Tcl build directory]) BUILD_TCLSH=${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT} AC_MSG_RESULT($BUILD_TCLSH) AC_SUBST(BUILD_TCLSH) ])

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	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	- + - + + + - - + +	/* /* * tclAppInit.c -- * * Provides a default version of the main program and Tcl_AppInit * procedure for Tcl applications (without Tk). Note that this * program must be built in Win32 console mode to work properly. * * Copyright (c) 1996-1997 by 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. * * RCS: @(#) $Id: tclAppInit.c,v 1.11 2002/12/04 03:59:17 davygrvy Exp $ * RCS: @(#) $Id: tclAppInit.c,v 1.11.2.3 2007/03/19 17:06:26 dgp Exp $ */ #include "tcl.h" #include <windows.h> #include <locale.h> #ifdef TCL_TEST extern int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp)); extern int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp)); extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp)); extern int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp)); #ifdef TCL_THREADS extern int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp)); #endif #endif /* TCL_TEST */ static void setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr)); static BOOL __stdcall sigHandler (DWORD fdwCtrlType); static Tcl_AsyncProc asyncExit; static void AppInitExitHandler(ClientData clientData); static char ** argvSave = NULL; Tcl_AsyncHandler exitToken; DWORD exitErrorCode; static Tcl_AsyncHandler exitToken = NULL; static DWORD exitErrorCode = 0;  /* *---------------------------------------------------------------------- * * main -- *
︙
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	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	- + - + - + - + + + + + +	{ /* * The following #if block allows you to change the AppInit * function by using a #define of TCL_LOCAL_APPINIT instead * of rewriting this entire file. The #if checks for that * #define and uses Tcl_AppInit if it doesn't exist. */ #ifndef TCL_LOCAL_APPINIT #define TCL_LOCAL_APPINIT Tcl_AppInit #define TCL_LOCAL_APPINIT Tcl_AppInit #endif extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp)); /* * The following #if block allows you to change how Tcl finds the startup * script, prime the library or encoding paths, fiddle with the argv, * etc., without needing to rewrite Tcl_Main() */ #ifdef TCL_LOCAL_MAIN_HOOK extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv)); #endif char buffer[MAX_PATH +1]; char *p; /* * Set up the default locale to be standard "C" locale so parsing * is performed correctly. */ setlocale(LC_ALL, "C"); setargv(&argc, &argv); /* * Save this for later, so we can free it. */ argvSave = argv; /* * Replace argv[0] with full pathname of executable, and forward * slashes substituted for backslashes. */ GetModuleFileName(NULL, buffer, sizeof(buffer)); argv[0] = buffer;
︙
139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154	146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167	- - + + + + + + + +	if (Tcl_Init(interp) == TCL_ERROR) { return TCL_ERROR; } /* * Install a signal handler to the win32 console tclsh is running in. */ SetConsoleCtrlHandler(sigHandler, TRUE); exitToken = Tcl_AsyncCreate(asyncExit, NULL); SetConsoleCtrlHandler(sigHandler, TRUE); exitToken = Tcl_AsyncCreate(asyncExit, NULL); /* * This exit handler will be used to free the * resources allocated in this file. */ Tcl_CreateExitHandler(AppInitExitHandler, NULL); #ifdef TCL_TEST if (Tcltest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, (Tcl_PackageInitProc *) NULL);
︙
206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227	219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - +	* where "app" is the name of the application. If this line is deleted * then no user-specific startup file will be run under any conditions. */ Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY); return TCL_OK; }  /* *---------------------------------------------------------------------- * * AppInitExitHandler -- * * This function is called to cleanup the app init resources before * Tcl is unloaded. * * Results: * None. * * Side effects: * Frees the saved argv and deletes the async exit handler. * *---------------------------------------------------------------------- */ static void AppInitExitHandler( ClientData clientData) { if (argvSave != NULL) { ckfree((char *)argvSave); argvSave = NULL; } if (exitToken != NULL) { /* * This should be safe to do even if we * are in an async exit right now. */ Tcl_AsyncDelete(exitToken); exitToken = NULL; } }  /* *------------------------------------------------------------------------- * * setargv -- * * Parse the Windows command line string into argc/argv. Done here * because we don't trust the builtin argument parser in crt0. * because we don't trust the builtin argument parser in crt0. * Windows applications are responsible for breaking their command * line into arguments. * * 2N backslashes + quote -> N backslashes + begin quoted string * 2N + 1 backslashes + quote -> literal * N backslashes + non-quote -> literal * quote + quote in a quoted string -> single quote
︙
242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276	291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325	- + - +	setargv(argcPtr, argvPtr) int *argcPtr; /* Filled with number of argument strings. */ char ***argvPtr; /* Filled with argument strings (malloc'd). */ { char *cmdLine, *p, *arg, *argSpace; char **argv; int argc, size, inquote, copy, slashes; cmdLine = GetCommandLine(); /* INTL: BUG */ /* * Precompute an overly pessimistic guess at the number of arguments * in the command line by counting non-space spans. */ size = 2; for (p = cmdLine; *p != '\0'; p++) { if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ size++; while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ p++; } if (*p == '\0') { break; } } } argSpace = (char *) Tcl_Alloc( argSpace = (char *) ckalloc( (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1)); argv = (char **) argSpace; argSpace += size * sizeof(char *); size--; p = cmdLine; for (argc = 0; argc < size; argc++) {
︙
323 324 325 326 327 328 329 330 331 332 333 334 335 336 337	372 373 374 375 376 377 378 379 380 381 382 383 384 385 386	- +	argSpace = arg + 1; } argv[argc] = NULL; *argcPtr = argc; *argvPtr = argv; }  /* *---------------------------------------------------------------------- * * asyncExit -- * * The AsyncProc for the exitToken. *
︙
348 349 350 351 352 353 354 355 356 357 358 359 360 361 362	397 398 399 400 401 402 403 404 405 406 407 408 409 410 411	- +	asyncExit (ClientData clientData, Tcl_Interp *interp, int code) { Tcl_Exit((int)exitErrorCode); /* NOTREACHED */ return code; }  /* *---------------------------------------------------------------------- * * sigHandler -- * * Signal handler for the Win32 OS. Catches Ctrl+C, Ctrl+Break and * other exits. This is needed so tclsh can do it's real clean-up
︙
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	422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455	+ + + + + + - - - - + + + + - - - + + +	*---------------------------------------------------------------------- */ BOOL __stdcall sigHandler(DWORD fdwCtrlType) { HANDLE hStdIn; if (!exitToken) { /* Async token must have been destroyed, punt gracefully. */ return FALSE; } /* * If Tcl is currently executing some bytecode or in the eventloop, * this will cause Tcl to enter asyncExit at the next command * boundry. */ exitErrorCode = fdwCtrlType; Tcl_AsyncMark(exitToken); /* * This will cause Tcl_Gets in Tcl_Main() to drop-out with an <EOF> * should it be blocked on input and our Tcl_AsyncMark didn't grab * the attention of the interpreter. /* * This will cause Tcl_Gets in Tcl_Main() to drop-out with an <EOF> * should it be blocked on input and our Tcl_AsyncMark didn't grab * the attention of the interpreter. */ hStdIn = GetStdHandle(STD_INPUT_HANDLE); if (hStdIn) { CloseHandle(hStdIn); } /* indicate to the OS not to call the default terminator */ return TRUE; } /* indicate to the OS not to call the default terminator */ return TRUE; }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	/* * tclWin32Dll.c -- * * This file contains the DLL entry point. * * Copyright (c) 1995-1996 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclWin32Dll.c,v 1.24 2003/02/04 17:06:52 vincentdarley Exp $ * RCS: @(#) $Id: tclWin32Dll.c,v 1.24.2.10 2006/10/17 04:36:45 dgp Exp $ */ #include "tclWinInt.h" /* * The following data structures are used when loading the thunking * library for execing child processes under Win32s.
︙
33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54	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	- - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + +	* on a per-instance basis. Each time this DLL is loaded, it gets its own * new data segment with its own copy of all static and global information. */ static HINSTANCE hInstance; /* HINSTANCE of this DLL. */ static int platformId; /* Running under NT, or 95/98? */ #if defined(HAVE_NO_SEH) && defined(TCL_MEM_DEBUG) static void *INITIAL_ESP, *INITIAL_EBP, *INITIAL_HANDLER, *RESTORED_ESP, *RESTORED_EBP, *RESTORED_HANDLER; #endif /* HAVE_NO_SEH && TCL_MEM_DEBUG */ #ifdef HAVE_NO_SEH /* * Unlike Borland and Microsoft, we don't register exception handlers * by pushing registration records onto the runtime stack. Instead, we * register them by creating an EXCEPTION_REGISTRATION within the activation * record. */ typedef struct EXCEPTION_REGISTRATION { struct EXCEPTION_REGISTRATION* link; EXCEPTION_DISPOSITION (*handler)( struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void* ); void* ebp; void* esp; int status; } EXCEPTION_REGISTRATION; #endif /* * VC++ 5.x has no 'cpuid' assembler instruction, so we * must emulate it */ #if defined(_MSC_VER) && ( _MSC_VER <= 1100 ) #define cpuid __asm __emit 0fh __asm __emit 0a2h #endif /* * The following function tables are used to dispatch to either the * wide-character or multi-byte versions of the operating system calls, * depending on whether the Unicode calls are available. */
︙
84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106	103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134	- + + + + + + + + + +	(BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileA, (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryA, (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD, WCHAR *, TCHAR **)) SearchPathA, (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA, (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA, /* * These two function pointers will only be set when * The three NULL function pointers will only be set when * Tcl_FindExecutable is called. If you don't ever call that * function, the application will crash whenever WinTcl tries to call * functions through these null pointers. That is not a bug in Tcl * -- Tcl_FindExecutable is obligatory in recent Tcl releases. */ NULL, NULL, (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _utime, NULL, NULL, /* getLongPathNameProc */ NULL, /* Security SDK - not available on 95,98,ME */ NULL, NULL, NULL, NULL, NULL, NULL, /* ReadConsole and WriteConsole */ (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleA, (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleA }; static TclWinProcs unicodeProcs = { 1, (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBW, (TCHAR *(WINAPI *)(TCHAR *)) CharLowerW,
︙
131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165	159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240	- + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	(BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileW, (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryW, (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD, WCHAR *, TCHAR **)) SearchPathW, (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW, (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW, /* * These two function pointers will only be set when * The three NULL function pointers will only be set when * Tcl_FindExecutable is called. If you don't ever call that * function, the application will crash whenever WinTcl tries to call * functions through these null pointers. That is not a bug in Tcl * -- Tcl_FindExecutable is obligatory in recent Tcl releases. */ NULL, NULL, (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _wutime, NULL, NULL, /* getLongPathNameProc */ NULL, /* Security SDK - will be filled in on NT,XP,2000,2003 */ NULL, NULL, NULL, NULL, NULL, NULL, /* ReadConsole and WriteConsole */ (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleW, (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleW }; TclWinProcs *tclWinProcs; static Tcl_Encoding tclWinTCharEncoding; #ifdef HAVE_NO_SEH /* Need to add noinline flag to DllMain declaration so that gcc -O3 * does not inline asm code into DllEntryPoint and cause a * compile time error because of redefined local labels. */ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, LPVOID reserved) __attribute__ ((noinline)); #else /* * The following declaration is for the VC++ DLL entry point. */ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, LPVOID reserved); #endif /* HAVE_NO_SEH */ /* * The following structure and linked list is to allow us to map between * volume mount points and drive letters on the fly (no Win API exists * for this). */ typedef struct MountPointMap { CONST WCHAR* volumeName; /* Native wide string volume name */ char driveLetter; /* Drive letter corresponding to * the volume name. */ struct MountPointMap* nextPtr; /* Pointer to next structure in list, * or NULL */ } MountPointMap; /* * This is the head of the linked list, which is protected by the * mutex which follows, for thread-enabled builds. */ MountPointMap *driveLetterLookup = NULL; TCL_DECLARE_MUTEX(mountPointMap) /* We will need this below */ extern Tcl_FSDupInternalRepProc TclNativeDupInternalRep; #ifdef __WIN32__ #ifndef STATIC_BUILD  /* *----------------------------------------------------------------------
︙
207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229	282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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	+ + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	*/ BOOL APIENTRY DllMain(hInst, reason, reserved) HINSTANCE hInst; /* Library instance handle. */ DWORD reason; /* Reason this function is being called. */ LPVOID reserved; /* Not used. */ { #ifdef HAVE_NO_SEH EXCEPTION_REGISTRATION registration; #endif switch (reason) { case DLL_PROCESS_ATTACH: DisableThreadLibraryCalls(hInst); TclWinInit(hInst); return TRUE; case DLL_PROCESS_DETACH: /* * Protect the call to Tcl_Finalize. The OS could be unloading * us from an exception handler and the state of the stack might * be unstable. */ #ifdef HAVE_NO_SEH __asm__ __volatile__ ( if (hInst == hInstance) { /* * Construct an EXCEPTION_REGISTRATION to protect the * call to Tcl_Finalize */ "leal %[registration], %%edx" "\n\t" "movl %%fs:0, %%eax" "\n\t" "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ "leal 1f, %%eax" "\n\t" "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ "movl %[error], 0x10(%%edx)" "\n\t" /* status */ /* * Link the EXCEPTION_REGISTRATION on the chain */ "movl %%edx, %%fs:0" "\n\t" /* * Call Tcl_Finalize */ "call _Tcl_Finalize" "\n\t" /* * Come here on a normal exit. Recover the EXCEPTION_REGISTRATION * and store a TCL_OK status */ "movl %%fs:0, %%edx" "\n\t" "movl %[ok], %%eax" "\n\t" "movl %%eax, 0x10(%%edx)" "\n\t" "jmp 2f" "\n" /* * Come here on an exception. Get the EXCEPTION_REGISTRATION * that we previously put on the chain. */ "1:" "\t" "movl %%fs:0, %%edx" "\n\t" "movl 0x8(%%edx), %%edx" "\n" /* * Come here however we exited. Restore context from the * EXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" "movl 0xc(%%edx), %%esp" "\n\t" "movl 0x8(%%edx), %%ebp" "\n\t" "movl 0x0(%%edx), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" : /* No outputs */ : [registration] "m" (registration), [ok] "i" (TCL_OK), [error] "i" (TCL_ERROR) : "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory" ); #else /* HAVE_NO_SEH */ __try { Tcl_Finalize(); } __except (EXCEPTION_EXECUTE_HANDLER) { /* empty handler body. */ } #endif break; } return TRUE; } #endif /* !STATIC_BUILD */
︙
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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473	520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634	+ + + + - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + - - + - + - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -	* *---------------------------------------------------------------------- */ int TclpCheckStackSpace() { #ifdef HAVE_NO_SEH EXCEPTION_REGISTRATION registration; #endif int retval = 0; /* * We can recurse only if there is at least TCL_WIN_STACK_THRESHOLD * bytes of stack space left. alloca() is cheap on windows; basically * it just subtracts from the stack pointer causing the OS to throw an * exception if the stack pointer is set below the bottom of the stack. */ #ifdef HAVE_NO_SEH # ifdef TCL_MEM_DEBUG __asm__ __volatile__ ( "movl %%esp, %0" "\n\t" "movl %%ebp, %1" "\n\t" "movl %%fs:0, %2" "\n\t" : "=m"(INITIAL_ESP), "=m"(INITIAL_EBP), "=r"(INITIAL_HANDLER) ); # endif /* TCL_MEM_DEBUG */ /* * Construct an EXCEPTION_REGISTRATION to protect the * call to __alloca */ "leal %[registration], %%edx" "\n\t" "movl %%fs:0, %%eax" "\n\t" "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ "leal 1f, %%eax" "\n\t" "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ "movl %[error], 0x10(%%edx)" "\n\t" /* status */ /* * Link the EXCEPTION_REGISTRATION on the chain */ "movl %%edx, %%fs:0" "\n\t" /* * Attempt a call to __alloca, to determine whether there's * sufficient memory to be had. */ "movl %[size], %%eax" "\n\t" "pushl %%eax" "\n\t" "call __alloca" "\n\t" /* * Come here on a normal exit. Recover the EXCEPTION_REGISTRATION * and store a TCL_OK status */ "movl %%fs:0, %%edx" "\n\t" "movl %[ok], %%eax" "\n\t" "movl %%eax, 0x10(%%edx)" "\n\t" "jmp 2f" "\n" /* * Come here on an exception. Get the EXCEPTION_REGISTRATION * that we previously put on the chain. */ "1:" "\t" "movl %%fs:0, %%edx" "\n\t" "movl 0x8(%%edx), %%edx" "\n\t" __asm__ __volatile__ ( "pushl %ebp" "\n\t" "pushl $__except_checkstackspace_handler" "\n\t" "pushl %fs:0" "\n\t" "movl %esp, %fs:0"); #else /* * Come here however we exited. Restore context from the * EXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" "movl 0xc(%%edx), %%esp" "\n\t" "movl 0x8(%%edx), %%ebp" "\n\t" "movl 0x0(%%edx), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" : /* No outputs */ : [registration] "m" (registration), [ok] "i" (TCL_OK), [error] "i" (TCL_ERROR), [size] "i" (TCL_WIN_STACK_THRESHOLD) : "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory" ); retval = (registration.status == TCL_OK); #else /* !HAVE_NO_SEH */ __try { #endif /* HAVE_NO_SEH */ #ifdef HAVE_ALLOCA_GCC_INLINE __asm__ __volatile__ ( __asm__ __volatile__ ( "movl %0, %%eax" "\n\t" "call __alloca" "\n\t" : : "i"(TCL_WIN_STACK_THRESHOLD) : "%eax"); #else alloca(TCL_WIN_STACK_THRESHOLD); alloca(TCL_WIN_STACK_THRESHOLD); #endif /* HAVE_ALLOCA_GCC_INLINE */ retval = 1; retval = 1; #ifdef HAVE_NO_SEH __asm__ __volatile__ ( "movl %%fs:0, %%esp" "\n\t" "jmp checkstackspace_pop" "\n" "checkstackspace_reentry:" "\n\t" "movl %%fs:0, %%eax" "\n\t" "movl 0x8(%%eax), %%esp" "\n\t" "movl 0x8(%%esp), %%ebp" "\n" "checkstackspace_pop:" "\n\t" "movl (%%esp), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" "add $12, %%esp" "\n\t" : : : "%eax"); # ifdef TCL_MEM_DEBUG __asm__ __volatile__ ( "movl %%esp, %0" "\n\t" "movl %%ebp, %1" "\n\t" "movl %%fs:0, %2" "\n\t" : "=m"(RESTORED_ESP), "=m"(RESTORED_EBP), "=r"(RESTORED_HANDLER) ); if (INITIAL_ESP != RESTORED_ESP) panic("ESP restored incorrectly"); if (INITIAL_EBP != RESTORED_EBP) panic("EBP restored incorrectly"); if (INITIAL_HANDLER != RESTORED_HANDLER) panic("HANDLER restored incorrectly"); # endif /* TCL_MEM_DEBUG */ #else } __except (EXCEPTION_EXECUTE_HANDLER) {} #endif /* HAVE_NO_SEH */ /* * Avoid using control flow statements in the SEH guarded block! */ return retval; } #ifdef HAVE_NO_SEH static __attribute__ ((cdecl)) EXCEPTION_DISPOSITION _except_checkstackspace_handler( struct _EXCEPTION_RECORD *ExceptionRecord, void *EstablisherFrame, struct _CONTEXT *ContextRecord, void *DispatcherContext) { __asm__ __volatile__ ( "jmp checkstackspace_reentry"); /* Nuke compiler warning about unused static function */ _except_checkstackspace_handler(NULL, NULL, NULL, NULL); return 0; /* Function does not return */ } #endif /* HAVE_NO_SEH */  /* *---------------------------------------------------------------------- * * TclWinGetPlatform -- * * This is a kludge that allows the test library to get access
︙
527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586	688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	tclWinProcs->getFileAttributesExProc = (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExW"); tclWinProcs->createHardLinkProc = (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, "CreateHardLinkW"); tclWinProcs->findFirstFileExProc = (HANDLE (WINAPI *)(CONST TCHAR*, UINT, LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance, "FindFirstFileExW"); tclWinProcs->getVolumeNameForVMPProc = (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*, DWORD)) GetProcAddress(hInstance, "GetVolumeNameForVolumeMountPointW"); FreeLibrary(hInstance); } hInstance = LoadLibraryA("advapi32"); if (hInstance != NULL) { tclWinProcs->getFileSecurityProc = (BOOL (WINAPI *)( LPCTSTR lpFileName, SECURITY_INFORMATION RequestedInformation, PSECURITY_DESCRIPTOR pSecurityDescriptor, DWORD nLength, LPDWORD lpnLengthNeeded)) GetProcAddress(hInstance, "GetFileSecurityW"); tclWinProcs->impersonateSelfProc = (BOOL (WINAPI *) ( SECURITY_IMPERSONATION_LEVEL ImpersonationLevel)) GetProcAddress(hInstance, "ImpersonateSelf"); tclWinProcs->openThreadTokenProc = (BOOL (WINAPI *) ( HANDLE ThreadHandle, DWORD DesiredAccess, BOOL OpenAsSelf, PHANDLE TokenHandle)) GetProcAddress(hInstance, "OpenThreadToken"); tclWinProcs->revertToSelfProc = (BOOL (WINAPI *) (void)) GetProcAddress(hInstance, "RevertToSelf"); tclWinProcs->mapGenericMaskProc = (VOID (WINAPI *) ( PDWORD AccessMask, PGENERIC_MAPPING GenericMapping)) GetProcAddress(hInstance, "MapGenericMask"); tclWinProcs->accessCheckProc = (BOOL (WINAPI *)( PSECURITY_DESCRIPTOR pSecurityDescriptor, HANDLE ClientToken, DWORD DesiredAccess, PGENERIC_MAPPING GenericMapping, PPRIVILEGE_SET PrivilegeSet, LPDWORD PrivilegeSetLength, LPDWORD GrantedAccess, LPBOOL AccessStatus)) GetProcAddress(hInstance, "AccessCheck"); FreeLibrary(hInstance); } } } else { tclWinProcs = &asciiProcs; tclWinTCharEncoding = NULL; if (tclWinProcs->getFileAttributesExProc == NULL) { HINSTANCE hInstance = LoadLibraryA("kernel32"); if (hInstance != NULL) { tclWinProcs->getFileAttributesExProc = (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExA"); tclWinProcs->createHardLinkProc = (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, "CreateHardLinkA"); tclWinProcs->findFirstFileExProc = (HANDLE (WINAPI *)(CONST TCHAR*, UINT, LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance, "FindFirstFileExA"); tclWinProcs->getLongPathNameProc = NULL; tclWinProcs->getVolumeNameForVMPProc = (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*, DWORD)) GetProcAddress(hInstance, "GetVolumeNameForVolumeMountPointA"); FreeLibrary(hInstance); } } } }  /* *--------------------------------------------------------------------------- * * TclWinResetInterfaceEncodings -- * * Called during finalization to free up any encodings we use. * The tclWinProcs-> look up table is still ok to use after * this call, provided no encoding conversion is required. * * We also clean up any memory allocated in our mount point * map which is used to follow certain kinds of symlinks. * That code should never be used once encodings are taken * down. * * Results: * None. * * Side effects: * None. * *--------------------------------------------------------------------------- */ void TclWinResetInterfaceEncodings() { MountPointMap *dlIter, *dlIter2; if (tclWinTCharEncoding != NULL) { Tcl_FreeEncoding(tclWinTCharEncoding); tclWinTCharEncoding = NULL; } /* Clean up the mount point map */ Tcl_MutexLock(&mountPointMap); dlIter = driveLetterLookup; while (dlIter != NULL) { dlIter2 = dlIter->nextPtr; ckfree((char*)dlIter->volumeName); ckfree((char*)dlIter); dlIter = dlIter2; } Tcl_MutexUnlock(&mountPointMap); }  /* *--------------------------------------------------------------------------- * * TclWinResetInterfaces -- *
︙
597 598 599 600 601 602 603 604 605 606 607 608 609 610	821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	*--------------------------------------------------------------------------- */ void TclWinResetInterfaces() { tclWinProcs = &asciiProcs; }  /* *-------------------------------------------------------------------- * * TclWinDriveLetterForVolMountPoint * * Unfortunately, Windows provides no easy way at all to get hold * of the drive letter for a volume mount point, but we need that * information to understand paths correctly. So, we have to * build an associated array to find these correctly, and allow * quick and easy lookup from volume mount points to drive letters. * * We assume here that we are running on a system for which the wide * character interfaces are used, which is valid for Win 2000 and WinXP * which are the only systems on which this function will ever be called. * * Result: the drive letter, or -1 if no drive letter corresponds to * the given mount point. * *-------------------------------------------------------------------- */ char TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint) { MountPointMap *dlIter, *dlPtr2; WCHAR Target[55]; /* Target of mount at mount point */ WCHAR drive[4] = { L'A', L':', L'\\', L'\0' }; /* * Detect the volume mounted there. Unfortunately, there is no * simple way to map a unique volume name to a DOS drive letter. * So, we have to build an associative array. */ Tcl_MutexLock(&mountPointMap); dlIter = driveLetterLookup; while (dlIter != NULL) { if (wcscmp(dlIter->volumeName, mountPoint) == 0) { /* * We need to check whether this information is * still valid, since either the user or various * programs could have adjusted the mount points on * the fly. */ drive[0] = L'A' + (dlIter->driveLetter - 'A'); /* Try to read the volume mount point and see where it points */ if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive, (TCHAR*)Target, 55) != 0) { if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) { /* Nothing has changed */ Tcl_MutexUnlock(&mountPointMap); return dlIter->driveLetter; } } /* * If we reach here, unfortunately, this mount point is * no longer valid at all */ if (driveLetterLookup == dlIter) { dlPtr2 = dlIter; driveLetterLookup = dlIter->nextPtr; } else { for (dlPtr2 = driveLetterLookup; dlPtr2 != NULL; dlPtr2 = dlPtr2->nextPtr) { if (dlPtr2->nextPtr == dlIter) { dlPtr2->nextPtr = dlIter->nextPtr; dlPtr2 = dlIter; break; } } } /* Now dlPtr2 points to the structure to free */ ckfree((char*)dlPtr2->volumeName); ckfree((char*)dlPtr2); /* * Restart the loop --- we could try to be clever * and continue half way through, but the logic is a * bit messy, so it's cleanest just to restart */ dlIter = driveLetterLookup; continue; } dlIter = dlIter->nextPtr; } /* We couldn't find it, so we must iterate over the letters */ for (drive[0] = L'A'; drive[0] <= L'Z'; drive[0]++) { /* Try to read the volume mount point and see where it points */ if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive, (TCHAR*)Target, 55) != 0) { int alreadyStored = 0; for (dlIter = driveLetterLookup; dlIter != NULL; dlIter = dlIter->nextPtr) { if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) { alreadyStored = 1; break; } } if (!alreadyStored) { dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap)); dlPtr2->volumeName = TclNativeDupInternalRep(Target); dlPtr2->driveLetter = 'A' + (drive[0] - L'A'); dlPtr2->nextPtr = driveLetterLookup; driveLetterLookup = dlPtr2; } } } /* Try again */ for (dlIter = driveLetterLookup; dlIter != NULL; dlIter = dlIter->nextPtr) { if (wcscmp(dlIter->volumeName, mountPoint) == 0) { Tcl_MutexUnlock(&mountPointMap); return dlIter->driveLetter; } } /* * The volume doesn't appear to correspond to a drive letter -- we * remember that fact and store '-1' so we don't have to look it * up each time. */ dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap)); dlPtr2->volumeName = TclNativeDupInternalRep((ClientData)mountPoint); dlPtr2->driveLetter = -1; dlPtr2->nextPtr = driveLetterLookup; driveLetterLookup = dlPtr2; Tcl_MutexUnlock(&mountPointMap); return -1; }  /* *--------------------------------------------------------------------------- * * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf -- * * Convert between UTF-8 and Unicode when running Windows NT or
︙
676 677 678 679 680 681 682	1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 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 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	* platform-specific string length. */ Tcl_DString *dsPtr; /* Uninitialized or free DString in which * the converted string is stored. */ { return Tcl_ExternalToUtfDString(tclWinTCharEncoding, (CONST char *) string, len, dsPtr); }  /* *------------------------------------------------------------------------ * * TclWinCPUID -- * * Get CPU ID information on an Intel box under Windows * * Results: * Returns TCL_OK if successful, TCL_ERROR if CPUID is not * supported or fails. * * Side effects: * If successful, stores EAX, EBX, ECX and EDX registers after * the CPUID instruction in the four integers designated by 'regsPtr' * *---------------------------------------------------------------------- */ int TclWinCPUID( unsigned int index, /* Which CPUID value to retrieve */ unsigned int * regsPtr ) /* Registers after the CPUID */ { #ifdef HAVE_NO_SEH EXCEPTION_REGISTRATION registration; #endif int status = TCL_ERROR; #if defined(__GNUC__) && !defined(_WIN64) /* * Execute the CPUID instruction with the given index, and * store results off 'regPtr'. */ __asm__ __volatile__ ( /* * Construct an EXCEPTION_REGISTRATION to protect the * CPUID instruction (early 486's don't have CPUID) */ "leal %[registration], %%edx" "\n\t" "movl %%fs:0, %%eax" "\n\t" "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ "leal 1f, %%eax" "\n\t" "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ "movl %[error], 0x10(%%edx)" "\n\t" /* status */ /* * Link the EXCEPTION_REGISTRATION on the chain */ "movl %%edx, %%fs:0" "\n\t" /* * Do the CPUID instruction, and save the results in * the 'regsPtr' area */ "movl %[rptr], %%edi" "\n\t" "movl %[index], %%eax" "\n\t" "cpuid" "\n\t" "movl %%eax, 0x0(%%edi)" "\n\t" "movl %%ebx, 0x4(%%edi)" "\n\t" "movl %%ecx, 0x8(%%edi)" "\n\t" "movl %%edx, 0xc(%%edi)" "\n\t" /* * Come here on a normal exit. Recover the EXCEPTION_REGISTRATION * and store a TCL_OK status */ "movl %%fs:0, %%edx" "\n\t" "movl %[ok], %%eax" "\n\t" "movl %%eax, 0x10(%%edx)" "\n\t" "jmp 2f" "\n" /* * Come here on an exception. Get the EXCEPTION_REGISTRATION * that we previously put on the chain. */ "1:" "\t" "movl %%fs:0, %%edx" "\n\t" "movl 0x8(%%edx), %%edx" "\n\t" /* * Come here however we exited. Restore context from the * EXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" "movl 0xc(%%edx), %%esp" "\n\t" "movl 0x8(%%edx), %%ebp" "\n\t" "movl 0x0(%%edx), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" : /* No outputs */ : [index] "m" (index), [rptr] "m" (regsPtr), [registration] "m" (registration), [ok] "i" (TCL_OK), [error] "i" (TCL_ERROR) : "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory" ); status = registration.status; #elif defined(_MSC_VER) && !defined(_WIN64) /* Define a structure in the stack frame to hold the registers */ struct { DWORD dw0; DWORD dw1; DWORD dw2; DWORD dw3; } regs; regs.dw0 = index; /* Execute the CPUID instruction and save regs in the stack frame */ _try { _asm { push ebx push ecx push edx mov eax, regs.dw0 cpuid mov regs.dw0, eax mov regs.dw1, ebx mov regs.dw2, ecx mov regs.dw3, edx pop edx pop ecx pop ebx } /* Copy regs back out to the caller */ regsPtr[0]=regs.dw0; regsPtr[1]=regs.dw1; regsPtr[2]=regs.dw2; regsPtr[3]=regs.dw3; status = TCL_OK; } __except( EXCEPTION_EXECUTE_HANDLER ) { } #else /* Don't know how to do assembly code for * this compiler and/or architecture */ #endif return status; }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	/* * tclWinChan.c * * Channel drivers for Windows channels based on files, command * pipes and TCP sockets. * * Copyright (c) 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. * * RCS: @(#) $Id: tclWinChan.c,v 1.30 2003/01/26 05:59:38 mdejong Exp $ * RCS: @(#) $Id: tclWinChan.c,v 1.30.2.5 2006/08/30 17:53:28 hobbs Exp $ */ #include "tclWinInt.h" #include "tclIO.h" /* * State flags used in the info structures below.
︙
94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140	94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153	- - + + + + - + + - - - - - + + + + + + + + + + + + + + + + + - - - +	long offset, int mode, int *errorCode)); static Tcl_WideInt FileWideSeekProc _ANSI_ARGS_((ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCode)); static void FileSetupProc _ANSI_ARGS_((ClientData clientData, int flags)); static void FileWatchProc _ANSI_ARGS_((ClientData instanceData, int mask)); static void FileThreadActionProc _ANSI_ARGS_ (( ClientData instanceData, int action)); static DWORD FileGetType _ANSI_ARGS_((HANDLE handle)); /* * This structure describes the channel type structure for file based IO. */ static Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_3, /* v3 channel */ TCL_CHANNEL_VERSION_4, /* v4 channel */ FileCloseProc, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ FileSeekProc, /* Seek proc. */ NULL, /* Set option proc. */ NULL, /* Get option proc. */ FileWatchProc, /* Set up the notifier to watch the channel. */ FileGetHandleProc, /* Get an OS handle from channel. */ NULL, /* close2proc. */ FileBlockProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ FileWideSeekProc, /* Wide seek proc. */ FileThreadActionProc, /* Thread action proc. */ }; #if defined(HAVE_NO_SEH) && defined(TCL_MEM_DEBUG) static void *INITIAL_ESP, *INITIAL_EBP, *INITIAL_HANDLER, *RESTORED_ESP, #ifdef HAVE_NO_SEH /* * Unlike Borland and Microsoft, we don't register exception handlers * by pushing registration records onto the runtime stack. Instead, we * register them by creating an EXCEPTION_REGISTRATION within the activation * record. */ typedef struct EXCEPTION_REGISTRATION { struct EXCEPTION_REGISTRATION* link; EXCEPTION_DISPOSITION (*handler)( struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void* ); void* ebp; void* esp; int status; } EXCEPTION_REGISTRATION; *RESTORED_EBP, *RESTORED_HANDLER; #endif /* HAVE_NO_SEH && TCL_MEM_DEBUG */ #endif  /* *---------------------------------------------------------------------- * * FileInit -- * * This function creates the window used to simulate file events.
︙
386 387 388 389 390 391 392 393 394 395 396 397 398 399	399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414	+ +	static int FileCloseProc(instanceData, interp) ClientData instanceData; /* Pointer to FileInfo structure. */ Tcl_Interp *interp; /* Not used. */ { FileInfo *fileInfoPtr = (FileInfo *) instanceData; FileInfo *infoPtr; ThreadSpecificData *tsdPtr; int errorCode = 0; /* * Remove the file from the watch list. */ FileWatchProc(instanceData, 0);
︙
410 411 412 413 414 415 416 417 418 419 420 421 422 423	425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455	+ + + + + + + + + + + + + + + + +	&& (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) { if (CloseHandle(fileInfoPtr->handle) == FALSE) { TclWinConvertError(GetLastError()); errorCode = errno; } } /* * See if this FileInfo* is still on the thread local list. */ tsdPtr = TCL_TSD_INIT(&dataKey); for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr == fileInfoPtr) { /* * This channel exists on the thread local list. It should * have been removed by an earlier Thread Action call, * but do that now since just deallocating fileInfoPtr would * leave an deallocated pointer on the thread local list. */ FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE); break; } } ckfree((char *)fileInfoPtr); return errorCode; }  /* *---------------------------------------------------------------------- *
︙
748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764	780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795	- + -	int mode; /* POSIX mode. */ int permissions; /* If the open involves creating a * file, with what modes to create * it? */ { Tcl_Channel channel = 0; int channelPermissions; DWORD accessMode, createMode, shareMode, flags, consoleParams, type; DWORD accessMode, createMode, shareMode, flags; CONST TCHAR *nativeName; DCB dcb; HANDLE handle; char channelName[16 + TCL_INTEGER_SPACE]; TclFile readFile = NULL; TclFile writeFile = NULL; nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr); if (nativeName == NULL) {
︙
849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885	880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896	- - - - - - - - - - - - - - - - - - - - - +	Tcl_AppendResult(interp, "couldn't open \"", Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), (char *) NULL); } return NULL; } type = GetFileType(handle); /* * If the file is a character device, we need to try to figure out * whether it is a serial port, a console, or something else. We * test for the console case first because this is more common. */ if (type == FILE_TYPE_CHAR) { if (GetConsoleMode(handle, &consoleParams)) { type = FILE_TYPE_CONSOLE; } else { dcb.DCBlength = sizeof( DCB ) ; if (GetCommState(handle, &dcb)) { type = FILE_TYPE_SERIAL; } } } channel = NULL; switch (type) { switch ( FileGetType(handle) ) { case FILE_TYPE_SERIAL: /* * Reopen channel for OVERLAPPED operation * Normally this shouldn't fail, because the channel exists */ handle = TclWinSerialReopen(handle, nativeName, accessMode); if (handle == INVALID_HANDLE_VALUE) {
︙
950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001	961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990	+ + + - - - - - - - - - - - - - - - - - - - - - - - - - - +	Tcl_Channel Tcl_MakeFileChannel(rawHandle, mode) ClientData rawHandle; /* OS level handle */ int mode; /* ORed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { #ifdef HAVE_NO_SEH EXCEPTION_REGISTRATION registration; #endif char channelName[16 + TCL_INTEGER_SPACE]; Tcl_Channel channel = NULL; HANDLE handle = (HANDLE) rawHandle; HANDLE dupedHandle; DCB dcb; DWORD consoleParams, type; TclFile readFile = NULL; TclFile writeFile = NULL; BOOL result; if (mode == 0) { return NULL; } /* * GetFileType() returns FILE_TYPE_UNKNOWN for invalid handles. */ type = GetFileType(handle); /* * If the file is a character device, we need to try to figure out * whether it is a serial port, a console, or something else. We * test for the console case first because this is more common. */ if (type == FILE_TYPE_CHAR) { if (GetConsoleMode(handle, &consoleParams)) { type = FILE_TYPE_CONSOLE; } else { dcb.DCBlength = sizeof( DCB ) ; if (GetCommState(handle, &dcb)) { type = FILE_TYPE_SERIAL; } } } switch (type) switch (FileGetType(handle)) { case FILE_TYPE_SERIAL: channel = TclWinOpenSerialChannel(handle, channelName, mode); break; case FILE_TYPE_CONSOLE: channel = TclWinOpenConsoleChannel(handle, channelName, mode); break;
︙
1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152	1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143	+ - - - - + + + + + + + + + + + + + + + - - - - - - + + + - + - - - - - - - - - + + + - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + - - + + + + + - - - - - + + + - - + - - + - - - - - - - - + + + + - - - - + + + + - - + - - + + - + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - -	} /* * Use structured exception handling (Win32 SEH) to protect the close * of this duped handle which might throw EXCEPTION_INVALID_HANDLE. */ result = 0; #ifdef HAVE_NO_SEH # ifdef TCL_MEM_DEBUG __asm__ __volatile__ ( "movl %%esp, %0" "\n\t" #ifndef HAVE_NO_SEH __try { CloseHandle(dupedHandle); result = 1; } __except (EXCEPTION_EXECUTE_HANDLER) {} #else /* * Don't have SEH available, do things the hard way. * Note that this needs to be one block of asm, to avoid stack * imbalance; also, it is illegal for one asm block to contain * a jump to another. */ __asm__ __volatile__ ( "movl %%ebp, %1" "\n\t" "movl %%fs:0, %2" "\n\t" : "=m"(INITIAL_ESP), "=m"(INITIAL_EBP), "=r"(INITIAL_HANDLER) ); # endif /* TCL_MEM_DEBUG */ /* * Pick up parameters before messing with the stack */ result = 0; "movl %[dupedHandle], %%ebx" "\n\t" __asm__ __volatile__ ( "pushl %ebp" "\n\t" "pushl $__except_makefilechannel_handler" "\n\t" "pushl %fs:0" "\n\t" "movl %esp, %fs:0"); #else __try { #endif /* HAVE_NO_SEH */ CloseHandle(dupedHandle); /* * Construct an EXCEPTION_REGISTRATION to protect the * call to CloseHandle #ifdef HAVE_NO_SEH __asm__ __volatile__ ( "jmp makefilechannel_pop" "\n" "makefilechannel_reentry:" "\n\t" "movl %%fs:0, %%eax" "\n\t" "movl 0x8(%%eax), %%esp" "\n\t" "movl 0x8(%%esp), %%ebp" "\n" "movl $1, %0" "\n" "makefilechannel_pop:" "\n\t" "movl (%%esp), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" "add $12, %%esp" "\n\t" : "=m"(result) : */ "leal %[registration], %%edx" "\n\t" "movl %%fs:0, %%eax" "\n\t" "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ "leal 1f, %%eax" "\n\t" "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* Link the EXCEPTION_REGISTRATION on the chain */ "movl %%edx, %%fs:0" "\n\t" /* Call CloseHandle( dupedHandle ) */ "pushl %%ebx" "\n\t" "call _CloseHandle@4" "\n\t" : "%eax"); /* * Come here on normal exit. Recover the EXCEPTION_REGISTRATION * and put a TRUE status return into it. */ # ifdef TCL_MEM_DEBUG __asm__ __volatile__ ( "movl %%esp, %0" "\n\t" "movl %%ebp, %1" "\n\t" "movl %%fs:0, %2" "\n\t" "movl %%fs:0, %%edx" "\n\t" "movl $1, %%eax" "\n\t" "movl %%eax, 0x10(%%edx)" "\n\t" : "=m"(RESTORED_ESP), "=m"(RESTORED_EBP), "jmp 2f" "\n" "=r"(RESTORED_HANDLER) ); if (INITIAL_ESP != RESTORED_ESP) panic("ESP restored incorrectly"); if (INITIAL_EBP != RESTORED_EBP) panic("EBP restored incorrectly"); if (INITIAL_HANDLER != RESTORED_HANDLER) panic("HANDLER restored incorrectly"); # endif /* TCL_MEM_DEBUG */ /* * Come here on an exception. Recover the EXCEPTION_REGISTRATION */ if (result) return NULL; #else } "1:" "\t" "movl %%fs:0, %%edx" "\n\t" "movl 0x8(%%edx), %%edx" "\n\t" __except (EXCEPTION_EXECUTE_HANDLER) { /* /* * Definately an invalid handle. So, therefore, the original * is invalid also. * Come here however we exited. Restore context from the * EXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" "movl 0xc(%%edx), %%esp" "\n\t" "movl 0x8(%%edx), %%ebp" "\n\t" "movl 0x0(%%edx), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" : /* No outputs */ : [registration] "m" (registration), [dupedHandle] "m" (dupedHandle) : "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory" ); result = registration.status; #endif if (result == FALSE) { return NULL; } #endif /* HAVE_NO_SEH */ /* Fall through, the handle is valid. */ /* * Create the undefined channel, anyways, because we know the handle * is valid to something. */ channel = TclWinOpenFileChannel(handle, channelName, mode, 0); } return channel; } #ifdef HAVE_NO_SEH static __attribute__ ((cdecl)) EXCEPTION_DISPOSITION _except_makefilechannel_handler( struct _EXCEPTION_RECORD *ExceptionRecord, void *EstablisherFrame, struct _CONTEXT *ContextRecord, void *DispatcherContext) { __asm__ __volatile__ ( "jmp makefilechannel_reentry"); /* Nuke compiler warning about unused static function */ _except_makefilechannel_handler(NULL, NULL, NULL, NULL); return 0; /* Function does not return */ } #endif  /* *---------------------------------------------------------------------- * * TclpGetDefaultStdChannel -- * * Constructs a channel for the specified standard OS handle.
︙
1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283	1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277	+ + + + - + -	infoPtr = infoPtr->nextPtr) { if (infoPtr->handle == (HANDLE) handle) { return (permissions == infoPtr->validMask) ? infoPtr->channel : NULL; } } infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo)); /* TIP #218. Removed the code inserting the new structure * into the global list. This is now handled in the thread * action callbacks, and only there. */ infoPtr->nextPtr = tsdPtr->firstFilePtr; infoPtr->nextPtr = NULL; tsdPtr->firstFilePtr = infoPtr; infoPtr->validMask = permissions; infoPtr->watchMask = 0; infoPtr->flags = appendMode; infoPtr->handle = handle; infoPtr->dirty = 0; wsprintfA(channelName, "file%lx", (int) infoPtr);
︙
1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430	1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433	- + - + - - - + + - - - + + - - - - + + + + + + + + - - - - - - - - - - - - - + + + + + + + + - - - - - + + + + + - - - - - + + + + + + + - + - + - - + - - - + + + - - - - - - + + + + + + + + + + + - - - + + + + + + + + + - - - + + + - +	} } }  /* *---------------------------------------------------------------------- * * TclpCutFileChannel -- * FileThreadActionProc -- * * Remove any thread local refs to this channel. See * Insert or remove any thread local refs to this channel. * Tcl_CutChannel for more info. * * Results: * None. * * Side effects: * Changes thread local list of valid channels. * *---------------------------------------------------------------------- */ void TclpCutFileChannel(chan) static void FileThreadActionProc (instanceData, action) Tcl_Channel chan; /* The channel being removed. Must * not be referenced in any * interpreter. */ ClientData instanceData; int action; { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Channel *chanPtr = (Channel *) chan; FileInfo *infoPtr; FileInfo **nextPtrPtr; int removed = 0; FileInfo *infoPtr = (FileInfo *) instanceData; if (action == TCL_CHANNEL_THREAD_INSERT) { infoPtr->nextPtr = tsdPtr->firstFilePtr; tsdPtr->firstFilePtr = infoPtr; } else { FileInfo **nextPtrPtr; int removed = 0; if (chanPtr->typePtr != &fileChannelType) return; infoPtr = (FileInfo *) chanPtr->instanceData; for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL; nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { if ((*nextPtrPtr) == infoPtr) { (*nextPtrPtr) = infoPtr->nextPtr; removed = 1; break; } } for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL; nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { if ((*nextPtrPtr) == infoPtr) { (*nextPtrPtr) = infoPtr->nextPtr; removed = 1; break; } } /* * This could happen if the channel was created in one thread * and then moved to another without updating the thread * local data in each thread. */ /* * This could happen if the channel was created in one thread * and then moved to another without updating the thread * local data in each thread. */ if (!removed) panic("file info ptr not on thread channel list"); }  if (!removed) { panic("file info ptr not on thread channel list"); } } } /* *---------------------------------------------------------------------- * * TclpSpliceFileChannel -- * FileGetType -- * * Insert thread local ref for this channel. * Given a file handle, return its type * Tcl_SpliceChannel for more info. * * Results: * None. * * Side effects: * Changes thread local list of valid channels. * None. * *---------------------------------------------------------------------- */ void TclpSpliceFileChannel(chan) Tcl_Channel chan; /* The channel being removed. Must DWORD FileGetType(handle) HANDLE handle; /* Opened file handle */ * not be referenced in any * interpreter. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Channel *chanPtr = (Channel *) chan; FileInfo *infoPtr; { DWORD type; DWORD consoleParams; DCB dcb; type = GetFileType(handle); /* * If the file is a character device, we need to try to figure out * whether it is a serial port, a console, or something else. We * test for the console case first because this is more common. */ if (chanPtr->typePtr != &fileChannelType) return; if (type == FILE_TYPE_CHAR || (type == FILE_TYPE_UNKNOWN && !GetLastError())) { if (GetConsoleMode(handle, &consoleParams)) { type = FILE_TYPE_CONSOLE; } else { dcb.DCBlength = sizeof( DCB ) ; if (GetCommState(handle, &dcb)) { type = FILE_TYPE_SERIAL; } infoPtr = (FileInfo *) chanPtr->instanceData; infoPtr->nextPtr = tsdPtr->firstFilePtr; } } tsdPtr->firstFilePtr = infoPtr; return type; }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	/* * tclWinConsole.c -- * * This file implements the Windows-specific console functions, * and the "console" channel driver. * * Copyright (c) 1999 by Scriptics Corp. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclWinConsole.c,v 1.11 2002/11/26 22:41:58 davygrvy Exp $ * RCS: @(#) $Id: tclWinConsole.c,v 1.11.2.3 2006/03/28 21:02:37 hobbs Exp $ */ #include "tclWinInt.h" #include <fcntl.h> #include <io.h> #include <sys/stat.h>
︙
144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208	144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213	- + + + + - + + + - +	static void ConsoleCheckProc(ClientData clientData, int flags); static int ConsoleCloseProc(ClientData instanceData, Tcl_Interp *interp); static int ConsoleEventProc(Tcl_Event *evPtr, int flags); static void ConsoleExitHandler(ClientData clientData); static int ConsoleGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); static ThreadSpecificData *ConsoleInit(void); static void ConsoleInit(void); static int ConsoleInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); static int ConsoleOutputProc(ClientData instanceData, CONST char *buf, int toWrite, int *errorCode); static DWORD WINAPI ConsoleReaderThread(LPVOID arg); static void ConsoleSetupProc(ClientData clientData, int flags); static void ConsoleWatchProc(ClientData instanceData, int mask); static DWORD WINAPI ConsoleWriterThread(LPVOID arg); static void ProcExitHandler(ClientData clientData); static int WaitForRead(ConsoleInfo *infoPtr, int blocking); static void ConsoleThreadActionProc _ANSI_ARGS_ (( ClientData instanceData, int action)); /* * This structure describes the channel type structure for command console * based IO. */ static Tcl_ChannelType consoleChannelType = { "console", /* Type name. */ TCL_CHANNEL_VERSION_2, /* v2 channel */ TCL_CHANNEL_VERSION_4, /* v4 channel */ ConsoleCloseProc, /* Close proc. */ ConsoleInputProc, /* Input proc. */ ConsoleOutputProc, /* Output proc. */ NULL, /* Seek proc. */ NULL, /* Set option proc. */ NULL, /* Get option proc. */ ConsoleWatchProc, /* Set up notifier to watch the channel. */ ConsoleGetHandleProc, /* Get an OS handle from channel. */ NULL, /* close2proc. */ ConsoleBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc */ ConsoleThreadActionProc, /* thread action proc */ };  /* *---------------------------------------------------------------------- * * ConsoleInit -- * * This function initializes the static variables for this file. * * Results: * None. * * Side effects: * Creates a new event source. * *---------------------------------------------------------------------- */ static ThreadSpecificData * static void ConsoleInit() { ThreadSpecificData *tsdPtr; /* * Check the initialized flag first, then check again in the mutex. * This is a speed enhancement.
︙
220 221 222 223 224 225 226 227 228 229 230 231 232 233 234	225 226 227 228 229 230 231 232 233 234 235 236 237 238	-	tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->firstConsolePtr = NULL; Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL); Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL); } return tsdPtr; }  /* *---------------------------------------------------------------------- * * ConsoleExitHandler -- *
︙
1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180	1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187	+ + - + +	/* * Alert the foreground thread. Note that we need to treat this like * a critical section so the foreground thread does not terminate * this thread while we are holding a mutex in the notifier code. */ Tcl_MutexLock(&consoleMutex); if (infoPtr->threadId != NULL) { /* TIP #218. When in flight ignore the event, no one will receive it anyway */ Tcl_ThreadAlert(infoPtr->threadId); Tcl_ThreadAlert(infoPtr->threadId); } Tcl_MutexUnlock(&consoleMutex); } return 0; }  /*
︙
1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266	1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276	+ + - + +	/* * Alert the foreground thread. Note that we need to treat this like * a critical section so the foreground thread does not terminate * this thread while we are holding a mutex in the notifier code. */ Tcl_MutexLock(&consoleMutex); if (infoPtr->threadId != NULL) { /* TIP #218. When in flight ignore the event, no one will receive it anyway */ Tcl_ThreadAlert(infoPtr->threadId); Tcl_ThreadAlert(infoPtr->threadId); } Tcl_MutexUnlock(&consoleMutex); } return 0; }
︙
1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330	1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340	- - + + + + - -	TclWinOpenConsoleChannel(handle, channelName, permissions) HANDLE handle; char *channelName; int permissions; { char encoding[4 + TCL_INTEGER_SPACE]; ConsoleInfo *infoPtr; ThreadSpecificData *tsdPtr; DWORD id, modes; tsdPtr = ConsoleInit(); ConsoleInit(); /* * See if a channel with this handle already exists. */ infoPtr = (ConsoleInfo *) ckalloc((unsigned) sizeof(ConsoleInfo)); memset(infoPtr, 0, sizeof(ConsoleInfo)); infoPtr->validMask = permissions; infoPtr->handle = handle; infoPtr->channel = (Tcl_Channel) NULL; wsprintfA(encoding, "cp%d", GetConsoleCP()); infoPtr->threadId = Tcl_GetCurrentThread(); /* * Use the pointer for the name of the result channel. * This keeps the channel names unique, since some may share * handles (stdin/stdout/stderr for instance). */ wsprintfA(channelName, "file%lx", (int) infoPtr); infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName, (ClientData) infoPtr, permissions); infoPtr->threadId = Tcl_GetCurrentThread(); if (permissions & TCL_READABLE) { /* * Make sure the console input buffer is ready for only character * input notifications and the buffer is set for line buffering. * IOW, we only want to catch when complete lines are ready for * reading. */
︙
1357 1358 1359 1360 1361 1362 1363	1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding); return infoPtr->channel; }  /* *---------------------------------------------------------------------- * * ConsoleThreadActionProc -- * * Insert or remove any thread local refs to this channel. * * Results: * None. * * Side effects: * Changes thread local list of valid channels. * *---------------------------------------------------------------------- */ static void ConsoleThreadActionProc (instanceData, action) ClientData instanceData; int action; { ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData; /* We do not access firstConsolePtr in the thread structures. This is * not for all serials managed by the thread, but only those we are * watching. Removal of the filevent handlers before transfer thus * takes care of this structure. */ Tcl_MutexLock(&consoleMutex); if (action == TCL_CHANNEL_THREAD_INSERT) { /* We can't copy the thread information from the channel when * the channel is created. At this time the channel back * pointer has not been set yet. However in that case the * threadId has already been set by TclpCreateCommandChannel * itself, so the structure is still good. */ ConsoleInit (); if (infoPtr->channel != NULL) { infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel); } } else { infoPtr->threadId = NULL; } Tcl_MutexUnlock(&consoleMutex); }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24	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	- + + +	/* * tclWinDde.c -- * * This file provides procedures that implement the "send" * command, allowing commands to be passed from interpreter * to interpreter. * * Copyright (c) 1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclWinDde.c,v 1.13 2003/03/03 17:12:48 dgp Exp $ * RCS: @(#) $Id: tclWinDde.c,v 1.13.2.7 2006/04/05 20:50:46 dgp Exp $ */ #include "tclPort.h" #include <dde.h> #include <ddeml.h> #include <tchar.h> /* * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the * Registry_Init declaration is in the source file itself, which is only * accessed when we are building a library. */
︙
65 66 67 68 69 70 71 72 73 74 75 76 77 78 79	67 68 69 70 71 72 73 74 75 76 77 78 79 80 81	- +	* The Mutex ddeMutex guards access to the ddeInstance. */ static HSZ ddeServiceGlobal = 0; static DWORD ddeInstance; /* The application instance handle given * to us by DdeInitialize. */ static int ddeIsServer = 0; #define TCL_DDE_VERSION "1.2.1" #define TCL_DDE_VERSION "1.2.4" #define TCL_DDE_PACKAGE_NAME "dde" #define TCL_DDE_SERVICE_NAME "TclEval" TCL_DECLARE_MUTEX(ddeMutex) /* * Forward declarations for procedures defined later in this file.
︙
87 88 89 90 91 92 93 94 95 96 97 98 99 100	89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106	+ + + +	static int MakeDdeConnection _ANSI_ARGS_((Tcl_Interp *interp, char *name, HCONV *ddeConvPtr)); static HDDEDATA CALLBACK DdeServerProc _ANSI_ARGS_((UINT uType, UINT uFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2)); static void SetDdeError _ANSI_ARGS_((Tcl_Interp *interp)); static int DdeGetServicesList _ANSI_ARGS_(( Tcl_Interp *interp, char *serviceName, char *topicName)); int Tcl_DdeObjCmd(ClientData clientData, /* Used only for deletion */ Tcl_Interp *interp, /* The interp we are sending from */ int objc, /* Number of arguments */ Tcl_Obj *CONST objv[]); /* The arguments */ EXTERN int Dde_Init(Tcl_Interp *interp);
︙
287 288 289 290 291 292 293 294 295 296 297 298 299 300 301	293 294 295 296 297 298 299 300 301 302 303 304 305 306 307	- +	/* * We have found a unique name. Now add it to the registry. */ riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp)); riPtr->interp = interp; riPtr->name = ckalloc(strlen(name) + 1); riPtr->name = ckalloc((unsigned int) strlen(name) + 1); riPtr->nextPtr = tsdPtr->interpListPtr; tsdPtr->interpListPtr = riPtr; strcpy(riPtr->name, name); Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, (ClientData) riPtr, DeleteProc); if (Tcl_IsSafe(interp)) {
︙
751 752 753 754 755 756 757 758 759 760 761 762 763 764	757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	*ddeConvPtr = ddeConv; return TCL_OK; }  /* *-------------------------------------------------------------- * * DdeGetServicesList -- * * This procedure obtains the list of DDE services. * * The functions between here and this procedure are all * involved with handling the DDE callbacks for this. * * Results: * A standard Tcl result. * * Side effects: * Sets the services list into the interp result. * *-------------------------------------------------------------- */ typedef struct ddeEnumServices { Tcl_Interp *interp; int result; ATOM service; ATOM topic; HWND hwnd; } ddeEnumServices; LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam); static LRESULT DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam); static int DdeCreateClient(ddeEnumServices *es) { WNDCLASSEX wc; static const char *szDdeClientClassName = "TclEval client class"; static const char *szDdeClientWindowName = "TclEval client window"; memset(&wc, 0, sizeof(wc)); wc.cbSize = sizeof(wc); wc.lpfnWndProc = DdeClientWindowProc; wc.lpszClassName = szDdeClientClassName; wc.cbWndExtra = sizeof(ddeEnumServices*); /* register and create the callback window */ RegisterClassEx(&wc); es->hwnd = CreateWindowEx(0, szDdeClientClassName, szDdeClientWindowName, WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL, (LPVOID)es); return TCL_OK; } LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) { LRESULT lr = 0L; switch (uMsg) { case WM_CREATE: { LPCREATESTRUCT lpcs = (LPCREATESTRUCT)lParam; ddeEnumServices *es; es = (ddeEnumServices*)lpcs->lpCreateParams; #ifdef _WIN64 SetWindowLongPtr(hwnd, GWLP_USERDATA, (long)es); #else SetWindowLong(hwnd, GWL_USERDATA, (long)es); #endif break; } case WM_DDE_ACK: lr = DdeServicesOnAck(hwnd, wParam, lParam); break; default: lr = DefWindowProc(hwnd, uMsg, wParam, lParam); } return lr; } static LRESULT DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam) { HWND hwndRemote = (HWND)wParam; ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); ddeEnumServices *es; TCHAR sz[255]; #ifdef _WIN64 es = (ddeEnumServices *)GetWindowLongPtr(hwnd, GWLP_USERDATA); #else es = (ddeEnumServices *)GetWindowLong(hwnd, GWL_USERDATA); #endif if ((es->service == (ATOM)NULL || es->service == service) && (es->topic == (ATOM)NULL || es->topic == topic)) { Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL); GlobalGetAtomName(service, sz, 255); Tcl_ListObjAppendElement(es->interp, matchPtr, Tcl_NewStringObj(sz, -1)); GlobalGetAtomName(topic, sz, 255); Tcl_ListObjAppendElement(es->interp, matchPtr, Tcl_NewStringObj(sz, -1)); /* Adding the hwnd as a third list element provides a unique * identifier in the case of multiple servers with the name * application and topic names. */ /* Needs a TIP though * Tcl_ListObjAppendElement(es->interp, matchPtr, * Tcl_NewLongObj((long)hwndRemote)); */ Tcl_ListObjAppendElement(es->interp, Tcl_GetObjResult(es->interp), matchPtr); } /* tell the server we are no longer interested */ PostMessage(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L); return 0L; } static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam) { LRESULT dwResult = 0; ddeEnumServices *es = (ddeEnumServices *)lParam; SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000, &dwResult); return TRUE; } static int DdeGetServicesList(Tcl_Interp *interp, char *serviceName, char *topicName) { ddeEnumServices es; int r = TCL_OK; es.interp = interp; es.result = TCL_OK; es.service = (serviceName == NULL) ? (ATOM)NULL : GlobalAddAtom(serviceName); es.topic = (topicName == NULL) ? (ATOM)NULL : GlobalAddAtom(topicName); Tcl_ResetResult(interp); /* our list is to be appended to result. */ DdeCreateClient(&es); EnumWindows(DdeEnumWindowsCallback, (LPARAM)&es); if (IsWindow(es.hwnd)) DestroyWindow(es.hwnd); if (es.service != (ATOM)NULL) GlobalDeleteAtom(es.service); if (es.topic != (ATOM)NULL) GlobalDeleteAtom(es.topic); return es.result; }  /* *-------------------------------------------------------------- * * SetDdeError -- * * Sets the interp result to a cogent error message * describing the last DDE error. * * Results: * None.
︙
1128 1129 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 1174 1175 1176 1177 1178 1179 1180 1181	1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307	- - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -	result = TCL_ERROR; } } break; } case DDE_SERVICES: { HCONVLIST hConvList; CONVINFO convInfo; Tcl_Obj *convListObjPtr, *elementObjPtr; Tcl_DString dString; char *name; result = DdeGetServicesList(interp, serviceName, topicName); convInfo.cb = sizeof(CONVINFO); hConvList = DdeConnectList(ddeInstance, ddeService, ddeTopic, 0, NULL); DdeFreeStringHandle(ddeInstance,ddeService); DdeFreeStringHandle(ddeInstance, ddeTopic); hConv = 0; convListObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); Tcl_DStringInit(&dString); while (hConv = DdeQueryNextServer(hConvList, hConv), hConv != 0) { elementObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); DdeQueryConvInfo(hConv, QID_SYNC, &convInfo); length = DdeQueryString(ddeInstance, convInfo.hszSvcPartner, NULL, 0, CP_WINANSI); Tcl_DStringSetLength(&dString, length); name = Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, convInfo.hszSvcPartner, name, (DWORD) length + 1, CP_WINANSI); Tcl_ListObjAppendElement(interp, elementObjPtr, Tcl_NewStringObj(name, length)); length = DdeQueryString(ddeInstance, convInfo.hszTopic, NULL, 0, CP_WINANSI); Tcl_DStringSetLength(&dString, length); name = Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, convInfo.hszTopic, name, (DWORD) length + 1, CP_WINANSI); Tcl_ListObjAppendElement(interp, elementObjPtr, Tcl_NewStringObj(name, length)); Tcl_ListObjAppendElement(interp, convListObjPtr, elementObjPtr); } DdeDisconnectList(hConvList); Tcl_SetObjResult(interp, convListObjPtr); Tcl_DStringFree(&dString); break; } case DDE_EVAL: { if (serviceName == NULL) { Tcl_SetStringObj(Tcl_GetObjResult(interp), "invalid service name \"\"", -1); goto errorNoResult;
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	/* * tclWinFCmd.c * * This file implements the Windows specific portion of file manipulation * subcommands of the "file" command. * * Copyright (c) 1996-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclWinFCmd.c,v 1.35 2003/02/07 15:29:33 vincentdarley Exp $ * RCS: @(#) $Id: tclWinFCmd.c,v 1.35.2.5 2006/08/30 17:48:48 hobbs Exp $ */ #include "tclWinInt.h" /* * The following constants specify the type of callback when * TraverseWinTree() calls the traverseProc()
︙
69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90	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	- - - - - - + + + + + + + + + + + + + + + + + + - - +	{GetWinFileAttributes, SetWinFileAttributes}, {GetWinFileAttributes, SetWinFileAttributes}, {GetWinFileLongName, CannotSetAttribute}, {GetWinFileAttributes, SetWinFileAttributes}, {GetWinFileShortName, CannotSetAttribute}, {GetWinFileAttributes, SetWinFileAttributes}}; #if defined(HAVE_NO_SEH) && defined(TCL_MEM_DEBUG) static void *INITIAL_ESP, *INITIAL_EBP, *INITIAL_HANDLER, *RESTORED_ESP, *RESTORED_EBP, #ifdef HAVE_NO_SEH /* * Unlike Borland and Microsoft, we don't register exception handlers * by pushing registration records onto the runtime stack. Instead, we * register them by creating an EXCEPTION_REGISTRATION within the activation * record. */ typedef struct EXCEPTION_REGISTRATION { struct EXCEPTION_REGISTRATION* link; EXCEPTION_DISPOSITION (*handler)( struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void* ); void* ebp; void* esp; int status; } EXCEPTION_REGISTRATION; *RESTORED_HANDLER; #endif /* HAVE_NO_SEH && TCL_MEM_DEBUG */ #endif /* * Prototype for the TraverseWinTree callback function. */ typedef int (TraversalProc)(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, int type, Tcl_DString *errorPtr);
︙
167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259	178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302	+ + + - + - - - - - - - - - - - - - - - - - + + - + + + + + + + + + + - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + - - - - - - + + + + + - - - + + + + + - - - - - - - + + + + + - - - - - + + + + + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + +	static int DoRenameFile( CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed * (native). */ CONST TCHAR *nativeDst) /* New pathname for file or directory * (native). */ { #ifdef HAVE_NO_SEH EXCEPTION_REGISTRATION registration; #endif DWORD srcAttr, dstAttr; int retval = -1; /* * The MoveFile API acts differently under Win95/98 and NT * WRT NULL and "". Avoid passing these values. */ if (nativeSrc == NULL || nativeSrc[0] == '\0' || nativeDst == NULL || nativeDst[0] == '\0') { Tcl_SetErrno(ENOENT); return TCL_ERROR; } /* * The MoveFile API would throw an exception under NT * if one of the arguments is a char block device. */ #ifdef HAVE_NO_SEH #ifndef HAVE_NO_SEH # ifdef TCL_MEM_DEBUG __asm__ __volatile__ ( "movl %%esp, %0" "\n\t" "movl %%ebp, %1" "\n\t" "movl %%fs:0, %2" "\n\t" : "=m"(INITIAL_ESP), "=m"(INITIAL_EBP), "=r"(INITIAL_HANDLER) ); # endif /* TCL_MEM_DEBUG */ __asm__ __volatile__ ( "pushl %ebp" "\n\t" "pushl $__except_dorenamefile_handler" "\n\t" "pushl %fs:0" "\n\t" "movl %esp, %fs:0"); #else __try { #endif /* HAVE_NO_SEH */ if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { retval = TCL_OK; } } __except (EXCEPTION_EXECUTE_HANDLER) {} #else #ifdef HAVE_NO_SEH /* * Don't have SEH available, do things the hard way. * Note that this needs to be one block of asm, to avoid stack * imbalance; also, it is illegal for one asm block to contain * a jump to another. */ __asm__ __volatile__ ( /* * Pick up params before messing with the stack */ "jmp dorenamefile_pop" "\n" "dorenamefile_reentry:" "\n\t" "movl %%fs:0, %%eax" "\n\t" "movl 0x8(%%eax), %%esp" "\n\t" "movl 0x8(%%esp), %%ebp" "\n" "dorenamefile_pop:" "\n\t" "movl (%%esp), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" "add $12, %%esp" "\n\t" : : : "%eax"); "movl %[nativeDst], %%ebx" "\n\t" "movl %[nativeSrc], %%ecx" "\n\t" /* * Construct an EXCEPTION_REGISTRATION to protect the * call to MoveFile */ "leal %[registration], %%edx" "\n\t" "movl %%fs:0, %%eax" "\n\t" "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ "leal 1f, %%eax" "\n\t" "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* Link the EXCEPTION_REGISTRATION on the chain */ "movl %%edx, %%fs:0" "\n\t" /* Call MoveFile( nativeSrc, nativeDst ) */ # ifdef TCL_MEM_DEBUG __asm__ __volatile__ ( "movl %%esp, %0" "\n\t" "movl %%ebp, %1" "\n\t" "movl %%fs:0, %2" "\n\t" : "=m"(RESTORED_ESP), "pushl %%ebx" "\n\t" "pushl %%ecx" "\n\t" "movl %[moveFile], %%eax" "\n\t" "call *%%eax" "\n\t" "=m"(RESTORED_EBP), "=r"(RESTORED_HANDLER) ); /* * Come here on normal exit. Recover the EXCEPTION_REGISTRATION * and put the status return from MoveFile into it. */ if (INITIAL_ESP != RESTORED_ESP) panic("ESP restored incorrectly"); if (INITIAL_EBP != RESTORED_EBP) panic("EBP restored incorrectly"); if (INITIAL_HANDLER != RESTORED_HANDLER) panic("HANDLER restored incorrectly"); # endif /* TCL_MEM_DEBUG */ "movl %%fs:0, %%edx" "\n\t" "movl %%eax, 0x10(%%edx)" "\n\t" "jmp 2f" "\n" /* #else } __except (EXCEPTION_EXECUTE_HANDLER) {} #endif /* HAVE_NO_SEH */ /* * Come here on an exception. Recover the EXCEPTION_REGISTRATION */ "1:" "\t" "movl %%fs:0, %%edx" "\n\t" "movl 0x8(%%edx), %%edx" "\n\t" /* * Avoid using control flow statements in the SEH guarded block! */ * Come here however we exited. Restore context from the * EXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" "movl 0xc(%%edx), %%esp" "\n\t" "movl 0x8(%%edx), %%ebp" "\n\t" "movl 0x0(%%edx), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" : /* No outputs */ : [registration] "m" (registration), [nativeDst] "m" (nativeDst), [nativeSrc] "m" (nativeSrc), [moveFile] "r" (tclWinProcs->moveFileProc) : "%eax", "%ebx", "%ecx", "%edx", "memory" ); if (registration.status != FALSE) { retval = TCL_OK; } #endif if (retval != -1) return retval; TclWinConvertError(GetLastError()); srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
︙
463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493	506 507 508 509 510 511 512 513 514 515 516 517 518 519	- - - - - - - - - - - - - - - - -	} return result; } } } return TCL_ERROR; } #ifdef HAVE_NO_SEH static __attribute__ ((cdecl)) EXCEPTION_DISPOSITION _except_dorenamefile_handler( struct _EXCEPTION_RECORD *ExceptionRecord, void *EstablisherFrame, struct _CONTEXT *ContextRecord, void *DispatcherContext) { __asm__ __volatile__ ( "jmp dorenamefile_reentry"); /* Nuke compiler warning about unused static function */ _except_dorenamefile_handler(NULL, NULL, NULL, NULL); return 0; /* Function does not return */ } #endif /* HAVE_NO_SEH */  /* *--------------------------------------------------------------------------- * * TclpObjCopyFile, DoCopyFile -- * * Copy a single file (not a directory). If dst already exists and
︙
522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613	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 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673	+ + + - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	} static int DoCopyFile( CONST TCHAR *nativeSrc, /* Pathname of file to be copied (native). */ CONST TCHAR *nativeDst) /* Pathname of file to copy to (native). */ { #ifdef HAVE_NO_SEH EXCEPTION_REGISTRATION registration; #endif int retval = -1; /* * The CopyFile API acts differently under Win95/98 and NT * WRT NULL and "". Avoid passing these values. */ if (nativeSrc == NULL || nativeSrc[0] == '\0' || nativeDst == NULL || nativeDst[0] == '\0') { Tcl_SetErrno(ENOENT); return TCL_ERROR; } /* * The CopyFile API would throw an exception under NT if one * of the arguments is a char block device. */ #ifdef HAVE_NO_SEH #ifndef HAVE_NO_SEH # ifdef TCL_MEM_DEBUG __asm__ __volatile__ ( "movl %%esp, %0" "\n\t" "movl %%ebp, %1" "\n\t" "movl %%fs:0, %2" "\n\t" : "=m"(INITIAL_ESP), "=m"(INITIAL_EBP), "=r"(INITIAL_HANDLER) ); # endif /* TCL_MEM_DEBUG */ __asm__ __volatile__ ( "pushl %ebp" "\n\t" "pushl $__except_docopyfile_handler" "\n\t" "pushl %fs:0" "\n\t" "movl %esp, %fs:0"); #else __try { #endif /* HAVE_NO_SEH */ if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) { retval = TCL_OK; } #ifdef HAVE_NO_SEH __asm__ __volatile__ ( "jmp docopyfile_pop" "\n" "docopyfile_reentry:" "\n\t" "movl %%fs:0, %%eax" "\n\t" "movl 0x8(%%eax), %%esp" "\n\t" "movl 0x8(%%esp), %%ebp" "\n" "docopyfile_pop:" "\n\t" "movl (%%esp), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" "add $12, %%esp" "\n\t" : : : "%eax"); } __except (EXCEPTION_EXECUTE_HANDLER) {} # ifdef TCL_MEM_DEBUG __asm__ __volatile__ ( "movl %%esp, %0" "\n\t" "movl %%ebp, %1" "\n\t" "movl %%fs:0, %2" "\n\t" : "=m"(RESTORED_ESP), "=m"(RESTORED_EBP), "=r"(RESTORED_HANDLER) ); if (INITIAL_ESP != RESTORED_ESP) panic("ESP restored incorrectly"); if (INITIAL_EBP != RESTORED_EBP) panic("EBP restored incorrectly"); if (INITIAL_HANDLER != RESTORED_HANDLER) panic("HANDLER restored incorrectly"); # endif /* TCL_MEM_DEBUG */ #else } __except (EXCEPTION_EXECUTE_HANDLER) {} #endif /* HAVE_NO_SEH */ /* * Avoid using control flow statements in the SEH guarded block! * Don't have SEH available, do things the hard way. * Note that this needs to be one block of asm, to avoid stack * imbalance; also, it is illegal for one asm block to contain * a jump to another. */ __asm__ __volatile__ ( /* * Pick up parameters before messing with the stack */ "movl %[nativeDst], %%ebx" "\n\t" "movl %[nativeSrc], %%ecx" "\n\t" /* * Construct an EXCEPTION_REGISTRATION to protect the * call to CopyFile */ "leal %[registration], %%edx" "\n\t" "movl %%fs:0, %%eax" "\n\t" "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ "leal 1f, %%eax" "\n\t" "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* Link the EXCEPTION_REGISTRATION on the chain */ "movl %%edx, %%fs:0" "\n\t" /* Call CopyFile( nativeSrc, nativeDst, 0 ) */ "movl %[copyFile], %%eax" "\n\t" "pushl $0" "\n\t" "pushl %%ebx" "\n\t" "pushl %%ecx" "\n\t" "call *%%eax" "\n\t" /* * Come here on normal exit. Recover the EXCEPTION_REGISTRATION * and put the status return from CopyFile into it. */ "movl %%fs:0, %%edx" "\n\t" "movl %%eax, 0x10(%%edx)" "\n\t" "jmp 2f" "\n" /* * Come here on an exception. Recover the EXCEPTION_REGISTRATION */ "1:" "\t" "movl %%fs:0, %%edx" "\n\t" "movl 0x8(%%edx), %%edx" "\n\t" /* * Come here however we exited. Restore context from the * EXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" "movl 0xc(%%edx), %%esp" "\n\t" "movl 0x8(%%edx), %%ebp" "\n\t" "movl 0x0(%%edx), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" : /* No outputs */ : [registration] "m" (registration), [nativeDst] "m" (nativeDst), [nativeSrc] "m" (nativeSrc), [copyFile] "r" (tclWinProcs->copyFileProc) : "%eax", "%ebx", "%ecx", "%edx", "memory" ); if (registration.status != FALSE) { retval = TCL_OK; } #endif if (retval != -1) return retval; TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EBADF) { Tcl_SetErrno(EACCES); return TCL_ERROR;
︙
645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674	705 706 707 708 709 710 711 712 713 714 715 716 717 718	- - - - - - - - - - - - - - - -	TclWinConvertError(GetLastError()); (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr); } } } return TCL_ERROR; } #ifdef HAVE_NO_SEH static __attribute__ ((cdecl)) EXCEPTION_DISPOSITION _except_docopyfile_handler( struct _EXCEPTION_RECORD *ExceptionRecord, void *EstablisherFrame, struct _CONTEXT *ContextRecord, void *DispatcherContext) { __asm__ __volatile__ ( "jmp docopyfile_reentry"); _except_docopyfile_handler(NULL,NULL,NULL,NULL); return 0; /* Function does not return */ } #endif /* HAVE_NO_SEH */  /* *--------------------------------------------------------------------------- * * TclpObjDeleteFile, TclpDeleteFile -- * * Removes a single file (not a directory).
︙
850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877	894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934	+ - - - - + + + + + + + + + + + + + + + - + +	TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) Tcl_Obj *srcPathPtr; Tcl_Obj *destPathPtr; Tcl_Obj **errorPtr; { Tcl_DString ds; Tcl_DString srcString, dstString; Tcl_Obj *normSrcPtr, *normDestPtr; int ret; Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr), -1, &srcString); Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,destPathPtr), -1, &dstString); normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr); if (normSrcPtr == NULL) { return TCL_ERROR; } Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString); normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr); if (normDestPtr == NULL) { return TCL_ERROR; } Tcl_WinUtfToTChar(Tcl_GetString(normDestPtr), -1, &dstString); ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds); Tcl_DStringFree(&srcString); Tcl_DStringFree(&dstString); if (ret != TCL_OK) { if (!strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normSrcPtr))) { *errorPtr = srcPathPtr; } else if (!strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normDestPtr))) { *errorPtr = destPathPtr; } else { *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); } Tcl_DStringFree(&ds); Tcl_IncrRefCount(*errorPtr); } return ret; }  /*
︙
906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939	963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005	+ - - + + + + + + + + + - + +	int TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) Tcl_Obj *pathPtr; int recursive; Tcl_Obj **errorPtr; { Tcl_DString ds; Tcl_Obj *normPtr = NULL; int ret; if (recursive) { /* * In the recursive case, the string rep is used to construct a * Tcl_DString which may be used extensively, so we can't * optimize this case easily. */ Tcl_DString native; Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL, pathPtr), -1, &native); normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normPtr == NULL) { return TCL_ERROR; } Tcl_WinUtfToTChar(Tcl_GetString(normPtr), -1, &native); ret = DoRemoveDirectory(&native, recursive, &ds); Tcl_DStringFree(&native); } else { ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 0, &ds); } if (ret != TCL_OK) { int len = Tcl_DStringLength(&ds); if (len > 0) { if (normPtr != NULL && !strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normPtr))) { *errorPtr = pathPtr; } else { *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); } Tcl_IncrRefCount(*errorPtr); } Tcl_DStringFree(&ds); } return ret; }
︙
1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232	1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298	- +	wp++; } if (*wp == '\0') { continue; } } nativeName = (TCHAR *) data.w.cFileName; len = Tcl_UniCharLen(data.w.cFileName) * sizeof(WCHAR); len = wcslen(data.w.cFileName) * sizeof(WCHAR); } else { if ((strcmp(data.a.cFileName, ".") == 0) || (strcmp(data.a.cFileName, "..") == 0)) { continue; } nativeName = (TCHAR *) data.a.cFileName; len = strlen(data.a.cFileName);
︙
1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297	1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363	- +	if (nativeErrfile != NULL) { TclWinConvertError(GetLastError()); if (errorPtr != NULL) { Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr); } result = TCL_ERROR; } return result; }  /* *---------------------------------------------------------------------- * * TraversalCopy
︙

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	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	- + + + + + + + +	/* * tclWinFile.c -- * * This file contains temporary wrappers around UNIX file handling * functions. These wrappers map the UNIX functions to Win32 HANDLE-style * files, which can be manipulated through the Win32 console redirection * interfaces. * * Copyright (c) 1995-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclWinFile.c,v 1.44 2003/02/10 12:50:32 vincentdarley Exp $ * RCS: @(#) $Id: tclWinFile.c,v 1.44.2.18 2006/10/17 04:36:45 dgp Exp $ */ //#define _WIN32_WINNT 0x0500 #include "tclWinInt.h" #include <winioctl.h> #include <sys/stat.h> #include <shlobj.h> #include <lmaccess.h> /* For TclpGetUserHome(). */ /* * The number of 100-ns intervals between the Windows system epoch (1601-01-01 * on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01). */ #define POSIX_EPOCH_AS_FILETIME 116444736000000000 /* * Declarations for 'link' related information. This information * should come with VC++ 6.0, but is not in some older SDKs. * In any case it is not well documented. */ #ifndef IO_REPARSE_TAG_RESERVED_ONE # define IO_REPARSE_TAG_RESERVED_ONE 0x000000001
︙
71 72 73 74 75 76 77 78 79 80 81 82 83 84	78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94	+ + +	# define FILE_SPECIAL_ACCESS (FILE_ANY_ACCESS) #endif #ifndef FSCTL_SET_REPARSE_POINT # define FSCTL_SET_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 41, METHOD_BUFFERED, FILE_SPECIAL_ACCESS) # define FSCTL_GET_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS) # define FSCTL_DELETE_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 43, METHOD_BUFFERED, FILE_SPECIAL_ACCESS) #endif #ifndef INVALID_FILE_ATTRIBUTES #define INVALID_FILE_ATTRIBUTES ((DWORD)-1) #endif /* * Maximum reparse buffer info size. The max user defined reparse * data is 16KB, plus there's a header. */ #define MAX_REPARSE_SIZE 17000
︙
123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140	133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171	+ + + + + + + + + + + + + + + + + + + + +	} REPARSE_DATA_BUFFER; #endif typedef struct { REPARSE_DATA_BUFFER dummy; WCHAR dummyBuf[MAX_PATH*3]; } DUMMY_REPARSE_BUFFER; #if defined(_MSC_VER) && ( _MSC_VER <= 1100 ) #define HAVE_NO_FINDEX_ENUMS #elif !defined(_WIN32_WINNT) || (_WIN32_WINNT < 0x0400) #define HAVE_NO_FINDEX_ENUMS #endif #ifdef HAVE_NO_FINDEX_ENUMS /* These two aren't in VC++ 5.2 headers */ typedef enum _FINDEX_INFO_LEVELS { FindExInfoStandard, FindExInfoMaxInfoLevel } FINDEX_INFO_LEVELS; typedef enum _FINDEX_SEARCH_OPS { FindExSearchNameMatch, FindExSearchLimitToDirectories, FindExSearchLimitToDevices, FindExSearchMaxSearchOp } FINDEX_SEARCH_OPS; #endif /* HAVE_NO_FINDEX_ENUMS */ /* Other typedefs required by this code */ static time_t ToCTime(FILETIME fileTime); static void FromCTime(time_t posixTime, FILETIME *fileTime); typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC (LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr); typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC (LPVOID Buffer);
︙
152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172	183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203	+ -	static int NativeReadReparse(CONST TCHAR* LinkDirectory, REPARSE_DATA_BUFFER* buffer); static int NativeWriteReparse(CONST TCHAR* LinkDirectory, REPARSE_DATA_BUFFER* buffer); static int NativeMatchType(int isDrive, DWORD attr, CONST TCHAR* nativeName, Tcl_GlobTypeData *types); static int WinIsDrive(CONST char *name, int nameLen); static int WinIsReserved(CONST char *path); static Tcl_Obj* WinReadLink(CONST TCHAR* LinkSource); static Tcl_Obj* WinReadLinkDirectory(CONST TCHAR* LinkDirectory); static int WinLink(CONST TCHAR* LinkSource, CONST TCHAR* LinkTarget, int linkAction); static int WinSymLinkDirectory(CONST TCHAR* LinkDirectory, CONST TCHAR* LinkTarget);  /* *-------------------------------------------------------------------- * * WinLink * * Make a link from source to target.
︙
245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260	276 277 278 279 280 281 282 283 284 285 286 287 288 289 290	- + -	}  /* *-------------------------------------------------------------------- * * WinReadLink * * What does 'LinkSource' point to? We need the original 'pathPtr' * What does 'LinkSource' point to? * just so we can construct a path object in the correct filesystem. *-------------------------------------------------------------------- */ static Tcl_Obj* WinReadLink(LinkSource) CONST TCHAR* LinkSource; { WCHAR tempFileName[MAX_PATH];
︙
425 426 427 428 429 430 431 432 433 434 435 436 437 438 439	455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473	- + + + + +	* * This routine reads a NTFS junction, using the undocumented * FSCTL_GET_REPARSE_POINT structure Win2K uses for mount points * and junctions. * * Assumption that LinkDirectory is a valid, existing directory. * * Returns a Tcl_Obj with refCount of 1 (i.e. owned by the caller). * Returns a Tcl_Obj with refCount of 1 (i.e. owned by the caller), * or NULL if anything went wrong. * * In the future we should enhance this to return a path object * rather than a string. *-------------------------------------------------------------------- */ static Tcl_Obj* WinReadLinkDirectory(LinkDirectory) CONST TCHAR* LinkDirectory; { int attr;
︙
453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488	487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571	- + - - - - - + - - - - - + + + + + + + + + + + - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	case 0x80000000|IO_REPARSE_TAG_SYMBOLIC_LINK: case IO_REPARSE_TAG_SYMBOLIC_LINK: case IO_REPARSE_TAG_MOUNT_POINT: { Tcl_Obj *retVal; Tcl_DString ds; CONST char *copy; int len; int offset = 0; Tcl_WinTCharToUtf( (CONST char*)reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, (int)reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength, &ds); copy = Tcl_DStringValue(&ds); len = Tcl_DStringLength(&ds); /* * Certain native path representations on Windows have this special * prefix to indicate that they are to be treated specially. For * example extremely long paths, or symlinks * Certain native path representations on Windows have a * special prefix to indicate that they are to be treated * specially. For example extremely long paths, or symlinks, * or volumes mounted inside directories. * * There is an assumption in this code that 'wide' interfaces * are being used (see tclWin32Dll.c), which is true for the * only systems which support reparse tags at present. If * that changes in the future, this code will have to be * generalised. */ if (reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer[0] if (*copy == '\\') { if (0 == strncmp(copy,"\\??\\",4)) { copy += 4; len -= 4; } else if (0 == strncmp(copy,"\\\\?\\",4)) { copy += 4; len -= 4; == L'\\') { /* Check whether this is a mounted volume */ if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, L"\\??\\Volume{",11) == 0) { char drive; /* * There is some confusion between \??\ and \\?\ which * we have to fix here. It doesn't seem very well * documented. */ reparseBuffer->SymbolicLinkReparseBuffer .PathBuffer[1] = L'\\'; /* * Check if a corresponding drive letter exists, and * use that if it is found */ drive = TclWinDriveLetterForVolMountPoint(reparseBuffer ->SymbolicLinkReparseBuffer.PathBuffer); if (drive != -1) { char driveSpec[3] = { drive, ':', '\0' }; retVal = Tcl_NewStringObj(driveSpec,2); Tcl_IncrRefCount(retVal); return retVal; } /* * This is actually a mounted drive, which doesn't * exists as a DOS drive letter. This means the path * isn't actually a link, although we partially treat * it like one ('file type' will return 'link'), but * then the link will actually just be treated like * an ordinary directory. I don't believe any * serious inconsistency will arise from this, but it * is something to be aware of. */ Tcl_SetErrno(EINVAL); return NULL; } else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer .PathBuffer, L"\\\\?\\",4) == 0) { /* Strip off the prefix */ offset = 4; } else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer .PathBuffer, L"\\??\\",4) == 0) { /* Strip off the prefix */ offset = 4; } } Tcl_WinTCharToUtf( (CONST char*)reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, (int)reparseBuffer->SymbolicLinkReparseBuffer .SubstituteNameLength, &ds); copy = Tcl_DStringValue(&ds)+offset; len = Tcl_DStringLength(&ds)-offset; retVal = Tcl_NewStringObj(copy,len); Tcl_IncrRefCount(retVal); Tcl_DStringFree(&ds); return retVal; } } Tcl_SetErrno(EINVAL);
︙
588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642	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 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727	- - - + + + - - - + + - + - - - - - + + + + + + + + + -	* * TclpFindExecutable -- * * This procedure computes the absolute path name of the current * application, given its argv[0] value. * * Results: * A dirty UTF string that is the path to the executable. At this * point we may not know the system encoding. Convert the native * string value to UTF using the default encoding. The assumption * A clean UTF string that is the path to the executable. At this * point we may not know the system encoding, but we convert the * string value to UTF-8 using core Windows functions. The path name * is that we will still be able to parse the path given the path * name contains ASCII string and '/' chars do not conflict with * other UTF chars. * contains ASCII string and '/' chars do not conflict with other UTF * chars. * * Side effects: * The variable tclNativeExecutableName gets filled in with the file * name for the application, if we figured it out. If we couldn't * figure it out, tclNativeExecutableName is set to NULL. * *--------------------------------------------------------------------------- */ char * TclpFindExecutable(argv0) CONST char *argv0; /* The value of the application's argv[0] * (native). */ { Tcl_DString ds; WCHAR wName[MAX_PATH]; char name[MAX_PATH * TCL_UTF_MAX]; if (argv0 == NULL) { return NULL; } if (tclNativeExecutableName != NULL) { return tclNativeExecutableName; } /* * Under Windows we ignore argv0, and return the path for the file used to * create this process. */ (*tclWinProcs->getModuleFileNameProc)(NULL, wName, MAX_PATH); Tcl_WinTCharToUtf((CONST TCHAR *) wName, -1, &ds); tclNativeExecutableName = ckalloc((unsigned) (Tcl_DStringLength(&ds) + 1)); strcpy(tclNativeExecutableName, Tcl_DStringValue(&ds)); if (GetModuleFileNameW(NULL, wName, MAX_PATH) == 0) { GetModuleFileNameA(NULL, name, sizeof(name)); } else { WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); } tclNativeExecutableName = ckalloc((unsigned) (strlen(name) + 1)); strcpy(tclNativeExecutableName, name); Tcl_DStringFree(&ds); TclWinNoBackslash(tclNativeExecutableName); return tclNativeExecutableName; }  /* *----------------------------------------------------------------------
︙
741 742 743 744 745 746 747 748 749 750 751 752 753 754 755	826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841	+ - +	if ((*p != '\\') && (*p != ':')) { Tcl_DStringAppend(&dirString, "\\", 1); Tcl_DStringAppend(&dsOrig, "/", 1); dirLength++; } } dirName = Tcl_DStringValue(&dirString); Tcl_DecrRefCount(fileNamePtr); /* * First verify that the specified path is actually a directory. */ native = Tcl_WinUtfToTChar(dirName, Tcl_DStringLength(&dirString), &ds); attr = (*tclWinProcs->getFileAttributesProc)(native);
︙
764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789	850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876	- - + + +	* We need to check all files in the directory, so append a *.* * to the path. */ dirName = Tcl_DStringAppend(&dirString, "*.*", 3); native = Tcl_WinUtfToTChar(dirName, -1, &ds); handle = (*tclWinProcs->findFirstFileProc)(native, &data); Tcl_DStringFree(&ds); if (handle == INVALID_HANDLE_VALUE) { Tcl_DStringFree(&dirString); TclWinConvertError(GetLastError()); Tcl_DStringFree(&ds); Tcl_DStringFree(&dirString); Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't read directory \"", Tcl_DStringValue(&dsOrig), "\": ", Tcl_PosixError(interp), (char *) NULL); Tcl_DStringFree(&dsOrig); return TCL_ERROR; } Tcl_DStringFree(&ds); /* * Check to see if the pattern should match the special * . and .. names, referring to the current directory, * or the directory above. We need a special check for * this because paths beginning with a dot are not considered * hidden on Windows, and so otherwise a relative glob like
︙
928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955	1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - - + +	&& (len == 2 || (name[2] == '/' || name[2] == '\\'))) { /* Path is of the form 'x:' or 'x:/' or 'x:\' */ return 1; } } return 0; }  /* * Does the given path represent a reserved window path name? If not * return 0, if true, return the number of characters of the path that * we actually want (not any trailing :). */ static int WinIsReserved( CONST char *path) /* Path in UTF-8 */ { if ((path[0] == 'c' || path[0] == 'C') && (path[1] == 'o' || path[1] == 'O')) { if ((path[2] == 'm' || path[2] == 'M') && path[3] >= '1' && path[3] <= '4') { /* May have match for 'com[1-4]:?', which is a serial port */ if (path[4] == '\0') { return 4; } else if (path [4] == ':' && path[5] == '\0') { return 4; } } else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') { /* Have match for 'con' */ return 3; } } else if ((path[0] == 'l' || path[0] == 'L') && (path[1] == 'p' || path[1] == 'P') && (path[2] == 't' || path[2] == 'T')) { if (path[3] >= '1' && path[3] <= '3') { /* May have match for 'lpt[1-3]:?' */ if (path[4] == '\0') { return 4; } else if (path [4] == ':' && path[5] == '\0') { return 4; } } } else if (stricmp(path, "prn") == 0) { /* Have match for 'prn' */ return 3; } else if (stricmp(path, "nul") == 0) { /* Have match for 'nul' */ return 3; } else if (stricmp(path, "aux") == 0) { /* Have match for 'aux' */ return 3; } return 0; }  /* *---------------------------------------------------------------------- * * NativeMatchType -- * * This function needs a special case for a path which is a root * volume, because for NTFS root volumes, the getFileAttributesProc * returns a 'hidden' attribute when it should not. * * We only ever make one call to a 'get attributes' routine here, * We never make any calss to a 'get attributes' routine here, * so that this function is as fast as possible. Unfortunately, * it still means we have to make the call for every single file * we return from 'glob', which is not ideal. * since we have arranged things so that our caller already knows * such information. * * Results: * 0 = file doesn't match * 1 = file matches * *---------------------------------------------------------------------- */
︙
1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243	1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 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	- + + + - + + - + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + + + - - - - + + + +	{ DWORD attr; attr = (*tclWinProcs->getFileAttributesProc)(nativePath); if (attr == 0xffffffff) { /* * File doesn't exist. * File doesn't exist. */ TclWinConvertError(GetLastError()); return -1; } if ((mode & W_OK) && (tclWinProcs->getFileSecurityProc == NULL) if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) { && (attr & FILE_ATTRIBUTE_READONLY)) { /* * We don't have the advanced 'getFileSecurityProc', and * File is not writable. * our attributes say the file is not writable. If we * do have 'getFileSecurityProc', we'll do a more * robust XP-related check below. */ Tcl_SetErrno(EACCES); return -1; } if (mode & X_OK) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { if (!(attr & FILE_ATTRIBUTE_DIRECTORY) && !NativeIsExec(nativePath)) { /* * It's not a directory and doesn't have the correct extension. * Therefore it can't be executable */ Tcl_SetErrno(EACCES); return -1; } } /* * It looks as if the permissions are ok, but if we are on NT, 2000 or XP, * we have a more complex permissions structure so we try to check that. * The code below is remarkably complex for such a simple thing as finding * what permissions the OS has set for a file. * * If we are simply checking for file existence, then we don't need all * these complications (which are really quite slow: with this code 'file * readable' is 5-6 times slower than 'file exists'). */ if ((mode != F_OK) && (tclWinProcs->getFileSecurityProc != NULL)) { SECURITY_DESCRIPTOR *sdPtr = NULL; unsigned long size; GENERIC_MAPPING genMap; HANDLE hToken = NULL; DWORD desiredAccess = 0; DWORD grantedAccess = 0; BOOL accessYesNo = FALSE; PRIVILEGE_SET privSet; DWORD privSetSize = sizeof(PRIVILEGE_SET); int error; /* * First find out how big the buffer needs to be */ size = 0; (*tclWinProcs->getFileSecurityProc)(nativePath, OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION, 0, 0, &size); /* * Should have failed with ERROR_INSUFFICIENT_BUFFER */ error = GetLastError(); if (error != ERROR_INSUFFICIENT_BUFFER) { /* * Most likely case is ERROR_ACCESS_DENIED, which we will convert * to EACCES - just what we want! */ TclWinConvertError((DWORD)error); return -1; } /* * Now size contains the size of buffer needed */ sdPtr = (SECURITY_DESCRIPTOR *) HeapAlloc(GetProcessHeap(), 0, size); if (sdPtr == NULL) { goto accessError; } /* * Call GetFileSecurity() for real */ if (!(*tclWinProcs->getFileSecurityProc)(nativePath, OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION, sdPtr, size, &size)) { /* * Error getting owner SD */ goto accessError; } /* * Perform security impersonation of the user and open the * resulting thread token. */ if (!(*tclWinProcs->impersonateSelfProc)(SecurityImpersonation)) { /* * Unable to perform security impersonation. */ goto accessError; } if (!(*tclWinProcs->openThreadTokenProc)(GetCurrentThread (), TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) { /* * Unable to get current thread's token. */ * Directories are always executable. */ return 0; goto accessError; } (*tclWinProcs->revertToSelfProc)(); /* * Setup desiredAccess according to the access priveleges we are * checking. */ if (mode & R_OK) { desiredAccess |= FILE_GENERIC_READ; } if (mode & W_OK) { desiredAccess |= FILE_GENERIC_WRITE; } if (mode & X_OK) { desiredAccess |= FILE_GENERIC_EXECUTE; } memset (&genMap, 0x0, sizeof (GENERIC_MAPPING)); genMap.GenericRead = FILE_GENERIC_READ; genMap.GenericWrite = FILE_GENERIC_WRITE; genMap.GenericExecute = FILE_GENERIC_EXECUTE; genMap.GenericAll = FILE_ALL_ACCESS; /* * Perform access check using the token. */ if (!(*tclWinProcs->accessCheckProc)(sdPtr, hToken, desiredAccess, &genMap, &privSet, &privSetSize, &grantedAccess, &accessYesNo)) { /* * Unable to perform access check. */ accessError: TclWinConvertError(GetLastError()); if (sdPtr != NULL) { HeapFree(GetProcessHeap(), 0, sdPtr); } if (hToken != NULL) { CloseHandle(hToken); } return -1; } if (NativeIsExec(nativePath)) { return 0; /* * Clean up. */ HeapFree(GetProcessHeap (), 0, sdPtr); CloseHandle(hToken); if (!accessYesNo) { Tcl_SetErrno(EACCES); return -1; } /* * For directories the above checks are ok. For files, though, * we must still check the 'attr' value. */ if ((mode & W_OK) && !(attr & FILE_ATTRIBUTE_DIRECTORY) && (attr & FILE_ATTRIBUTE_READONLY)) { Tcl_SetErrno(EACCES); return -1; } Tcl_SetErrno(EACCES); return -1; } } return 0; }  /* *---------------------------------------------------------------------- * * NativeIsExec --
︙
1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289	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	- + - + - + - - - - + + + + + + + - + - +	static int NativeIsExec(nativePath) CONST TCHAR *nativePath; { if (tclWinProcs->useWide) { CONST WCHAR *path; int len; path = (CONST WCHAR*)nativePath; len = wcslen(path); if (len < 5) { return 0; } if (path[len-4] != L'.') { return 0; } if ((memcmp((char*)(path+len-3),L"exe",3*sizeof(WCHAR)) == 0) || (memcmp((char*)(path+len-3),L"com",3*sizeof(WCHAR)) == 0) || (memcmp((char*)(path+len-3),L"bat",3*sizeof(WCHAR)) == 0)) { /* * Use wide-char case-insensitive comparison */ if ((_wcsicmp(path+len-3,L"exe") == 0) || (_wcsicmp(path+len-3,L"com") == 0) || (_wcsicmp(path+len-3,L"bat") == 0)) { return 1; } } else { CONST char *p; /* We are only looking for pure ascii */ p = strrchr((CONST char*)nativePath, '.'); if (p != NULL) { p++; /* * Note: in the old code, stat considered '.pif' files as * executable, whereas access did not. */
︙
1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335	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	+ + + + + + + + + + + + + + +	int TclpObjChdir(pathPtr) Tcl_Obj *pathPtr; /* Path to new working directory. */ { int result; CONST TCHAR *nativePath; #ifdef __CYGWIN__ extern int cygwin_conv_to_posix_path _ANSI_ARGS_((CONST char *, char *)); char posixPath[MAX_PATH+1]; CONST char *path; Tcl_DString ds; #endif /* __CYGWIN__ */ nativePath = (CONST TCHAR *) Tcl_FSGetNativePath(pathPtr); #ifdef __CYGWIN__ /* Cygwin chdir only groks POSIX path. */ path = Tcl_WinTCharToUtf(nativePath, -1, &ds); cygwin_conv_to_posix_path(path, posixPath); result = (chdir(posixPath) == 0 ? 1 : 0); Tcl_DStringFree(&ds); #else /* __CYGWIN__ */ result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath); #endif /* __CYGWIN__ */ if (result == 0) { TclWinConvertError(GetLastError()); return -1; } return 0; }
︙
1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481	1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795	+ + + +	/* * Eliminate file names containing wildcard characters, or subsequent * call to FindFirstFile() will expand them, matching some other file. */ transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); if (transPtr == NULL || (strpbrk(Tcl_GetString(transPtr), "?*") != NULL)) { if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } Tcl_SetErrno(ENOENT); return -1; } Tcl_DecrRefCount(transPtr); #endif /* * Ensure correct file sizes by forcing the OS to write any * pending data to disk. This is done only for channels which are * dirty, i.e. have been written to since the last flush here. */
︙
1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548	1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862	- +	if (handle == INVALID_HANDLE_VALUE) { /* * FindFirstFile() doesn't work on root directories, so call * GetFileAttributes() to see if the specified file exists. */ attr = (*tclWinProcs->getFileAttributesProc)(nativePath); if (attr == 0xffffffff) { if (attr == INVALID_FILE_ATTRIBUTES) { Tcl_SetErrno(ENOENT); return -1; } /* * Make up some fake information for this file. It has the * correct file attributes and a time of 0.
︙
1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775	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 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089	+ + + + + + + + + + + + + - + - + - - - + - - + + - - - - + + + + - - - + + + + - - - - - - - + + - - - - + + + + - - - + + - - - - - + + + + + + - - + + - - - - - - - - + - - - + + +	*/ mode |= (mode & 0x0700) >> 3; mode |= (mode & 0x0700) >> 6; return (unsigned short)mode; }  /* *------------------------------------------------------------------------ * * ToCTime -- * * Converts a Windows FILETIME to a time_t in UTC. * * Results: * Returns the count of seconds from the Posix epoch. * *------------------------------------------------------------------------ */ static time_t ToCTime( FILETIME fileTime) /* UTC Time to convert to local time_t. */ FILETIME fileTime) /* UTC time */ { FILETIME localFileTime; LARGE_INTEGER convertedTime; SYSTEMTIME systemTime; struct tm tm; if (FileTimeToLocalFileTime(&fileTime, &localFileTime) == 0) { convertedTime.LowPart = fileTime.dwLowDateTime; return 0; } convertedTime.HighPart = (LONG) fileTime.dwHighDateTime; if (FileTimeToSystemTime(&localFileTime, &systemTime) == 0) { return 0; } tm.tm_sec = systemTime.wSecond; return (time_t) ((convertedTime.QuadPart - (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000); }  tm.tm_min = systemTime.wMinute; tm.tm_hour = systemTime.wHour; tm.tm_mday = systemTime.wDay; /* *------------------------------------------------------------------------ * * FromCTime -- tm.tm_mon = systemTime.wMonth - 1; tm.tm_year = systemTime.wYear - 1900; tm.tm_wday = 0; tm.tm_yday = 0; tm.tm_isdst = -1; return mktime(&tm); * * Converts a time_t to a Windows FILETIME } #if 0 * * Results: * Returns the count of 100-ns ticks seconds from the Windows epoch. * /* * Borland's stat doesn't take into account localtime. */ *------------------------------------------------------------------------ */ if ((result == 0) && (buf->st_mtime != 0)) { TIME_ZONE_INFORMATION tz; int time, bias; time = GetTimeZoneInformation(&tz); static void FromCTime( time_t posixTime, FILETIME* fileTime) /* UTC Time */ { LARGE_INTEGER convertedTime; bias = tz.Bias; if (time == TIME_ZONE_ID_DAYLIGHT) { convertedTime.QuadPart = ((LONGLONG) posixTime) * 10000000 + POSIX_EPOCH_AS_FILETIME; bias += tz.DaylightBias; } bias *= 60; buf->st_atime -= bias; buf->st_ctime -= bias; buf->st_mtime -= bias; } fileTime->dwLowDateTime = convertedTime.LowPart; #endif fileTime->dwHighDateTime = convertedTime.HighPart; }  #if 0 /* *------------------------------------------------------------------------- * * TclWinResolveShortcut -- * * Resolve a potential Windows shortcut to get the actual file or
︙
1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950	2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264	- +	*/ Tcl_Obj* TclpFilesystemPathType(pathObjPtr) Tcl_Obj* pathObjPtr; { #define VOL_BUF_SIZE 32 int found; char volType[VOL_BUF_SIZE]; WCHAR volType[VOL_BUF_SIZE]; char* firstSeparator; CONST char *path; Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathObjPtr); if (normPath == NULL) return NULL; path = Tcl_GetString(normPath); if (path == NULL) return NULL;
︙
1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979	2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293	- +	if (found == 0) { return NULL; } else { Tcl_DString ds; Tcl_Obj *objPtr; Tcl_WinTCharToUtf(volType, -1, &ds); Tcl_WinTCharToUtf((CONST char *)volType, -1, &ds); objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds)); Tcl_DStringFree(&ds); return objPtr; } #undef VOL_BUF_SIZE }
︙
2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069	2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396	- + - + + + + + + + + + + + + + + - +	/* * Now we convert the tail of the current path to its * 'long form', and append it to 'dsNorm' which holds * the current normalized path, if the file exists. */ if (isDrive) { if (GetFileAttributesA(nativePath) if (GetFileAttributesA(nativePath) == INVALID_FILE_ATTRIBUTES) { == 0xffffffff) { /* File doesn't exist */ if (isDrive) { int len = WinIsReserved(path); if (len > 0) { /* Actually it does exist - COM1, etc */ int i; for (i=0;i<len;i++) { if (nativePath[i] >= 'a') { ((char*)nativePath)[i] -= ('a' - 'A'); } } Tcl_DStringAppend(&dsNorm, nativePath, len); lastValidPathEnd = currentPathEndPosition; } } Tcl_DStringFree(&ds); break; } if (nativePath[0] >= 'a') { ((char*)nativePath)[0] -= ('a' - 'A'); } Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds)); } else { WIN32_FIND_DATA fData; HANDLE handle; handle = FindFirstFileA(nativePath, &fData); if (handle == INVALID_HANDLE_VALUE) { if (GetFileAttributesA(nativePath) == 0xffffffff) { == INVALID_FILE_ATTRIBUTES) { /* File doesn't exist */ Tcl_DStringFree(&ds); break; } /* This is usually the '/' in 'c:/' at end of string */ Tcl_DStringAppend(&dsNorm,"/", 1); } else {
︙
2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120	2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464	+ + + + + + + + + + + + + + + + +	/* Reached directory separator, or end of string */ WIN32_FILE_ATTRIBUTE_DATA data; CONST char *nativePath = Tcl_WinUtfToTChar(path, currentPathEndPosition - path, &ds); if ((*tclWinProcs->getFileAttributesExProc)(nativePath, GetFileExInfoStandard, &data) != TRUE) { /* File doesn't exist */ if (isDrive) { int len = WinIsReserved(path); if (len > 0) { /* Actually it does exist - COM1, etc */ int i; for (i=0;i<len;i++) { WCHAR wc = ((WCHAR*)nativePath)[i]; if (wc >= L'a') { wc -= (L'a' - L'A'); ((WCHAR*)nativePath)[i] = wc; } } Tcl_DStringAppend(&dsNorm, nativePath, sizeof(WCHAR)*len); lastValidPathEnd = currentPathEndPosition; } } Tcl_DStringFree(&ds); break; } /* * File 'nativePath' does exist if we get here. We * now want to check if it is a symlink and otherwise
︙
2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197	2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + +	WCHAR drive = ((WCHAR*)nativePath)[0]; if (drive >= L'a') { drive -= (L'a' - L'A'); ((WCHAR*)nativePath)[0] = drive; } Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds)); } else { char *checkDots = NULL; if (lastValidPathEnd[1] == '.') { checkDots = lastValidPathEnd + 1; while (checkDots < currentPathEndPosition) { if (*checkDots != '.') { checkDots = NULL; break; } checkDots++; } } if (checkDots != NULL) { int dotLen = currentPathEndPosition - lastValidPathEnd; /* * Path is just dots. We shouldn't really * ever see a path like that. However, to be * nice we at least don't mangle the path -- * we just add the dots as a path segment and * continue */ Tcl_DStringAppend(&dsNorm, (TCHAR*)((WCHAR*)(nativePath + Tcl_DStringLength(&ds)) - dotLen), (int)(dotLen * sizeof(WCHAR))); } else { /* Normal path */ WIN32_FIND_DATAW fData; HANDLE handle; handle = FindFirstFileW((WCHAR*)nativePath, &fData); if (handle == INVALID_HANDLE_VALUE) { /* This is usually the '/' in 'c:/' at end of string */ Tcl_DStringAppend(&dsNorm,(CONST char*)L"/", sizeof(WCHAR)); } else { WCHAR *nativeName; if (fData.cFileName[0] != '\0') { nativeName = fData.cFileName; } else { nativeName = fData.cAlternateFileName; } FindClose(handle); Tcl_DStringAppend(&dsNorm,(CONST char*)L"/", sizeof(WCHAR)); Tcl_DStringAppend(&dsNorm,(TCHAR*)nativeName, (int) (wcslen(nativeName)*sizeof(WCHAR))); WIN32_FIND_DATAW fData; HANDLE handle; handle = FindFirstFileW((WCHAR*)nativePath, &fData); if (handle == INVALID_HANDLE_VALUE) { /* This is usually the '/' in 'c:/' at end of string */ Tcl_DStringAppend(&dsNorm,(CONST char*)L"/", sizeof(WCHAR)); } else { WCHAR *nativeName; if (fData.cFileName[0] != '\0') { nativeName = fData.cFileName; } else { nativeName = fData.cAlternateFileName; } FindClose(handle); Tcl_DStringAppend(&dsNorm,(CONST char*)L"/", sizeof(WCHAR)); Tcl_DStringAppend(&dsNorm,(TCHAR*)nativeName, (int) (wcslen(nativeName)*sizeof(WCHAR))); } } } Tcl_DStringFree(&ds); lastValidPathEnd = currentPathEndPosition; if (cur == 0) { break; }
︙
2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274	2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673	+ - + + - - - + + + - - + + + + + + + + + + + + + + + + + + + - - + + - - - + + + + + + + + + - - + - + + +	* * Set the modification date for a file. * * Results: * 0 on success, -1 on error. * * Side effects: * Sets errno to a representation of any Windows problem that's observed * None. * in the process. * *--------------------------------------------------------------------------- */ int TclpUtime(pathPtr, tval) Tcl_Obj *pathPtr; /* File to modify */ struct utimbuf *tval; /* New modification date structure */ TclpUtime( Tcl_Obj *pathPtr, /* File to modify */ struct utimbuf *tval) /* New modification date structure */ { int res; /* int res = 0; HANDLE fileHandle; CONST TCHAR *native; DWORD attr = 0; DWORD flags = FILE_ATTRIBUTE_NORMAL; FILETIME lastAccessTime, lastModTime; FromCTime(tval->actime, &lastAccessTime); FromCTime(tval->modtime, &lastModTime); native = (CONST TCHAR *)Tcl_FSGetNativePath(pathPtr); attr = (*tclWinProcs->getFileAttributesProc)(native); if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) { flags = FILE_FLAG_BACKUP_SEMANTICS; } /* * Windows uses a slightly different structure name and, possibly, * contents, so we have to copy the information over * We use the native APIs (not 'utime') because there are some daylight * savings complications that utime gets wrong. */ struct _utimbuf buf; buf.actime = tval->actime; fileHandle = (tclWinProcs->createFileProc) ( native, FILE_WRITE_ATTRIBUTES, 0, NULL, OPEN_EXISTING, flags, NULL); if (fileHandle == INVALID_HANDLE_VALUE || !SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) { TclWinConvertError(GetLastError()); res = -1; buf.modtime = tval->modtime; } res = (*tclWinProcs->utimeProc)(Tcl_FSGetNativePath(pathPtr),&buf); if (fileHandle != INVALID_HANDLE_VALUE) { CloseHandle(fileHandle); } return res; }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17	- +	/* * tclWinInit.c -- * * Contains the Windows-specific interpreter initialization functions. * * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. * * RCS: @(#) $Id: tclWinInit.c,v 1.40 2003/02/27 03:47:09 chengyemao Exp $ * RCS: @(#) $Id: tclWinInit.c,v 1.40.2.6 2005/10/23 22:01:31 msofer Exp $ */ #include "tclWinInt.h" #include <winnt.h> #include <winbase.h> #include <lmcons.h>
︙
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	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	+ + + + + + - + - + - + - + +	#endif #ifndef PROCESSOR_ARCHITECTURE_ALPHA64 #define PROCESSOR_ARCHITECTURE_ALPHA64 7 #endif #ifndef PROCESSOR_ARCHITECTURE_MSIL #define PROCESSOR_ARCHITECTURE_MSIL 8 #endif #ifndef PROCESSOR_ARCHITECTURE_AMD64 #define PROCESSOR_ARCHITECTURE_AMD64 9 #endif #ifndef PROCESSOR_ARCHITECTURE_IA32_ON_WIN64 #define PROCESSOR_ARCHITECTURE_IA32_ON_WIN64 10 #endif #ifndef PROCESSOR_ARCHITECTURE_UNKNOWN #define PROCESSOR_ARCHITECTURE_UNKNOWN 0xFFFF #endif /* * The following arrays contain the human readable strings for the Windows * platform and processor values. */ #define NUMPLATFORMS 3 #define NUMPLATFORMS 4 static char* platforms[NUMPLATFORMS] = { "Win32s", "Windows 95", "Windows NT" "Win32s", "Windows 95", "Windows NT", "Windows CE" }; #define NUMPROCESSORS 9 #define NUMPROCESSORS 11 static char* processors[NUMPROCESSORS] = { "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil" "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil", "amd64", "ia32_on_win64" }; /* Used to store the encoding used for binary files */ static Tcl_Encoding binaryEncoding = NULL; /* Has the basic library path encoding issue been fixed */ static int libraryPathEncodingFixed = 0;
︙
154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176	161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183	- + - +	* This call sets the library path to strings in UTF-8. Any * pre-existing library path information is assumed to have been * in the native multibyte encoding. * * Called at process initialization time. * * Results: * None. * Return 0, indicating that the UTF is clean. * * Side effects: * None. * *--------------------------------------------------------------------------- */ void int TclpInitLibraryPath(path) CONST char *path; /* Potentially dirty UTF string that is */ /* the path to the executable name. */ { #define LIBRARY_SIZE 32 Tcl_Obj *pathPtr, *objPtr; CONST char *str;
︙
186 187 188 189 190 191 192 193 194 195 196 197 198 199 200	193 194 195 196 197 198 199 200 201 202 203 204 205 206 207	- +	* Initialize the substrings used when locating an executable. The * installLib variable computes the path as though the executable * is installed. The developLib computes the path as though the * executable is run from a develpment directory. */ sprintf(installLib, "lib/tcl%s", TCL_VERSION); sprintf(developLib, "../tcl%s/library", TCL_PATCH_LEVEL); sprintf(developLib, "tcl%s/library", TCL_PATCH_LEVEL); /* * Look for the library relative to default encoding dir. */ str = Tcl_GetDefaultEncodingDir(); if ((str != NULL) && (str[0] != '\0')) {
︙
241 242 243 244 245 246 247 248 249 250 251 252 253 254 255	248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280	+ + + - + + + + + + + + + + + + + + + +	/* * The variable path holds an absolute path. Take care not to * overwrite pathv[0] since that might produce a relative path. */ if (path != NULL) { int i, origc; CONST char **origv; Tcl_SplitPath(path, &pathc, &pathv); Tcl_SplitPath(path, &origc, &origv); pathc = 0; pathv = (CONST char **) ckalloc((unsigned int)(origc * sizeof(char *))); for (i=0; i< origc; i++) { if (origv[i][0] == '.') { if (strcmp(origv[i], ".") == 0) { /* do nothing */ } else if (strcmp(origv[i], "..") == 0) { pathc--; } else { pathv[pathc++] = origv[i]; } } else { pathv[pathc++] = origv[i]; } } if (pathc > 2) { str = pathv[pathc - 2]; pathv[pathc - 2] = installLib; path = Tcl_JoinPath(pathc - 1, pathv, &ds); pathv[pathc - 2] = str; objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
︙
296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313	321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341	+ + +	pathv[pathc - 4] = developLib; path = Tcl_JoinPath(pathc - 3, pathv, &ds); pathv[pathc - 4] = str; objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } ckfree((char *) origv); ckfree((char *) pathv); } TclSetLibraryPath(pathPtr); return 0; /* 0 indicates that pathPtr is clean (true) utf */ }  /* *--------------------------------------------------------------------------- * * AppendEnvironment -- *
︙
332 333 334 335 336 337 338 339 340 341 342 343 344 345	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	+ + + + + + + + + + + + + + + + + + +	{ int pathc; WCHAR wBuf[MAX_PATH]; char buf[MAX_PATH * TCL_UTF_MAX]; Tcl_Obj *objPtr; Tcl_DString ds; CONST char **pathv; char *shortlib; /* * The shortlib value needs to be the tail component of the * lib path. For example, "lib/tcl8.4" -> "tcl8.4" while * "usr/share/tcl8.5" -> "tcl8.5". */ for (shortlib = (char *) (lib + strlen(lib) - 1); shortlib > lib ; shortlib--) { if (*shortlib == '/') { if (shortlib == (lib + strlen(lib) - 1)) { Tcl_Panic("last character in lib cannot be '/'"); } shortlib++; break; } } if (shortlib == lib) { Tcl_Panic("no '/' character found in lib"); } /* * The "L" preceeding the TCL_LIBRARY string is used to tell VC++ * that this is a unicode string. */ if (GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH) == 0) {
︙
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	401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428	- + - + - +	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); TclWinNoBackslash(buf); Tcl_SplitPath(buf, &pathc, &pathv); /* * The lstrcmpi() will work even if pathv[pathc - 1] is random * UTF-8 chars because I know lib is ascii. * UTF-8 chars because I know shortlib is ascii. */ if ((pathc > 0) && (lstrcmpiA(lib + 4, pathv[pathc - 1]) != 0)) { if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) { CONST char *str; /* * TCL_LIBRARY is set but refers to a different tcl * installation than the current version. Try fiddling with the * specified directory to make it refer to this installation by * removing the old "tclX.Y" and substituting the current * version string. */ pathv[pathc - 1] = (lib + 4); pathv[pathc - 1] = shortlib; Tcl_DStringInit(&ds); str = Tcl_JoinPath(pathc, pathv, &ds); objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds)); Tcl_DStringFree(&ds); } else { objPtr = Tcl_NewStringObj(buf, -1); }
︙
520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541	567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591	- + + + + - - + + - +	void TclpSetInitialEncodings() { CONST char *encoding; char buf[4 + TCL_INTEGER_SPACE]; if (libraryPathEncodingFixed == 0) { int platformId; int platformId, useWide; platformId = TclWinGetPlatformId(); useWide = ((platformId == VER_PLATFORM_WIN32_NT) || (platformId == VER_PLATFORM_WIN32_CE)); TclWinSetInterfaces(platformId == VER_PLATFORM_WIN32_NT); TclWinSetInterfaces(useWide); wsprintfA(buf, "cp%d", GetACP()); Tcl_SetSystemEncoding(NULL, buf); if (platformId != VER_PLATFORM_WIN32_NT) { if (!useWide) { Tcl_Obj *pathPtr = TclGetLibraryPath(); if (pathPtr != NULL) { int i, objc; Tcl_Obj **objv; objc = 0; Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
︙
793 794 795 796 797 798 799 800 801 802 803 804 805 806 807	843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859	+ +	}; } pathPtr = TclGetLibraryPath(); if (pathPtr == NULL) { pathPtr = Tcl_NewObj(); } Tcl_IncrRefCount(pathPtr); Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(pathPtr); return Tcl_Eval(interp, initScript); }  /* *---------------------------------------------------------------------- * * Tcl_SourceRCFile --
︙

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	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	- + - + + + + +	/* * tclWinInt.h -- * * Declarations of Windows-specific shared variables and procedures. * * Copyright (c) 1994-1996 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclWinInt.h,v 1.20 2003/02/04 17:06:53 vincentdarley Exp $ * RCS: @(#) $Id: tclWinInt.h,v 1.20.2.5 2006/03/10 10:35:25 vincentdarley Exp $ */ #ifndef _TCLWININT #define _TCLWININT #ifndef _TCLINT #include "tclInt.h" #endif #ifndef _TCLPORT #include "tclPort.h" #endif /* * The following specifies how much stack space TclpCheckStackSpace() * ensures is available. TclpCheckStackSpace() is called by Tcl_EvalObj() * to help avoid overflowing the stack in the case of infinite recursion. */ #define TCL_WIN_STACK_THRESHOLD 0x2000 #define TCL_WIN_STACK_THRESHOLD 0x8000 #ifdef BUILD_tcl # undef TCL_STORAGE_CLASS # define TCL_STORAGE_CLASS DLLEXPORT #endif /* * Some versions of Borland C have a define for the OSVERSIONINFO for * Win32s and for NT, but not for Windows 95. * Define VER_PLATFORM_WIN32_CE for those without newer headers. */ #ifndef VER_PLATFORM_WIN32_WINDOWS #define VER_PLATFORM_WIN32_WINDOWS 1 #endif #ifndef VER_PLATFORM_WIN32_CE #define VER_PLATFORM_WIN32_CE 3 #endif /* * The following structure keeps track of whether we are using the * multi-byte or the wide-character interfaces to the operating system. * System calls should be made through the following function table. */
︙
98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128	102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177	+ + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	*/ BOOL (WINAPI *getFileAttributesExProc)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, LPVOID); BOOL (WINAPI *createHardLinkProc)(CONST TCHAR*, CONST TCHAR*, LPSECURITY_ATTRIBUTES); INT (__cdecl *utimeProc)(CONST TCHAR*, struct _utimbuf *); /* These two are also NULL at start; see comment above */ HANDLE (WINAPI *findFirstFileExProc)(CONST TCHAR*, UINT, LPVOID, UINT, LPVOID, DWORD); BOOL (WINAPI *getVolumeNameForVMPProc)(CONST TCHAR*, TCHAR*, DWORD); DWORD (WINAPI *getLongPathNameProc)(CONST TCHAR*, TCHAR*, DWORD); /* * These six are for the security sdk to get correct file * permissions on NT, 2000, XP, etc. On 95,98,ME they are * always null. */ BOOL (WINAPI *getFileSecurityProc)(LPCTSTR lpFileName, SECURITY_INFORMATION RequestedInformation, PSECURITY_DESCRIPTOR pSecurityDescriptor, DWORD nLength, LPDWORD lpnLengthNeeded); BOOL (WINAPI *impersonateSelfProc) (SECURITY_IMPERSONATION_LEVEL ImpersonationLevel); BOOL (WINAPI *openThreadTokenProc) (HANDLE ThreadHandle, DWORD DesiredAccess, BOOL OpenAsSelf, PHANDLE TokenHandle); BOOL (WINAPI *revertToSelfProc) (void); VOID (WINAPI *mapGenericMaskProc) (PDWORD AccessMask, PGENERIC_MAPPING GenericMapping); BOOL (WINAPI *accessCheckProc)(PSECURITY_DESCRIPTOR pSecurityDescriptor, HANDLE ClientToken, DWORD DesiredAccess, PGENERIC_MAPPING GenericMapping, PPRIVILEGE_SET PrivilegeSet, LPDWORD PrivilegeSetLength, LPDWORD GrantedAccess, LPBOOL AccessStatus); /* * Unicode console support. WriteConsole and ReadConsole */ BOOL (WINAPI *readConsoleProc)(HANDLE hConsoleInput, LPVOID lpBuffer, DWORD nNumberOfCharsToRead, LPDWORD lpNumberOfCharsRead, LPVOID lpReserved); BOOL (WINAPI *writeConsoleProc)(HANDLE hConsoleOutput, const VOID* lpBuffer, DWORD nNumberOfCharsToWrite, LPDWORD lpNumberOfCharsWritten, LPVOID lpReserved); } TclWinProcs; EXTERN TclWinProcs *tclWinProcs; /* * Declarations of functions that are not accessible by way of the * stubs table. */ EXTERN void TclWinEncodingsCleanup(); EXTERN void TclWinResetInterfaceEncodings(); EXTERN void TclWinInit(HINSTANCE hInst); EXTERN int TclWinSymLinkCopyDirectory(CONST TCHAR* LinkOriginal, CONST TCHAR* LinkCopy); EXTERN int TclWinSymLinkDelete(CONST TCHAR* LinkOriginal, int linkOnly); EXTERN char TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint); #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) EXTERN void TclWinFreeAllocCache(void); EXTERN void TclFreeAllocCache(void *); EXTERN Tcl_Mutex *TclpNewAllocMutex(void); EXTERN void *TclpGetAllocCache(void); EXTERN void TclpSetAllocCache(void *); #endif /* TCL_THREADS */
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclWinNotify.c -- * * This file contains Windows-specific procedures for the notifier, * which is the lowest-level part of the Tcl event loop. This file * works together with ../generic/tclNotify.c. * * Copyright (c) 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. * * RCS: @(#) $Id: tclWinNotify.c,v 1.11 2003/01/16 19:02:00 mdejong Exp $ * RCS: @(#) $Id: tclWinNotify.c,v 1.11.2.1 2003/03/21 03:24:09 dgp Exp $ */ #include "tclWinInt.h" /* * The follwing static indicates whether this module has been initialized. */
︙
41 42 43 44 45 46 47 48 49 50 51 52 53 54	41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56	+ +	int timeout; /* Current timeout value. */ int timerActive; /* 1 if interval timer is running. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; extern TclStubs tclStubs; extern Tcl_NotifierProcs tclOriginalNotifier; /* * The following static indicates the number of threads that have * initialized notifiers. It controls the lifetime of the TclNotifier * window class. * * You must hold the notifierMutex lock before accessing this variable. */
︙
263 264 265 266 267 268 269 270 271 272 273 274 275 276 277	265 266 267 268 269 270 271 272 273 274 275 276 277 278 279	- +	UINT timeout; /* * Allow the notifier to be hooked. This may not make sense * on Windows, but mirrors the UNIX hook. */ if (tclStubs.tcl_SetTimer != Tcl_SetTimer) { if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) { tclStubs.tcl_SetTimer(timePtr); return; } /* * We only need to set up an interval timer if we're being called * from an external event loop. If we don't have a window handle
︙
429 430 431 432 433 434 435 436 437 438 439 440 441 442 443	431 432 433 434 435 436 437 438 439 440 441 442 443 444 445	- +	int status; /* * Allow the notifier to be hooked. This may not make * sense on windows, but mirrors the UNIX hook. */ if (tclStubs.tcl_WaitForEvent != Tcl_WaitForEvent) { if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) { return tclStubs.tcl_WaitForEvent(timePtr); } /* * Compute the timeout in milliseconds. */
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19	- +	/* * tclWinPipe.c -- * * This file implements the Windows-specific exec pipeline functions, * the "pipe" channel driver, and the "pid" Tcl command. * * Copyright (c) 1996-1997 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclWinPipe.c,v 1.33 2003/01/28 11:03:53 mdejong Exp $ * RCS: @(#) $Id: tclWinPipe.c,v 1.33.2.17 2006/03/14 20:36:39 andreas_kupries Exp $ */ #include "tclWinInt.h" #include <fcntl.h> #include <io.h> #include <sys/stat.h>
︙
185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234	185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237	- - + + + - + + +	CONST char **argv, Tcl_DString *linePtr); static BOOL HasConsole(void); static int PipeBlockModeProc(ClientData instanceData, int mode); static void PipeCheckProc(ClientData clientData, int flags); static int PipeClose2Proc(ClientData instanceData, Tcl_Interp *interp, int flags); static int PipeEventProc(Tcl_Event *evPtr, int flags); static void PipeExitHandler(ClientData clientData); static int PipeGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); static void PipeInit(void); static int PipeInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); static int PipeOutputProc(ClientData instanceData, CONST char *buf, int toWrite, int *errorCode); static DWORD WINAPI PipeReaderThread(LPVOID arg); static void PipeSetupProc(ClientData clientData, int flags); static void PipeWatchProc(ClientData instanceData, int mask); static DWORD WINAPI PipeWriterThread(LPVOID arg); static void ProcExitHandler(ClientData clientData); static int TempFileName(WCHAR name[MAX_PATH]); static int WaitForRead(PipeInfo *infoPtr, int blocking); static void PipeThreadActionProc _ANSI_ARGS_ (( ClientData instanceData, int action)); /* * This structure describes the channel type structure for command pipe * based IO. */ static Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ TCL_CHANNEL_VERSION_2, /* v2 channel */ TCL_CHANNEL_VERSION_4, /* v4 channel */ TCL_CLOSE2PROC, /* Close proc. */ PipeInputProc, /* Input proc. */ PipeOutputProc, /* Output proc. */ NULL, /* Seek proc. */ NULL, /* Set option proc. */ NULL, /* Get option proc. */ PipeWatchProc, /* Set up notifier to watch the channel. */ PipeGetHandleProc, /* Get an OS handle from channel. */ PipeClose2Proc, /* close2proc */ PipeBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc */ PipeThreadActionProc, /* thread action proc */ };  /* *---------------------------------------------------------------------- * * PipeInit -- *
︙
254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329	257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308	- - - + - - + + - - + + - - + - - - + - - - + - - - - - - + + - - - - - - - - + + - - - - - - -	*/ if (!initialized) { Tcl_MutexLock(&pipeMutex); if (!initialized) { initialized = 1; procList = NULL; Tcl_CreateExitHandler(ProcExitHandler, NULL); } Tcl_MutexUnlock(&pipeMutex); } tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->firstPipePtr = NULL; Tcl_CreateEventSource(PipeSetupProc, PipeCheckProc, NULL); Tcl_CreateThreadExitHandler(PipeExitHandler, NULL); } }  /* *---------------------------------------------------------------------- * * PipeExitHandler -- * TclpFinalizePipes -- * * This function is called to cleanup the pipe module before * Tcl is unloaded. * This function is called from Tcl_FinalizeThread to finalize the * platform specific pipe subsystem. * * Results: * None. * * Side effects: * Removes the pipe event source. * *---------------------------------------------------------------------- */ static void PipeExitHandler( void TclpFinalizePipes() ClientData clientData) /* Old window proc */ { { Tcl_DeleteEventSource(PipeSetupProc, PipeCheckProc, NULL); }  ThreadSpecificData *tsdPtr; /* *---------------------------------------------------------------------- * * ProcExitHandler -- * * This function is called to cleanup the process list before * Tcl is unloaded. * * Results: tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (tsdPtr != NULL) { * None. * * Side effects: * Resets the process list. * *---------------------------------------------------------------------- */ Tcl_DeleteEventSource(PipeSetupProc, PipeCheckProc, NULL); } static void ProcExitHandler( ClientData clientData) /* Old window proc */ { Tcl_MutexLock(&pipeMutex); initialized = 0; Tcl_MutexUnlock(&pipeMutex); }  /* *---------------------------------------------------------------------- * * PipeSetupProc -- *
︙
664 665 666 667 668 669 670 671 672 673 674 675 676 677 678	643 644 645 646 647 648 649 650 651 652 653 654 655 656 657	- +	return NULL; } /* * Seek to the end of file if we are writing. */ if (mode & O_WRONLY) { if (mode & (O_WRONLY|O_APPEND)) { SetFilePointer(handle, 0, NULL, FILE_END); } return TclWinMakeFile(handle); }  /*
︙
901 902 903 904 905 906 907 908 909 910 911 912 913 914	880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895	+ +	*/ unsigned long TclpGetPid( Tcl_Pid pid) /* The HANDLE of the child process. */ { ProcInfo *infoPtr; PipeInit(); Tcl_MutexLock(&pipeMutex); for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->hProcess == (HANDLE) pid) { Tcl_MutexUnlock(&pipeMutex); return infoPtr->dwProcessId; }
︙
1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166	1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147	- +	* of a hidden console application, and then run that hidden * console as a detached process. */ startInfo.wShowWindow = SW_HIDE; startInfo.dwFlags |= STARTF_USESHOWWINDOW; createFlags = CREATE_NEW_CONSOLE; Tcl_DStringAppend(&cmdLine, "cmd.exe /c ", -1); Tcl_DStringAppend(&cmdLine, "cmd.exe /c", -1); } else { createFlags = DETACHED_PROCESS; } } else { if (HasConsole()) { createFlags = 0; } else {
︙
1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220	1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199	- + - -	{ Tcl_Obj *tclExePtr, *pipeDllPtr; int i, fileExists; char *start,*end; Tcl_DString pipeDll; Tcl_DStringInit(&pipeDll); Tcl_DStringAppend(&pipeDll, TCL_PREFIX_IDENT "tclpip" Tcl_DStringAppend(&pipeDll, TCL_PIPE_DLL, -1); STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) STRINGIFY(TCL_DEBUG_IDENT) ".dll ", -1); tclExePtr = Tcl_NewStringObj(TclpFindExecutable(""), -1); start = Tcl_GetStringFromObj(tclExePtr, &i); for (end = start + (i-1); end > start; end--) { if (*end == '/') break; } if (*end != '/')
︙
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	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	- + + - + + - + + + - - + + + - - - + + - + - + + - + - + - - - - - - +	CONST char *arg, *start, *special; int quote, i; Tcl_DString ds; Tcl_DStringInit(&ds); /* * Prime the path. * Prime the path. Add a space separator if we were primed with * something. */ Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1); if (Tcl_DStringLength(&ds) > 0) Tcl_DStringAppend(&ds, " ", 1); for (i = 0; i < argc; i++) { if (i == 0) { arg = executable; } else { arg = argv[i]; Tcl_DStringAppend(&ds, " ", 1); } quote = 0; if (arg[0] == '\0') { quote = 1; } else { int count; Tcl_UniChar ch; for (start = arg; *start != '\0'; start++) { if (isspace(*start)) { /* INTL: ISO space. */ for (start = arg; *start != '\0'; start += count) { count = Tcl_UtfToUniChar(start, &ch); if (Tcl_UniCharIsSpace(ch)) { /* INTL: ISO space. */ quote = 1; break; } } } if (quote) { Tcl_DStringAppend(&ds, "\"", 1); } start = arg; for (special = arg; ; ) { if ((*special == '\\') && (special[1] == '\\' || special[1] == '"')) { Tcl_DStringAppend(&ds, start, special - start); (special[1] == '\\' || special[1] == '"' || (quote && special[1] == '\0'))) { Tcl_DStringAppend(&ds, start, (int) (special - start)); start = special; while (1) { special++; if (*special == '"') { if (*special == '"' || (quote && *special == '\0')) { /* * N backslashes followed a quote -> insert * N * 2 + 1 backslashes then a quote. */ Tcl_DStringAppend(&ds, start, special - start); Tcl_DStringAppend(&ds, start, (int) (special - start)); break; } if (*special != '\\') { break; } } Tcl_DStringAppend(&ds, start, special - start); Tcl_DStringAppend(&ds, start, (int) (special - start)); start = special; } if (*special == '"') { Tcl_DStringAppend(&ds, start, special - start); Tcl_DStringAppend(&ds, start, (int) (special - start)); Tcl_DStringAppend(&ds, "\\\"", 2); start = special + 1; } if (*special == '{') { Tcl_DStringAppend(&ds, start, special - start); Tcl_DStringAppend(&ds, "\\{", 2); start = special + 1; } if (*special == '\0') { break; } special++; } Tcl_DStringAppend(&ds, start, special - start); Tcl_DStringAppend(&ds, start, (int) (special - start)); if (quote) { Tcl_DStringAppend(&ds, "\"", 1); } } Tcl_DStringFree(linePtr); Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr); Tcl_DStringFree(&ds);
︙
1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700	1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680	+	infoPtr->writeFile = writeFile; infoPtr->errorFile = errorFile; infoPtr->numPids = numPids; infoPtr->pidPtr = pidPtr; infoPtr->writeBuf = 0; infoPtr->writeBufLen = 0; infoPtr->writeError = 0; infoPtr->channel = (Tcl_Channel) NULL; /* * Use one of the fds associated with the channel as the * channel id. */ if (readFile) {
︙
1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893	1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873	- +	int errorCode, result; PipeInfo *infoPtr, **nextPtrPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); DWORD exitCode; errorCode = 0; if ((!flags || (flags == TCL_CLOSE_READ)) && (pipePtr->readFile != NULL)) { && (pipePtr->readFile != NULL)) { /* * Clean up the background thread if necessary. Note that this * must be done before we can close the file, since the * thread may be blocking trying to read from the pipe. */ if (pipePtr->readThread) {
︙
1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922	1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902	- +	SetEvent(pipePtr->stopReader); /* * Wait at most 20 milliseconds for the reader thread to close. */ if (WaitForSingleObject(pipePtr->readThread, 20) == WAIT_TIMEOUT) { == WAIT_TIMEOUT) { /* * The thread must be blocked waiting for the pipe to * become readable in ReadFile(). There isn't a clean way * to exit the thread from this condition. We should * terminate the child process instead to get the reader * thread to fall out of ReadFile with a FALSE. (below) is * not the correct way to do this, but will stay here until
︙
1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958	1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938	- +	if (TclpCloseFile(pipePtr->readFile) != 0) { errorCode = errno; } pipePtr->validMask &= ~TCL_READABLE; pipePtr->readFile = NULL; } if ((!flags || (flags & TCL_CLOSE_WRITE)) && (pipePtr->writeFile != NULL)) { && (pipePtr->writeFile != NULL)) { if (pipePtr->writeThread) { /* * Wait for the writer thread to finish the current buffer, * then terminate the thread and close the handles. If the * channel is nonblocking, there should be no pending write * operations.
︙
1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991	1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971	- +	SetEvent(pipePtr->stopWriter); /* * Wait at most 20 milliseconds for the reader thread to close. */ if (WaitForSingleObject(pipePtr->writeThread, 20) == WAIT_TIMEOUT) { == WAIT_TIMEOUT) { /* * The thread must be blocked waiting for the pipe to * consume input in WriteFile(). There isn't a clean way * to exit the thread from this condition. We should * terminate the child process instead to get the writer * thread to fall out of WriteFile with a FALSE. (below) is * not the correct way to do this, but will stay here until
︙
2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070	2010 2011 2012 2013 2014 2015 2016 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 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070	- - + + + - - - - + + + + + + + + + + + + + + + + + + + + + + - - + + - - - - - - - + + + + + + + - - - + + + +	} /* * Remove the file from the list of watched files. */ for (nextPtrPtr = &(tsdPtr->firstPipePtr), infoPtr = *nextPtrPtr; infoPtr != NULL; nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) { infoPtr != NULL; nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) { if (infoPtr == (PipeInfo *)pipePtr) { *nextPtrPtr = infoPtr->nextPtr; break; } } if ((pipePtr->flags & PIPE_ASYNC) || TclInExit()) { /* * Wrap the error file into a channel and give it to the cleanup * routine. */ /* * If the channel is non-blocking or Tcl is being cleaned up, * just detach the children PIDs, reap them (important if we are * in a dynamic load module), and discard the errorFile. */ Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr); Tcl_ReapDetachedProcs(); if (pipePtr->errorFile) { if (TclpCloseFile(pipePtr->errorFile) != 0) { if ( errorCode == 0 ) { errorCode = errno; } } } result = 0; } else { /* * Wrap the error file into a channel and give it to the cleanup * routine. */ if (pipePtr->errorFile) { WinFile *filePtr; if (pipePtr->errorFile) { WinFile *filePtr; filePtr = (WinFile*)pipePtr->errorFile; errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle, TCL_READABLE); ckfree((char *) filePtr); } else { errChan = NULL; } filePtr = (WinFile*)pipePtr->errorFile; errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle, TCL_READABLE); ckfree((char *) filePtr); } else { errChan = NULL; } result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr, errChan); result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr, errChan); } if (pipePtr->numPids > 0) { ckfree((char *) pipePtr->pidPtr); } if (pipePtr->writeBuf != NULL) { ckfree(pipePtr->writeBuf); }
︙
2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515	2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522	- + - + + + + + + + +	Tcl_Pid Tcl_WaitPid( Tcl_Pid pid, int *statPtr, int options) { ProcInfo *infoPtr, **prevPtrPtr; ProcInfo *infoPtr = NULL, **prevPtrPtr; DWORD flags; Tcl_Pid result; DWORD ret, exitCode; PipeInit(); /* * If no pid is specified, do nothing. */ if (pid == 0) { *statPtr = 0; return 0; } /* * Find the process on the process list. * Find the process and cut it from the process list. * SF Tcl Bug 859820, Backport of its fix. * SF Tcl Bug 1381436, asking for the backport. * * [x] Cutting the infoPtr after the closehandle allows the * pointer to become stale. We do it here, and compensate if the * process was not done yet. */ Tcl_MutexLock(&pipeMutex); prevPtrPtr = &procList; for (infoPtr = procList; infoPtr != NULL; prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) { if (infoPtr->hProcess == (HANDLE) pid) { *prevPtrPtr = infoPtr->nextPtr; break; } } Tcl_MutexUnlock(&pipeMutex); /* * If the pid is not one of the processes we know about (we started it)
︙
2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611	2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621	+ + + + + + + + - + - + - + - + - + - - - - - + - + - + -	} else { flags = INFINITE; } ret = WaitForSingleObject(infoPtr->hProcess, flags); if (ret == WAIT_TIMEOUT) { *statPtr = 0; if (options & WNOHANG) { /* * Re-insert the cut infoPtr back on the list. * See [x] for explanation. */ Tcl_MutexLock(&pipeMutex); infoPtr->nextPtr = procList; procList = infoPtr; Tcl_MutexUnlock(&pipeMutex); return 0; } else { result = 0; } } else if (ret == WAIT_OBJECT_0) { GetExitCodeProcess(infoPtr->hProcess, &exitCode); if (exitCode & 0xC0000000) { /* * A fatal exception occured. */ switch (exitCode) { case EXCEPTION_FLT_DENORMAL_OPERAND: case EXCEPTION_FLT_DIVIDE_BY_ZERO: case EXCEPTION_FLT_INEXACT_RESULT: case EXCEPTION_FLT_INVALID_OPERATION: case EXCEPTION_FLT_OVERFLOW: case EXCEPTION_FLT_STACK_CHECK: case EXCEPTION_FLT_UNDERFLOW: case EXCEPTION_INT_DIVIDE_BY_ZERO: case EXCEPTION_INT_OVERFLOW: *statPtr = SIGFPE; *statPtr = 0xC0000000 | SIGFPE; break; case EXCEPTION_PRIV_INSTRUCTION: case EXCEPTION_ILLEGAL_INSTRUCTION: *statPtr = SIGILL; *statPtr = 0xC0000000 | SIGILL; break; case EXCEPTION_ACCESS_VIOLATION: case EXCEPTION_DATATYPE_MISALIGNMENT: case EXCEPTION_ARRAY_BOUNDS_EXCEEDED: case EXCEPTION_STACK_OVERFLOW: case EXCEPTION_NONCONTINUABLE_EXCEPTION: case EXCEPTION_INVALID_DISPOSITION: case EXCEPTION_GUARD_PAGE: case EXCEPTION_INVALID_HANDLE: *statPtr = SIGSEGV; *statPtr = 0xC0000000 | SIGSEGV; break; case CONTROL_C_EXIT: *statPtr = SIGINT; *statPtr = 0xC0000000 | SIGINT; break; default: *statPtr = SIGABRT; *statPtr = 0xC0000000 | SIGABRT; break; } } else { /* * Non exception, normal, exit code. Note that the exit code * is truncated to a byte range. */ *statPtr = ((exitCode << 8) & 0xff00); *statPtr = exitCode; } result = pid; } else { errno = ECHILD; *statPtr = ECHILD; *statPtr = 0xC0000000 | ECHILD; result = (Tcl_Pid) -1; } /* * Remove the process from the process list and close the process handle. * Officially close the process handle. */ CloseHandle(infoPtr->hProcess); *prevPtrPtr = infoPtr->nextPtr; ckfree((char*)infoPtr); return result; }  /* *----------------------------------------------------------------------
︙
2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640	2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653	+ + +	void TclWinAddProcess(hProcess, id) HANDLE hProcess; /* Handle to process */ DWORD id; /* Global process identifier */ { ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo)); PipeInit(); procPtr->hProcess = hProcess; procPtr->dwProcessId = id; Tcl_MutexLock(&pipeMutex); procPtr->nextPtr = procList; procList = procPtr; Tcl_MutexUnlock(&pipeMutex); }
︙
2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940	2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956	+ + - + +	/* * Alert the foreground thread. Note that we need to treat this like * a critical section so the foreground thread does not terminate * this thread while we are holding a mutex in the notifier code. */ Tcl_MutexLock(&pipeMutex); if (infoPtr->threadId != NULL) { /* TIP #218. When in flight ignore the event, no one will receive it anyway */ Tcl_ThreadAlert(infoPtr->threadId); Tcl_ThreadAlert(infoPtr->threadId); } Tcl_MutexUnlock(&pipeMutex); } return 0; }  /*
︙
3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027	3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093	+ + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	/* * Alert the foreground thread. Note that we need to treat this like * a critical section so the foreground thread does not terminate * this thread while we are holding a mutex in the notifier code. */ Tcl_MutexLock(&pipeMutex); if (infoPtr->threadId != NULL) { /* TIP #218. When in flight ignore the event, no one will receive it anyway */ Tcl_ThreadAlert(infoPtr->threadId); Tcl_ThreadAlert(infoPtr->threadId); } Tcl_MutexUnlock(&pipeMutex); } return 0; } /* *---------------------------------------------------------------------- * * PipeThreadActionProc -- * * Insert or remove any thread local refs to this channel. * * Results: * None. * * Side effects: * Changes thread local list of valid channels. * *---------------------------------------------------------------------- */ static void PipeThreadActionProc (instanceData, action) ClientData instanceData; int action; { PipeInfo *infoPtr = (PipeInfo *) instanceData; /* We do not access firstPipePtr in the thread structures. This is * not for all pipes managed by the thread, but only those we are * watching. Removal of the filevent handlers before transfer thus * takes care of this structure. */ Tcl_MutexLock(&pipeMutex); if (action == TCL_CHANNEL_THREAD_INSERT) { /* We can't copy the thread information from the channel when * the channel is created. At this time the channel back * pointer has not been set yet. However in that case the * threadId has already been set by TclpCreateCommandChannel * itself, so the structure is still good. */ PipeInit (); if (infoPtr->channel != NULL) { infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel); } } else { infoPtr->threadId = NULL; } Tcl_MutexUnlock(&pipeMutex); }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20	- +	/* * tclWinPort.h -- * * This header file handles porting issues that occur because of * differences between Windows and Unix. It should be the only * file that contains #ifdefs to handle different flavors of OS. * * Copyright (c) 1994-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. * * RCS: @(#) $Id: tclWinPort.h,v 1.36 2002/11/27 18:13:38 davygrvy Exp $ * RCS: @(#) $Id: tclWinPort.h,v 1.36.2.2 2005/11/04 18:33:35 patthoyts Exp $ */ #ifndef _TCLWINPORT #define _TCLWINPORT #ifndef _TCLINT # include "tclInt.h"
︙
226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256	226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256	- + - + - + - +	#if TCL_UNION_WAIT # define WAIT_STATUS_TYPE union wait #else # define WAIT_STATUS_TYPE int #endif /* TCL_UNION_WAIT */ #ifndef WIFEXITED # define WIFEXITED(stat) (((*((int *) &(stat))) & 0xff) == 0) # define WIFEXITED(stat) (((*((int *) &(stat))) & 0xC0000000) == 0) #endif #ifndef WEXITSTATUS # define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff) # define WEXITSTATUS(stat) (*((int *) &(stat))) #endif #ifndef WIFSIGNALED # define WIFSIGNALED(stat) (((*((int *) &(stat)))) && ((*((int *) &(stat))) == ((*((int *) &(stat))) & 0x00ff))) # define WIFSIGNALED(stat) ((*((int *) &(stat))) & 0xC0000000) #endif #ifndef WTERMSIG # define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7f) #endif #ifndef WIFSTOPPED # define WIFSTOPPED(stat) (((*((int *) &(stat))) & 0xff) == 0177) # define WIFSTOPPED(stat) 0 #endif #ifndef WSTOPSIG # define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xff) #endif /*
︙
419 420 421 422 423 424 425 426 427 428 429 430 431 432 433	419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434	- + +	/* * The following define ensures that we use the native putenv * implementation to modify the environment array. This keeps * the C level environment in synch with the system level environment. */ #define USE_PUTENV 1 #define USE_PUTENV 1 #define USE_PUTENV_FOR_UNSET 1 /* * Msvcrt's putenv() copies the string rather than takes ownership of it. */ #if defined(_MSC_VER) || defined(__MINGW32__) # define HAVE_PUTENV_THAT_COPIES 1
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	/* * tclWinReg.c -- * * This file contains the implementation of the "registry" Tcl * built-in command. This command is built as a dynamically * loadable extension in a separate DLL. * * Copyright (c) 1997 by 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. * * RCS: @(#) $Id: tclWinReg.c,v 1.21 2003/03/03 17:12:49 dgp Exp $ * RCS: @(#) $Id: tclWinReg.c,v 1.21.2.7 2007/05/15 16:08:22 dgp Exp $ */ #include <tclPort.h> #include <stdlib.h> /* * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
︙
224 225 226 227 228 229 230 231 232 233 234 235 236 237 238	224 225 226 227 228 229 230 231 232 233 234 235 236 237 238	- +	if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { regWinProcs = &unicodeProcs; } else { regWinProcs = &asciiProcs; } Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, NULL, NULL); return Tcl_PkgProvide(interp, "registry", "1.1.1"); return Tcl_PkgProvide(interp, "registry", "1.1.5"); }  /* *---------------------------------------------------------------------- * * RegistryObjCmd -- *
︙
509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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	509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609	+ - - - - - - + + + + + + + + + + - - - - - - - - - + + + + + + + + - - + + + - + + + + + + + + + + + + + + + + + + + - - - - + + + + + + + + + + + + + + + + + + + + + + - + + +	static int GetKeyNames( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Key to enumerate. */ Tcl_Obj *patternObj) /* Optional match pattern. */ { char *pattern; /* Pattern being matched against subkeys */ HKEY key; DWORD index; char buffer[MAX_PATH+1], *pattern, *name; Tcl_Obj *resultPtr; int result = TCL_OK; Tcl_DString ds; HKEY key; /* Handle to the key being examined */ DWORD subKeyCount; /* Number of subkeys to list */ DWORD maxSubKeyLen; /* Maximum string length of any subkey */ char *buffer; /* Buffer to hold the subkey name */ DWORD bufSize; /* Size of the buffer */ DWORD index; /* Position of the current subkey */ char *name; /* Subkey name */ Tcl_Obj *resultPtr; /* List of subkeys being accumulated */ int result = TCL_OK; /* Return value from this command */ Tcl_DString ds; /* Buffer to translate subkey name to UTF-8 */ /* * Attempt to open the key for enumeration. */ if (OpenKey(interp, keyNameObj, KEY_ENUMERATE_SUB_KEYS, 0, &key) != TCL_OK) { return TCL_ERROR; } if (patternObj) { pattern = Tcl_GetString(patternObj); } else { pattern = NULL; } /* Attempt to open the key for enumeration. */ if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS, 0, &key) != TCL_OK) { return TCL_ERROR; } /* * Enumerate over the subkeys until we get an error, indicating the /* * Determine how big a buffer is needed for enumerating subkeys, and * how many subkeys there are * end of the list. */ result = (*regWinProcs->regQueryInfoKeyProc) (key, NULL, NULL, NULL, &subKeyCount, &maxSubKeyLen, NULL, NULL, NULL, NULL, NULL, NULL); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_NewObj()); Tcl_AppendResult(interp, "unable to query key \"", Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); RegCloseKey(key); return TCL_ERROR; } if (regWinProcs->useWide) { buffer = ckalloc((maxSubKeyLen+1) * sizeof(WCHAR)); } else { buffer = ckalloc(maxSubKeyLen+1); } /* Enumerate the subkeys */ resultPtr = Tcl_GetObjResult(interp); for (index = 0; (*regWinProcs->regEnumKeyProc)(key, index, buffer, MAX_PATH+1) == ERROR_SUCCESS; index++) { Tcl_WinTCharToUtf((TCHAR *) buffer, -1, &ds); resultPtr = Tcl_NewObj(); for (index = 0; index < subKeyCount; ++index) { bufSize = maxSubKeyLen+1; result = (*regWinProcs->regEnumKeyExProc) (key, index, buffer, &bufSize, NULL, NULL, NULL, NULL); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_NewObj()); Tcl_AppendResult(interp, "unable to enumerate subkeys of \"", Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); result = TCL_ERROR; break; } if (regWinProcs->useWide) { Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize * sizeof(WCHAR), &ds); } else { Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize, &ds); } name = Tcl_DStringValue(&ds); if (pattern && !Tcl_StringMatch(name, pattern)) { Tcl_DStringFree(&ds); continue; } result = Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(name, Tcl_DStringLength(&ds))); Tcl_DStringFree(&ds); if (result != TCL_OK) { break; } } if (result == TCL_OK) { Tcl_SetObjResult(interp, resultPtr); } ckfree(buffer); RegCloseKey(key); return result; }  /* *---------------------------------------------------------------------- *
︙
978 979 980 981 982 983 984 985 986 987 988 989 990 991 992	1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035	- +	* Now open the specified key with the requested permissions. Note * that this key must be closed by the caller. */ keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf); if (flags & REG_CREATE) { DWORD create; result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, "", result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, NULL, REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create); } else { if (rootKey == HKEY_PERFORMANCE_DATA) { /* * Here we fudge it for this special root key. * See MSDN for more info on HKEY_PERFORMANCE_DATA and * the peculiarities surrounding it
︙
1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338	1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381	- +	static int BroadcastValue( Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj * CONST objv[]) /* Argument values. */ { DWORD result, sendResult; LRESULT result, sendResult; UINT timeout = 3000; int len; char *str; Tcl_Obj *objPtr; if ((objc != 3) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?");
︙
1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373	1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416	- - + +	/* * Use the ignore the result. */ result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult); objPtr = Tcl_NewObj(); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj((int) result)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj((int) sendResult)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) result)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) sendResult)); Tcl_SetObjResult(interp, objPtr); return TCL_OK; }  /* *----------------------------------------------------------------------
︙

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21	- +	/* * tclWinSerial.c -- * * This file implements the Windows-specific serial port functions, * and the "serial" channel driver. * * Copyright (c) 1999 by Scriptics Corp. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * Serial functionality implemented by Rolf.Schroedter@dlr.de * * RCS: @(#) $Id: tclWinSerial.c,v 1.25 2003/01/16 20:55:53 hobbs Exp $ * RCS: @(#) $Id: tclWinSerial.c,v 1.25.2.3 2005/10/05 06:33:52 hobbs Exp $ */ #include "tclWinInt.h" #include <fcntl.h> #include <io.h> #include <sys/stat.h>
︙
186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219	186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224	+ + + - + + +	Tcl_Interp *interp, CONST char *optionName, Tcl_DString *dsPtr)); static int SerialSetOptionProc _ANSI_ARGS_((ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, CONST char *value)); static DWORD WINAPI SerialWriterThread(LPVOID arg); static void SerialThreadActionProc _ANSI_ARGS_ (( ClientData instanceData, int action)); /* * This structure describes the channel type structure for command serial * based IO. */ static Tcl_ChannelType serialChannelType = { "serial", /* Type name. */ TCL_CHANNEL_VERSION_2, /* v2 channel */ TCL_CHANNEL_VERSION_4, /* v4 channel */ SerialCloseProc, /* Close proc. */ SerialInputProc, /* Input proc. */ SerialOutputProc, /* Output proc. */ NULL, /* Seek proc. */ SerialSetOptionProc, /* Set option proc. */ SerialGetOptionProc, /* Get option proc. */ SerialWatchProc, /* Set up notifier to watch the channel. */ SerialGetHandleProc, /* Get an OS handle from channel. */ NULL, /* close2proc. */ SerialBlockProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc */ SerialThreadActionProc, /* thread action proc */ }; /* *---------------------------------------------------------------------- * * SerialInit -- *
︙
643 644 645 646 647 648 649 650 651 652 653 654 655 656	648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663	+ +	TerminateThread(serialPtr->writeThread, 0); Tcl_MutexUnlock(&serialMutex); } } CloseHandle(serialPtr->writeThread); CloseHandle(serialPtr->osWrite.hEvent); DeleteCriticalSection(&serialPtr->csWrite); CloseHandle(serialPtr->evWritable); CloseHandle(serialPtr->evStartWriter); CloseHandle(serialPtr->evStopWriter); serialPtr->writeThread = NULL; PurgeComm(serialPtr->handle, PURGE_TXABORT | PURGE_TXCLEAR); }
︙
1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354	1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364	+ + - + +	/* * Alert the foreground thread. Note that we need to treat this like * a critical section so the foreground thread does not terminate * this thread while we are holding a mutex in the notifier code. */ Tcl_MutexLock(&serialMutex); if (infoPtr->threadId != NULL) { /* TIP #218. When in flight ignore the event, no one will receive it anyway */ Tcl_ThreadAlert(infoPtr->threadId); Tcl_ThreadAlert(infoPtr->threadId); } Tcl_MutexUnlock(&serialMutex); } return 0; }
︙
1413 1414 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	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	- - + - - + + + + + + + + + + + + - - - - - - - -	Tcl_Channel TclWinOpenSerialChannel(handle, channelName, permissions) HANDLE handle; char *channelName; int permissions; { SerialInfo *infoPtr; ThreadSpecificData *tsdPtr; DWORD id; tsdPtr = SerialInit(); SerialInit(); infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo)); memset(infoPtr, 0, sizeof(SerialInfo)); infoPtr->validMask = permissions; infoPtr->handle = handle; infoPtr->validMask = permissions; infoPtr->handle = handle; infoPtr->channel = (Tcl_Channel) NULL; infoPtr->readable = 0; infoPtr->writable = 1; infoPtr->toWrite = infoPtr->writeQueue = 0; infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME; infoPtr->lastEventTime = 0; infoPtr->lastError = infoPtr->error = 0; infoPtr->threadId = Tcl_GetCurrentThread(); infoPtr->sysBufRead = 4096; infoPtr->sysBufWrite = 4096; /* * Use the pointer to keep the channel names unique, in case * the handles are shared between multiple channels (stdin/stdout). */ wsprintfA(channelName, "file%lx", (int) infoPtr); infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName, (ClientData) infoPtr, permissions); infoPtr->readable = 0; infoPtr->writable = 1; infoPtr->toWrite = infoPtr->writeQueue = 0; infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME; infoPtr->lastEventTime = 0; infoPtr->lastError = infoPtr->error = 0; infoPtr->threadId = Tcl_GetCurrentThread(); infoPtr->sysBufRead = infoPtr->sysBufWrite = 4096; SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite); PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR); /* * default is blocking
︙
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 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894	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 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910	- - - - + + + + - + - - - - + + + + - - - + + + - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + - - - - - + + + + + - - - - - - - - + + + + + + + + - - - - + + + + - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - + + + + - - - - + + + + - - - - - + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - + + + - - - - - + + + + + - - - - + + + + - - - - - - - - - - - - - - + + + + + + + + + + + + + + - + - + - +	* Side effects: * May modify an option on a device. * *---------------------------------------------------------------------- */ static int SerialSetOptionProc(instanceData, interp, optionName, value) ClientData instanceData; /* File state. */ Tcl_Interp *interp; /* For error reporting - can be NULL. */ CONST char *optionName; /* Which option to set? */ CONST char *value; /* New value for option. */ ClientData instanceData; /* File state. */ Tcl_Interp *interp; /* For error reporting - can be NULL. */ CONST char *optionName; /* Which option to set? */ CONST char *value; /* New value for option. */ { SerialInfo *infoPtr; DCB dcb; BOOL result, flag; size_t len, vlen; Tcl_DString ds; CONST TCHAR *native; int argc; CONST char **argv; infoPtr = (SerialInfo *) instanceData; /* * Parse options */ /* * Parse options */ len = strlen(optionName); vlen = strlen(value); /* * Option -mode baud,parity,databits,stopbits */ /* * Option -mode baud,parity,databits,stopbits */ if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) { if (! GetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't get comm state", (char *) NULL); } return TCL_ERROR; } native = Tcl_WinUtfToTChar(value, -1, &ds); result = (*tclWinProcs->buildCommDCBProc)(native, &dcb); Tcl_DStringFree(&ds); if (result == FALSE) { if (interp) { Tcl_AppendResult(interp, "bad value for -mode: should be baud,parity,data,stop", (char *) NULL); } return TCL_ERROR; } if (! GetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't get comm state", (char *) NULL); } return TCL_ERROR; } native = Tcl_WinUtfToTChar(value, -1, &ds); result = (*tclWinProcs->buildCommDCBProc)(native, &dcb); Tcl_DStringFree(&ds); if (result == FALSE) { if (interp) { Tcl_AppendResult(interp, "bad value for -mode: should be baud,parity,data,stop", (char *) NULL); } return TCL_ERROR; } /* Default settings for serial communications */ dcb.fBinary = TRUE; dcb.fErrorChar = FALSE; dcb.fNull = FALSE; dcb.fAbortOnError = FALSE; /* Default settings for serial communications */ dcb.fBinary = TRUE; dcb.fErrorChar = FALSE; dcb.fNull = FALSE; dcb.fAbortOnError = FALSE; if (! SetCommState(infoPtr->handle, &dcb) ) { if (interp) { Tcl_AppendResult(interp, "can't set comm state", (char *) NULL); } return TCL_ERROR; } return TCL_OK; if (! SetCommState(infoPtr->handle, &dcb) ) { if (interp) { Tcl_AppendResult(interp, "can't set comm state", (char *) NULL); } return TCL_ERROR; } return TCL_OK; } /* * Option -handshake none|xonxoff|rtscts|dtrdsr */ /* * Option -handshake none|xonxoff|rtscts|dtrdsr */ if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) { if (! GetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't get comm state", (char *) NULL); } return TCL_ERROR; } /* * Reset all handshake options * DTR and RTS are ON by default */ dcb.fOutX = dcb.fInX = FALSE; dcb.fOutxCtsFlow = dcb.fOutxDsrFlow = dcb.fDsrSensitivity = FALSE; dcb.fDtrControl = DTR_CONTROL_ENABLE; dcb.fRtsControl = RTS_CONTROL_ENABLE; dcb.fTXContinueOnXoff = FALSE; if (! GetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't get comm state", (char *) NULL); } return TCL_ERROR; } /* * Reset all handshake options * DTR and RTS are ON by default */ dcb.fOutX = dcb.fInX = FALSE; dcb.fOutxCtsFlow = dcb.fOutxDsrFlow = dcb.fDsrSensitivity = FALSE; dcb.fDtrControl = DTR_CONTROL_ENABLE; dcb.fRtsControl = RTS_CONTROL_ENABLE; dcb.fTXContinueOnXoff = FALSE; /* * Adjust the handshake limits. * Yes, the XonXoff limits seem to influence even hardware handshake */ dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2); dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4); if (strnicmp(value, "NONE", vlen) == 0) { /* leave all handshake options disabled */ } else if (strnicmp(value, "XONXOFF", vlen) == 0) { dcb.fOutX = dcb.fInX = TRUE; } else if (strnicmp(value, "RTSCTS", vlen) == 0) { dcb.fOutxCtsFlow = TRUE; dcb.fRtsControl = RTS_CONTROL_HANDSHAKE; } else if (strnicmp(value, "DTRDSR", vlen) == 0) { dcb.fOutxDsrFlow = TRUE; dcb.fDtrControl = DTR_CONTROL_HANDSHAKE; } else { if (interp) { Tcl_AppendResult(interp, "bad value for -handshake: ", "must be one of xonxoff, rtscts, dtrdsr or none", (char *) NULL); return TCL_ERROR; } } if (! SetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't set comm state", (char *) NULL); } return TCL_ERROR; } return TCL_OK; /* * Adjust the handshake limits. * Yes, the XonXoff limits seem to influence even hardware handshake */ dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2); dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4); if (strnicmp(value, "NONE", vlen) == 0) { /* leave all handshake options disabled */ } else if (strnicmp(value, "XONXOFF", vlen) == 0) { dcb.fOutX = dcb.fInX = TRUE; } else if (strnicmp(value, "RTSCTS", vlen) == 0) { dcb.fOutxCtsFlow = TRUE; dcb.fRtsControl = RTS_CONTROL_HANDSHAKE; } else if (strnicmp(value, "DTRDSR", vlen) == 0) { dcb.fOutxDsrFlow = TRUE; dcb.fDtrControl = DTR_CONTROL_HANDSHAKE; } else { if (interp) { Tcl_AppendResult(interp, "bad value for -handshake: ", "must be one of xonxoff, rtscts, dtrdsr or none", (char *) NULL); return TCL_ERROR; } } if (! SetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't set comm state", (char *) NULL); } return TCL_ERROR; } return TCL_OK; } /* * Option -xchar {\x11 \x13} */ /* * Option -xchar {\x11 \x13} */ if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) { if (! GetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't get comm state", (char *) NULL); } return TCL_ERROR; } if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } if (argc == 2) { dcb.XonChar = argv[0][0]; dcb.XoffChar = argv[1][0]; } else { if (interp) { Tcl_AppendResult(interp, "bad value for -xchar: should be a list of two elements", (char *) NULL); } return TCL_ERROR; } if (! SetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't set comm state", (char *) NULL); } return TCL_ERROR; } return TCL_OK; if (! GetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't get comm state", (char *) NULL); } return TCL_ERROR; } if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } if (argc == 2) { dcb.XonChar = argv[0][0]; dcb.XoffChar = argv[1][0]; ckfree((char *) argv); } else { if (interp) { Tcl_AppendResult(interp, "bad value for -xchar: should be a list of two elements", (char *) NULL); } ckfree((char *) argv); return TCL_ERROR; } if (! SetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't set comm state", (char *) NULL); } return TCL_ERROR; } return TCL_OK; } /* * Option -ttycontrol {DTR 1 RTS 0 BREAK 0} */ /* * Option -ttycontrol {DTR 1 RTS 0 BREAK 0} */ if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) { int i, result = TCL_OK; if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } if ((argc % 2) == 1) { if (interp) { Tcl_AppendResult(interp, "bad value for -ttycontrol: should be a list of signal,value pairs", (char *) NULL); } return TCL_ERROR; } while (argc > 1) { if (Tcl_GetBoolean(interp, argv[1], &flag) == TCL_ERROR) { return TCL_ERROR; } if (strnicmp(argv[0], "DTR", strlen(argv[0])) == 0) { if (! EscapeCommFunction(infoPtr->handle, flag ? (DWORD) SETDTR : (DWORD) CLRDTR)) { if (interp) { Tcl_AppendResult(interp, "can't set DTR signal", (char *) NULL); } return TCL_ERROR; } } else if (strnicmp(argv[0], "RTS", strlen(argv[0])) == 0) { if (! EscapeCommFunction(infoPtr->handle, flag ? (DWORD) SETRTS : (DWORD) CLRRTS)) { if (interp) { Tcl_AppendResult(interp, "can't set RTS signal", (char *) NULL); } return TCL_ERROR; } } else if (strnicmp(argv[0], "BREAK", strlen(argv[0])) == 0) { if (! EscapeCommFunction(infoPtr->handle, flag ? (DWORD) SETBREAK : (DWORD) CLRBREAK)) { if (interp) { Tcl_AppendResult(interp, "can't set BREAK signal", (char *) NULL); } return TCL_ERROR; } } else { if (interp) { Tcl_AppendResult(interp, "bad signal for -ttycontrol: must be DTR, RTS or BREAK", if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } if ((argc % 2) == 1) { if (interp) { Tcl_AppendResult(interp, "bad value for -ttycontrol: should be a list of signal,value pairs", (char *) NULL); } ckfree((char *) argv); return TCL_ERROR; } for (i = 0; i < argc - 1; i += 2) { if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) { result = TCL_ERROR; break; } if (strnicmp(argv[i], "DTR", strlen(argv[i])) == 0) { if (!EscapeCommFunction(infoPtr->handle, flag ? (DWORD) SETDTR : (DWORD) CLRDTR)) { if (interp) { Tcl_AppendResult(interp, "can't set DTR signal", (char *) NULL); } result = TCL_ERROR; break; } } else if (strnicmp(argv[i], "RTS", strlen(argv[i])) == 0) { if (!EscapeCommFunction(infoPtr->handle, flag ? (DWORD) SETRTS : (DWORD) CLRRTS)) { if (interp) { Tcl_AppendResult(interp, "can't set RTS signal", (char *) NULL); } result = TCL_ERROR; break; } } else if (strnicmp(argv[i], "BREAK", strlen(argv[i])) == 0) { if (!EscapeCommFunction(infoPtr->handle, flag ? (DWORD) SETBREAK : (DWORD) CLRBREAK)) { if (interp) { Tcl_AppendResult(interp, "can't set BREAK signal", (char *) NULL); } result = TCL_ERROR; break; } } else { if (interp) { Tcl_AppendResult(interp, "bad signal for -ttycontrol: ", "must be DTR, RTS or BREAK", (char *) NULL); (char *) NULL); } return TCL_ERROR; } } result = TCL_ERROR; break; } argc -= 2, argv += 2; } /* while (argc > 1) */ return TCL_OK; } ckfree((char *) argv); return result; } /* * Option -sysbuffer {read_size write_size} * Option -sysbuffer read_size */ /* * Option -sysbuffer {read_size write_size} * Option -sysbuffer read_size */ if ((len > 1) && (strncmp(optionName, "-sysbuffer", len) == 0)) { /* * -sysbuffer 4096 or -sysbuffer {64536 4096} */ size_t inSize = (size_t) -1, outSize = (size_t) -1; if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } if (argc == 1) { inSize = atoi(argv[0]); outSize = infoPtr->sysBufWrite; } else if (argc == 2) { inSize = atoi(argv[0]); outSize = atoi(argv[1]); } if ( (inSize <= 0) || (outSize <= 0) ) { if (interp) { Tcl_AppendResult(interp, "bad value for -sysbuffer: should be a list of one or two integers > 0", (char *) NULL); } return TCL_ERROR; } if (! SetupComm(infoPtr->handle, inSize, outSize)) { if (interp) { Tcl_AppendResult(interp, "can't setup comm buffers", (char *) NULL); } return TCL_ERROR; } infoPtr->sysBufRead = inSize; infoPtr->sysBufWrite = outSize; /* * Adjust the handshake limits. * Yes, the XonXoff limits seem to influence even hardware handshake */ if (! GetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't get comm state", (char *) NULL); } return TCL_ERROR; } dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2); dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4); if (! SetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't set comm state", (char *) NULL); } return TCL_ERROR; } return TCL_OK; /* * -sysbuffer 4096 or -sysbuffer {64536 4096} */ size_t inSize = (size_t) -1, outSize = (size_t) -1; if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } if (argc == 1) { inSize = atoi(argv[0]); outSize = infoPtr->sysBufWrite; } else if (argc == 2) { inSize = atoi(argv[0]); outSize = atoi(argv[1]); } ckfree((char *) argv); if ((inSize <= 0) || (outSize <= 0)) { if (interp) { Tcl_AppendResult(interp, "bad value for -sysbuffer: should be a list of one or two integers > 0", (char *) NULL); } return TCL_ERROR; } if (! SetupComm(infoPtr->handle, inSize, outSize)) { if (interp) { Tcl_AppendResult(interp, "can't setup comm buffers", (char *) NULL); } return TCL_ERROR; } infoPtr->sysBufRead = inSize; infoPtr->sysBufWrite = outSize; /* * Adjust the handshake limits. * Yes, the XonXoff limits seem to influence even hardware handshake */ if (! GetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't get comm state", (char *) NULL); } return TCL_ERROR; } dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2); dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4); if (! SetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't set comm state", (char *) NULL); } return TCL_ERROR; } return TCL_OK; } /* * Option -pollinterval msec */ /* * Option -pollinterval msec */ if ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0)) { if ( Tcl_GetInt(interp, value, &(infoPtr->blockTime)) != TCL_OK ) { return TCL_ERROR; } return TCL_OK; if ( Tcl_GetInt(interp, value, &(infoPtr->blockTime)) != TCL_OK ) { return TCL_ERROR; } return TCL_OK; } /* * Option -timeout msec */ /* * Option -timeout msec */ if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) { int msec; COMMTIMEOUTS tout = {0,0,0,0,0}; if ( Tcl_GetInt(interp, value, &msec) != TCL_OK ) { return TCL_ERROR; } tout.ReadTotalTimeoutConstant = msec; if (! SetCommTimeouts(infoPtr->handle, &tout)) { if (interp) { Tcl_AppendResult(interp, "can't set comm timeouts", (char *) NULL); } return TCL_ERROR; } int msec; COMMTIMEOUTS tout = {0,0,0,0,0}; if ( Tcl_GetInt(interp, value, &msec) != TCL_OK ) { return TCL_ERROR; } tout.ReadTotalTimeoutConstant = msec; if (! SetCommTimeouts(infoPtr->handle, &tout)) { if (interp) { Tcl_AppendResult(interp, "can't set comm timeouts", (char *) NULL); } return TCL_ERROR; } return TCL_OK; return TCL_OK; } return Tcl_BadChannelOption(interp, optionName, "mode handshake pollinterval sysbuffer timeout ttycontrol xchar"); "mode handshake pollinterval sysbuffer timeout ttycontrol xchar"); } /* *---------------------------------------------------------------------- * * SerialGetOptionProc -- *
︙
1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 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 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107	1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 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 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 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 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171	- - - - + + + + - + - + - + - + - + - - - + + + - + - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + - + - - - + + + - + - - - - - - + + + + + + - + - - - + + + - - + + - + - - + + - - - - + + + + - + - + - - - + + + - - + + - + - - + + - - - - - - - - - - - + + + + + + + + + + + - + - - - - - + + + + + - - + + - + - - - - + + + + - - - + + + - + - - - - + + + + - - - - - - - - - - + + + + + + + + + + - - - - + + + + - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + - + - + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	* The string returned by this function is in static storage and * may be reused at any time subsequent to the call. * *---------------------------------------------------------------------- */ static int SerialGetOptionProc(instanceData, interp, optionName, dsPtr) ClientData instanceData; /* File state. */ Tcl_Interp *interp; /* For error reporting - can be NULL. */ CONST char *optionName; /* Option to get. */ Tcl_DString *dsPtr; /* Where to store value(s). */ ClientData instanceData; /* File state. */ Tcl_Interp *interp; /* For error reporting - can be NULL. */ CONST char *optionName; /* Option to get. */ Tcl_DString *dsPtr; /* Where to store value(s). */ { SerialInfo *infoPtr; DCB dcb; size_t len; int valid = 0; /* flag if valid option parsed */ infoPtr = (SerialInfo *) instanceData; if (optionName == NULL) { len = 0; len = 0; } else { len = strlen(optionName); len = strlen(optionName); } /* * get option -mode */ * get option -mode */ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-mode"); Tcl_DStringAppendElement(dsPtr, "-mode"); } if ((len == 0) || ((len > 2) && (strncmp(optionName, "-mode", len) == 0))) { char parity; char *stop; char buf[2 * TCL_INTEGER_SPACE + 16]; if (! GetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't get comm state", (char *) NULL); } return TCL_ERROR; } valid = 1; parity = 'n'; if (dcb.Parity <= 4) { parity = "noems"[dcb.Parity]; } stop = (dcb.StopBits == ONESTOPBIT) ? "1" : (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2"; wsprintfA(buf, "%d,%c,%d,%s", dcb.BaudRate, parity, dcb.ByteSize, stop); Tcl_DStringAppendElement(dsPtr, buf); ((len > 2) && (strncmp(optionName, "-mode", len) == 0))) { char parity; char *stop; char buf[2 * TCL_INTEGER_SPACE + 16]; if (! GetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't get comm state", (char *) NULL); } return TCL_ERROR; } valid = 1; parity = 'n'; if (dcb.Parity <= 4) { parity = "noems"[dcb.Parity]; } stop = (dcb.StopBits == ONESTOPBIT) ? "1" : (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2"; wsprintfA(buf, "%d,%c,%d,%s", dcb.BaudRate, parity, dcb.ByteSize, stop); Tcl_DStringAppendElement(dsPtr, buf); } /* * get option -pollinterval */ * get option -pollinterval */ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-pollinterval"); Tcl_DStringAppendElement(dsPtr, "-pollinterval"); } if ((len == 0) || ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0))) { char buf[TCL_INTEGER_SPACE + 1]; valid = 1; wsprintfA(buf, "%d", infoPtr->blockTime); Tcl_DStringAppendElement(dsPtr, buf); ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0))) { char buf[TCL_INTEGER_SPACE + 1]; valid = 1; wsprintfA(buf, "%d", infoPtr->blockTime); Tcl_DStringAppendElement(dsPtr, buf); } /* * get option -sysbuffer */ * get option -sysbuffer */ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-sysbuffer"); Tcl_DStringStartSublist(dsPtr); Tcl_DStringAppendElement(dsPtr, "-sysbuffer"); Tcl_DStringStartSublist(dsPtr); } if ((len == 0) || ((len > 1) && (strncmp(optionName, "-sysbuffer", len) == 0))) { ((len > 1) && (strncmp(optionName, "-sysbuffer", len) == 0))) { char buf[TCL_INTEGER_SPACE + 1]; valid = 1; char buf[TCL_INTEGER_SPACE + 1]; valid = 1; wsprintfA(buf, "%d", infoPtr->sysBufRead); Tcl_DStringAppendElement(dsPtr, buf); wsprintfA(buf, "%d", infoPtr->sysBufWrite); Tcl_DStringAppendElement(dsPtr, buf); wsprintfA(buf, "%d", infoPtr->sysBufRead); Tcl_DStringAppendElement(dsPtr, buf); wsprintfA(buf, "%d", infoPtr->sysBufWrite); Tcl_DStringAppendElement(dsPtr, buf); } if (len == 0) { Tcl_DStringEndSublist(dsPtr); Tcl_DStringEndSublist(dsPtr); } /* * get option -xchar */ * get option -xchar */ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-xchar"); Tcl_DStringStartSublist(dsPtr); Tcl_DStringAppendElement(dsPtr, "-xchar"); Tcl_DStringStartSublist(dsPtr); } if ((len == 0) || ((len > 1) && (strncmp(optionName, "-xchar", len) == 0))) { ((len > 1) && (strncmp(optionName, "-xchar", len) == 0))) { char buf[4]; valid = 1; char buf[4]; valid = 1; if (! GetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't get comm state", (char *) NULL); } return TCL_ERROR; } sprintf(buf, "%c", dcb.XonChar); Tcl_DStringAppendElement(dsPtr, buf); sprintf(buf, "%c", dcb.XoffChar); Tcl_DStringAppendElement(dsPtr, buf); if (! GetCommState(infoPtr->handle, &dcb)) { if (interp) { Tcl_AppendResult(interp, "can't get comm state", (char *) NULL); } return TCL_ERROR; } sprintf(buf, "%c", dcb.XonChar); Tcl_DStringAppendElement(dsPtr, buf); sprintf(buf, "%c", dcb.XoffChar); Tcl_DStringAppendElement(dsPtr, buf); } if (len == 0) { Tcl_DStringEndSublist(dsPtr); Tcl_DStringEndSublist(dsPtr); } /* * get option -lasterror * option is readonly and returned by [fconfigure chan -lasterror] * but not returned by unnamed [fconfigure chan] */ * get option -lasterror * option is readonly and returned by [fconfigure chan -lasterror] * but not returned by unnamed [fconfigure chan] */ if ( (len > 1) && (strncmp(optionName, "-lasterror", len) == 0) ) { valid = 1; SerialErrorStr(infoPtr->lastError, dsPtr); valid = 1; SerialErrorStr(infoPtr->lastError, dsPtr); } /* * get option -queue * option is readonly and returned by [fconfigure chan -queue] */ * get option -queue * option is readonly and returned by [fconfigure chan -queue] */ if ((len > 1) && (strncmp(optionName, "-queue", len) == 0)) { char buf[TCL_INTEGER_SPACE + 1]; COMSTAT cStat; DWORD error; char buf[TCL_INTEGER_SPACE + 1]; COMSTAT cStat; DWORD error; int inBuffered, outBuffered, count; valid = 1; valid = 1; /* * Query the pending data in Tcl's internal queues */ inBuffered = Tcl_InputBuffered(infoPtr->channel); /* * Query the pending data in Tcl's internal queues */ inBuffered = Tcl_InputBuffered(infoPtr->channel); outBuffered = Tcl_OutputBuffered(infoPtr->channel); /* * Query the number of bytes in our output queue: * 1. The bytes pending in the output thread * 2. The bytes in the system drivers buffer * The writer thread should not interfere this action. */ EnterCriticalSection(&infoPtr->csWrite); ClearCommError( infoPtr->handle, &error, &cStat ); count = (int)cStat.cbOutQue + infoPtr->writeQueue; LeaveCriticalSection(&infoPtr->csWrite); /* * Query the number of bytes in our output queue: * 1. The bytes pending in the output thread * 2. The bytes in the system drivers buffer * The writer thread should not interfere this action. */ EnterCriticalSection(&infoPtr->csWrite); ClearCommError( infoPtr->handle, &error, &cStat ); count = (int)cStat.cbOutQue + infoPtr->writeQueue; LeaveCriticalSection(&infoPtr->csWrite); wsprintfA(buf, "%d", inBuffered + cStat.cbInQue); Tcl_DStringAppendElement(dsPtr, buf); wsprintfA(buf, "%d", outBuffered + count); Tcl_DStringAppendElement(dsPtr, buf); wsprintfA(buf, "%d", inBuffered + cStat.cbInQue); Tcl_DStringAppendElement(dsPtr, buf); wsprintfA(buf, "%d", outBuffered + count); Tcl_DStringAppendElement(dsPtr, buf); } /* * get option -ttystatus * option is readonly and returned by [fconfigure chan -ttystatus] * but not returned by unnamed [fconfigure chan] */ if ( (len > 4) && (strncmp(optionName, "-ttystatus", len) == 0) ) { DWORD status; if (! GetCommModemStatus(infoPtr->handle, &status)) { if (interp) { Tcl_AppendResult(interp, "can't get tty status", (char *) NULL); } return TCL_ERROR; } valid = 1; SerialModemStatusStr(status, dsPtr); * get option -ttystatus * option is readonly and returned by [fconfigure chan -ttystatus] * but not returned by unnamed [fconfigure chan] */ if ((len > 4) && (strncmp(optionName, "-ttystatus", len) == 0)) { DWORD status; if (! GetCommModemStatus(infoPtr->handle, &status)) { if (interp) { Tcl_AppendResult(interp, "can't get tty status", (char *) NULL); } return TCL_ERROR; } valid = 1; SerialModemStatusStr(status, dsPtr); } if (valid) { return TCL_OK; return TCL_OK; } else { return Tcl_BadChannelOption(interp, optionName, "mode pollinterval lasterror queue sysbuffer ttystatus xchar"); return Tcl_BadChannelOption(interp, optionName, "mode pollinterval lasterror queue sysbuffer ttystatus xchar"); } }  /* *---------------------------------------------------------------------- * * SerialThreadActionProc -- * * Insert or remove any thread local refs to this channel. * * Results: * None. * * Side effects: * Changes thread local list of valid channels. * *---------------------------------------------------------------------- */ static void SerialThreadActionProc (instanceData, action) ClientData instanceData; int action; { SerialInfo *infoPtr = (SerialInfo *) instanceData; /* We do not access firstSerialPtr in the thread structures. This is * not for all serials managed by the thread, but only those we are * watching. Removal of the filevent handlers before transfer thus * takes care of this structure. */ Tcl_MutexLock(&serialMutex); if (action == TCL_CHANNEL_THREAD_INSERT) { /* We can't copy the thread information from the channel when * the channel is created. At this time the channel back * pointer has not been set yet. However in that case the * threadId has already been set by TclpCreateCommandChannel * itself, so the structure is still good. */ SerialInit (); if (infoPtr->channel != NULL) { infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel); } } else { infoPtr->threadId = NULL; } Tcl_MutexUnlock(&serialMutex); }

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18	- +	/* * tclWinSock.c -- * * This file contains Windows-specific socket related code. * * Copyright (c) 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. * * RCS: @(#) $Id: tclWinSock.c,v 1.36 2003/01/16 19:02:00 mdejong Exp $ * RCS: @(#) $Id: tclWinSock.c,v 1.36.2.6 2006/09/26 21:40:37 patthoyts Exp $ */ #include "tclWinInt.h" /* * Make sure to remove the redirection defines set in tclWinPort.h * that is in use in other sections of the core, except for us.
︙
245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307	245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312	- + + + + - + + + - +	static Tcl_EventProc SocketEventProc; static void SocketExitHandler _ANSI_ARGS_(( ClientData clientData)); static LRESULT CALLBACK SocketProc _ANSI_ARGS_((HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam)); static Tcl_EventSetupProc SocketSetupProc; static Tcl_ExitProc SocketThreadExitHandler; static int SocketsEnabled _ANSI_ARGS_((void)); static void TcpAccept _ANSI_ARGS_((SocketInfo *infoPtr)); static Tcl_DriverBlockModeProc TcpBlockProc; static Tcl_DriverCloseProc TcpCloseProc; static Tcl_DriverSetOptionProc TcpSetOptionProc; static Tcl_DriverGetOptionProc TcpGetOptionProc; static Tcl_DriverInputProc TcpInputProc; static Tcl_DriverOutputProc TcpOutputProc; static Tcl_DriverWatchProc TcpWatchProc; static Tcl_DriverGetHandleProc TcpGetHandleProc; static int WaitForSocketEvent _ANSI_ARGS_(( SocketInfo *infoPtr, int events, int *errorCodePtr)); static DWORD WINAPI SocketThread _ANSI_ARGS_((LPVOID arg)); static void TcpThreadActionProc _ANSI_ARGS_ (( ClientData instanceData, int action)); /* * This structure describes the channel type structure for TCP socket * based IO. */ static Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_2, /* v2 channel */ TCL_CHANNEL_VERSION_4, /* v4 channel */ TcpCloseProc, /* Close proc. */ TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ TcpSetOptionProc, /* Set option proc. */ TcpGetOptionProc, /* Get option proc. */ TcpWatchProc, /* Set up notifier to watch this channel. */ TcpGetHandleProc, /* Get an OS handle from channel. */ NULL, /* close2proc. */ TcpBlockProc, /* Set socket into (non-)blocking mode. */ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc */ TcpThreadActionProc, /* thread action proc */ };  /* *---------------------------------------------------------------------- * * InitSockets -- * * Initialize the socket module. Attempts to load the wsock32.dll * library and set up the winSock function table. If successful, * registers the event window for the socket notifier code. * * Assumes Mutex is held. * Assumes socketMutex is held. * * Results: * None. * * Side effects: * Dynamically loads wsock32.dll, and registers a new window * class and creates a window for use in asynchronous socket
︙
481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533	486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534	- + - - + - + + + + + + - - - + + - - + + - - - + + - - - + - - + - + - - - + -	/* * Check for per-thread initialization. */ if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->socketList = NULL; tsdPtr->hwnd = NULL; tsdPtr->hwnd = NULL; tsdPtr->threadId = Tcl_GetCurrentThread(); tsdPtr->threadId = Tcl_GetCurrentThread(); tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL); if (tsdPtr->readyEvent == NULL) { goto unloadLibrary; } tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL); if (tsdPtr->socketListLock == NULL) { goto unloadLibrary; } tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, 0, &id); SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST); if (tsdPtr->socketThread == NULL) { goto unloadLibrary; } SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST); /* * Wait for the thread to signal that the window has * been created and is ready to go. Timeout after twenty * Wait for the thread to signal when the window has * been created and if it is ready to go. * seconds. */ if (WaitForSingleObject(tsdPtr->readyEvent, 20000) WaitForSingleObject(tsdPtr->readyEvent, INFINITE); == WAIT_TIMEOUT) { goto unloadLibrary; } if (tsdPtr->hwnd == NULL) { goto unloadLibrary; goto unloadLibrary; /* Trouble creating the window */ } Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL); Tcl_CreateThreadExitHandler(SocketThreadExitHandler, NULL); } return; unloadLibrary: if (tsdPtr != NULL && tsdPtr->hwnd != NULL) { SocketThreadExitHandler(0); TclpFinalizeSockets(); } FreeLibrary(winSock.hModule); winSock.hModule = NULL; return; }  /* *----------------------------------------------------------------------
︙
558 559 560 561 562 563 564 565 566 567 568 569 570 571 572	559 560 561 562 563 564 565 566 567 568 569 570 571 572 573	- +	/* *---------------------------------------------------------------------- * * SocketExitHandler -- * * Callback invoked during exit clean up to delete the socket * Callback invoked during app exit clean up to delete the socket * communication window and to release the WinSock DLL. * * Results: * None. * * Side effects: * None.
︙
581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650	582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653	- + - + + + + - + - - + - - - + + - - + - + - + - - - - - + + + - - - - - + + + + - - - - - - - - + + + + + + + + + + + + + + -	{ Tcl_MutexLock(&socketMutex); if (winSock.hModule) { /* * Make sure the socket event handling window is cleaned-up * for, at most, this thread. */ SocketThreadExitHandler(clientData); TclpFinalizeSockets(); UnregisterClass("TclSocket", TclWinGetTclInstance()); winSock.WSACleanup(); FreeLibrary(winSock.hModule); winSock.hModule = NULL; } initialized = 0; hostnameInitialized = 0; Tcl_MutexUnlock(&socketMutex); }  /* *---------------------------------------------------------------------- * * SocketThreadExitHandler -- * TclpFinalizeSockets -- * * This function is called from Tcl_FinalizeThread to finalize * the platform specific socket subsystem. * Also, it may be called from within this module to cleanup * Callback invoked during thread clean up to delete the socket * the state if unable to initialize the sockets subsystem. * event source. * * Results: * None. * * Side effects: * Delete the event source. * Deletes the event source and destroys the socket thread. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static void SocketThreadExitHandler(clientData) void TclpFinalizeSockets() ClientData clientData; /* Not used. */ { ThreadSpecificData *tsdPtr = ThreadSpecificData *tsdPtr; (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (tsdPtr != NULL && tsdPtr->socketThread != NULL) { if (tsdPtr != NULL) { DWORD exitCode; GetExitCodeThread(tsdPtr->socketThread, &exitCode); if (exitCode == STILL_ACTIVE) { PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0); if (tsdPtr->socketThread != NULL) { if (tsdPtr->hwnd != NULL) { PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0); /* * Wait for the thread to close. This ensures that we are * completely cleaned up before we leave this function. */ /* * Wait for the thread to exit. This ensures that we are * completely cleaned up before we leave this function. */ WaitForSingleObject(tsdPtr->socketThread, INFINITE); } CloseHandle(tsdPtr->socketThread); tsdPtr->socketThread = NULL; CloseHandle(tsdPtr->readyEvent); CloseHandle(tsdPtr->socketListLock); WaitForSingleObject(tsdPtr->readyEvent, INFINITE); tsdPtr->hwnd = NULL; } CloseHandle(tsdPtr->socketThread); tsdPtr->socketThread = NULL; } if (tsdPtr->readyEvent != NULL) { CloseHandle(tsdPtr->readyEvent); tsdPtr->readyEvent = NULL; } if (tsdPtr->socketListLock != NULL) { CloseHandle(tsdPtr->socketListLock); tsdPtr->socketListLock = NULL; } Tcl_DeleteThreadExitHandler(SocketThreadExitHandler, NULL); Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL); } }  /* *---------------------------------------------------------------------- *
︙
865 866 867 868 869 870 871 872 873 874 875 876 877 878 879	868 869 870 871 872 873 874 875 876 877 878 879 880 881 882	- +	* have to watch out for the channel being deleted out from under * us. This may cause a redundant trip through the event loop, but * it's simpler than trying to do unwind protection. */ Tcl_Time blockTime = { 0, 0 }; Tcl_SetMaxBlockTime(&blockTime); mask |= TCL_READABLE; mask |= TCL_READABLE|TCL_WRITABLE; } else if (events & FD_READ) { fd_set readFds; struct timeval timeout; /* * We must check to see if data is really available, since someone * could have consumed the data in the meantime. Turn off async
︙
896 897 898 899 900 901 902 903 904 905 906 907 908 909	899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916	+ + + +	infoPtr->readyEvents &= ~(FD_READ); SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr); } } if (events & (FD_WRITE | FD_CONNECT)) { mask |= TCL_WRITABLE; if (events & FD_CONNECT && infoPtr->lastError != NO_ERROR) { /* connect errors should also fire the readable handler. */ mask |= TCL_READABLE; } } if (mask) { Tcl_NotifyChannel(infoPtr->channel, mask); } return 1; }
︙
961 962 963 964 965 966 967 968 969 970 971 972 973 974 975	968 969 970 971 972 973 974 975 976 977 978 979 980 981 982	- +	/* ARGSUSED */ static int TcpCloseProc(instanceData, interp) ClientData instanceData; /* The socket to close. */ Tcl_Interp *interp; /* Unused. */ { SocketInfo *infoPtr = (SocketInfo *) instanceData; SocketInfo **nextPtrPtr; /* TIP #218 */ int errorCode = 0; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Check that WinSock is initialized; do not call it if not, to * prevent system crashes. This can happen at exit time if the exit * handler for WinSock ran before other exit handlers that want to
︙
986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072	993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071	- - + + + + + - - - - - - - - - - - - + - - - + + + + + - - - +	if (winSock.closesocket(infoPtr->socket) == SOCKET_ERROR) { TclWinConvertWSAError((DWORD) winSock.WSAGetLastError()); errorCode = Tcl_GetErrno(); } } /* * Remove the socket from socketList. /* TIP #218. Removed the code removing the structure * from the global socket list. This is now done by * the thread action callbacks, and only there. This * happens before this code is called. We can free * without fear of damanging the list. */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL; nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { if ((*nextPtrPtr) == infoPtr) { (*nextPtrPtr) = infoPtr->nextPtr; break; } } SetEvent(tsdPtr->socketListLock); ckfree((char *) infoPtr); return errorCode; }  /* *---------------------------------------------------------------------- * * NewSocketInfo -- * * This function allocates and initializes a new SocketInfo * structure. * * Results: * Returns a newly allocated SocketInfo. * * Side effects: * Adds the socket to the global socket list. * None, except for allocation of memory. * *---------------------------------------------------------------------- */ static SocketInfo * NewSocketInfo(socket) SOCKET socket; { SocketInfo *infoPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo)); infoPtr->socket = socket; infoPtr->flags = 0; infoPtr->watchEvents = 0; infoPtr->readyEvents = 0; infoPtr->selectEvents = 0; infoPtr->acceptEventCount = 0; infoPtr->acceptProc = NULL; infoPtr->lastError = 0; WaitForSingleObject(tsdPtr->socketListLock, INFINITE); infoPtr->nextPtr = tsdPtr->socketList; /* TIP #218. Removed the code inserting the new structure * into the global list. This is now handled in the thread * action callbacks, and only there. */ infoPtr->nextPtr = NULL; tsdPtr->socketList = infoPtr; SetEvent(tsdPtr->socketListLock); return infoPtr; }  /* *---------------------------------------------------------------------- * * CreateSocket -- * * This function opens a new socket and initializes the * SocketInfo structure. * * Results: * Returns a new SocketInfo, or NULL with an error in interp. * * Side effects: * Adds a new socket to the socketList. * None, except for allocation of memory. * *---------------------------------------------------------------------- */ static SocketInfo * CreateSocket(interp, port, host, server, myaddr, myport, async) Tcl_Interp *interp; /* For error reporting; can be NULL. */
︙
1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094	1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093	- +	* asynchronously. */ { u_long flag = 1; /* Indicates nonblocking mode. */ int asyncConnect = 0; /* Will be 1 if async connect is * in progress. */ SOCKADDR_IN sockaddr; /* Socket address */ SOCKADDR_IN mysockaddr; /* Socket address for client */ SOCKET sock; SOCKET sock = INVALID_SOCKET; SocketInfo *infoPtr; /* The returned value. */ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); /* * Check that WinSock is initialized; do not call it if not, to * prevent system crashes. This can happen at exit time if the exit
︙
2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264	2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263	- +	if (!infoPtr->acceptProc) { infoPtr->watchEvents = 0; if (mask & TCL_READABLE) { infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT); } if (mask & TCL_WRITABLE) { infoPtr->watchEvents |= (FD_WRITE|FD_CONNECT); infoPtr->watchEvents |= (FD_WRITE|FD_CLOSE|FD_CONNECT); } /* * If there are any conditions already set, then tell the notifier to poll * rather than block. */
︙
2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352	2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366	+ + + + - + - - + - + + + + + + + + + + + + + - +	static DWORD WINAPI SocketThread(LPVOID arg) { MSG msg; ThreadSpecificData *tsdPtr = (ThreadSpecificData *)(arg); /* * Create a dummy window receiving socket events. */ tsdPtr->hwnd = CreateWindow("TclSocket", "TclSocket", WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg); /* * Signal the main thread that the window has been created * Signalize thread creator that we are done creating the window. * and that the socket thread is ready to go. */ SetEvent(tsdPtr->readyEvent); /* * If unable to create the window, exit this thread immediately. */ if (tsdPtr->hwnd == NULL) { return 1; } /* * Process all messages on the socket window until WM_QUIT. * This threads exits only when instructed to do so by the * call to PostMessage(SOCKET_TERMINATE) in TclpFinalizeSockets(). */ while (GetMessage(&msg, NULL, 0, 0) > 0) { DispatchMessage(&msg); } /* * This releases waiters on thread exit in TclpFinalizeSockets() */ SetEvent(tsdPtr->readyEvent); return msg.wParam; return (DWORD)msg.wParam; }  /* *---------------------------------------------------------------------- * * SocketProc --
︙
2650 2651 2652 2653 2654 2655 2656 2657 2658	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 2698 2699 2700 2701 2702 2703 2704 2705 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	- - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	*/ if (!SocketsEnabled()) { return (struct servent *) NULL; } return winSock.getservbyname(name, proto); }  /* *---------------------------------------------------------------------- * * TcpThreadActionProc -- * * Insert or remove any thread local refs to this channel. * * Results: * None. * * Side effects: * Changes thread local list of valid channels. * *---------------------------------------------------------------------- */ static void TcpThreadActionProc (instanceData, action) ClientData instanceData; int action; { ThreadSpecificData *tsdPtr; SocketInfo *infoPtr = (SocketInfo *) instanceData; int notifyCmd; if (action == TCL_CHANNEL_THREAD_INSERT) { /* * Ensure that socket subsystem is initialized in this thread, or * else sockets will not work. */ Tcl_MutexLock(&socketMutex); InitSockets(); Tcl_MutexUnlock(&socketMutex); tsdPtr = TCL_TSD_INIT(&dataKey); WaitForSingleObject(tsdPtr->socketListLock, INFINITE); infoPtr->nextPtr = tsdPtr->socketList; tsdPtr->socketList = infoPtr; SetEvent(tsdPtr->socketListLock); notifyCmd = SELECT; } else { SocketInfo **nextPtrPtr; int removed = 0; tsdPtr = TCL_TSD_INIT(&dataKey); /* TIP #218, Bugfix: All access to socketList has to be protected by the lock */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL; nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { if ((*nextPtrPtr) == infoPtr) { (*nextPtrPtr) = infoPtr->nextPtr; removed = 1; break; } } SetEvent(tsdPtr->socketListLock); /* * This could happen if the channel was created in one thread * and then moved to another without updating the thread * local data in each thread. */ if (!removed) { Tcl_Panic("file info ptr not on thread channel list"); } notifyCmd = UNSELECT; } /* * Ensure that, or stop, notifications for the socket occur in this thread. */ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) notifyCmd, (LPARAM) infoPtr); }

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	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	- + + + + + + + + + + + + + + + - + + + + + + + + + + + + +	/* * tclWinTest.c -- * * Contains commands for platform specific tests on Windows. * * Copyright (c) 1996 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclWinTest.c,v 1.8 2002/12/17 02:47:39 davygrvy Exp $ * RCS: @(#) $Id: tclWinTest.c,v 1.8.2.6 2006/03/27 23:30:54 patthoyts Exp $ */ #define USE_COMPAT_CONST #include "tclWinInt.h" /* * For TestplatformChmod on Windows */ #ifdef __WIN32__ #include <aclapi.h> #endif /* * MinGW 3.4.2 does not define this. */ #ifndef INHERITED_ACE #define INHERITED_ACE (0x10) #endif /* * Forward declarations of procedures defined later in this file: */ int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp)); static int TesteventloopCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); Tcl_Interp *interp, int argc, CONST84 char **argv)); static int TestvolumetypeCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int TestwinclockCmd _ANSI_ARGS_(( ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj *CONST objv[] )); static int TestwinsleepCmd _ANSI_ARGS_(( ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj *CONST objv[] )); static Tcl_ObjCmdProc TestExceptionCmd; static int TestwincpuidCmd _ANSI_ARGS_(( ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj *CONST objv[] )); static int TestplatformChmod _ANSI_ARGS_((CONST char *nativePath, int pmode)); static int TestchmodCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST84 char **argv));  /* *---------------------------------------------------------------------- * * TclplatformtestInit -- *
︙
51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71	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	+ + - + - + - - + + + + + + +	TclplatformtestInit(interp) Tcl_Interp *interp; /* Interpreter to add commands to. */ { /* * Add commands for platform specific tests for Windows here. */ Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL); (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "testwincpuid", TestwincpuidCmd, (ClientData) 0, (Tcl_CmdDeleteProc*) NULL ); Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL ); Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); return TCL_OK; }  /* *---------------------------------------------------------------------- * * TesteventloopCmd --
︙
84 85 86 87 88 89 90 91 92 93 94 95 96 97 98	117 118 119 120 121 122 123 124 125 126 127 128 129 130 131	- +	*/ static int TesteventloopCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ char **argv; /* Argument strings. */ CONST84 char **argv; /* Argument strings. */ { static int *framePtr = NULL; /* Pointer to integer on stack frame of * innermost invocation of the "wait" * subcommand. */ if (argc < 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
︙
123 124 125 126 127 128 129 130 131 132 133 134 135 136 137	156 157 158 159 160 161 162 163 164 165 166 167 168 169 170	- +	while (!done) { if (!GetMessage(&msg, NULL, 0, 0)) { /* * The application is exiting, so repost the quit message * and start unwinding. */ PostQuitMessage(msg.wParam); PostQuitMessage((int)msg.wParam); break; } TranslateMessage(&msg); DispatchMessage(&msg); } (void) Tcl_SetServiceMode(oldMode); framePtr = oldFramePtr;
︙
198 199 200 201 202 203 204 205 206 207 208 209 210 211 212	231 232 233 234 235 236 237 238 239 240 241 242 243 244 245	- +	return TCL_OK; #undef VOL_BUF_SIZE }  /* *---------------------------------------------------------------------- * * TestclockCmd -- * TestwinclockCmd -- * * Command that returns the seconds and microseconds portions of * the system clock and of the Tcl clock so that they can be * compared to validate that the Tcl clock is staying in sync. * * Usage: * testclock
︙
238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279	271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 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 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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421	+ + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	CONST static FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE }; /* The Posix epoch, expressed as a * Windows FILETIME */ Tcl_Time tclTime; /* Tcl clock */ FILETIME sysTime; /* System clock */ Tcl_Obj* result; /* Result of the command */ LARGE_INTEGER t1, t2; LARGE_INTEGER p1, p2; if ( objc != 1 ) { Tcl_WrongNumArgs( interp, 1, objv, "" ); return TCL_ERROR; } QueryPerformanceCounter( &p1 ); Tcl_GetTime( &tclTime ); GetSystemTimeAsFileTime( &sysTime ); t1.LowPart = posixEpoch.dwLowDateTime; t1.HighPart = posixEpoch.dwHighDateTime; t2.LowPart = sysTime.dwLowDateTime; t2.HighPart = sysTime.dwHighDateTime; t2.QuadPart -= t1.QuadPart; QueryPerformanceCounter( &p2 ); result = Tcl_NewObj(); Tcl_ListObjAppendElement ( interp, result, Tcl_NewIntObj( (int) (t2.QuadPart / 10000000 ) ) ); Tcl_ListObjAppendElement ( interp, result, Tcl_NewIntObj( (int) ( (t2.QuadPart / 10 ) % 1000000 ) ) ); Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.sec ) ); Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.usec ) ); Tcl_ListObjAppendElement( interp, result, Tcl_NewWideIntObj( p1.QuadPart ) ); Tcl_ListObjAppendElement( interp, result, Tcl_NewWideIntObj( p2.QuadPart ) ); Tcl_SetObjResult( interp, result ); return TCL_OK; }  /* *---------------------------------------------------------------------- * * TestwincpuidCmd -- * * Retrieves CPU ID information. * * Usage: * testwincpuid <eax> * * Parameters: * eax - The value to pass in the EAX register to a CPUID instruction. * * Results: * Returns a four-element list containing the values from the * EAX, EBX, ECX and EDX registers returned from the CPUID instruction. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TestwincpuidCmd( ClientData dummy, Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *CONST * objv ) /* Parameter vector */ { int status; int index; unsigned int regs[4]; Tcl_Obj * regsObjs[4]; int i; if ( objc != 2 ) { Tcl_WrongNumArgs( interp, 1, objv, "eax" ); return TCL_ERROR; } if ( Tcl_GetIntFromObj( interp, objv[1], &index ) != TCL_OK ) { return TCL_ERROR; } status = TclWinCPUID( (unsigned int) index, regs ); if ( status != TCL_OK ) { Tcl_SetObjResult( interp, Tcl_NewStringObj( "operation not available", -1 ) ); return status; } for ( i = 0; i < 4; ++i ) { regsObjs[i] = Tcl_NewIntObj( (int) regs[i] ); } Tcl_SetObjResult( interp, Tcl_NewListObj( 4, regsObjs ) ); return TCL_OK; }  /* *---------------------------------------------------------------------- * * TestwinsleepCmd -- * * Causes this process to wait for the given number of milliseconds * by means of a direct call to Sleep. * * Usage: * testwinsleep <n> * * Parameters: * n - the number of milliseconds to sleep * * Results: * None. * * Side effects: * Sleeps for the requisite number of milliseconds. * *---------------------------------------------------------------------- */ static int TestwinsleepCmd( ClientData clientData, /* Unused */ Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj * CONST * objv ) /* Parameter vector */ { int ms; if ( objc != 2 ) { Tcl_WrongNumArgs( interp, 1, objv, "ms" ); return TCL_ERROR; } if ( Tcl_GetIntFromObj( interp, objv[1], &ms ) != TCL_OK ) { return TCL_ERROR; } Sleep( (DWORD) ms ); return TCL_OK; }  /* *---------------------------------------------------------------------- * * TestExceptionCmd -- * * Causes this process to end with the named exception. Used for * testing Tcl_WaitPid().
︙
373 374 375 376 377 378 379	515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 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 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 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 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832	+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	/* SMASH! */ RaiseException(exceptions[cmd], EXCEPTION_NONCONTINUABLE, 0, NULL); /* NOTREACHED */ return TCL_OK; }  static int TestplatformChmod(CONST char *nativePath, int pmode) { SID_IDENTIFIER_AUTHORITY userSidAuthority = { SECURITY_WORLD_SID_AUTHORITY }; typedef DWORD (WINAPI *getSidLengthRequiredDef) ( UCHAR ); typedef BOOL (WINAPI *initializeSidDef) ( PSID, PSID_IDENTIFIER_AUTHORITY, BYTE ); typedef PDWORD (WINAPI *getSidSubAuthorityDef) ( PSID, DWORD ); static getSidLengthRequiredDef getSidLengthRequiredProc; static initializeSidDef initializeSidProc; static getSidSubAuthorityDef getSidSubAuthorityProc; static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION; static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA | FILE_WRITE_DATA | DELETE; BYTE *secDesc = 0; DWORD secDescLen; const BOOL set_readOnly = !(pmode & 0222); BOOL acl_readOnly_found = FALSE; ACL_SIZE_INFORMATION ACLSize; BOOL curAclPresent, curAclDefaulted; PACL curAcl; PACL newAcl = 0; DWORD newAclSize; WORD j; SID *userSid = 0; TCHAR *userDomain = NULL; DWORD attr; int res = 0; /* * One time initialization, dynamically load Windows NT features */ typedef DWORD (WINAPI *setNamedSecurityInfoADef)( IN LPSTR, IN SE_OBJECT_TYPE, IN SECURITY_INFORMATION, IN PSID, IN PSID, IN PACL, IN PACL ); typedef BOOL (WINAPI *getAceDef) (PACL, DWORD, LPVOID *); typedef BOOL (WINAPI *addAceDef) ( PACL, DWORD, DWORD, LPVOID, DWORD ); typedef BOOL (WINAPI *equalSidDef) ( PSID, PSID ); typedef BOOL (WINAPI *addAccessDeniedAceDef) ( PACL, DWORD, DWORD, PSID ); typedef BOOL (WINAPI *initializeAclDef) ( PACL, DWORD, DWORD ); typedef DWORD (WINAPI *getLengthSidDef) ( PSID ); typedef BOOL (WINAPI *getAclInformationDef) (PACL, LPVOID, DWORD, ACL_INFORMATION_CLASS ); typedef BOOL (WINAPI *getSecurityDescriptorDaclDef) (PSECURITY_DESCRIPTOR, LPBOOL, PACL *, LPBOOL ); typedef BOOL (WINAPI *lookupAccountNameADef) ( LPCSTR, LPCSTR, PSID, PDWORD, LPSTR, LPDWORD, PSID_NAME_USE ); typedef BOOL (WINAPI *getFileSecurityADef) ( LPCSTR, SECURITY_INFORMATION, PSECURITY_DESCRIPTOR, DWORD, LPDWORD ); static setNamedSecurityInfoADef setNamedSecurityInfoProc; static getAceDef getAceProc; static addAceDef addAceProc; static equalSidDef equalSidProc; static addAccessDeniedAceDef addAccessDeniedAceProc; static initializeAclDef initializeAclProc; static getLengthSidDef getLengthSidProc; static getAclInformationDef getAclInformationProc; static getSecurityDescriptorDaclDef getSecurityDescriptorDaclProc; static lookupAccountNameADef lookupAccountNameProc; static getFileSecurityADef getFileSecurityProc; static int initialized = 0; if (!initialized) { TCL_DECLARE_MUTEX(initializeMutex) Tcl_MutexLock(&initializeMutex); if (!initialized) { HINSTANCE hInstance = LoadLibrary("Advapi32"); if (hInstance != NULL) { setNamedSecurityInfoProc = (setNamedSecurityInfoADef) GetProcAddress(hInstance, "SetNamedSecurityInfoA"); getFileSecurityProc = (getFileSecurityADef) GetProcAddress(hInstance, "GetFileSecurityA"); getAceProc = (getAceDef) GetProcAddress(hInstance, "GetAce"); addAceProc = (addAceDef) GetProcAddress(hInstance, "AddAce"); equalSidProc = (equalSidDef) GetProcAddress(hInstance, "EqualSid"); addAccessDeniedAceProc = (addAccessDeniedAceDef) GetProcAddress(hInstance, "AddAccessDeniedAce"); initializeAclProc = (initializeAclDef) GetProcAddress(hInstance, "InitializeAcl"); getLengthSidProc = (getLengthSidDef) GetProcAddress(hInstance, "GetLengthSid"); getAclInformationProc = (getAclInformationDef) GetProcAddress(hInstance, "GetAclInformation"); getSecurityDescriptorDaclProc = (getSecurityDescriptorDaclDef) GetProcAddress(hInstance, "GetSecurityDescriptorDacl"); lookupAccountNameProc = (lookupAccountNameADef) GetProcAddress(hInstance, "LookupAccountNameA"); getSidLengthRequiredProc = (getSidLengthRequiredDef) GetProcAddress(hInstance, "GetSidLengthRequired"); initializeSidProc = (initializeSidDef) GetProcAddress(hInstance, "InitializeSid"); getSidSubAuthorityProc = (getSidSubAuthorityDef) GetProcAddress(hInstance, "GetSidSubAuthority"); if (setNamedSecurityInfoProc && getAceProc && addAceProc && equalSidProc && addAccessDeniedAceProc && initializeAclProc && getLengthSidProc && getAclInformationProc && getSecurityDescriptorDaclProc && lookupAccountNameProc && getFileSecurityProc && getSidLengthRequiredProc && initializeSidProc && getSidSubAuthorityProc) initialized = 1; } if (!initialized) initialized = -1; } Tcl_MutexUnlock(&initializeMutex); } /* Process the chmod request */ attr = GetFileAttributes(nativePath); /* nativePath not found */ if (attr == 0xffffffff) { res = -1; goto done; } /* If no ACL API is present or nativePath is not a directory, * there is no special handling */ if (initialized < 0 || !(attr & FILE_ATTRIBUTE_DIRECTORY)) { goto done; } /* Set the result to error, if the ACL change is successful it will * be reset to 0 */ res = -1; /* * Read the security descriptor for the directory. Note the * first call obtains the size of the security descriptor. */ if (!getFileSecurityProc(nativePath, infoBits, NULL, 0, &secDescLen)) { if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) { DWORD secDescLen2 = 0; secDesc = (BYTE *) ckalloc(secDescLen); if (!getFileSecurityProc(nativePath, infoBits, (PSECURITY_DESCRIPTOR)secDesc, secDescLen, &secDescLen2) || (secDescLen < secDescLen2)) { goto done; } } else { goto done; } } /* Get the World SID */ userSid = (SID*) ckalloc(getSidLengthRequiredProc((UCHAR)1)); initializeSidProc( userSid, &userSidAuthority, (BYTE)1); *(getSidSubAuthorityProc( userSid, 0)) = SECURITY_WORLD_RID; /* If curAclPresent == false then curAcl and curAclDefaulted not valid */ if (!getSecurityDescriptorDaclProc(secDesc, &curAclPresent, &curAcl, &curAclDefaulted)) goto done; if (!curAclPresent || !curAcl) { ACLSize.AclBytesInUse = 0; ACLSize.AceCount = 0; } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize), AclSizeInformation)) goto done; /* Allocate memory for the new ACL */ newAclSize = ACLSize.AclBytesInUse + sizeof (ACCESS_DENIED_ACE) + getLengthSidProc(userSid) - sizeof (DWORD); newAcl = (ACL *) ckalloc (newAclSize); /* Initialize the new ACL */ if(!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) { goto done; } /* Add denied to make readonly, this will be known as a "read-only tag" */ if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION, readOnlyMask, userSid)) { goto done; } acl_readOnly_found = FALSE; for (j = 0; j < ACLSize.AceCount; j++) { PACL *pACE2; ACE_HEADER *phACE2; if (! getAceProc (curAcl, j, (LPVOID*) &pACE2)) { goto done; } phACE2 = ((ACE_HEADER *) pACE2); /* Do NOT propagate inherited ACEs */ if (phACE2->AceFlags & INHERITED_ACE) { continue; } /* Skip the "read-only tag" restriction (either added above, or it * is being removed) */ if (phACE2->AceType == ACCESS_DENIED_ACE_TYPE) { ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *)phACE2; if (pACEd->Mask == readOnlyMask && equalSidProc(userSid, (PSID)&(pACEd->SidStart))) { acl_readOnly_found = TRUE; continue; } } /* Copy the current ACE from the old to the new ACL */ if(! addAceProc (newAcl, ACL_REVISION, MAXDWORD, pACE2, ((PACE_HEADER) pACE2)->AceSize)) { goto done; } } /* Apply the new ACL */ if (set_readOnly == acl_readOnly_found || setNamedSecurityInfoProc((LPSTR)nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION, NULL, NULL, newAcl, NULL) == ERROR_SUCCESS ) { res = 0; } done: if (secDesc) ckfree(secDesc); if (newAcl) ckfree((char *)newAcl); if (userSid) ckfree((char *)userSid); if (userDomain) ckfree(userDomain); if (res != 0) return res; /* Run normal chmod command */ return chmod(nativePath, pmode); }  /* *--------------------------------------------------------------------------- * * TestchmodCmd -- * * Implements the "testchmod" cmd. Used when testing "file" command. * The only attribute used by the Windows platform is the user write * flag; if this is not set, the file is made read-only. Otehrwise, the * file is made read-write. * * Results: * A standard Tcl result. * * Side effects: * Changes permissions of specified files. * *--------------------------------------------------------------------------- */ static int TestchmodCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ CONST84 char **argv; /* Argument strings. */ { int i, mode; char *rest; if (argc < 2) { usage: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " mode file ?file ...?", NULL); return TCL_ERROR; } mode = (int) strtol(argv[1], &rest, 8); if ((rest == argv[1]) || (*rest != '\0')) { goto usage; } for (i = 2; i < argc; i++) { Tcl_DString buffer; CONST char *translated; translated = Tcl_TranslateFileName(interp, argv[i], &buffer); if (translated == NULL) { return TCL_ERROR; } if (TestplatformChmod(translated, mode) != 0) { Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } Tcl_DStringFree(&buffer); } return TCL_OK; }

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	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	- + - - + + + +	/* * tclWinThread.c -- * * This file implements the Windows-specific thread operations. * * Copyright (c) 1998 by Sun Microsystems, Inc. * Copyright (c) 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. * * RCS: @(#) $Id: tclWinThrd.c,v 1.24 2003/01/14 02:06:11 mdejong Exp $ * RCS: @(#) $Id: tclWinThrd.c,v 1.24.2.12 2007/03/24 09:31:11 vasiljevic Exp $ */ #include "tclWinInt.h" #include <fcntl.h> #include <io.h> #include <sys/stat.h> /* * This is the master lock used to serialize access to other * serialization data structures. */ static CRITICAL_SECTION masterLock; static int init = 0; #define MASTER_LOCK EnterCriticalSection(&masterLock) #define MASTER_UNLOCK LeaveCriticalSection(&masterLock) #define MASTER_LOCK TclpMasterLock() #define MASTER_UNLOCK TclpMasterUnlock() /* * This is the master lock used to serialize initialization and finalization * of Tcl as a whole. */ static CRITICAL_SECTION initLock; /* * allocLock is used by Tcl's version of malloc for synchronization. * For obvious reasons, cannot use any dyamically allocated storage. */ #ifdef TCL_THREADS static CRITICAL_SECTION allocLock; static Tcl_Mutex allocLockPtr = (Tcl_Mutex) &allocLock; static int allocOnce = 0; #endif /* TCL_THREADS */ /* * The joinLock serializes Create- and ExitThread. This is necessary to * prevent a race where a new joinable thread exits before the creating * thread had the time to create the necessary data structures in the
︙
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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139	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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153	+ + + + + + + + + + + + + + - - - + - +	struct ThreadSpecificData *prevPtr; int flags; /* See flags below */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; #endif /* TCL_THREADS */ /* * Additions by AOL for specialized thread memory allocator. */ #if defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG) static int once; static DWORD tlsKey; typedef struct allocMutex { Tcl_Mutex tlock; CRITICAL_SECTION wlock; } allocMutex; #endif /* * State bits for the thread. * WIN_THREAD_UNINIT Uninitialized. Must be zero because * of the way ThreadSpecificData is created. * WIN_THREAD_RUNNING Running, not waiting. * WIN_THREAD_BLOCKED Waiting, or trying to wait. * WIN_THREAD_DEAD Dying - no per-thread event anymore. */ #define WIN_THREAD_UNINIT 0x0 #define WIN_THREAD_RUNNING 0x1 #define WIN_THREAD_BLOCKED 0x2 #define WIN_THREAD_DEAD 0x4 /* * The per condition queue pointers and the * Mutex used to serialize access to the queue. */ typedef struct WinCondition { CRITICAL_SECTION condLock; /* Lock to serialize queuing on the condition */ struct ThreadSpecificData *firstPtr; /* Queue pointers */ struct ThreadSpecificData *lastPtr; } WinCondition;  /* *---------------------------------------------------------------------- * * Tcl_CreateThread -- * TclpThreadCreate -- * * This procedure creates a new thread. * * Results: * TCL_OK if the thread could be created. The thread ID is * returned in a parameter. * * Side effects: * A new thread is created. * *---------------------------------------------------------------------- */ int Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags) TclpThreadCreate(idPtr, proc, clientData, stackSize, flags) Tcl_ThreadId *idPtr; /* Return, the ID of the thread */ Tcl_ThreadCreateProc proc; /* Main() function of the thread */ ClientData clientData; /* The one argument to Main() */ int stackSize; /* Size of stack for the new thread */ int flags; /* Flags controlling behaviour of * the new thread */ {
︙
183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203	197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217	- - - - - + + + + + - +	* The result area is set to the exit code of the thread we * waited upon. * *---------------------------------------------------------------------- */ int Tcl_JoinThread(id, result) Tcl_ThreadId id; /* Id of the thread to wait upon */ int* result; /* Reference to the storage the result * of the thread we wait upon will be * written into. */ Tcl_JoinThread(threadId, result) Tcl_ThreadId threadId; /* Id of the thread to wait upon */ int* result; /* Reference to the storage the result * of the thread we wait upon will be * written into. */ { return TclJoinThread (id, result); return TclJoinThread (threadId, result); }  /* *---------------------------------------------------------------------- * * TclpThreadExit -- *
︙
389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414	403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459	- - - + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	*---------------------------------------------------------------------- */ Tcl_Mutex * Tcl_GetAllocMutex() { #ifdef TCL_THREADS static int once = 0; if (!once) { if (!allocOnce) { InitializeCriticalSection(&allocLock); once = 1; allocOnce = 1; } return &allocLockPtr; #else return NULL; #endif }  /* *---------------------------------------------------------------------- * * TclpFinalizeLock * * This procedure is used to destroy all private resources used in * this file. * * Results: * None. * * Side effects: * Destroys everything private. TclpInitLock must be held * entering this function. * *---------------------------------------------------------------------- */ void TclFinalizeLock () { MASTER_LOCK; DeleteCriticalSection(&joinLock); /* Destroy the critical section that we are holding! */ DeleteCriticalSection(&masterLock); init = 0; #ifdef TCL_THREADS DeleteCriticalSection(&allocLock); allocOnce = 0; #endif /* Destroy the critical section that we are holding! */ DeleteCriticalSection(&initLock); }  #ifdef TCL_THREADS /* locally used prototype */ static void FinalizeConditionEvent(ClientData data);
︙
535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553	580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604	+ + + - + + + +	void TclpThreadDataKeyInit(keyPtr) Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk, * really (DWORD **) */ { DWORD *indexPtr; DWORD newKey; MASTER_LOCK; if (*keyPtr == NULL) { indexPtr = (DWORD *)ckalloc(sizeof(DWORD)); newKey = TlsAlloc(); if (newKey != TLS_OUT_OF_INDEXES) { *indexPtr = TlsAlloc(); *indexPtr = newKey; } else { panic("TlsAlloc failed from TclpThreadDataKeyInit!"); /* this should be a fatal error */ } *keyPtr = (Tcl_ThreadDataKey)indexPtr; TclRememberDataKey(keyPtr); } MASTER_UNLOCK; }  /*
︙
569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586	620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642	+ - + + + + +	VOID * TclpThreadDataKeyGet(keyPtr) Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk, * really (DWORD **) */ { DWORD *indexPtr = *(DWORD **)keyPtr; LPVOID result; if (indexPtr == NULL) { return NULL; } else { return (VOID *) TlsGetValue(*indexPtr); result = TlsGetValue(*indexPtr); if ((result == NULL) && (GetLastError() != NO_ERROR)) { panic("TlsGetValue failed from TclpThreadDataKeyGet!"); } return result; } }  /* *---------------------------------------------------------------------- * * TclpThreadDataKeySet --
︙
600 601 602 603 604 605 606 607 608 609 610 611 612 613 614	656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674	+ - + + + +	void TclpThreadDataKeySet(keyPtr, data) Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk, * really (pthread_key_t **) */ VOID *data; /* Thread local storage */ { DWORD *indexPtr = *(DWORD **)keyPtr; BOOL success; TlsSetValue(*indexPtr, (void *)data); success = TlsSetValue(*indexPtr, (void *)data); if (!success) { panic("TlsSetValue failed from TclpThreadDataKeySet!"); } }  /* *---------------------------------------------------------------------- * * TclpFinalizeThreadData -- *
︙
626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649	686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720	+ - - - + + + + + + - + + + + + + + +	void TclpFinalizeThreadData(keyPtr) Tcl_ThreadDataKey *keyPtr; { VOID *result; DWORD *indexPtr; BOOL success; #ifdef USE_THREAD_ALLOC TclWinFreeAllocCache(); #endif if (*keyPtr != NULL) { indexPtr = *(DWORD **)keyPtr; result = (VOID *)TlsGetValue(*indexPtr); if (result != NULL) { #if defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG) if (indexPtr == &tlsKey) { TclpFreeAllocCache(result); return; } #endif ckfree((char *)result); TlsSetValue(*indexPtr, (void *)NULL); success = TlsSetValue(*indexPtr, (void *)NULL); if (!success) { panic("TlsSetValue failed from TclpFinalizeThreadData!"); } } else { if (GetLastError() != NO_ERROR) { panic("TlsGetValue failed from TclpFinalizeThreadData!"); } } } }  /* *---------------------------------------------------------------------- *
︙
665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681	736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756	+ - + + + +	*/ void TclpFinalizeThreadDataKey(keyPtr) Tcl_ThreadDataKey *keyPtr; { DWORD *indexPtr; BOOL success; if (*keyPtr != NULL) { indexPtr = *(DWORD **)keyPtr; TlsFree(*indexPtr); success = TlsFree(*indexPtr); if (!success) { panic("TlsFree failed from TclpFinalizeThreadDataKey!"); } ckfree((char *)indexPtr); *keyPtr = NULL; } }  /* *----------------------------------------------------------------------
︙
708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729	783 784 785 786 787 788 789 790 791 792 793 794 795 796	- - - - - - - -	WinCondition *winCondPtr; /* Per-condition queue head */ CRITICAL_SECTION *csPtr; /* Caller's Mutex, after casting */ DWORD wtime; /* Windows time value */ int timeout; /* True if we got a timeout */ int doExit = 0; /* True if we need to do exit setup */ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->flags & WIN_THREAD_DEAD) { /* * No more per-thread event on which to wait. */ return; } /* * Self initialize the two parts of the condition. * The per-condition and per-thread parts need to be * handled independently. */ if (tsdPtr->flags == WIN_THREAD_UNINIT) {
︙
875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890	942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962	+ + + + +	void Tcl_ConditionNotify(condPtr) Tcl_Condition *condPtr; { WinCondition *winCondPtr; ThreadSpecificData *tsdPtr; if (condPtr != NULL) { winCondPtr = *((WinCondition **)condPtr); if (winCondPtr == NULL) { return; } /* * Loop through all the threads waiting on the condition * and notify them (i.e., broadcast semantics). The queue * manipulation is guarded by the per-condition coordinating mutex. */
︙
927 928 929 930 931 932 933 934 935 936 937 938 939 940 941	999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013	- +	*/ static void FinalizeConditionEvent(data) ClientData data; { ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data; tsdPtr->flags = WIN_THREAD_DEAD; tsdPtr->flags = WIN_THREAD_UNINIT; CloseHandle(tsdPtr->condEvent); }  /* *---------------------------------------------------------------------- * * TclpFinalizeCondition --
︙
973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039	1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141	- - + - - - - + - + + + + + + + + + + + - + - + - + - + + - + + + + + + - - - + + + + + + - + - + - - - + + + + + + + + + + + + + + + + + +	*condPtr = NULL; } } /* * Additions by AOL for specialized thread memory allocator. */ #ifdef USE_THREAD_ALLOC static DWORD key; #if defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG) Tcl_Mutex * TclpNewAllocMutex(void) { struct lock { Tcl_Mutex tlock; CRITICAL_SECTION wlock; } *lockPtr; struct allocMutex *lockPtr; lockPtr = malloc(sizeof(struct lock)); lockPtr = malloc(sizeof(struct allocMutex)); if (lockPtr == NULL) { panic("could not allocate lock"); } lockPtr->tlock = (Tcl_Mutex) &lockPtr->wlock; InitializeCriticalSection(&lockPtr->wlock); return &lockPtr->tlock; } void TclpFreeAllocMutex(mutex) Tcl_Mutex *mutex; /* The alloc mutex to free. */ { allocMutex* lockPtr = (allocMutex*) mutex; if (!lockPtr) return; DeleteCriticalSection(&lockPtr->wlock); free(lockPtr); } void * TclpGetAllocCache(void) { static int once = 0; VOID *result; if (!once) { /* * We need to make sure that TclWinFreeAllocCache is called * We need to make sure that TclpFreeAllocCache is called * on each thread that calls this, but only on threads that * call this. */ key = TlsAlloc(); tlsKey = TlsAlloc(); once = 1; if (key == TLS_OUT_OF_INDEXES) { if (tlsKey == TLS_OUT_OF_INDEXES) { panic("could not allocate thread local storage"); } } return TlsGetValue(key); result = TlsGetValue(tlsKey); if ((result == NULL) && (GetLastError() != NO_ERROR)) { panic("TlsGetValue failed from TclpGetAllocCache!"); } return result; } void TclpSetAllocCache(void *ptr) { BOOL success; TlsSetValue(key, ptr); } success = TlsSetValue(tlsKey, ptr); if (!success) { panic("TlsSetValue failed from TclpSetAllocCache!"); } } void TclWinFreeAllocCache(void) TclpFreeAllocCache(void *ptr) { void *ptr; BOOL success; ptr = TlsGetValue(key); if (ptr != NULL) { TlsSetValue(key, NULL); TclFreeAllocCache(ptr); /* * Called by the pthread lib when a thread exits */ TclFreeAllocCache(ptr); success = TlsSetValue(tlsKey, NULL); if (!success) { panic("TlsSetValue failed from TclpFreeAllocCache!"); } } else if (once) { /* * Called by us in TclFinalizeThreadAlloc() during * the library finalization initiated from Tcl_Finalize() */ success = TlsFree(tlsKey); if (!success) { Tcl_Panic("TlsFree failed from TclpFreeAllocCache!"); } once = 0; /* reset for next time. */ } } #endif /* USE_THREAD_ALLOC */ #endif /* TCL_THREADS */

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	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	- + + + + + + - - - - - - -	/* * tclWinTime.c -- * * Contains Windows specific versions of Tcl functions that * obtain time values from the operating system. * * Copyright 1995-1998 by Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclWinTime.c,v 1.14 2003/02/14 22:16:27 kennykb Exp $ * RCS: @(#) $Id: tclWinTime.c,v 1.14.2.11 2007/04/21 19:52:15 kennykb Exp $ */ #include "tclWinInt.h" #define SECSPERDAY (60L * 60L * 24L) #define SECSPERYEAR (SECSPERDAY * 365L) #define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY) /* * Number of samples over which to estimate the performance counter */ #define SAMPLES 64 /* * The following arrays contain the day of year for the last day of * each month, where index 1 is January. */ static int normalDays[] = { -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364 }; static int leapDays[] = { -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 }; typedef struct ThreadSpecificData { char tzName[64]; /* Time zone name */ struct tm tm; /* time information */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * Calibration interval for the high-resolution timer, in msec */ static CONST unsigned long clockCalibrateWakeupInterval = 10000; /* FIXME: 10 s -- should be about 10 min! */ /* * Data for managing high-resolution timers. */ typedef struct TimeInfo { CRITICAL_SECTION cs; /* Mutex guarding this structure */
︙
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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138	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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149	+ + + + - - + + - - - + + + - + - - - + - - - - + + + + + - - + + + - - + + + + + + + + + + +	HANDLE calibrationThread; /* Handle to the thread that keeps the * virtual clock calibrated. */ HANDLE readyEvent; /* System event used to * trigger the requesting thread * when the clock calibration procedure * is initialized for the first time */ HANDLE exitEvent; /* Event to signal out of an exit handler * to tell the calibration loop to * terminate */ LARGE_INTEGER nominalFreq; /* Nominal frequency of the system * performance counter, that is, the value * returned from QueryPerformanceFrequency. */ /* * The following values are used for calculating virtual time. * Virtual time is always equal to: * lastFileTime + (current perf counter - lastCounter) * * 10000000 / curCounterFreq * and lastFileTime and lastCounter are updated any time that * virtual time is returned to a caller. */ ULARGE_INTEGER lastFileTime; LARGE_INTEGER lastCounter; ULARGE_INTEGER fileTimeLastCall; LARGE_INTEGER perfCounterLastCall; LARGE_INTEGER curCounterFreq; /* * The next two values are used only in the calibration thread, to track * the frequency of the performance counter. /* * Data used in developing the estimate of performance counter * frequency */ Tcl_WideUInt fileTimeSample[SAMPLES]; LONGLONG lastPerfCounter; /* Performance counter the last time * that UpdateClockEachSecond was called */ LONGLONG lastSysTime; /* System clock at the last time /* Last 64 samples of system time */ * that UpdateClockEachSecond was called */ LONGLONG estPerfCounterFreq; /* Current estimate of the counter frequency * using the system clock as the standard */ Tcl_WideInt perfCounterSample[SAMPLES]; /* Last 64 samples of performance counter */ int sampleNo; /* Current sample number */ } TimeInfo; static TimeInfo timeInfo = { { NULL }, 0, 0, (HANDLE) NULL, (HANDLE) NULL, (HANDLE) NULL, #ifdef HAVE_CAST_TO_UNION (LARGE_INTEGER) (Tcl_WideInt) 0, (ULARGE_INTEGER) (DWORDLONG) 0, (LARGE_INTEGER) (LONGLONG) 0, (LARGE_INTEGER) (LONGLONG) 0, (LARGE_INTEGER) (Tcl_WideInt) 0, (LARGE_INTEGER) (Tcl_WideInt) 0, #else 0, 0, 0, 0, #endif 0, 0, { 0 }, { 0 }, 0 }; CONST static FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE }; /* * Declarations for functions defined later in this file. */ static struct tm * ComputeGMT _ANSI_ARGS_((const time_t *tp)); static void StopCalibration _ANSI_ARGS_(( ClientData )); static DWORD WINAPI CalibrationThread _ANSI_ARGS_(( LPVOID arg )); static void UpdateTimeEachSecond _ANSI_ARGS_(( void )); static void ResetCounterSamples _ANSI_ARGS_(( Tcl_WideUInt fileTime, Tcl_WideInt perfCounter, Tcl_WideInt perfFreq )); static Tcl_WideInt AccumulateSample _ANSI_ARGS_(( Tcl_WideInt perfCounter, Tcl_WideUInt fileTime ));  /* *---------------------------------------------------------------------- * * TclpGetSeconds -- * * This procedure returns the number of seconds from the epoch.
︙
208 209 210 211 212 213 214 215 216 217 218 219 220 221 222	219 220 221 222 223 224 225 226 227 228 229 230 231 232 233	- +	* None. * *---------------------------------------------------------------------- */ int TclpGetTimeZone (currentTime) unsigned long currentTime; Tcl_WideInt currentTime; { int timeZone; tzset(); timeZone = _timezone / 60; return timeZone;
︙
245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277	256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287	- - +	*---------------------------------------------------------------------- */ void Tcl_GetTime(timePtr) Tcl_Time *timePtr; /* Location to store time information. */ { struct timeb t; int useFtime = 1; /* Flag == TRUE if we need to fall back * on ftime rather than using the perf * counter */ /* Initialize static storage on the first trip through. */ /* * Note: Outer check for 'initialized' is a performance win * since it avoids an extra mutex lock in the common case. */ if ( !timeInfo.initialized ) { TclpInitLock(); if ( !timeInfo.initialized ) { timeInfo.perfCounterAvailable = QueryPerformanceFrequency( &timeInfo.curCounterFreq ); = QueryPerformanceFrequency( &timeInfo.nominalFreq ); /* * Some hardware abstraction layers use the CPU clock * in place of the real-time clock as a performance counter * reference. This results in: * - inconsistent results among the processors on * multi-processor systems.
︙
292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310	302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350	- - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	* frequency (perhaps in an attempt to calibrate the clock?) * we use the latter rule rather than an exact match. */ if ( timeInfo.perfCounterAvailable /* The following lines would do an exact match on * crystal frequency: * && timeInfo.curCounterFreq.QuadPart != (LONGLONG) 1193182 * && timeInfo.curCounterFreq.QuadPart != (LONGLONG) 3579545 */ && timeInfo.curCounterFreq.QuadPart > (LONGLONG) 15000000 ) { * && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt) 1193182 * && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt) 3579545 */ && timeInfo.nominalFreq.QuadPart > (Tcl_WideInt) 15000000 ) { /* * As an exception, if every logical processor on the system * is on the same chip, we use the performance counter anyway, * presuming that everyone's TSC is locked to the same * oscillator. */ SYSTEM_INFO systemInfo; unsigned int regs[4]; GetSystemInfo( &systemInfo ); if ( TclWinCPUID( 0, regs ) == TCL_OK && regs[1] == 0x756e6547 /* "Genu" */ && regs[3] == 0x49656e69 /* "ineI" */ && regs[2] == 0x6c65746e /* "ntel" */ && TclWinCPUID( 1, regs ) == TCL_OK && ( (regs[0] & 0x00000F00) == 0x00000F00 /* Pentium 4 */ || ( (regs[0] & 0x00F00000) /* Extended family */ && (regs[3] & 0x10000000) ) ) /* Hyperthread */ && ( ( ( regs[1] & 0x00FF0000 ) >> 16 ) /* CPU count */ == systemInfo.dwNumberOfProcessors ) ) { timeInfo.perfCounterAvailable = TRUE; } else { timeInfo.perfCounterAvailable = FALSE; } } /* * If the performance counter is available, start a thread to * calibrate it. */
︙
334 335 336 337 338 339 340 341 342 343 344 345 346 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 402 403	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 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444	- - + - + + - + - + + + - - - - - + + + + + - - + + - + - + - + - - +	} timeInfo.initialized = TRUE; } TclpInitUnlock(); } if ( timeInfo.perfCounterAvailable ) { /* * Query the performance counter and use it to calculate the * current time. */ LARGE_INTEGER curCounter; /* Current performance counter */ LONGLONG curFileTime; Tcl_WideInt curFileTime; /* Current estimated time, expressed * as 100-ns ticks since the Windows epoch */ static LARGE_INTEGER posixEpoch; /* Posix epoch expressed as 100-ns ticks * since the windows epoch */ LONGLONG usecSincePosixEpoch; Tcl_WideInt usecSincePosixEpoch; /* Current microseconds since Posix epoch */ posixEpoch.LowPart = 0xD53E8000; posixEpoch.HighPart = 0x019DB1DE; EnterCriticalSection( &timeInfo.cs ); QueryPerformanceCounter( &curCounter ); /* * If it appears to be more than 1.1 seconds since the last trip * through the calibration loop, the performance counter may * have jumped. Discard it. See MSDN Knowledge Base article * have jumped forward. (See MSDN Knowledge Base article * Q274323 for a description of the hardware problem that makes * this test necessary. * this test necessary.) If the counter jumps, we don't want * to use it directly. Instead, we must return system time. * Eventually, the calibration loop should recover. */ if ( curCounter.QuadPart - timeInfo.lastPerfCounter < 11 * timeInfo.estPerfCounterFreq / 10 ) { curFileTime = timeInfo.lastFileTime.QuadPart + ( ( curCounter.QuadPart - timeInfo.lastCounter.QuadPart ) if ( curCounter.QuadPart - timeInfo.perfCounterLastCall.QuadPart < 11 * timeInfo.curCounterFreq.QuadPart / 10 ) { curFileTime = timeInfo.fileTimeLastCall.QuadPart + ( ( curCounter.QuadPart - timeInfo.perfCounterLastCall.QuadPart ) * 10000000 / timeInfo.curCounterFreq.QuadPart ); timeInfo.lastFileTime.QuadPart = curFileTime; timeInfo.lastCounter.QuadPart = curCounter.QuadPart; timeInfo.fileTimeLastCall.QuadPart = curFileTime; timeInfo.perfCounterLastCall.QuadPart = curCounter.QuadPart; usecSincePosixEpoch = ( curFileTime - posixEpoch.QuadPart ) / 10; timePtr->sec = (time_t) ( usecSincePosixEpoch / 1000000 ); timePtr->sec = (long) ( usecSincePosixEpoch / 1000000 ); timePtr->usec = (unsigned long ) ( usecSincePosixEpoch % 1000000 ); useFtime = 0; } } LeaveCriticalSection( &timeInfo.cs ); } if ( useFtime ) { /* High resolution timer is not available. Just use ftime */ ftime(&t); timePtr->sec = t.time; timePtr->sec = (long)t.time; timePtr->usec = t.millitm * 1000; } }  /* *---------------------------------------------------------------------- *
︙
441 442 443 444 445 446 447 448 449 450 451 452 453 454 455	482 483 484 485 486 487 488 489 490 491 492 493 494 495 496	- +	* *---------------------------------------------------------------------- */ char * TclpGetTZName(int dst) { int len; size_t len; char *zone, *p; TIME_ZONE_INFORMATION tz; Tcl_Encoding encoding; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); char *name = tsdPtr->tzName; /*
︙
488 489 490 491 492 493 494 495 496 497 498 499 500 501 502	529 530 531 532 533 534 535 536 537 538 539 540 541 542 543	- +	zone = p; len = strlen(zone); if (len > 3) { len = 3; } } } Tcl_ExternalToUtf(NULL, NULL, zone, len, 0, NULL, name, Tcl_ExternalToUtf(NULL, NULL, zone, (int)len, 0, NULL, name, sizeof(tsdPtr->tzName), NULL, NULL, NULL); } if (name[0] == '\0') { if (GetTimeZoneInformation(&tz) == TIME_ZONE_ID_UNKNOWN) { /* * MSDN: On NT this is returned if DST is not used in * the current TZ
︙
533 534 535 536 537 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	574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604	- + - +	struct tm * TclpGetDate(t, useGMT) TclpTime_t t; int useGMT; { const time_t *tp = (const time_t *) t; struct tm *tmPtr; long time; time_t time; if (!useGMT) { tzset(); /* * If we are in the valid range, let the C run-time library * handle it. Otherwise we need to fake it. Note that this * algorithm ignores daylight savings time before the epoch. */ if (*tp >= 0) { return localtime(tp); } time = *tp - _timezone; /* * If we aren't near to overflowing the long, just add the bias and * use the normal calculation. Otherwise we will need to adjust * the result at the end. */ if (*tp < (LONG_MAX - 2 * SECSPERDAY)
︙
575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607	616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648	- + - - - + + +	time = tmPtr->tm_sec - _timezone; tmPtr->tm_sec = (int)(time % 60); if (tmPtr->tm_sec < 0) { tmPtr->tm_sec += 60; time -= 60; } time = tmPtr->tm_min + time/60; tmPtr->tm_min = (int)(time % 60); if (tmPtr->tm_min < 0) { tmPtr->tm_min += 60; time -= 60; } time = tmPtr->tm_hour + time/60; tmPtr->tm_hour = (int)(time % 24); if (tmPtr->tm_hour < 0) { tmPtr->tm_hour += 24; time -= 24; } time /= 24; tmPtr->tm_mday += time; tmPtr->tm_yday += time; tmPtr->tm_wday = (tmPtr->tm_wday + time) % 7; tmPtr->tm_mday += (int)time; tmPtr->tm_yday += (int)time; tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7; } } else { tmPtr = ComputeGMT(tp); } return tmPtr; }
︙
634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649	675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690	- - + +	tmPtr = &tsdPtr->tm; /* * Compute the 4 year span containing the specified time. */ tmp = *tp / SECSPER4YEAR; rem = *tp % SECSPER4YEAR; tmp = (long)(*tp / SECSPER4YEAR); rem = (LONG)(*tp % SECSPER4YEAR); /* * Correct for weird mod semantics so the remainder is always positive. */ if (rem < 0) { tmp--;
︙
701 702 703 704 705 706 707 708 709 710 711 712 713 714 715	742 743 744 745 746 747 748 749 750 751 752 753 754 755 756	- +	tmPtr->tm_mon = --tmp; tmPtr->tm_mday = tmPtr->tm_yday - days[tmp]; /* * Compute day of week. Epoch started on a Thursday. */ tmPtr->tm_wday = (*tp / SECSPERDAY) + 4; tmPtr->tm_wday = (long)(*tp / SECSPERDAY) + 4; if ((*tp % SECSPERDAY) < 0) { tmPtr->tm_wday--; } tmPtr->tm_wday %= 7; if (tmPtr->tm_wday < 0) { tmPtr->tm_wday += 7; }
︙
730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771	771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810	- - + - + - - + + - - - - + + +	* arg -- Client data from the CreateThread call. This parameter * points to the static TimeInfo structure. * * Return value: * None. This thread embeds an infinite loop. * * Side effects: * At an interval of clockCalibrateWakeupInterval ms, this thread * performs virtual time discipline. * At an interval of 1 s, this thread performs virtual time discipline. * * Note: When this thread is entered, TclpInitLock has been called * to safeguard the static storage. There is therefore no synchronization * in the body of this procedure. * *---------------------------------------------------------------------- */ static DWORD WINAPI CalibrationThread( LPVOID arg ) { FILETIME curFileTime; DWORD waitResult; /* Get initial system time and performance counter */ GetSystemTimeAsFileTime( &curFileTime ); QueryPerformanceCounter( &timeInfo.lastCounter ); QueryPerformanceCounter( &timeInfo.perfCounterLastCall ); QueryPerformanceFrequency( &timeInfo.curCounterFreq ); timeInfo.lastFileTime.LowPart = curFileTime.dwLowDateTime; timeInfo.lastFileTime.HighPart = curFileTime.dwHighDateTime; timeInfo.fileTimeLastCall.LowPart = curFileTime.dwLowDateTime; timeInfo.fileTimeLastCall.HighPart = curFileTime.dwHighDateTime; /* Initialize the working storage for the calibration callback */ timeInfo.lastPerfCounter = timeInfo.lastCounter.QuadPart; timeInfo.estPerfCounterFreq = timeInfo.curCounterFreq.QuadPart; ResetCounterSamples( timeInfo.fileTimeLastCall.QuadPart, timeInfo.perfCounterLastCall.QuadPart, timeInfo.curCounterFreq.QuadPart ); /* * Wake up the calling thread. When it wakes up, it will release the * initialization lock. */ SetEvent( timeInfo.readyEvent );
︙
811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938	850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 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 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147	- - - - - - - - - + - + - - - + - - - + + - + + - + + + - - - + + + + + + + + + + + + - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + - - - - - + + + + + + + + + + + + - - + + + + + + + - - + + + + + + + - - - + + + + + + + + + + + + - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - + + + + + + + + - + + + + + + + + + + + + + - - + + + + + + + - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - + + + + + + + + + + + + + + + + + + + + - - - + + - - - - - + + + + + + + + + + + + + + - - - + + + + + + + + + + + + +	UpdateTimeEachSecond() { LARGE_INTEGER curPerfCounter; /* Current value returned from * QueryPerformanceCounter */ LONGLONG perfCounterDiff; /* Difference between the current value * and the value of 1 second ago */ FILETIME curSysTime; /* Current system time */ LARGE_INTEGER curFileTime; /* File time at the time this callback * was scheduled. */ LONGLONG fileTimeDiff; /* Elapsed time on the system clock * since the last time this procedure * was called */ LONGLONG instantFreq; /* Instantaneous estimate of the * performance counter frequency */ Tcl_WideInt estFreq; /* Estimated perf counter frequency */ LONGLONG delta; /* Increment to add to the estimated Tcl_WideInt vt0; /* Tcl time right now */ * performance counter frequency in the * loop filter */ Tcl_WideInt vt1; /* Tcl time one second from now */ LONGLONG fuzz; /* Tolerance for the perf counter frequency */ LONGLONG lowBound; /* Lower bound for the frequency assuming * 1000 ppm tolerance */ Tcl_WideInt tdiff; /* Difference between system clock and * Tcl time. */ LONGLONG hiBound; /* Upper bound for the frequency */ Tcl_WideInt driftFreq; /* Frequency needed to drift virtual time * into step over 1 second */ /* * Get current performance counter and system time. * Sample performance counter and system time. */ QueryPerformanceCounter( &curPerfCounter ); GetSystemTimeAsFileTime( &curSysTime ); curFileTime.LowPart = curSysTime.dwLowDateTime; curFileTime.HighPart = curSysTime.dwHighDateTime; EnterCriticalSection( &timeInfo.cs ); /* * Several things may have gone wrong here that have to * be checked for. * Find out how many ticks of the performance counter and the * system clock have elapsed since we got into this procedure. * Estimate the current frequency. * (1) The performance counter may have jumped. * (2) The system clock may have been reset. * * In either case, we'll need to reinitialize the circular buffer * with samples relative to the current system time and the NOMINAL * performance frequency (not the actual, because the actual has * probably run slow in the first case). Our estimated frequency * will be the nominal frequency. */ /* * Store the current sample into the circular buffer of samples, * and estimate the performance counter frequency. */ perfCounterDiff = curPerfCounter.QuadPart - timeInfo.lastPerfCounter; timeInfo.lastPerfCounter = curPerfCounter.QuadPart; fileTimeDiff = curFileTime.QuadPart - timeInfo.lastSysTime; timeInfo.lastSysTime = curFileTime.QuadPart; instantFreq = ( 10000000 * perfCounterDiff / fileTimeDiff ); estFreq = AccumulateSample( curPerfCounter.QuadPart, (Tcl_WideUInt) curFileTime.QuadPart ); /* * We want to adjust things so that time appears to be continuous. * Virtual file time, right now, is * * vt0 = 10000000 * ( curPerfCounter - perfCounterLastCall ) * / curCounterFreq * + fileTimeLastCall * * Ideally, we would like to drift the clock into place over a * period of 2 sec, so that virtual time 2 sec from now will be * * vt1 = 20000000 + curFileTime * * The frequency that we need to use to drift the counter back into * place is estFreq * 20000000 / ( vt1 - vt0 ) */ vt0 = 10000000 * ( curPerfCounter.QuadPart - timeInfo.perfCounterLastCall.QuadPart ) / timeInfo.curCounterFreq.QuadPart + timeInfo.fileTimeLastCall.QuadPart; vt1 = 20000000 + curFileTime.QuadPart; /* * Consider this a timing glitch if instant frequency varies * significantly from the current estimate. * If we've gotten more than a second away from system time, * then drifting the clock is going to be pretty hopeless. * Just let it jump. Otherwise, compute the drift frequency and * fill in everything. */ tdiff = vt0 - curFileTime.QuadPart; if ( tdiff > 10000000 || tdiff < -10000000 ) { fuzz = timeInfo.estPerfCounterFreq >> 10; lowBound = timeInfo.estPerfCounterFreq - fuzz; hiBound = timeInfo.estPerfCounterFreq + fuzz; if ( instantFreq < lowBound || instantFreq > hiBound ) { LeaveCriticalSection( &timeInfo.cs ); timeInfo.fileTimeLastCall.QuadPart = curFileTime.QuadPart; timeInfo.curCounterFreq.QuadPart = estFreq; } else { driftFreq = estFreq * 20000000 / ( vt1 - vt0 ); if ( driftFreq > 1003 * estFreq / 1000 ) { driftFreq = 1003 * estFreq / 1000; } if ( driftFreq < 997 * estFreq / 1000 ) { driftFreq = 997 * estFreq / 1000; } timeInfo.fileTimeLastCall.QuadPart = vt0; timeInfo.curCounterFreq.QuadPart = driftFreq; return; } } timeInfo.perfCounterLastCall.QuadPart = curPerfCounter.QuadPart; LeaveCriticalSection( &timeInfo.cs ); } /* * Update the current estimate of performance counter frequency. /* *---------------------------------------------------------------------- * * ResetCounterSamples -- * * Fills the sample arrays in 'timeInfo' with dummy values that will * yield the current performance counter and frequency. * This code is equivalent to the loop filter of a phase locked * loop. */ * * Results: * None. * * Side effects: * The array of samples is filled in so that it appears that there * are SAMPLES samples at one-second intervals, separated by precisely * the given frequency. * *---------------------------------------------------------------------- */ static void delta = ( instantFreq - timeInfo.estPerfCounterFreq ) >> 6; timeInfo.estPerfCounterFreq += delta; /* * Update the current virtual time. */ ResetCounterSamples( Tcl_WideUInt fileTime, /* Current file time */ Tcl_WideInt perfCounter, /* Current performance counter */ Tcl_WideInt perfFreq ) /* Target performance frequency */ { int i; for ( i = SAMPLES-1; i >= 0; --i ) { timeInfo.perfCounterSample[i] = perfCounter; timeInfo.fileTimeSample[i] = fileTime; perfCounter -= perfFreq; fileTime -= 10000000; } timeInfo.sampleNo = 0; } /* *---------------------------------------------------------------------- * * AccumulateSample -- * * Updates the circular buffer of performance counter and system * time samples with a new data point. * * Results: * None. * timeInfo.lastFileTime.QuadPart += ( ( curPerfCounter.QuadPart - timeInfo.lastCounter.QuadPart ) * 10000000 / timeInfo.curCounterFreq.QuadPart ); * Side effects: * The new data point replaces the oldest point in the circular * buffer, and the descriptive statistics are updated to accumulate * the new point. * * Several things may have gone wrong here that have to * be checked for. * (1) The performance counter may have jumped. timeInfo.lastCounter.QuadPart = curPerfCounter.QuadPart; * (2) The system clock may have been reset. * * In either case, we'll need to reinitialize the circular buffer * with samples relative to the current system time and the NOMINAL * performance frequency (not the actual, because the actual has * probably run slow in the first case). */ static Tcl_WideInt AccumulateSample( Tcl_WideInt perfCounter, Tcl_WideUInt fileTime ) { Tcl_WideUInt workFTSample; /* File time sample being removed * from or added to the circular buffer */ delta = curFileTime.QuadPart - timeInfo.lastFileTime.QuadPart; if ( delta > 10000000 || delta < -10000000 ) { Tcl_WideInt workPCSample; /* Performance counter sample being * removed from or added to the circular * buffer */ Tcl_WideUInt lastFTSample; /* Last file time sample recorded */ Tcl_WideInt lastPCSample; /* Last performance counter sample recorded */ /* * If the virtual time slip exceeds one second, then adjusting * the counter frequency is hopeless (it'll take over fifteen * minutes to line up with the system clock). The most likely * cause of this large a slip is a sudden change to the system * clock, perhaps because it was being corrected by wristwatch * and eyeball. Accept the system time, and set the performance * counter frequency to the current estimate. */ timeInfo.lastFileTime.QuadPart = curFileTime.QuadPart; timeInfo.curCounterFreq.QuadPart = timeInfo.estPerfCounterFreq; } else { /* * Compute a counter frequency that will cause virtual time to line * up with system time one second from now, assuming that the Tcl_WideInt FTdiff; /* Difference between last FT and current */ Tcl_WideInt PCdiff; /* Difference between last PC and current */ Tcl_WideInt estFreq; /* Estimated performance counter frequency */ /* Test for jumps and reset the samples if we have one. */ if ( timeInfo.sampleNo == 0 ) { lastPCSample = timeInfo.perfCounterSample[ timeInfo.sampleNo + SAMPLES - 1 ]; lastFTSample = timeInfo.fileTimeSample[ timeInfo.sampleNo + SAMPLES - 1 ]; } else { lastPCSample = timeInfo.perfCounterSample[ timeInfo.sampleNo - 1 ]; lastFTSample = timeInfo.fileTimeSample[ timeInfo.sampleNo - 1 ]; } PCdiff = perfCounter - lastPCSample; FTdiff = fileTime - lastFTSample; if ( PCdiff < timeInfo.nominalFreq.QuadPart * 9 / 10 || PCdiff > timeInfo.nominalFreq.QuadPart * 11 / 10 || FTdiff < 9000000 || FTdiff > 11000000 ) { ResetCounterSamples( fileTime, perfCounter, timeInfo.nominalFreq.QuadPart ); return timeInfo.nominalFreq.QuadPart; } else { /* Estimate the frequency */ workPCSample = timeInfo.perfCounterSample[ timeInfo.sampleNo ]; workFTSample = timeInfo.fileTimeSample[ timeInfo.sampleNo ]; estFreq = 10000000 * ( perfCounter - workPCSample ) / ( fileTime - workFTSample ); timeInfo.perfCounterSample[ timeInfo.sampleNo ] = perfCounter; timeInfo.fileTimeSample[ timeInfo.sampleNo ] = (Tcl_WideInt) fileTime; /* Advance the sample number */ if ( ++timeInfo.sampleNo >= SAMPLES ) { timeInfo.sampleNo = 0; } return estFreq; } }  /* *---------------------------------------------------------------------- * * TclpGmtime -- * * Wrapper around the 'gmtime' library function to make it thread * safe. * * Results: * Returns a pointer to a 'struct tm' in thread-specific data. * * Side effects: * Invokes gmtime or gmtime_r as appropriate. * performance counter continues to tick at timeInfo.estPerfCounterFreq. */ timeInfo.curCounterFreq.QuadPart = 10000000 * timeInfo.estPerfCounterFreq / ( delta + 10000000 ); /* * *---------------------------------------------------------------------- */ struct tm * TclpGmtime( tt ) TclpTime_t_CONST tt; { CONST time_t *timePtr = (CONST time_t *) tt; /* Pointer to the number of seconds * since the local system's epoch */ /* * The MS implementation of gmtime is thread safe because * it returns the time in a block of thread-local storage, * and Windows does not provide a Posix gmtime_r function. */ return gmtime( timePtr ); }  /* * Limit frequency excursions to 1000 ppm from estimate */ *---------------------------------------------------------------------- * if ( timeInfo.curCounterFreq.QuadPart < lowBound ) { timeInfo.curCounterFreq.QuadPart = lowBound; } else if ( timeInfo.curCounterFreq.QuadPart > hiBound ) { timeInfo.curCounterFreq.QuadPart = hiBound; } * TclpLocaltime -- * * Wrapper around the 'localtime' library function to make it thread * safe. * * Results: * Returns a pointer to a 'struct tm' in thread-specific data. * * Side effects: * Invokes localtime or localtime_r as appropriate. * *---------------------------------------------------------------------- */ } LeaveCriticalSection( &timeInfo.cs ); struct tm * TclpLocaltime( tt ) TclpTime_t_CONST tt; { CONST time_t *timePtr = (CONST time_t *) tt; /* Pointer to the number of seconds * since the local system's epoch */ /* * The MS implementation of localtime is thread safe because * it returns the time in a block of thread-local storage, * and Windows does not provide a Posix localtime_r function. */ return localtime( timePtr ); }