Change the signature of PkgRequireCore in preparation to provide

TclNRPackageObjCmd.

1 files changed, 21 insertions, 22 deletions

diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 288d5dc..2b842b4 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -85,7 +85,7 @@ static void		AddRequirementsToResult(Tcl_Interp *interp, int reqc,
 static void		AddRequirementsToDString(Tcl_DString *dstring,
 			    int reqc, Tcl_Obj *const reqv[]);
 static Package *	FindPackage(Tcl_Interp *interp, const char *name);
-static const char *	PkgRequireCore(Tcl_Interp *interp, const char *name,
+static int		PkgRequireCore(Tcl_Interp *interp, const char *name,
 			    int reqc, Tcl_Obj *const reqv[],
 			    void *clientDataPtr);
 
@@ -365,7 +365,10 @@ Tcl_PkgRequireEx(
      */
 
     if (version == NULL) {
-	result = PkgRequireCore(interp, name, 0, NULL, clientDataPtr);
+	if (Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr) == TCL_OK) {
+	    result = Tcl_GetStringResult(interp);
+	    Tcl_ResetResult(interp);
+	}
     } else {
 	if (exact && TCL_OK
 		!= CheckVersionAndConvert(interp, version, NULL, NULL)) {
@@ -376,10 +379,12 @@ Tcl_PkgRequireEx(
 	    Tcl_AppendStringsToObj(ov, "-", version, NULL);
 	}
 	Tcl_IncrRefCount(ov);
-	result = PkgRequireCore(interp, name, 1, &ov, clientDataPtr);
+	if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) {
+	    result = Tcl_GetStringResult(interp);
+	    Tcl_ResetResult(interp);
+	}
 	TclDecrRefCount(ov);
     }
-
     return result;
 }
 
@@ -394,17 +399,14 @@ Tcl_PkgRequireProc(
 				 * available. */
     void *clientDataPtr)
 {
-    const char *result =
-	    PkgRequireCore(interp, name, reqc, reqv, clientDataPtr);
-
-    if (result == NULL) {
-	return TCL_ERROR;
+    int code = CheckAllRequirements(interp, reqc, reqv);
+    if (code != TCL_OK) {
+	return code;
     }
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
-    return TCL_OK;
+    return PkgRequireCore(interp, name, reqc, reqv, clientDataPtr);
 }
 
-static const char *
+int
 PkgRequireCore(
     Tcl_Interp *interp,		/* Interpreter in which package is now
 				 * available. */
@@ -424,10 +426,6 @@ PkgRequireCore(
     char *script, *pkgVersionI;
     Tcl_DString command;
 
-    if (TCL_OK != CheckAllRequirements(interp, reqc, reqv)) {
-	return NULL;
-    }
-
     /*
      * 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
@@ -453,7 +451,7 @@ PkgRequireCore(
 		    name, (char *) pkgPtr->clientData, name));
 	    AddRequirementsToResult(interp, reqc, reqv);
 	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
-	    return NULL;
+	    return TCL_ERROR;
 	}
 
 	/*
@@ -678,7 +676,7 @@ PkgRequireCore(
 		    pkgPtr->version = NULL;
 		}
 		pkgPtr->clientData = NULL;
-		return NULL;
+		return code;
 	    }
 
 	    break;
@@ -714,7 +712,7 @@ PkgRequireCore(
 	    if (code == TCL_ERROR) {
 		Tcl_AddErrorInfo(interp,
 			"\n    (\"package unknown\" script)");
-		return NULL;
+		return code;
 	    }
 	    Tcl_ResetResult(interp);
 	}
@@ -725,7 +723,7 @@ PkgRequireCore(
 		"can't find package %s", name));
 	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL);
 	AddRequirementsToResult(interp, reqc, reqv);
-	return NULL;
+	return TCL_ERROR;
     }
 
     /*
@@ -746,7 +744,7 @@ PkgRequireCore(
 	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
 		    NULL);
 	    AddRequirementsToResult(interp, reqc, reqv);
-	    return NULL;
+	    return TCL_ERROR;
 	}
     }
 
@@ -755,7 +753,8 @@ PkgRequireCore(
 
 	*ptr = pkgPtr->clientData;
     }
-    return pkgPtr->version;
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(pkgPtr->version, -1));
+    return TCL_OK;
 }
 
 /*