Tcl Source Code

/* 
 * tclCmdAH.c --
 *
 *	This file contains the top-level command routines for most of
 *	the Tcl built-in commands whose names begin with the letters
 *	A to H.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdAH.c,v 1.1.2.11 1999/04/06 04:27:01 rjohnson Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include <locale.h>

typedef int (StatProc)_ANSI_ARGS_((CONST char *path, struct stat *buf));

    } else {
	dirName = "~";
    }
    if (Tcl_TranslateFileName(interp, dirName, &ds) == NULL) {
	return TCL_ERROR;
    }

    result = Tcl_Chdir(Tcl_DStringValue(&ds));
    Tcl_DStringFree(&ds);

    if (result != 0) {
	Tcl_AppendResult(interp, "couldn't change working directory to \"",
		dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
	return TCL_ERROR;
    }

 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdMZ.c,v 1.1.2.12 1999/04/06 04:27:01 rjohnson Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclCompile.h"
#include "tclRegexp.h"

    Tcl_DString ds;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    if (Tcl_GetCwd(interp, &ds) == NULL) {
	return TCL_ERROR;
    }
    Tcl_DStringResult(interp, &ds);
    return TCL_OK;
}

/*

/*
 * tclEncoding.c --
 *
 *	Contains the implementation of the encoding conversion package.
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclEncoding.c,v 1.1.2.11 1999/04/06 04:27:02 rjohnson Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

typedef size_t (LengthProc)_ANSI_ARGS_((CONST char *src));

	Tcl_Obj **objv;
	Tcl_DString pwdString;
	char globArgString[10];

	objc = 0;
	Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);

	Tcl_GetCwd(interp, &pwdString);

	for (i = 0; i < objc; i++) {
	    char *string;
	    int j, objc2, length;
	    Tcl_Obj **objv2;

	    string = Tcl_GetStringFromObj(objv[i], NULL);
	    Tcl_ResetResult(interp);

	    /*
	     * TclGlob() changes the contents of globArgString, which causes
	     * a segfault if we pass in a pointer to non-writeable memory.
	     * TclGlob() puts its results directly into interp.
	     */

	    strcpy(globArgString, "*.enc");
	    if ((Tcl_Chdir(string) == 0)
		    && (Tcl_Chdir("encoding") == 0)
		    && (TclGlob(interp, globArgString, 0) == TCL_OK)) {
		objc2 = 0;

		Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), &objc2,
			&objv2);

		for (j = 0; j < objc2; j++) {
		    string = Tcl_GetStringFromObj(objv2[j], &length);
		    length -= 4;
		    if (length > 0) {
			string[length] = '\0';
			Tcl_CreateHashEntry(&table, string, &dummy);
			string[length] = '.';
		    }
		}
	    }
	    Tcl_Chdir(Tcl_DStringValue(&pwdString));
	}
	Tcl_DStringFree(&pwdString);
    }

    /*
     * Clear any values placed in the result by globbing.
     */

/* 
 * tclUtil.c --
 *
 *	This file contains utility procedures that are used by many Tcl
 *	commands.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 *  RCS: @(#) $Id: tclUtil.c,v 1.1.2.10 1999/04/06 04:27:02 rjohnson Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * The following variable holds the full path name of the binary

 */

CONST char *
Tcl_GetNameOfExecutable()
{
    return (tclExecutableName);
}





/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCwd --
 *
 *	This function replaces the library version of getcwd().

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_GetCwd(interp, cwdPtr)
    Tcl_Interp *interp;
    Tcl_DString *cwdPtr;
{
    return TclpGetCwd(interp, cwdPtr);
}



/*
 *----------------------------------------------------------------------
 *
 * Tcl_Chdir --
 *
 *	This function replaces the library version of chdir().
 *
 * Results:
 *	See chdir() documentation.
 *
 * Side effects:
 *	See chdir() documentation.  
 *
 *----------------------------------------------------------------------
 */

int
Tcl_Chdir(dirName)
    CONST char *dirName;
{
    return TclpChdir(dirName);
}

# This file tests the multiple interpreter facility of Tcl
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: interp.test,v 1.1.2.11 1999/04/06 04:27:03 rjohnson Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# The set of hidden commands is platform dependent:

if {"$tcl_platform(platform)" == "macintosh"} {
    set hidden_cmds {beep cd echo exit fconfigure file glob load ls open pwd socket source}
} else {
    set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source}
}

foreach i [interp slaves] {
  interp delete $i
}

proc equiv {x} {return $x}

    lappend l [interp aliases a]
    lappend l [lsort [interp hidden a]]
    a alias bar {}
    lappend l [interp aliases a]
    lappend l [lsort [interp hidden a]]
    interp delete a
    set l
} {{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}} 

test interp-23.3 {testing hiding vs aliases} {macOnly} {
    catch {interp delete a}
    interp create a -safe
    set l ""
    lappend l [lsort [interp hidden a]]
    a alias bar bar