Tcl Source Code

Check-in [4ee7449197]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment: Made internal functions call Tcl_GetCwd & Tcl_Chdir Fixed broken tests due to adding encoding function.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: 4ee74491973ad0b7309bb440e441a673923a8b36
User & Date: rjohnson 1999-04-06 04:27:01
Context
1999-04-06
04:51
Fixed more tests. check-in: f6849d360d user: rjohnson tags: core-8-1-branch-old
04:27
Made internal functions call Tcl_GetCwd & Tcl_Chdir Fixed broken tests due to adding encoding funct... check-in: 4ee7449197 user: rjohnson tags: core-8-1-branch-old
03:19
decrease timeouts for DDE functions check-in: 25b9f0ef5e user: redman tags: core-8-1-branch-old
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to generic/tclCmdAH.c.

     7      7    *
     8      8    * Copyright (c) 1987-1993 The Regents of the University of California.
     9      9    * Copyright (c) 1994-1997 Sun Microsystems, Inc.
    10     10    *
    11     11    * See the file "license.terms" for information on usage and redistribution
    12     12    * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    13     13    *
    14         - * RCS: @(#) $Id: tclCmdAH.c,v 1.1.2.10 1999/03/10 06:49:14 stanton Exp $
           14  + * RCS: @(#) $Id: tclCmdAH.c,v 1.1.2.11 1999/04/06 04:27:01 rjohnson Exp $
    15     15    */
    16     16   
    17     17   #include "tclInt.h"
    18     18   #include "tclPort.h"
    19     19   #include <locale.h>
    20     20   
    21     21   typedef int (StatProc)_ANSI_ARGS_((CONST char *path, struct stat *buf));
................................................................................
   321    321       } else {
   322    322   	dirName = "~";
   323    323       }
   324    324       if (Tcl_TranslateFileName(interp, dirName, &ds) == NULL) {
   325    325   	return TCL_ERROR;
   326    326       }
   327    327   
   328         -    result = TclpChdir(Tcl_DStringValue(&ds));
          328  +    result = Tcl_Chdir(Tcl_DStringValue(&ds));
   329    329       Tcl_DStringFree(&ds);
   330    330   
   331    331       if (result != 0) {
   332    332   	Tcl_AppendResult(interp, "couldn't change working directory to \"",
   333    333   		dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
   334    334   	return TCL_ERROR;
   335    335       }

Changes to generic/tclCmdMZ.c.

     9      9    * Copyright (c) 1987-1993 The Regents of the University of California.
    10     10    * Copyright (c) 1994-1997 Sun Microsystems, Inc.
    11     11    * Copyright (c) 1998-1999 by Scriptics Corporation.
    12     12    *
    13     13    * See the file "license.terms" for information on usage and redistribution
    14     14    * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    15     15    *
    16         - * RCS: @(#) $Id: tclCmdMZ.c,v 1.1.2.11 1999/04/05 22:20:27 rjohnson Exp $
           16  + * RCS: @(#) $Id: tclCmdMZ.c,v 1.1.2.12 1999/04/06 04:27:01 rjohnson Exp $
    17     17    */
    18     18   
    19     19   #include "tclInt.h"
    20     20   #include "tclPort.h"
    21     21   #include "tclCompile.h"
    22     22   #include "tclRegexp.h"
    23     23   
................................................................................
    90     90       Tcl_DString ds;
    91     91   
    92     92       if (objc != 1) {
    93     93   	Tcl_WrongNumArgs(interp, 1, objv, NULL);
    94     94   	return TCL_ERROR;
    95     95       }
    96     96   
    97         -    if (TclpGetCwd(interp, &ds) == NULL) {
           97  +    if (Tcl_GetCwd(interp, &ds) == NULL) {
    98     98   	return TCL_ERROR;
    99     99       }
   100    100       Tcl_DStringResult(interp, &ds);
   101    101       return TCL_OK;
   102    102   }
   103    103   
   104    104   /*

Changes to generic/tclEncoding.c.

     4      4    *	Contains the implementation of the encoding conversion package.
     5      5    *
     6      6    * Copyright (c) 1996-1998 Sun Microsystems, Inc.
     7      7    *
     8      8    * See the file "license.terms" for information on usage and redistribution
     9      9    * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    10     10    *
    11         - * RCS: @(#) $Id: tclEncoding.c,v 1.1.2.10 1999/04/06 02:05:35 stanton Exp $
           11  + * RCS: @(#) $Id: tclEncoding.c,v 1.1.2.11 1999/04/06 04:27:02 rjohnson Exp $
    12     12    */
    13     13   
    14     14   #include "tclInt.h"
    15     15   #include "tclPort.h"
    16     16   
    17     17   typedef size_t (LengthProc)_ANSI_ARGS_((CONST char *src));
    18     18   
................................................................................
   562    562   	Tcl_Obj **objv;
   563    563   	Tcl_DString pwdString;
   564    564   	char globArgString[10];
   565    565   
   566    566   	objc = 0;
   567    567   	Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
   568    568   
   569         -	TclpGetCwd(interp, &pwdString);
          569  +	Tcl_GetCwd(interp, &pwdString);
   570    570   
   571    571   	for (i = 0; i < objc; i++) {
   572    572   	    char *string;
   573    573   	    int j, objc2, length;
   574    574   	    Tcl_Obj **objv2;
   575    575   
   576    576   	    string = Tcl_GetStringFromObj(objv[i], NULL);
................................................................................
   579    579   	    /*
   580    580   	     * TclGlob() changes the contents of globArgString, which causes
   581    581   	     * a segfault if we pass in a pointer to non-writeable memory.
   582    582   	     * TclGlob() puts its results directly into interp.
   583    583   	     */
   584    584   
   585    585   	    strcpy(globArgString, "*.enc");
   586         -	    if ((TclpChdir(string) == 0)
   587         -		    && (TclpChdir("encoding") == 0)
          586  +	    if ((Tcl_Chdir(string) == 0)
          587  +		    && (Tcl_Chdir("encoding") == 0)
   588    588   		    && (TclGlob(interp, globArgString, 0) == TCL_OK)) {
   589    589   		objc2 = 0;
   590    590   
   591    591   		Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), &objc2,
   592    592   			&objv2);
   593    593   
   594    594   		for (j = 0; j < objc2; j++) {
................................................................................
   597    597   		    if (length > 0) {
   598    598   			string[length] = '\0';
   599    599   			Tcl_CreateHashEntry(&table, string, &dummy);
   600    600   			string[length] = '.';
   601    601   		    }
   602    602   		}
   603    603   	    }
   604         -	    TclpChdir(Tcl_DStringValue(&pwdString));
          604  +	    Tcl_Chdir(Tcl_DStringValue(&pwdString));
   605    605   	}
   606    606   	Tcl_DStringFree(&pwdString);
   607    607       }
   608    608   
   609    609       /*
   610    610        * Clear any values placed in the result by globbing.
   611    611        */

Changes to generic/tclUtil.c.

     6      6    *
     7      7    * Copyright (c) 1987-1993 The Regents of the University of California.
     8      8    * Copyright (c) 1994-1998 Sun Microsystems, Inc.
     9      9    *
    10     10    * See the file "license.terms" for information on usage and redistribution
    11     11    * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    12     12    *
    13         - *  RCS: @(#) $Id: tclUtil.c,v 1.1.2.9 1999/04/06 03:13:19 redman Exp $
           13  + *  RCS: @(#) $Id: tclUtil.c,v 1.1.2.10 1999/04/06 04:27:02 rjohnson Exp $
    14     14    */
    15     15   
    16     16   #include "tclInt.h"
    17     17   #include "tclPort.h"
    18     18   
    19     19   /*
    20     20    * The following variable holds the full path name of the binary
................................................................................
  2101   2101    */
  2102   2102   
  2103   2103   CONST char *
  2104   2104   Tcl_GetNameOfExecutable()
  2105   2105   {
  2106   2106       return (tclExecutableName);
  2107   2107   }
  2108         -
  2109         -
  2110         -
  2111         -
  2112   2108   
  2113   2109   /*
  2114   2110    *----------------------------------------------------------------------
  2115   2111    *
  2116   2112    * Tcl_GetCwd --
  2117   2113    *
  2118   2114    *	This function replaces the library version of getcwd().
................................................................................
  2127   2123    *
  2128   2124    * Side effects:
  2129   2125    *	None.
  2130   2126    *
  2131   2127    *----------------------------------------------------------------------
  2132   2128    */
  2133   2129   
  2134         -char *Tcl_GetCwd(interp, cwdPtr)
         2130  +char *
         2131  +Tcl_GetCwd(interp, cwdPtr)
  2135   2132       Tcl_Interp *interp;
  2136   2133       Tcl_DString *cwdPtr;
  2137   2134   {
  2138   2135       return TclpGetCwd(interp, cwdPtr);
  2139   2136   }
  2140         -
  2141         -
  2142   2137   
  2143   2138   /*
  2144   2139    *----------------------------------------------------------------------
  2145   2140    *
  2146   2141    * Tcl_Chdir --
  2147   2142    *
  2148   2143    *	This function replaces the library version of chdir().
................................................................................
  2151   2146    *	See chdir() documentation.
  2152   2147    *
  2153   2148    * Side effects:
  2154   2149    *	See chdir() documentation.  
  2155   2150    *
  2156   2151    *----------------------------------------------------------------------
  2157   2152    */
  2158         -int Tcl_Chdir(dirName)
         2153  +
         2154  +int
         2155  +Tcl_Chdir(dirName)
  2159   2156       CONST char *dirName;
  2160   2157   {
  2161   2158       return TclpChdir(dirName);
  2162   2159   }
  2163   2160   

Changes to tests/interp.test.

     6      6   #
     7      7   # Copyright (c) 1995-1996 Sun Microsystems, Inc.
     8      8   # Copyright (c) 1998-1999 by Scriptics Corporation.
     9      9   #
    10     10   # See the file "license.terms" for information on usage and redistribution
    11     11   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    12     12   #
    13         -# RCS: @(#) $Id: interp.test,v 1.1.2.10 1999/04/02 23:44:39 stanton Exp $
           13  +# RCS: @(#) $Id: interp.test,v 1.1.2.11 1999/04/06 04:27:03 rjohnson Exp $
    14     14   
    15     15   if {[lsearch [namespace children] ::tcltest] == -1} {
    16     16       source [file join [pwd] [file dirname [info script]] defs.tcl]
    17     17   }
    18     18   
    19     19   # The set of hidden commands is platform dependent:
    20     20   
    21     21   if {"$tcl_platform(platform)" == "macintosh"} {
    22     22       set hidden_cmds {beep cd echo exit fconfigure file glob load ls open pwd socket source}
    23     23   } else {
    24         -    set hidden_cmds {cd exec exit fconfigure file glob load open pwd socket source}
           24  +    set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source}
    25     25   }
    26     26   
    27     27   foreach i [interp slaves] {
    28     28     interp delete $i
    29     29   }
    30     30   
    31     31   proc equiv {x} {return $x}
................................................................................
  1678   1678       lappend l [interp aliases a]
  1679   1679       lappend l [lsort [interp hidden a]]
  1680   1680       a alias bar {}
  1681   1681       lappend l [interp aliases a]
  1682   1682       lappend l [lsort [interp hidden a]]
  1683   1683       interp delete a
  1684   1684       set l
  1685         -} {{cd exec exit fconfigure file glob load open pwd socket source} bar {cd exec exit fconfigure file glob load open pwd socket source} bar {bar cd exec exit fconfigure file glob load open pwd socket source} {} {cd exec exit fconfigure file glob load open pwd socket source}} 
         1685  +} {{cd encoding exec exit fconfigure file glob load open pwd socket source} bar {cd exec exit fconfigure file glob load open pwd socket source} bar {bar cd exec exit fconfigure file glob load open pwd socket source} {} {cd exec exit fconfigure file glob load open pwd socket source}} 
  1686   1686   
  1687   1687   test interp-23.3 {testing hiding vs aliases} {macOnly} {
  1688   1688       catch {interp delete a}
  1689   1689       interp create a -safe
  1690   1690       set l ""
  1691   1691       lappend l [lsort [interp hidden a]]
  1692   1692       a alias bar bar