summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog16
-rw-r--r--generic/tclInt.decls4
-rw-r--r--generic/tclIntPlatDecls.h6
-rw-r--r--mac/tclMacChan.c4
-rw-r--r--mac/tclMacFCmd.c4
-rw-r--r--mac/tclMacFile.c36
-rw-r--r--mac/tclMacInit.c14
-rw-r--r--mac/tclMacLoad.c24
-rw-r--r--mac/tclMacResource.c21
-rw-r--r--mac/tclMacSock.c6
-rw-r--r--tests/event.test6
-rw-r--r--tests/main.test28
12 files changed, 98 insertions, 71 deletions
diff --git a/ChangeLog b/ChangeLog
index ab42573..52e7b4d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,19 @@
+2001-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.
+
2002-01-25 Mo DeJong <mdejong@users.sourceforge.net>
Make -eofchar and -translation options read only for
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 008b1d3..67bd6f7 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -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: tclInt.decls,v 1.44 2002/01/25 22:01:31 dgp Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.45 2002/01/27 11:09:30 das Exp $
library tcl
@@ -780,7 +780,7 @@ declare 24 mac {
char * TclpGetTZName(int isdst)
}
declare 25 mac {
- int TclMacChmod(char *path, int mode)
+ int TclMacChmod(CONST char *path, int mode)
}
############################
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index 3ddaf22..907a648 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -9,7 +9,7 @@
* Copyright (c) 1998-1999 by Scriptics Corporation.
* All rights reserved.
*
- * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.15 2002/01/25 20:40:55 dgp Exp $
+ * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.16 2002/01/27 11:09:34 das Exp $
*/
#ifndef _TCLINTPLATDECLS
@@ -197,7 +197,7 @@ EXTERN FILE * TclMacFOpenHack _ANSI_ARGS_((CONST char * path,
/* 24 */
EXTERN char * TclpGetTZName _ANSI_ARGS_((int isdst));
/* 25 */
-EXTERN int TclMacChmod _ANSI_ARGS_((char * path, int mode));
+EXTERN int TclMacChmod _ANSI_ARGS_((CONST char * path, int mode));
#endif /* MAC_TCL */
typedef struct TclIntPlatStubs {
@@ -272,7 +272,7 @@ typedef struct TclIntPlatStubs {
int (*tclMacCreateEnv) _ANSI_ARGS_((void)); /* 22 */
FILE * (*tclMacFOpenHack) _ANSI_ARGS_((CONST char * path, CONST char * mode)); /* 23 */
char * (*tclpGetTZName) _ANSI_ARGS_((int isdst)); /* 24 */
- int (*tclMacChmod) _ANSI_ARGS_((char * path, int mode)); /* 25 */
+ int (*tclMacChmod) _ANSI_ARGS_((CONST char * path, int mode)); /* 25 */
#endif /* MAC_TCL */
} TclIntPlatStubs;
diff --git a/mac/tclMacChan.c b/mac/tclMacChan.c
index da74176..90be8a4 100644
--- a/mac/tclMacChan.c
+++ b/mac/tclMacChan.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: tclMacChan.c,v 1.11 2002/01/18 03:22:36 das Exp $
+ * RCS: @(#) $Id: tclMacChan.c,v 1.12 2002/01/27 11:09:38 das Exp $
*/
#include "tclInt.h"
@@ -1282,7 +1282,7 @@ GetOpenMode(
* "RDONLY CREAT". */
{
int mode, modeArgc, c, i, gotRW;
- char **modeArgv, *flag;
+ CONST char **modeArgv, *flag;
/*
* Check for the simpler fopen-like access modes (e.g. "r"). They
diff --git a/mac/tclMacFCmd.c b/mac/tclMacFCmd.c
index 528f5fc..1a75ce7 100644
--- a/mac/tclMacFCmd.c
+++ b/mac/tclMacFCmd.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: tclMacFCmd.c,v 1.15 2002/01/26 01:10:08 dgp Exp $
+ * RCS: @(#) $Id: tclMacFCmd.c,v 1.16 2002/01/27 11:09:44 das Exp $
*/
#include "tclInt.h"
@@ -1024,7 +1024,7 @@ GetFileSpecs(
Boolean *pathIsDirectoryPtr)/* Set to true if path is itself a directory,
* otherwise false. */
{
- char *dirName;
+ CONST char *dirName;
OSErr err;
int argc;
CONST char **argv;
diff --git a/mac/tclMacFile.c b/mac/tclMacFile.c
index 921ada5..522372a 100644
--- a/mac/tclMacFile.c
+++ b/mac/tclMacFile.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: tclMacFile.c,v 1.15 2002/01/25 20:40:56 dgp Exp $
+ * RCS: @(#) $Id: tclMacFile.c,v 1.16 2002/01/27 11:09:49 das Exp $
*/
/*
@@ -610,25 +610,23 @@ TclpReadlink(
Handle theString = NULL;
int pathSize;
Tcl_DString ds;
- char *native;
- native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
+ Tcl_UtfToExternalDString(NULL, path, -1, &ds);
/*
* Remove ending colons if they exist.
*/
- while ((strlen(native) != 0) && (path[strlen(native) - 1] == ':')) {
- native[strlen(native) - 1] = NULL;
+ while ((Tcl_DStringLength(&ds) != 0) && (Tcl_DStringValue(&ds)[Tcl_DStringLength(&ds) - 1] == ':')) {
+ Tcl_DStringSetLength(&ds, Tcl_DStringLength(&ds) - 1);
}
- if (strchr(native, ':') == NULL) {
- strcpy(fileName + 1, native);
- native = NULL;
+ end = strrchr(Tcl_DStringValue(&ds), ':');
+ if (end == NULL ) {
+ strcpy(fileName + 1, Tcl_DStringValue(&ds));
} else {
- end = strrchr(native, ':') + 1;
- strcpy(fileName + 1, end);
- *end = NULL;
+ strcpy(fileName + 1, end + 1);
+ Tcl_DStringSetLength(&ds, end + 1 - Tcl_DStringValue(&ds));
}
fileName[0] = (char) strlen(fileName + 1);
@@ -637,8 +635,8 @@ TclpReadlink(
* we want to look at.
*/
- if (native != NULL) {
- err = FSpLocationFromPath(strlen(native), native, &fileSpec);
+ if (end != NULL) {
+ err = FSpLocationFromPath(Tcl_DStringLength(&ds), Tcl_DStringValue(&ds), &fileSpec);
if (err != noErr) {
Tcl_DStringFree(&ds);
errno = EINVAL;
@@ -904,7 +902,7 @@ TclMacFOpenHack(
int size;
FILE * f;
- err = FSpLocationFromPath(strlen(path), (char *) path, &fileSpec);
+ err = FSpLocationFromPath(strlen(path), path, &fileSpec);
if ((err != noErr) && (err != fnfErr)) {
return NULL;
}
@@ -1007,14 +1005,15 @@ TclMacOSErrorToPosixError(
int
TclMacChmod(
- char *path,
+ CONST char *path,
int mode)
{
HParamBlockRec hpb;
OSErr err;
-
- c2pstr(path);
- hpb.fileParam.ioNamePtr = (unsigned char *) path;
+ Str255 pathName;
+ strcpy((char *) pathName + 1, path);
+ pathName[0] = strlen(path);
+ hpb.fileParam.ioNamePtr = pathName;
hpb.fileParam.ioVRefNum = 0;
hpb.fileParam.ioDirID = 0;
@@ -1023,7 +1022,6 @@ TclMacChmod(
} else {
err = PBHSetFLockSync(&hpb);
}
- p2cstr((unsigned char *) path);
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
diff --git a/mac/tclMacInit.c b/mac/tclMacInit.c
index 451e377..8cfe2b5 100644
--- a/mac/tclMacInit.c
+++ b/mac/tclMacInit.c
@@ -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: tclMacInit.c,v 1.7 2002/01/25 20:40:56 dgp Exp $
+ * RCS: @(#) $Id: tclMacInit.c,v 1.8 2002/01/27 11:09:54 das Exp $
*/
#include <AppleEvents.h>
@@ -537,7 +537,7 @@ TclpSetVariables(interp)
int minor, major, objc;
Tcl_Obj **objv;
char versStr[2 * TCL_INTEGER_SPACE];
- char *str;
+ CONST char *str;
Tcl_Obj *pathPtr;
Tcl_DString ds;
@@ -781,9 +781,13 @@ Tcl_SourceRCFile(
fileName = Tcl_GetVar(interp, "tcl_rcRsrcName", TCL_GLOBAL_ONLY);
if (fileName != NULL) {
- c2pstr(fileName);
- h = GetNamedResource('TEXT', (StringPtr) fileName);
- p2cstr((StringPtr) fileName);
+ Str255 rezName;
+ Tcl_DString ds;
+ Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
+ strcpy((char *) rezName + 1, Tcl_DStringValue(&ds));
+ rezName[0] = (unsigned) Tcl_DStringLength(&ds);
+ h = GetNamedResource('TEXT', rezName);
+ Tcl_DStringFree(&ds);
if (h != NULL) {
if (Tcl_MacEvalResource(interp, fileName, 0, NULL) != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
diff --git a/mac/tclMacLoad.c b/mac/tclMacLoad.c
index 1082a23..e767651 100644
--- a/mac/tclMacLoad.c
+++ b/mac/tclMacLoad.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: tclMacLoad.c,v 1.11 2002/01/18 03:22:58 das Exp $
+ * RCS: @(#) $Id: tclMacLoad.c,v 1.12 2002/01/27 11:09:58 das Exp $
*/
#include <CodeFragments.h>
@@ -126,11 +126,11 @@ TclpLoadFile(
UInt32 offset = 0;
UInt32 length = kCFragGoesToEOF;
StringPtr fragName=NULL;
- Str255 errName;
+ Str255 errName, symbolName;
Tcl_DString ds;
- char *native;
+ CONST char *native;
- native = (char *) Tcl_FSGetNativePath(pathPtr);
+ native = Tcl_FSGetNativePath(pathPtr);
err = FSpLocationFromPath(strlen(native), native, &fileSpec);
if (err != noErr) {
@@ -145,7 +145,7 @@ TclpLoadFile(
* it to us.
*/
native = Tcl_UtfToExternalDString(NULL, sym1, -1, &ds);
- native[strlen(native) - 5] = 0;
+ Tcl_DStringSetLength(&ds, Tcl_DStringLength(&ds) - 5);
/*
* See if this fragment has a 'cfrg' resource. It will tell us where
@@ -215,9 +215,10 @@ TclpLoadFile(
*unloadProcPtr = &TclpUnloadFile;
- native = Tcl_UtfToExternalDString(NULL, sym1, -1, &ds);
- c2pstr(native);
- err = FindSymbol(connID, (StringPtr) native, (Ptr *) proc1Ptr, &symClass);
+ Tcl_UtfToExternalDString(NULL, sym1, -1, &ds);
+ strcpy((char *) symbolName + 1, Tcl_DStringValue(&ds));
+ symbolName[0] = (unsigned) Tcl_DStringLength(&ds);
+ err = FindSymbol(connID, symbolName, (Ptr *) proc1Ptr, &symClass);
Tcl_DStringFree(&ds);
if (err != fragNoErr || symClass == kDataCFragSymbol) {
Tcl_SetResult(interp,
@@ -226,9 +227,10 @@ TclpLoadFile(
return TCL_ERROR;
}
- native = Tcl_UtfToExternalDString(NULL, sym2, -1, &ds);
- c2pstr(native);
- err = FindSymbol(connID, (StringPtr) native, (Ptr *) proc2Ptr, &symClass);
+ Tcl_UtfToExternalDString(NULL, sym2, -1, &ds);
+ strcpy((char *) symbolName + 1, Tcl_DStringValue(&ds));
+ symbolName[0] = (unsigned) Tcl_DStringLength(&ds);
+ err = FindSymbol(connID, symbolName, (Ptr *) proc2Ptr, &symClass);
Tcl_DStringFree(&ds);
if (err != fragNoErr || symClass == kDataCFragSymbol) {
*proc2Ptr = NULL;
diff --git a/mac/tclMacResource.c b/mac/tclMacResource.c
index 4e29420..671aea1 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.11 2002/01/26 01:10:08 dgp Exp $
+ * RCS: @(#) $Id: tclMacResource.c,v 1.12 2002/01/27 11:10:03 das Exp $
*/
#include <Errors.h>
@@ -496,7 +496,7 @@ resourceRef? resourceType");
return TCL_OK;
case RESOURCE_OPEN: {
Tcl_DString ds, buffer;
- char *str, *native;
+ CONST char *str, *native;
int length;
if (!((objc == 3) || (objc == 4))) {
@@ -1293,9 +1293,12 @@ Tcl_MacEvalResource(
* Load the resource by name or ID
*/
if (resourceName != NULL) {
- strcpy((char *) rezName + 1, resourceName);
- rezName[0] = strlen(resourceName);
+ Tcl_DString ds;
+ Tcl_UtfToExternalDString(NULL, resourceName, -1, &ds);
+ strcpy((char *) rezName + 1, Tcl_DStringValue(&ds));
+ rezName[0] = (unsigned) Tcl_DStringLength(&ds);
sourceText = GetNamedResource('TEXT', rezName);
+ Tcl_DStringFree(&ds);
} else {
sourceText = GetResource('TEXT', (short) resourceNumber);
}
@@ -1462,15 +1465,17 @@ Tcl_MacFindResource(
resource = GetResource(resourceType, resourceNumber);
}
} else {
+ Str255 rezName;
Tcl_DString ds;
- char *native = Tcl_UtfToExternalDString(NULL, resourceName, -1, &ds);
- c2pstr(native);
+ Tcl_UtfToExternalDString(NULL, resourceName, -1, &ds);
+ strcpy((char *) rezName + 1, Tcl_DStringValue(&ds));
+ rezName[0] = (unsigned) Tcl_DStringLength(&ds);
if (limitSearch) {
resource = Get1NamedResource(resourceType,
- (StringPtr) native);
+ rezName);
} else {
resource = GetNamedResource(resourceType,
- (StringPtr) resourceName);
+ rezName);
}
Tcl_DStringFree(&ds);
}
diff --git a/mac/tclMacSock.c b/mac/tclMacSock.c
index 7112ee3..70380b1 100644
--- a/mac/tclMacSock.c
+++ b/mac/tclMacSock.c
@@ -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: tclMacSock.c,v 1.11 2002/01/23 20:46:01 dgp Exp $
+ * RCS: @(#) $Id: tclMacSock.c,v 1.12 2002/01/27 11:10:07 das Exp $
*/
#include "tclInt.h"
@@ -2449,7 +2449,7 @@ GetHostFromString(
}
dnrState.done = 0;
GetCurrentProcess(&(dnrState.psn));
- err = StrToAddr(name, &dnrState.hostInfo, resultUPP, (Ptr) &dnrState);
+ err = StrToAddr((char*)name, &dnrState.hostInfo, resultUPP, (Ptr) &dnrState);
if (err == cacheFault) {
while (!dnrState.done) {
WaitNextEvent(0, &dummy, 1, NULL);
@@ -2464,7 +2464,7 @@ GetHostFromString(
if (dnrState.hostInfo.rtnCode == cacheFault) {
dnrState.done = 0;
- err = StrToAddr(name, &dnrState.hostInfo, resultUPP, (Ptr) &dnrState);
+ err = StrToAddr((char*)name, &dnrState.hostInfo, resultUPP, (Ptr) &dnrState);
if (err == cacheFault) {
while (!dnrState.done) {
WaitNextEvent(0, &dummy, 1, NULL);
diff --git a/tests/event.test b/tests/event.test
index ce9e34d..2afd33e 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -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: event.test,v 1.14 2001/12/10 20:30:13 msofer Exp $
+# RCS: @(#) $Id: event.test,v 1.15 2002/01/27 11:09:23 das Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -276,7 +276,9 @@ test event-7.4 {tkerror is nothing special anymore to tcl} {
set errRes
} bg:err1
-test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} {
+testConstraint exec [llength [info commands exec]]
+
+test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} {exec} {
set script {
after 1000 error hello
after 2000 set a 0
diff --git a/tests/main.test b/tests/main.test
index 18d3ea3..d1d5196 100644
--- a/tests/main.test
+++ b/tests/main.test
@@ -1,6 +1,6 @@
# This file contains a collection of tests for generic/tclMain.c.
#
-# RCS: @(#) $Id: main.test,v 1.3 2002/01/09 19:03:34 dgp Exp $
+# RCS: @(#) $Id: main.test,v 1.4 2002/01/27 11:09:26 das Exp $
if {[catch {package require tcltest 2}]} {
puts stderr "Skipping tests in [info script]. tcltest v2 needed."
@@ -46,7 +46,7 @@ namespace eval ::tcl::main::test {
Tcl_Main: startup script - normal
} -constraints [list exec] -setup {
makeFile {puts [list $argv0 $argv $tcl_interactive]} script
- set f [open "|[interpreter] script" r]
+ catch {set f [open "|[interpreter] script" r]}
} -body {
read $f
} -cleanup {
@@ -58,7 +58,7 @@ namespace eval ::tcl::main::test {
Tcl_Main: startup script - can't begin with '-'
} -constraints [list exec] -setup {
makeFile {puts [list $argv0 $argv $tcl_interactive]} -script
- set f [open "|[interpreter] -script" w+]
+ catch {set f [open "|[interpreter] -script" w+]}
} -body {
puts $f {puts [list $argv0 $argv $tcl_interactive]; exit}
flush $f
@@ -73,7 +73,7 @@ namespace eval ::tcl::main::test {
Note the shortcoming explained in Tcl Patch 491789
} -constraints [list exec] -setup {
makeFile {puts [list $argv0 $argv $tcl_interactive]} script
- set f [open "|[interpreter] script \u00c0" r]
+ catch {set f [open "|[interpreter] script \u00c0" r]}
} -body {
read $f
} -cleanup {
@@ -87,7 +87,7 @@ namespace eval ::tcl::main::test {
Note the shortcoming explained in Tcl Patch 491789
} -constraints [list exec] -setup {
makeFile {puts [list $argv0 $argv $tcl_interactive]} script
- set f [open "|[interpreter] script \u20ac" r]
+ catch {set f [open "|[interpreter] script \u20ac" r]}
} -body {
read $f
} -cleanup {
@@ -101,7 +101,7 @@ namespace eval ::tcl::main::test {
Note the shortcoming explained in Tcl Patch 491789
} -constraints [list exec] -setup {
makeFile {puts [list $argv0 $argv $tcl_interactive]} \u00c0
- set f [open "|[interpreter] \u00c0" r]
+ catch {set f [open "|[interpreter] \u00c0" r]}
} -body {
read $f
} -cleanup {
@@ -115,7 +115,7 @@ namespace eval ::tcl::main::test {
Note the shortcoming explained in Tcl Patch 491789
} -constraints [list exec] -setup {
makeFile {puts [list $argv0 $argv $tcl_interactive]} \u20ac
- set f [open "|[interpreter] \u20ac" r]
+ catch {set f [open "|[interpreter] \u20ac" r]}
} -body {
read $f
} -cleanup {
@@ -462,7 +462,7 @@ namespace eval ::tcl::main::test {
test Tcl_Main-5.2 {
Tcl_Main able to handle non-blocking stdin
} -constraints [list exec] -setup {
- set f [open "|[interpreter]" w+]
+ catch {set f [open "|[interpreter]" w+]}
} -body {
type $f {
fconfigure stdin -blocking 0
@@ -476,8 +476,8 @@ namespace eval ::tcl::main::test {
test Tcl_Main-5.3 {
Tcl_Main handles stdin EOF in mid-command
} -constraints [list exec] -setup {
- set f [open "|[interpreter]" w+]
- fconfigure $f -blocking 0
+ catch {set f [open "|[interpreter]" w+]}
+ catch {fconfigure $f -blocking 0}
} -body {
type $f "fconfigure stdin -eofchar \\032
if 1 \{\n\032"
@@ -499,8 +499,8 @@ namespace eval ::tcl::main::test {
Tcl_Main handles stdin EOF in mid-command
} -constraints [list exec] -setup {
set cmd {makeFile "if 1 \{" script}
- set f [open "|[interpreter] < [eval $cmd]" r]
- fconfigure $f -blocking 0
+ catch {set f [open "|[interpreter] < [eval $cmd]" r]}
+ catch {fconfigure $f -blocking 0}
} -body {
variable wait
fileevent $f readable \
@@ -604,8 +604,8 @@ namespace eval ::tcl::main::test {
test Tcl_Main-5.10 {
Tcl_Main: exit main loop in mid-interactive command
} -constraints [list exec Tcltest] -setup {
- set f [open "|[interpreter]" w+]
- fconfigure $f -blocking 0
+ catch {set f [open "|[interpreter]" w+]}
+ catch {fconfigure $f -blocking 0}
} -body {
type $f "testsetmainloop
after 2000 testexitmainloop
generated by cgit v0.12 at 2024-08-21 06:07:52 (GMT)