Itcl - the [incr Tcl] extension

Check-in [6fd366338e]
Login

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

Overview
Comment:merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | itcl-4-0-3-rc
Files: files | file ages | folders
SHA1: 6fd366338e80dd94b9197ec82c551d3cc1209e5e
User & Date: dgp 2015-01-21 13:47:36
Context
2015-02-12
21:35
Mismatch in Itcl_PreserveData / Itcl_ReleaseData balance. Closed-Leaf check-in: 0206ee9208 user: dgp tags: itcl-4-0-3, itcl-4-0-3-rc
2015-01-21
13:47
merge trunk check-in: 6fd366338e user: dgp tags: itcl-4-0-3-rc
13:46
Fix for [a956a5d397]. Make [info heritage] and [info inherit] scopes match those of Itcl 3. check-in: 42b7e87161 user: dgp tags: trunk
2015-01-13
18:31
merge trunk check-in: fb6abe64fb user: dgp tags: itcl-4-0-3-rc
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/itclInfo.c.

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
    upNsPtr = Itcl_GetUplevelNamespace(interp, 1);
    if (callContextPtr != NULL) {
        imPtr = callContextPtr->imPtr;
        contextIclsPtr = imPtr->iclsPtr;
    } else {
	contextIclsPtr = GetClassFromClassName(interp, upNsPtr->fullName, NULL);
    }







    if (imPtr->iclsPtr->infoPtr->useOldResolvers) {
        if (contextIoPtr != NULL) {






















            if (upNsPtr != contextIclsPtr->nsPtr) {
		Tcl_HashEntry *hPtr;
		hPtr = Tcl_FindHashEntry(
		        &imPtr->iclsPtr->infoPtr->namespaceClasses,
			(char *)upNsPtr);
		if (hPtr != NULL) {




		    contextIclsPtr = Tcl_GetHashValue(hPtr);
		} else {
                    contextIclsPtr = contextIoPtr->iclsPtr;
	        }
            }
        }
    } else {
        if (strcmp(Tcl_GetString(imPtr->namePtr), "info") == 0) {
            if (contextIoPtr != NULL) {
	        contextIclsPtr = contextIoPtr->iclsPtr;
            }
        }







>
>
>
>
>
>
>


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
<


|
>
>
>
>

<
<
|
|







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
    upNsPtr = Itcl_GetUplevelNamespace(interp, 1);
    if (callContextPtr != NULL) {
        imPtr = callContextPtr->imPtr;
        contextIclsPtr = imPtr->iclsPtr;
    } else {
	contextIclsPtr = GetClassFromClassName(interp, upNsPtr->fullName, NULL);
    }

    /*
     * Note the assumption here that imPtr != NULL.
     * This implies an assumption above that callContextPtr != NULL, and
     * that the call to GetClassFromClassName() is never taken.
     */

    if (imPtr->iclsPtr->infoPtr->useOldResolvers) {
        if (contextIoPtr != NULL) {

	    /*
	     * For consistency with Itcl 3, we must exhibit different
	     * context selection depending on whether the invocation
	     * was [$obj info inherit] or [info inherit] in a class context.
	     * Itcl 4 implements the routing of the direct [info inherit]
	     * by prepending a [my].  To distinguish the cases we look for
	     * that leading [my].  It is conceivable this would be confused
	     * with the literal command [my info inherit], but as it happens,
	     * such a command cannot be resolved in an Itcl method body, so
	     * it's at least very unlikely if not impossible for that confusion
	     * to arise.  See also Itcl_BiInfoHeritageCmd().
	     */

	    Tcl_Obj * const * objv = Itcl_GetCallFrameObjv(interp);
	    int isDirectCall = (strcmp(Tcl_GetString(objv[0]), "my") == 0);

	    /*
	     * The default behavior is to query the heritage of the
	     * invoking object....
	     */
            contextIclsPtr = contextIoPtr->iclsPtr;
	    if (isDirectCall && upNsPtr != contextIclsPtr->nsPtr) {
		Tcl_HashEntry *hPtr = Tcl_FindHashEntry(

		        &imPtr->iclsPtr->infoPtr->namespaceClasses,
			(char *)upNsPtr);
		if (hPtr) {
		    /*
		     * ...but when invoked as [info inherit] and in
		     * a class namespace, we query that class instead.
		     */
		    contextIclsPtr = Tcl_GetHashValue(hPtr);


		}
	    }
        }
    } else {
        if (strcmp(Tcl_GetString(imPtr->namePtr), "info") == 0) {
            if (contextIoPtr != NULL) {
	        contextIclsPtr = contextIoPtr->iclsPtr;
            }
        }
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
        imPtr = callContextPtr->imPtr;
        contextIclsPtr = imPtr->iclsPtr;
    } else {
	contextIclsPtr = GetClassFromClassName(interp, upNsPtr->fullName, NULL);
    }
    if (contextIclsPtr->infoPtr->useOldResolvers) {
        if (contextIoPtr != NULL) {





            if (upNsPtr != contextIclsPtr->nsPtr) {
	        Tcl_HashEntry *hPtr;
	        hPtr = Tcl_FindHashEntry(
		        &imPtr->iclsPtr->infoPtr->namespaceClasses,
			(char *)upNsPtr);
	        if (hPtr != NULL) {
	            contextIclsPtr = Tcl_GetHashValue(hPtr);
	        } else {
                    contextIclsPtr = contextIoPtr->iclsPtr;
	        }
            }
        }
    } else {
        if (strcmp(Tcl_GetString(imPtr->namePtr), "info") == 0) {
            if (contextIoPtr != NULL) {
	        contextIclsPtr = contextIoPtr->iclsPtr;
            }
        }







>
>
>
>
>
|
|
<


|
|
<
<
|
|







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
        imPtr = callContextPtr->imPtr;
        contextIclsPtr = imPtr->iclsPtr;
    } else {
	contextIclsPtr = GetClassFromClassName(interp, upNsPtr->fullName, NULL);
    }
    if (contextIclsPtr->infoPtr->useOldResolvers) {
        if (contextIoPtr != NULL) {
	    /* See Itcl_InfoInheritCmd() comments. */
	    Tcl_Obj * const * objv = Itcl_GetCallFrameObjv(interp);
	    int isDirectCall = (strcmp(Tcl_GetString(objv[0]), "my") == 0);

            contextIclsPtr = contextIoPtr->iclsPtr;
	    if (isDirectCall && upNsPtr != contextIclsPtr->nsPtr) {
		Tcl_HashEntry *hPtr = Tcl_FindHashEntry(

		        &imPtr->iclsPtr->infoPtr->namespaceClasses,
			(char *)upNsPtr);
		if (hPtr) {
		    contextIclsPtr = Tcl_GetHashValue(hPtr);


		}
	    }
        }
    } else {
        if (strcmp(Tcl_GetString(imPtr->namePtr), "info") == 0) {
            if (contextIoPtr != NULL) {
	        contextIclsPtr = contextIoPtr->iclsPtr;
            }
        }

Changes to tests/info.test.

339
340
341
342
343
344
345




346
347
348
349
350
351
352
353




354
355
356
357
358
359
360
test info-4.2a {query inheritance info (wrong # args)} {
    list [catch {ti info inherit x} result] $result
} {1 {wrong # args: should be "info inherit"}}

test info-4.2b {query inheritance info} {
    list [ti info inherit] [ti do info inherit]
} {::test_info_base {}}





test info-4.3a {query heritage info (wrong # args)} {
    list [catch {ti info heritage x} result] $result
} {1 {wrong # args: should be "info heritage"}}

test info-4.3b {query heritage info} {
    list [ti info heritage] [ti do info heritage]
} {{::test_info ::test_info_base} ::test_info_base}





test info-4.4a {query argument list (wrong # args)} {
    list [catch {ti info args} result] $result \
         [catch {ti info args x y} result] $result
} {1 {wrong # args: should be "info args function"} 1 {wrong # args: should be "info args function"}}

test info-4.4b {query argument list} {







>
>
>
>








>
>
>
>







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
test info-4.2a {query inheritance info (wrong # args)} {
    list [catch {ti info inherit x} result] $result
} {1 {wrong # args: should be "info inherit"}}

test info-4.2b {query inheritance info} {
    list [ti info inherit] [ti do info inherit]
} {::test_info_base {}}

test info-4.2c {query inheritance info} {
    ti do ti info inherit
} {::test_info_base}

test info-4.3a {query heritage info (wrong # args)} {
    list [catch {ti info heritage x} result] $result
} {1 {wrong # args: should be "info heritage"}}

test info-4.3b {query heritage info} {
    list [ti info heritage] [ti do info heritage]
} {{::test_info ::test_info_base} ::test_info_base}

test info-4.3c {query heritage info} {
    ti do ti info heritage
} {::test_info ::test_info_base}

test info-4.4a {query argument list (wrong # args)} {
    list [catch {ti info args} result] $result \
         [catch {ti info args x y} result] $result
} {1 {wrong # args: should be "info args function"} 1 {wrong # args: should be "info args function"}}

test info-4.4b {query argument list} {