Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch pyk-pkgrequirenre Excluding Merge-Ins
This is equivalent to a diff from dbb80e10f1 to fab0d99a87
2016-07-28
| ||
21:47 | merge pyk-pkgrequirenre check-in: 86d4e33030 user: pooryorick tags: pyk-trunk | |
2016-07-18
| ||
16:50 |
[104f2885bb] Rework the "chan" Tcl_ObjType to properly validate cached channel name lookups.
Also ... check-in: 98f348e049 user: dgp tags: trunk | |
05:49 |
NRE-enable [package ifneeded] scripts.
2018-02-06: This branch is closed. See the py-package-nre... Closed-Leaf check-in: fab0d99a87 user: pooryorick tags: pyk-pkgrequirenre | |
2016-07-15
| ||
15:54 | Reopened [3418547] with revised test resolver-1.1. check-in: d43f03c9f3 user: dgp tags: bug-3418547 | |
14:20 | Remove unmaintained disabled speculative code. Such things are for branches and history. check-in: dbb80e10f1 user: dgp tags: trunk | |
14:19 | Factor the cmdName intrep setting code into common utility routine. check-in: d38d059aeb user: dgp tags: trunk | |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
230 231 232 233 234 235 236 | {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE}, {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE}, {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE}, | | | 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 | {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE}, {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE}, {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE}, {"package", Tcl_PackageObjCmd, NULL, TclNRPackageObjCmd, CMD_IS_SAFE}, {"proc", Tcl_ProcObjCmd, NULL, NULL, CMD_IS_SAFE}, {"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, CMD_IS_SAFE}, {"regsub", Tcl_RegsubObjCmd, TclCompileRegsubCmd, NULL, CMD_IS_SAFE}, {"rename", Tcl_RenameObjCmd, NULL, NULL, CMD_IS_SAFE}, {"return", Tcl_ReturnObjCmd, TclCompileReturnCmd, NULL, CMD_IS_SAFE}, {"scan", Tcl_ScanObjCmd, NULL, NULL, CMD_IS_SAFE}, {"set", Tcl_SetObjCmd, TclCompileSetCmd, NULL, CMD_IS_SAFE}, |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 | MODULE_SCOPE Tcl_ObjCmdProc TclNREvalObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRCatchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRExprObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRLmapCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRWhileObjCmd; | > | 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 | MODULE_SCOPE Tcl_ObjCmdProc TclNREvalObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRCatchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRExprObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRLmapCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRPackageObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRWhileObjCmd; |
︙ | ︙ |
Changes to generic/tclPkg.c.
︙ | ︙ | |||
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 | * (malloc'ed). NULL means the package doesn't * exist in this interpreter yet. */ PkgAvail *availPtr; /* First in list of all available versions of * this package. */ const void *clientData; /* Client data. */ } Package; /* * Prototypes for functions defined in this file: */ static int CheckVersionAndConvert(Tcl_Interp *interp, const char *string, char **internal, int *stable); static int CompareVersions(char *v1i, 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(char *havei, const char *req); static int SomeRequirementSatisfied(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); | > > > > > > > > > > > > > > > > > > > > > > > < < < > > > > > > > > > > > > > > > > > | 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 | * (malloc'ed). NULL means the package doesn't * exist in this interpreter yet. */ PkgAvail *availPtr; /* First in list of all available versions of * this package. */ const void *clientData; /* Client data. */ } Package; /* PkgRequireState is passed between functions that form a unit of execution but that * are chunked up for the NRE * */ typedef struct PkgRequireState { const char *name; int reqc; int pass; int code; Package *pkgPtr; PkgAvail *availPtr; PkgAvail *bestPtr; PkgAvail *bestStablePtr; char *bestVersion; /* Internal rep. of versions */ char *availVersion; int availStable; char *pkgVersionI; void *clientDataPtr; char *result; char *versionToProvide; Tcl_Obj *scriptObj; } PkgRequireState; /* * Prototypes for functions defined in this file: */ static int CheckVersionAndConvert(Tcl_Interp *interp, const char *string, char **internal, int *stable); static int CompareVersions(char *v1i, 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(char *havei, const char *req); static int SomeRequirementSatisfied(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); /* This sequence is listed in order of execution. Later in the code they don't appear in order of execution because they are pushed onto the callback stack in reverse order of execution, and dynamically as processing of the callback stack proceeds. */ int TclNRPkgRequireProc(ClientData data[], Tcl_Interp *interp, int result); int PkgRequireCore(ClientData data[], Tcl_Interp *interp, int result); int PkgRequireCoreUnknown(ClientData data[], Tcl_Interp *interp, int result); int PkgRequireCoreUnknownEvalFinish(ClientData data[], Tcl_Interp *interp, int result); int PkgRequireCoreUnknownFinish(ClientData data[], Tcl_Interp *interp, int result); int PkgRequireCoreBest(ClientData data[], Tcl_Interp *interp, int result); int PkgRequireCoreBestEvalFinish(ClientData data[], Tcl_Interp *interp, int result); int PkgRequireCoreBestFinish(ClientData data[], Tcl_Interp *interp, int result); int PkgRequireCoreCheckFound(ClientData data[], Tcl_Interp *interp, int result); int PkgRequireCoreFinish(ClientData data[], Tcl_Interp *interp, int result); int PkgRequireProcFinish(ClientData data[], Tcl_Interp *interp, int result); /* * Helper macros. */ #define DupBlock(v,s,len) \ ((v) = ckalloc(len), memcpy((v),(s),(len))) #define DupString(v,s) \ |
︙ | ︙ | |||
295 296 297 298 299 300 301 | } /* * Translate between old and new API, and defer to the new function. */ if (version == NULL) { | | > > > < | > > > > > > > | > | > > > > > > > > > > > > | > > | > > > > > > > > > > > > > > > > > | > > | < < | | > | < < | < < < < | < < < < < < < | | > > | | | | | | | | | | | > | | > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | < > | | > > > > > > | > > | > > > > > > > | > > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > | > > > > > > > | | | | | | | | | | | > > > > | | | | | > | | | < | | < < < < < | < < | < < < < < < < < < | | < > | | < < < | > | | < < | | < | | | | | | | | | | | | | > | > > > > > > | > > > > > > > > > > | > | 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 | } /* * Translate between old and new API, and defer to the new function. */ if (version == NULL) { if (Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr) == TCL_OK) { result = Tcl_GetStringResult(interp); } } else { if (exact && TCL_OK != CheckVersionAndConvert(interp, version, NULL, NULL)) { return NULL; } ov = Tcl_NewStringObj(version, -1); Tcl_IncrRefCount(ov); if (exact) { Tcl_AppendStringsToObj(ov, "-", version, NULL); } if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) { result = Tcl_GetStringResult(interp); } TclDecrRefCount(ov); } return result; } int Tcl_PkgRequireProc( 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. */ void *clientDataPtr) { NRE_callback *rootPtr = TOP_CB(interp); TclNRAddCallback( interp, TclNRPkgRequireProc, name, INT2PTR(reqc), reqv, clientDataPtr); return TclNRRunCallbacks(interp, TCL_OK, rootPtr); } int TclNRPkgRequireProc( ClientData data[], Tcl_Interp *interp, /* Interpreter in which package is now * available. */ int result ) { PkgRequireState *statePtr; statePtr = ckalloc(sizeof(PkgRequireState)); statePtr->code = TCL_OK; statePtr->name = data[0]; statePtr->reqc = PTR2INT(data[1]); statePtr->pass = 1; statePtr->clientDataPtr = data[3]; statePtr->result = NULL; if (TCL_OK != CheckAllRequirements(interp, statePtr->reqc, data[2])) { return TCL_ERROR; } Tcl_NRAddCallback(interp, PkgRequireCore, statePtr, data[2], NULL, NULL); return TCL_OK; } int TclPkgRequireProcFinish( ClientData data[], Tcl_Interp *interp, int result ) { int objc = PTR2INT(data[0]); Tcl_Obj *const *objv = data[1]; while (objc-- > 0) { Tcl_DecrRefCount(objv[objc]); } if (data[2] != NULL) { Tcl_DecrRefCount(data[2]); } return result; } int PkgRequireCore( ClientData data[], Tcl_Interp *interp, int result0 ) { PkgRequireState *statePtr = data[0]; Tcl_Obj *const *reqv = data[1]; Interp *iPtr = (Interp *) interp; int satisfies; /* * 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. */ statePtr->pkgPtr = FindPackage(interp, statePtr->name); if (statePtr->pkgPtr->version != NULL) { Tcl_NRAddCallback(interp, PkgRequireCoreCheckFound, statePtr, (ClientData)reqv, NULL, NULL); return TCL_OK; } /* * Check whether we're already attempting to load some version of this * package (circular dependency detection). */ if (statePtr->pkgPtr->clientData != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "circular package dependency:" " attempt to provide %s %s requires %s", statePtr->name, (char *) statePtr->pkgPtr->clientData, statePtr->name)); AddRequirementsToResult(interp, statePtr->reqc, reqv); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL); TclNRAddCallback( interp, PkgRequireCoreFinish, statePtr, NULL, NULL, NULL); return TCL_ERROR; } /* * The package isn't yet present. Search the list of available * versions and invoke the script for the best available version. We * are actually locating the best, and the best stable version. One of * them is then chosen based on the selection mode. */ statePtr->bestPtr = NULL; statePtr->bestStablePtr = NULL; statePtr->bestVersion = NULL; for (statePtr->availPtr = statePtr->pkgPtr->availPtr; statePtr->availPtr != NULL; statePtr->availPtr = statePtr->availPtr->nextPtr) { if (CheckVersionAndConvert(interp, statePtr->availPtr->version, &statePtr->availVersion, &statePtr->availStable) != TCL_OK) { /* * The provided version number has invalid syntax. This * should not happen. This should have been caught by the * 'package ifneeded' registering the package. */ continue; } if (statePtr->bestPtr != NULL) { int res = CompareVersions(statePtr->availVersion, statePtr->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. */ ckfree(statePtr->availVersion); statePtr->availVersion = NULL; continue; } } /* * We have found a version which is better than our max. */ if (statePtr->reqc > 0) { /* Check satisfaction of requirements. */ satisfies = SomeRequirementSatisfied( statePtr->availVersion, statePtr->reqc, reqv); if (!satisfies) { ckfree(statePtr->availVersion); statePtr->availVersion = NULL; continue; } } statePtr->bestPtr = statePtr->availPtr; if (statePtr->bestVersion != NULL) { ckfree(statePtr->bestVersion); } statePtr->bestVersion = statePtr->availVersion; /* * If this new best version is stable then it also has to be * better than the max stable version found so far. */ if (statePtr->availStable) { statePtr->bestStablePtr = statePtr->availPtr; } } if (statePtr->bestVersion != NULL) { ckfree(statePtr->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) && (statePtr->bestStablePtr != NULL)) { statePtr->bestPtr = statePtr->bestStablePtr; } if (statePtr->bestPtr != NULL) { TclNRAddCallback( interp, PkgRequireCoreBestFinish, statePtr, reqv, NULL, NULL); TclNRAddCallback( interp, PkgRequireCoreBest, statePtr, NULL, NULL, NULL); return TCL_OK; } /* * 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 (statePtr->pass > 1) { Tcl_NRAddCallback(interp, PkgRequireCoreCheckFound, statePtr, (ClientData)reqv, NULL, NULL); return TCL_OK; } TclNRAddCallback( interp, PkgRequireCoreUnknownFinish, statePtr,reqv, NULL, NULL); TclNRAddCallback( interp, PkgRequireCoreUnknown, statePtr,reqv, NULL, NULL); return TCL_OK; } int PkgRequireCoreUnknown( ClientData data[], Tcl_Interp *interp, int result ) { Interp *iPtr = (Interp *) interp; PkgRequireState *statePtr = data[0]; Tcl_Obj *const *reqv = data[1]; Tcl_DString command; char *script; script = ((Interp *) interp)->packageUnknown; if (script != NULL) { Tcl_DStringInit(&command); Tcl_DStringAppend(&command, script, -1); Tcl_DStringAppendElement(&command, statePtr->name); AddRequirementsToDString(&command, statePtr->reqc, reqv); statePtr->scriptObj = Tcl_NewStringObj(Tcl_DStringValue(&command), -1); /* No need to increment of the ref count of scriptObj, because * TclNREvelObjEx does that. right? */ Tcl_DStringFree(&command); TclNRAddCallback( interp, PkgRequireCoreUnknownEvalFinish, statePtr, data[1], NULL, NULL); statePtr->code = TclNREvalObjEx( interp, statePtr->scriptObj, TCL_EVAL_GLOBAL, iPtr->cmdFramePtr, 1); } return result; } int PkgRequireCoreUnknownEvalFinish( ClientData data[], Tcl_Interp *interp, int result ) { PkgRequireState *statePtr = data[0]; /* Pick up the return code from TclNREvalObjEx */ statePtr->code = result; if ((statePtr->code != TCL_OK) && (statePtr->code != TCL_ERROR)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad return code: %d", statePtr->code)); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL); statePtr->code = TCL_ERROR; } if (statePtr->code == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (\"package unknown\" script)"); return TCL_ERROR; } Tcl_ResetResult(interp); return TCL_OK; } int PkgRequireCoreUnknownFinish( ClientData data[], Tcl_Interp *interp, int result ) { PkgRequireState *statePtr = data[0]; if (statePtr->code != TCL_OK) { /* error message has been set */ TclNRAddCallback( interp, PkgRequireCoreFinish, statePtr, NULL, NULL, NULL); return TCL_ERROR; } statePtr->pass++; Tcl_NRAddCallback(interp, PkgRequireCore, statePtr, data[1], NULL, NULL); return TCL_OK; } int PkgRequireCoreBest( ClientData data[], Tcl_Interp *interp, int result ) { Interp *iPtr = (Interp *) interp; PkgRequireState *statePtr = data[0]; char *script; /* * 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. */ statePtr->versionToProvide = statePtr->bestPtr->version; script = statePtr->bestPtr->script; statePtr->pkgPtr->clientData = statePtr->versionToProvide; Tcl_Preserve(statePtr->versionToProvide); statePtr->scriptObj = Tcl_NewStringObj(script, -1); Tcl_IncrRefCount(statePtr->scriptObj); TclNRAddCallback( interp, PkgRequireCoreBestEvalFinish, statePtr, data[1], NULL, NULL); TclNREvalObjEx( interp, statePtr->scriptObj, TCL_EVAL_GLOBAL , iPtr->cmdFramePtr, 0); return result; } int PkgRequireCoreBestEvalFinish( ClientData data[], Tcl_Interp *interp, int result ) { PkgRequireState *statePtr = data[0]; /* Pick up the return code from TclNREvalObjEx */ statePtr->code = result; Tcl_DecrRefCount(statePtr->scriptObj); statePtr->pkgPtr = FindPackage(interp, statePtr->name); if (statePtr->code == TCL_OK) { Tcl_ResetResult(interp); if (statePtr->pkgPtr->version == NULL) { statePtr->code = TCL_ERROR; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "attempt to provide package %s %s failed:" " no version of package %s provided", statePtr->name, statePtr->versionToProvide, statePtr->name)); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED", NULL); } else { char *pvi, *vi; if (CheckVersionAndConvert(interp, statePtr->pkgPtr->version, &pvi, NULL) != TCL_OK) { statePtr->code = TCL_ERROR; } else if (CheckVersionAndConvert(interp, statePtr->versionToProvide, &vi, NULL) != TCL_OK) { ckfree(pvi); statePtr->code = TCL_ERROR; } else { int res = CompareVersions(pvi, vi, NULL); ckfree(pvi); ckfree(vi); if (res != 0) { statePtr->code = TCL_ERROR; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "attempt to provide package %s %s failed:" " package %s %s provided instead", statePtr->name, statePtr->versionToProvide, statePtr->name, statePtr->pkgPtr->version)); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "WRONGPROVIDE", NULL); } } } } else if (statePtr->code != TCL_ERROR) { Tcl_Obj *codePtr = Tcl_NewIntObj(statePtr->code); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "attempt to provide package %s %s failed:" " bad return code: %s", statePtr->name, statePtr->versionToProvide, TclGetString(codePtr))); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL); TclDecrRefCount(codePtr); statePtr->code = TCL_ERROR; } if (statePtr->code == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"package ifneeded %s %s\" script)", statePtr->name, statePtr->versionToProvide)); } return result; } int PkgRequireCoreBestFinish( ClientData data[], Tcl_Interp *interp, int result ) { PkgRequireState *statePtr = data[0]; if (statePtr->code == TCL_ERROR) { /* * 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_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"package ifneeded %s %s\" script)", statePtr->name, statePtr->versionToProvide)); if (statePtr->pkgPtr->version != NULL) { ckfree(statePtr->pkgPtr->version); statePtr->pkgPtr->version = NULL; } statePtr->pkgPtr->clientData = NULL; TclNRAddCallback( interp, PkgRequireCoreFinish, statePtr, NULL, NULL, NULL); } else { Tcl_NRAddCallback(interp, PkgRequireCoreCheckFound, statePtr, data[1], NULL, NULL); } Tcl_Release(statePtr->versionToProvide); return result; } int PkgRequireCoreCheckFound( ClientData data[], Tcl_Interp *interp, int result ) { PkgRequireState *statePtr = data[0]; Tcl_Obj *const *reqv = data[1]; Package *pkgPtr = statePtr->pkgPtr; int satisfies; Tcl_NRAddCallback(interp, PkgRequireCoreFinish, statePtr, NULL, NULL,NULL); if (pkgPtr->version == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't find package %s", statePtr->name)); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL); AddRequirementsToResult(interp, statePtr->reqc, reqv); return TCL_ERROR; } /* * At this point we know that the package is present. Make sure that the * provided version meets the current requirements. */ if (statePtr->reqc != 0) { CheckVersionAndConvert(interp, pkgPtr->version, &statePtr->pkgVersionI, NULL); satisfies = SomeRequirementSatisfied(statePtr->pkgVersionI, statePtr->reqc, reqv); ckfree(statePtr->pkgVersionI); if (!satisfies) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "version conflict for package \"%s\": have %s, need", statePtr->name, pkgPtr->version)); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL); AddRequirementsToResult(interp, statePtr->reqc, reqv); return TCL_ERROR; } } if (statePtr->clientDataPtr) { const void **ptr = (const void **) statePtr->clientDataPtr; *ptr = pkgPtr->clientData; } statePtr->result = pkgPtr->version; return TCL_OK; } int PkgRequireCoreFinish( ClientData data[], Tcl_Interp *interp, int result ) { PkgRequireState *statePtr = data[0]; if (statePtr->result == NULL) { result = TCL_ERROR; } else { Tcl_SetObjResult(interp, Tcl_NewStringObj(statePtr->result, -1)); result = TCL_OK; } ckfree(statePtr); return result; } /* *---------------------------------------------------------------------- * * Tcl_PkgPresent / Tcl_PkgPresentEx -- * * Checks to see whether the specified package is present. If it is not |
︙ | ︙ | |||
752 753 754 755 756 757 758 759 760 761 762 763 | * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_PackageObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ | > | > > > | > > > > > > > | 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 | * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_PackageObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[] /* Argument objects. */ ) { return Tcl_NRCallObjProc(interp, TclNRPackageObjCmd, dummy, objc, objv); } int TclNRPackageObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[] /* Argument objects. */ ) { static const char *const pkgOptions[] = { "forget", "ifneeded", "names", "prefer", "present", "provide", "require", "unknown", "vcompare", "versions", "vsatisfies", NULL }; enum pkgOptions { PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, PKG_PREFER, PKG_PRESENT, |
︙ | ︙ | |||
972 973 974 975 976 977 978 | } argv3 = TclGetString(objv[3]); if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) { return TCL_ERROR; } return Tcl_PkgProvideEx(interp, argv2, argv3, NULL); case PKG_REQUIRE: | | | < < | | > | < > < | | > | > > > > > | | > > > > > > | 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 | } argv3 = TclGetString(objv[3]); if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) { return TCL_ERROR; } return Tcl_PkgProvideEx(interp, argv2, argv3, NULL); case PKG_REQUIRE: require: { if (objc < 3) { requireSyntax: Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?requirement ...?"); return TCL_ERROR; } version = NULL; argv2 = TclGetString(objv[2]); if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) { Tcl_Obj ** objv2; if (objc != 5) { goto requireSyntax; } objv2 = ckalloc((sizeof(Tcl_Obj *))); version = TclGetString(objv[4]); if (CheckVersionAndConvert(interp, version, NULL, NULL) != TCL_OK) { return TCL_ERROR; } /* * Create a new-style requirement for the exact version. */ objv2[0] = Tcl_NewStringObj(version, -1); Tcl_IncrRefCount(objv2[0]); Tcl_AppendStringsToObj(objv2[0], "-", version, NULL); argv3 = TclGetString(objv[3]); Tcl_IncrRefCount(objv[3]); TclNRAddCallback(interp, TclPkgRequireProcFinish, INT2PTR(1), objv2, objv[3], NULL); TclNRAddCallback(interp, TclNRPkgRequireProc, argv3, 1, objv2, NULL); return TCL_OK; } else { Tcl_Obj ** objv2; if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) { return TCL_ERROR; } objv2 = ckalloc((objc-3)*(sizeof(Tcl_Obj *))); for (i = 3; i < objc; i++) { objv2[i-3] = objv[i]; Tcl_IncrRefCount(objv[i]); } TclNRAddCallback(interp, TclPkgRequireProcFinish, INT2PTR(objc-3), objv2, NULL, NULL); TclNRAddCallback(interp, TclNRPkgRequireProc, argv2, INT2PTR(objc-3), objv2, NULL); return TCL_OK; } } break; case PKG_UNKNOWN: { int length; if (objc == 2) { if (iPtr->packageUnknown != NULL) { Tcl_SetObjResult(interp, |
︙ | ︙ |
Changes to tests/load.test.
︙ | ︙ | |||
208 209 210 211 212 213 214 | } \ -match glob -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}} \ -cleanup { interp delete child1 ; interp delete child2 } test load-10.1 {load from vfs} \ -constraints [list $dll $loaded testsimplefilesystem] \ -setup {set dir [pwd]; cd $testDir; testsimplefilesystem 1} \ | | | | 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 | } \ -match glob -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}} \ -cleanup { interp delete child1 ; interp delete child2 } test load-10.1 {load from vfs} \ -constraints [list $dll $loaded testsimplefilesystem] \ -setup {set dir [pwd]; cd $testDir; testsimplefilesystem 1} \ -body {list [catch {load simplefs:/pkgd$ext pkgd} msg]} \ -result 0 \ -cleanup {testsimplefilesystem 0; cd $dir; unset dir} test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \ [list $dll $loaded] { load [file join $testDir pkgooa$ext] list [pkgooa_stubsok] [lsort [info commands pkgooa_*]] } {1 pkgooa_stubsok} |
︙ | ︙ |
Changes to tests/package.test.
︙ | ︙ | |||
601 602 603 604 605 606 607 608 609 610 611 612 613 614 | } -body { foreach i {1.2b1 1.2 1.3 1.3a2} { package ifneeded t $i "set x $i; package provide t $i" } package require t return $x } -result {1.3} test package-4.1 {Tcl_PackageCmd procedure} -returnCodes error -body { package } -result {wrong # args: should be "package option ?arg ...?"} test package-4.2 {Tcl_PackageCmd procedure, "forget" option} { package forget {*}[package names] package names | > > > > > > > > > > > > | 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 | } -body { foreach i {1.2b1 1.2 1.3 1.3a2} { package ifneeded t $i "set x $i; package provide t $i" } package require t return $x } -result {1.3} test package-3.53 {Tcl_PkgRequire procedure, coroutine support} -setup { package forget t } -body { coroutine coro1 apply {{} { package ifneeded t 2.1 { yield package provide t 2.1 } package require t 2.1 }} list [catch {coro1} msg] $msg } -match glob -result {0 2.1} test package-4.1 {Tcl_PackageCmd procedure} -returnCodes error -body { package } -result {wrong # args: should be "package option ?arg ...?"} test package-4.2 {Tcl_PackageCmd procedure, "forget" option} { package forget {*}[package names] package names |
︙ | ︙ |
Changes to tests/unload.test.
︙ | ︙ | |||
74 75 76 77 78 79 80 | # Tests for loading/unloading in trusted (non-safe) interpreters... test unload-2.1 {basic loading of non-unloadable package, with guess for package name} [list $dll $loaded] { load [file join $testDir pkga$ext] list [pkga_eq abc def] [lsort [info commands pkga_*]] } {0 {pkga_eq pkga_quote}} test unload-2.2 {basic loading of unloadable package, with guess for package name} [list $dll $loaded] { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ | | | | 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 | # Tests for loading/unloading in trusted (non-safe) interpreters... test unload-2.1 {basic loading of non-unloadable package, with guess for package name} [list $dll $loaded] { load [file join $testDir pkga$ext] list [pkga_eq abc def] [lsort [info commands pkga_*]] } {0 {pkga_eq pkga_quote}} test unload-2.2 {basic loading of unloadable package, with guess for package name} [list $dll $loaded] { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ [load [file join $testDir pkgua$ext]; list] \ [pkgua_eq abc def] [lsort [info commands pkgua_*]] \ $pkgua_loaded $pkgua_detached $pkgua_unloaded } {{} {} {} {} 0 {pkgua_eq pkgua_quote} . {} {}} test unload-2.3 {basic unloading of non-unloadable package, with guess for package name} [list $dll $loaded] { list [catch {unload [file join $testDir pkga$ext]} msg] \ [string map [list [file join $testDir pkga$ext] file] $msg] } {1 {file "file" cannot be unloaded under a trusted interpreter}} test unload-2.4 {basic unloading of unloadable package, with guess for package name} [list $dll $loaded] { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ [unload [file join $testDir pkgua$ext]] \ [info commands pkgua_*] \ $pkgua_loaded $pkgua_detached $pkgua_unloaded } {. {} {} {} {} . . .} test unload-2.5 {reloading of unloaded package, with guess for package name} [list $dll $loaded] { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ [load [file join $testDir pkgua$ext]; list] \ [pkgua_eq abc def] [lsort [info commands pkgua_*]] \ $pkgua_loaded $pkgua_detached $pkgua_unloaded } {. . . {} 0 {pkgua_eq pkgua_quote} .. . .} test unload-2.6 {basic unloading of re-loaded package, with guess for package name} [list $dll $loaded] { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ [unload [file join $testDir pkgua$ext]] \ [info commands pkgua_*] \ |
︙ | ︙ | |||
167 168 169 170 171 172 173 | set pkgua_detached {} set pkgua_unloaded {} } ## Load package in main trusted interpreter... test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for package name} \ [list $dll $loaded] { list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \ | | | 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 | set pkgua_detached {} set pkgua_unloaded {} } ## Load package in main trusted interpreter... test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for package name} \ [list $dll $loaded] { list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \ [load [file join $testDir pkgua$ext]; list] \ [pkgua_eq abc def] [lsort [info commands pkgua_*]] \ [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] } {{.. .. ..} {} 0 {pkgua_eq pkgua_quote} {... .. ..}} ## Load package in child-safe interpreter... test unload-4.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} \ [list $dll $loaded] { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ |
︙ | ︙ |