From e3c04845583003a0742f88e1723a6bb318e64b83 Mon Sep 17 00:00:00 2001 From: jingham Date: Tue, 10 Nov 1998 06:49:19 +0000 Subject: Fixed a bug in the resource command when the file was opened twice. Fixed a bug in the testWriteTextResource command - it wrote one too many bytes. Factored out the common code from the .pch files FspLocationFromPath - make path a CONST FossilOrigin-Name: 784962bdc874b00d3e1e5b2c6c732347a11b617f --- mac/MW_TclHeader.pch | 81 ++-------------------------------------------------- mac/tclMac.h | 4 +-- mac/tclMacAppInit.c | 9 +++++- mac/tclMacResource.c | 74 ++++++++++++++++++++++++++++++----------------- mac/tclMacTest.c | 6 ++-- mac/tclMacUtil.c | 4 +-- 6 files changed, 65 insertions(+), 113 deletions(-) diff --git a/mac/MW_TclHeader.pch b/mac/MW_TclHeader.pch index 012182b..b6623ac 100644 --- a/mac/MW_TclHeader.pch +++ b/mac/MW_TclHeader.pch @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: MW_TclHeader.pch,v 1.3 1998/09/14 18:40:03 stanton Exp $ + * RCS: @(#) $Id: MW_TclHeader.pch,v 1.4 1998/11/10 06:49:19 jingham Exp $ */ /* @@ -30,73 +30,7 @@ #pragma precompile_target "MW_TclHeader68K" #endif -/* - * Macintosh Tcl must be compiled with certain compiler options to - * ensure that it will work correctly. The following pragmas are - * used to ensure that those options are set correctly. An error - * will occur at compile time if they are not set correctly. - */ - -#if !__option(enumsalwaysint) -#error Tcl requires the Metrowerks setting "Enums always ints". -#endif - -#if !defined(__POWERPC__) -#if !__option(far_data) -#error Tcl requires the Metrowerks setting "Far data". -#endif -#endif - -#if !defined(__POWERPC__) -#if !__option(fourbyteints) -#error Tcl requires the Metrowerks setting "4 byte ints". -#endif -#endif - -#if !defined(__POWERPC__) -#if !__option(IEEEdoubles) -#error Tcl requires the Metrowerks setting "8 byte doubles". -#endif -#endif - -/* - * The define is used most everywhere to tell Tcl (or any Tcl - * extensions) that we are compiling for the Macintosh platform. - */ - -#define MAC_TCL - -/* - * The following defines control the behavior of the Macintosh - * Universial Headers. - */ - -#define SystemSevenOrLater 1 -#define STRICT_CONTROLS 1 -#define STRICT_WINDOWS 1 - -/* - * Define the following symbol if you want - * comprehensive debugging turned on. - */ - -/* #define TCL_DEBUG */ - -#ifdef TCL_DEBUG -# define TCL_MEM_DEBUG -# define TCL_TEST -#endif - - -/* - * For a while, we will continue to use the old routine names, so that - * people with older versions of CodeWarrior will still be able to compile - * the source (albeit they will have to update the project files themselves). - * - * At some point, we will convert over to the new routine names. - */ - -#define OLDROUTINENAMES 1 +#include "tclMacCommonPch.h" /* * Place any includes below that will are needed by the majority of the @@ -109,16 +43,5 @@ #include "tclMac.h" #include "tclInt.h" -/* - * These three symbols are needed by Itcl, so we must export them - * here. They are all from tclCompile.h, but there is no need to - * export that whole file... - */ - -EXTERN void TclPrintSource _ANSI_ARGS_((FILE *outFile, - char *string, int maxChars)); -extern int tclTraceExec; -extern int tclTraceCompile; - #pragma export reset diff --git a/mac/tclMac.h b/mac/tclMac.h index c25a8ed..593232b 100644 --- a/mac/tclMac.h +++ b/mac/tclMac.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMac.h,v 1.2 1998/09/14 18:40:04 stanton Exp $ + * RCS: @(#) $Id: tclMac.h,v 1.3 1998/11/10 06:49:22 jingham Exp $ */ #ifndef _TCLMAC @@ -79,7 +79,7 @@ EXTERN pascal void FSpCreateResFileCompat(const FSSpec *spec, * Mac calls. These routines is from tclMacUtils.h. */ -EXTERN int FSpLocationFromPath _ANSI_ARGS_((int length, char *path, +EXTERN int FSpLocationFromPath _ANSI_ARGS_((int length, CONST char *path, FSSpecPtr theSpec)); EXTERN OSErr FSpPathFromLocation _ANSI_ARGS_((FSSpecPtr theSpec, int *length, Handle *fullPath)); diff --git a/mac/tclMacAppInit.c b/mac/tclMacAppInit.c index 9e66a20..693470c 100644 --- a/mac/tclMacAppInit.c +++ b/mac/tclMacAppInit.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMacAppInit.c,v 1.2 1998/09/14 18:40:04 stanton Exp $ + * RCS: @(#) $Id: tclMacAppInit.c,v 1.3 1998/11/10 06:49:25 jingham Exp $ */ #include "tcl.h" @@ -26,6 +26,8 @@ short InstallConsole _ANSI_ARGS_((short fd)); #endif #ifdef TCL_TEST +EXTERN int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp)); #endif /* TCL_TEST */ @@ -108,6 +110,11 @@ Tcl_AppInit( if (TclObjTest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } + if (Procbodytest_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init, + Procbodytest_SafeInit); #endif /* TCL_TEST */ /* diff --git a/mac/tclMacResource.c b/mac/tclMacResource.c index 81fe0bf..77879b4 100644 --- a/mac/tclMacResource.c +++ b/mac/tclMacResource.c @@ -11,7 +11,7 @@ * 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.3 1998/09/14 18:40:06 stanton Exp $ + * RCS: @(#) $Id: tclMacResource.c,v 1.4 1998/11/10 06:49:44 jingham Exp $ */ #include @@ -1823,7 +1823,7 @@ GetRsrcRefFromObj( * managed by the procedures in this file. If the resource file * is already registered with the table, then no new token is made. * - * The bahavior is controlled by the value of tokenPtr, and of the + * The behavior is controlled by the value of tokenPtr, and of the * flags variable. For tokenPtr, the possibilities are: * - NULL: The new token is auto-generated, but not returned. * - The string value of tokenPtr is the empty string: Then @@ -1845,7 +1845,7 @@ GetRsrcRefFromObj( * Standard Tcl Result * * Side effects: - * An entry is added to the resource name table. + * An entry may be added to the resource name table. * *---------------------------------------------------------------------- */ @@ -1871,12 +1871,14 @@ TclMacRegisterResourceFork( /* * If we were asked to, check that this file has not been opened - * already. + * already with a different permission. It it has, then return an error. */ + new = 1; + if (flags & TCL_RESOURCE_CHECK_IF_OPEN) { Tcl_HashSearch search; - short oldFileRef; + short oldFileRef, filePermissionFlag; FCBPBRec newFileRec, oldFileRec; OSErr err; @@ -1890,15 +1892,17 @@ TclMacRegisterResourceFork( newFileRec.ioVRefNum = 0; newFileRec.ioRefNum = fileRef; err = PBGetFCBInfo(&newFileRec, false); + filePermissionFlag = ( newFileRec.ioFCBFlags >> 12 ) & 0x1; resourceHashPtr = Tcl_FirstHashEntry(&resourceTable, &search); while (resourceHashPtr != NULL) { - oldFileRef = (short) Tcl_GetHashKey(&resourceTable, resourceHashPtr); - - + if (oldFileRef == fileRef) { + new = 0; + break; + } oldFileRec.ioVRefNum = 0; oldFileRec.ioRefNum = oldFileRef; err = PBGetFCBInfo(&oldFileRec, false); @@ -1909,34 +1913,52 @@ TclMacRegisterResourceFork( * to fix it here, OR because it is the ROM MAP, which has a * fileRef, but can't be gotten to by PBGetFCBInfo. */ - - if ((oldFileRef == fileRef) || - ((err == noErr) + + if ((err == noErr) && (newFileRec.ioFCBVRefNum == oldFileRec.ioFCBVRefNum) - && (newFileRec.ioFCBFlNm == oldFileRec.ioFCBFlNm))) { - - resourceId = (char *) Tcl_GetHashValue(resourceHashPtr); - Tcl_SetStringObj(tokenPtr, resourceId, -1); - return TCL_OK; + && (newFileRec.ioFCBFlNm == oldFileRec.ioFCBFlNm)) { + /* In MacOS 8.1 it seems like we get different file refs even though + * we pass the same file & permissions. This is not what Inside Mac + * says should happen, but it does, so if it does, then close the new res + * file and return the original one... + */ + + if (filePermissionFlag == ((oldFileRec.ioFCBFlags >> 12) & 0x1)) { + CloseResFile(fileRef); + new = 0; + break; + } else { + if (tokenPtr != NULL) { + Tcl_SetStringObj(tokenPtr, + "Resource already open with different permissions.", -1); + } + return TCL_ERROR; + } } - resourceHashPtr = Tcl_NextHashEntry(&search); } - - } + - resourceHashPtr = Tcl_CreateHashEntry(&resourceTable, + /* + * If the file has already been opened with these same permissions, then it + * will be in our list and we will have set new to 0 above. + * So we will just return the token (if tokenPtr is non-null) + */ + + if (new) { + resourceHashPtr = Tcl_CreateHashEntry(&resourceTable, (char *) fileRef, &new); + } + if (!new) { - if (tokenPtr != NULL) { + if (tokenPtr != NULL) { resourceId = (char *) Tcl_GetHashValue(resourceHashPtr); - Tcl_SetStringObj(tokenPtr, resourceId, -1); + Tcl_SetStringObj(tokenPtr, resourceId, -1); } - return TCL_OK; - } - - + return TCL_OK; + } + /* * If we were passed in a result pointer which is not an empty * string, attempt to use that as the key. If the key already diff --git a/mac/tclMacTest.c b/mac/tclMacTest.c index 3824031..3c982c5 100644 --- a/mac/tclMacTest.c +++ b/mac/tclMacTest.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMacTest.c,v 1.2 1998/09/14 18:40:07 stanton Exp $ + * RCS: @(#) $Id: tclMacTest.c,v 1.3 1998/11/10 06:49:51 jingham Exp $ */ #define TCL_TEST @@ -188,11 +188,11 @@ WriteTextResource( strcpy((char *) resourceName, rsrcName); c2pstr((char *) resourceName); - dataHandle = NewHandle(strlen(data) + 1); + dataHandle = NewHandle(strlen(data)); HLock(dataHandle); strcpy(*dataHandle, data); HUnlock(dataHandle); - + /* * Add the resource to the file and close it. */ diff --git a/mac/tclMacUtil.c b/mac/tclMacUtil.c index 37e1d90..fd981c9 100644 --- a/mac/tclMacUtil.c +++ b/mac/tclMacUtil.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMacUtil.c,v 1.2 1998/09/14 18:40:07 stanton Exp $ + * RCS: @(#) $Id: tclMacUtil.c,v 1.3 1998/11/10 06:49:55 jingham Exp $ */ #include "tcl.h" @@ -201,7 +201,7 @@ FSpFindFolder( int FSpLocationFromPath( int length, /* Length of path. */ - char *path, /* The path to convert. */ + CONST char *path, /* The path to convert. */ FSSpecPtr fileSpecPtr) /* On return the spec for the path. */ { Str255 fileName; -- cgit v0.12