Tcl Source Code

Changes On Branch tip-480
Login
Bounty program for improvements to Tcl and certain Tcl packages.

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

Changes In Branch tip-480 Excluding Merge-Ins

This is equivalent to a diff from 7bcb41aa5e to 5672730e2e

2019-05-28
21:42
Merge 8.6 check-in: f70e8b4830 user: jan.nijtmans tags: core-8-branch
2019-05-26
12:11
Import of old TIP 284 patch, and update for current Tcl check-in: 1832e6f878 user: dkf tags: tip-284
10:47
Fix a few critical errors and allow int32 as a type Leaf check-in: 5672730e2e user: dkf tags: tip-480
07:19
merge 8.7 check-in: 494534d018 user: dkf tags: tip-480
2019-05-25
08:17
Merge 8.7 check-in: dd82009b2c user: dkf tags: trunk
08:06
TIP 383: [coroinject] and [coroprobe] check-in: 7bcb41aa5e user: dkf tags: core-8-branch
08:01
Add to error info when passing an error out of [coroprobe] Closed-Leaf check-in: de44589e23 user: dkf tags: tip-383
07:46
Implement TIP 431: [file tempdir] check-in: 974c5d161d user: dkf tags: core-8-branch

Added doc/pragma.n.

            1  +'\"
            2  +'\" Copyright (c) 2018 Donal K. Fellows
            3  +'\"
            4  +'\" See the file "license.terms" for information on usage and redistribution
            5  +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
            6  +'\"
            7  +.TH pragma n 8.7 Tcl "Tcl Built-In Commands"
            8  +.so man.macros
            9  +.BS
           10  +'\" Note:  do not modify the .SH NAME line immediately below!
           11  +.SH NAME
           12  +tcl::pragma \- directives to assist efficient execution
           13  +.SH SYNOPSIS
           14  +.nf
           15  +\fBtcl::pragma noalias\fR ?\fIvariableSet ...\fR?
           16  +\fBtcl::pragma type \fItypeName\fR ?\fIvalue ...\fR?
           17  +.fi
           18  +.SH DESCRIPTION
           19  +The \fBtcl::pragma\fR command provides directives that can aid efficient
           20  +execution and compilation strategies for Tcl scripts, while also providing
           21  +meaningful execution models for those directives. It produces no output on
           22  +successful execution, and an error if a problem is detected. It supports two
           23  +subcommands:
           24  +.TP
           25  +\fBtcl::pragma noalias\fR ?\fIvariableSet ...\fR?
           26  +.
           27  +This subcommand takes an arbitrary number of variable sets, \fIvariableSet\fR,
           28  +(lists of variable names), and checks to see if they alias each other.
           29  +Variable names within a variable set may resolve to the same variable (after
           30  +following links such as those created by \fBupvar\fR and \fBglobal\fR, and
           31  +allowing for any current namespace qualification, TclOO variable resolution,
           32  +etc.), but it is an error if a variable mentioned in one variable set resolves
           33  +to the same variable as a variable mentioned in another set. Only existing
           34  +variables can be checked this way.
           35  +.RS
           36  +.PP
           37  +When the local variables in a procedure all have simple names (this is the
           38  +overwhelmingly common case), they can be asserted to all not alias each other
           39  +with:
           40  +.PP
           41  +.CS
           42  +\fBtcl::pragma noalias\fR {*}[info locals]
           43  +.CE
           44  +.RE
           45  +.TP
           46  +\fBtcl::pragma type \fItypeName\fR ?\fIvalue ...\fR?
           47  +.
           48  +This subcommand takes a value type, \fItypeName\fR, and throws an error if any
           49  +of the arbitrary number of \fIvalue\fRs are not of that type. Supported
           50  +\fItypeName\fRs are:
           51  +.RS
           52  +.TP
           53  +\fBboolean\fR
           54  +.
           55  +This indicates the type of values accepted by \fBTcl_GetBooleanFromObj\fR().
           56  +.TP
           57  +\fBdict\fR
           58  +.
           59  +This indicates the type of values accepted by \fBTcl_DictObjSize\fR().
           60  +.TP
           61  +\fBdouble\fR
           62  +.
           63  +This indicates the type of values accepted by \fBTcl_GetDoubleFromObj\fR().
           64  +.TP
           65  +\fBint32\fR
           66  +.
           67  +This indicates the type of values accepted by \fBTcl_GetIntFromObj\fR().
           68  +.TP
           69  +\fBint64\fR
           70  +.
           71  +This indicates the type of values accepted by \fBTcl_GetWideIntFromObj\fR().
           72  +.TP
           73  +\fBinteger\fR
           74  +.
           75  +This indicates the type of any value accepted as an integer, without length
           76  +restriction. This is the type of values accepted by integer-accepting
           77  +\fBexpr\fR operators, such as the \fB&\fR operator or the left side of the
           78  +\fB<<\fR operator.
           79  +.TP
           80  +\fBlist\fR
           81  +.
           82  +This indicates the type of values accepted by \fBTcl_ListObjLength\fR().
           83  +.TP
           84  +\fBnumber\fR
           85  +.
           86  +This indicates the type of any value accepted as a number, without length
           87  +restriction. This is the type of values accepted by \fBexpr\fR operators
           88  +such as \fB+\fR or \fB*\fR.
           89  +.RE
           90  +.SH EXAMPLES
           91  +.PP
           92  +This shows how a procedure could declare that it only operates on integers:
           93  +.PP
           94  +.CS
           95  +proc addThreeIntegers {a b c} {
           96  +    \fBtcl::pragma type\fR integer $a $b $c
           97  +    return [expr {$a + $b + $c}]
           98  +}
           99  +.CE
          100  +.PP
          101  +This shows how a procedure could declare that two variables passed in by
          102  +name/\fBupvar\fR must be distinct from each other:
          103  +.PP
          104  +.CS
          105  +proc swap {v1Name v2Name} {
          106  +    upvar 1 $v1Name v1 $v2Name v2
          107  +    \fBtcl::pragma noalias\fR v1 v2
          108  +    set tmp $v2
          109  +    set v2 $v1
          110  +    set v1 $tmp
          111  +    return
          112  +}
          113  +.CE
          114  +.SH "SEE ALSO"
          115  +dict(n), global(n), list(n), string(n), upvar(n)
          116  +.SH KEYWORDS
          117  +compilation, variables, types
          118  +.\" Local variables:
          119  +.\" mode: nroff
          120  +.\" fill-column: 78
          121  +.\" End:

Changes to generic/tclBasic.c.

   937    937       TclInitChanCmd(interp);
   938    938       TclInitDictCmd(interp);
   939    939       TclInitEncodingCmd(interp);
   940    940       TclInitFileCmd(interp);
   941    941       TclInitInfoCmd(interp);
   942    942       TclInitNamespaceCmd(interp);
   943    943       TclInitStringCmd(interp);
          944  +    TclInitPragmaCmd(interp);
   944    945       TclInitPrefixCmd(interp);
   945    946       TclInitProcessCmd(interp);
   946    947   
   947    948       /*
   948    949        * Register "clock" subcommands. These *do* go through
   949    950        * Tcl_CreateObjCommand, since they aren't in the global namespace and
   950    951        * involve ensembles.

Changes to generic/tclCmdMZ.c.

  5369   5369   
  5370   5370   	if (*element == 0) {
  5371   5371   	    /* ASSERT i == n */
  5372   5372   	    break;
  5373   5373   	}
  5374   5374       }
  5375   5375   }
         5376  +
         5377  +/*
         5378  + *----------------------------------------------------------------------
         5379  + *
         5380  + * TclInitPragmaCmd --
         5381  + *
         5382  + *	This function creates the 'tcl::pragma' Tcl command.
         5383  + *	Refer to the user documentation for details on what it does.
         5384  + *
         5385  + * Results:
         5386  + *	Returns a standard Tcl result.
         5387  + *
         5388  + * Side effects:
         5389  + *	See the user documentation.
         5390  + *
         5391  + *----------------------------------------------------------------------
         5392  + */
         5393  +
         5394  +Tcl_Command
         5395  +TclInitPragmaCmd(
         5396  +    Tcl_Interp *interp)
         5397  +{
         5398  +    static const EnsembleImplMap pragmaImplMap[] = {
         5399  +	{"noalias", TclPragmaNoAliasCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
         5400  +	{"type",    TclPragmaTypeCmd,	 TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
         5401  +	{NULL, NULL, NULL, NULL, NULL, 0}
         5402  +    };
         5403  +    Tcl_Command prefixCmd;
         5404  +
         5405  +    prefixCmd = TclMakeEnsemble(interp, "::tcl::pragma", pragmaImplMap);
         5406  +    Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0),
         5407  +	    "prefix", 0);
         5408  +    return prefixCmd;
         5409  +}
         5410  +
         5411  +/*
         5412  + *----------------------------------------------------------------------
         5413  + *
         5414  + * TclPragmaTypeCmd --
         5415  + *
         5416  + *	This function implements the 'tcl::pragma type' Tcl command.
         5417  + *	Refer to the user documentation for details on what it does.
         5418  + *
         5419  + * Results:
         5420  + *	Returns a standard Tcl result.
         5421  + *
         5422  + * Side effects:
         5423  + *	See the user documentation.
         5424  + *
         5425  + *----------------------------------------------------------------------
         5426  + */
         5427  +
         5428  +	/* ARGSUSED */
         5429  +int
         5430  +TclPragmaTypeCmd(
         5431  +    ClientData clientData,	/* Not used. */
         5432  +    Tcl_Interp *interp,		/* Current interpreter. */
         5433  +    int objc,			/* Number of arguments. */
         5434  +    Tcl_Obj *const objv[])	/* Argument objects. */
         5435  +{
         5436  +    enum PragmaTypes {
         5437  +	BOOL_TYPE, DICT_TYPE, DOUBLE_TYPE, INT32_TYPE, INT64_TYPE,
         5438  +	INTEGER_TYPE, LIST_TYPE, NUMBER_TYPE
         5439  +    };
         5440  +    static const char *types[] = {
         5441  +	"boolean", "dict", "double", "int32", "int64", "integer", "list",
         5442  +	"number", NULL
         5443  +    };
         5444  +    int idx, i;
         5445  +
         5446  +    if (objc < 2) {
         5447  +	Tcl_WrongNumArgs(interp, 1, objv, "typeName ?value...?");
         5448  +	return TCL_ERROR;
         5449  +    }
         5450  +    if (Tcl_GetIndexFromObj(interp, objv[1], types, "type", 0,
         5451  +	    &idx) != TCL_OK) {
         5452  +	return TCL_ERROR;
         5453  +    }
         5454  +
         5455  +    /*
         5456  +     * Check that the type constraint actually holds for all remaining values.
         5457  +     */
         5458  +
         5459  +    for (i=2 ; i<objc ; i++) {
         5460  +	Tcl_Obj *valuePtr = objv[i];
         5461  +	double dval;
         5462  +	int bval, len, i32val;
         5463  +	Tcl_WideInt i64val;
         5464  +	ClientData cdval;
         5465  +
         5466  +	switch ((enum PragmaTypes) idx) {
         5467  +	case BOOL_TYPE:
         5468  +	    if (Tcl_GetBooleanFromObj(interp, valuePtr, &bval) != TCL_OK) {
         5469  +		return TCL_ERROR;
         5470  +	    }
         5471  +	    break;
         5472  +	case DICT_TYPE:
         5473  +	    if (Tcl_DictObjSize(interp, valuePtr, &len) != TCL_OK) {
         5474  +		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
         5475  +			"expected dict value but got \"%s\"",
         5476  +			Tcl_GetString(valuePtr)));
         5477  +		return TCL_ERROR;
         5478  +	    }
         5479  +	    break;
         5480  +	case DOUBLE_TYPE:
         5481  +	    if (Tcl_GetDoubleFromObj(interp, valuePtr, &dval) != TCL_OK) {
         5482  +		return TCL_ERROR;
         5483  +	    }
         5484  +	    break;
         5485  +	case INT32_TYPE:
         5486  +	    if (Tcl_GetIntFromObj(interp, valuePtr, &i32val) != TCL_OK) {
         5487  +		return TCL_ERROR;
         5488  +	    }
         5489  +	    break;
         5490  +	case INT64_TYPE:
         5491  +	    if (Tcl_GetWideIntFromObj(interp, valuePtr, &i64val) != TCL_OK) {
         5492  +		return TCL_ERROR;
         5493  +	    }
         5494  +	    break;
         5495  +	case LIST_TYPE:
         5496  +	    if (Tcl_ListObjLength(interp, valuePtr, &len) != TCL_OK) {
         5497  +		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
         5498  +			"expected list value but got \"%s\"",
         5499  +			Tcl_GetString(valuePtr)));
         5500  +		return TCL_ERROR;
         5501  +	    }
         5502  +	    break;
         5503  +	case INTEGER_TYPE:
         5504  +	    if (TclGetWideBitsFromObj(interp, valuePtr, &i64val) != TCL_OK) {
         5505  +		return TCL_ERROR;
         5506  +	    }
         5507  +	    break;
         5508  +	case NUMBER_TYPE:
         5509  +	    if (TclGetNumberFromObj(interp, valuePtr, &cdval, &bval) != TCL_OK) {
         5510  +		return TCL_ERROR;
         5511  +	    }
         5512  +	    break;
         5513  +	}
         5514  +    }
         5515  +    return TCL_OK;
         5516  +}
  5376   5517   
  5377   5518   /*
  5378   5519    * Local Variables:
  5379   5520    * mode: c
  5380   5521    * c-basic-offset: 4
  5381   5522    * fill-column: 78
  5382   5523    * End:
  5383   5524    */

Changes to generic/tclInt.h.

  3503   3503   			    Tcl_Obj *const objv[]);
  3504   3504   MODULE_SCOPE int	Tcl_PackageObjCmd(ClientData clientData,
  3505   3505   			    Tcl_Interp *interp, int objc,
  3506   3506   			    Tcl_Obj *const objv[]);
  3507   3507   MODULE_SCOPE int	Tcl_PidObjCmd(ClientData clientData,
  3508   3508   			    Tcl_Interp *interp, int objc,
  3509   3509   			    Tcl_Obj *const objv[]);
         3510  +MODULE_SCOPE Tcl_Command TclInitPragmaCmd(Tcl_Interp *interp);
         3511  +MODULE_SCOPE Tcl_ObjCmdProc TclPragmaNoAliasCmd;
         3512  +MODULE_SCOPE Tcl_ObjCmdProc TclPragmaTypeCmd;
  3510   3513   MODULE_SCOPE Tcl_Command TclInitPrefixCmd(Tcl_Interp *interp);
  3511   3514   MODULE_SCOPE int	Tcl_PutsObjCmd(ClientData clientData,
  3512   3515   			    Tcl_Interp *interp, int objc,
  3513   3516   			    Tcl_Obj *const objv[]);
  3514   3517   MODULE_SCOPE int	Tcl_PwdObjCmd(ClientData clientData,
  3515   3518   			    Tcl_Interp *interp, int objc,
  3516   3519   			    Tcl_Obj *const objv[]);

Changes to generic/tclVar.c.

  6880   6880       }
  6881   6881       tablePtr->defaultObj = defaultObj;
  6882   6882       if (tablePtr->defaultObj) {
  6883   6883           Tcl_IncrRefCount(tablePtr->defaultObj);
  6884   6884           Tcl_IncrRefCount(tablePtr->defaultObj);
  6885   6885       }
  6886   6886   }
         6887  +
         6888  +/*
         6889  + *----------------------------------------------------------------------
         6890  + *
         6891  + * TclPragmaNoAliasCmd --
         6892  + *
         6893  + *	This function implements the 'tcl::pragma noalias' Tcl command.
         6894  + *	Refer to the user documentation for details on what it does.
         6895  + *
         6896  + * Results:
         6897  + *	Returns a standard Tcl result.
         6898  + *
         6899  + * Side effects:
         6900  + *	See the user documentation.
         6901  + *
         6902  + *----------------------------------------------------------------------
         6903  + */
         6904  +
         6905  +	/* ARGSUSED */
         6906  +int
         6907  +TclPragmaNoAliasCmd(
         6908  +    ClientData clientData,	/* Not used. */
         6909  +    Tcl_Interp *interp,		/* Current interpreter. */
         6910  +    int objc,			/* Number of arguments. */
         6911  +    Tcl_Obj *const objv[])	/* Argument objects. */
         6912  +{
         6913  +    typedef struct {
         6914  +	int setIndex;
         6915  +	Tcl_Obj *variableName;
         6916  +    } AliasData;
         6917  +    int i, j, varc, isNew, result = TCL_ERROR;
         6918  +    Var *key, *ignored;
         6919  +    Tcl_HashTable table;
         6920  +    Tcl_HashEntry *hPtr;
         6921  +    Tcl_HashSearch search;
         6922  +    Tcl_Obj **varv;
         6923  +    AliasData *aliasData;
         6924  +
         6925  +    Tcl_InitHashTable(&table, TCL_ONE_WORD_KEYS);
         6926  +
         6927  +    /*
         6928  +     * For each set of variables...
         6929  +     */
         6930  +
         6931  +    for (i=1 ; i<objc ; i++) {
         6932  +	if (Tcl_ListObjGetElements(interp, objv[i], &varc, &varv) != TCL_OK) {
         6933  +	    goto error;
         6934  +	}
         6935  +
         6936  +	/*
         6937  +	 * ... build a map from real variable location (because
         6938  +	 * TclObjLookupVarEx will follow links for us) to the name that led us
         6939  +	 * there.
         6940  +	 */
         6941  +
         6942  +	for (j=0 ; j<varc ; j++) {
         6943  +	    Tcl_Obj *varName = varv[j];
         6944  +
         6945  +	    Tcl_IncrRefCount(varName);
         6946  +	    key = TclObjLookupVarEx(interp, varName, NULL, TCL_LEAVE_ERR_MSG,
         6947  +		    "resolve", 0, 0, &ignored);
         6948  +	    if (key == NULL) {
         6949  +		TclDecrRefCount(varName);
         6950  +		goto error;
         6951  +	    }
         6952  +
         6953  +	    hPtr = Tcl_CreateHashEntry(&table, key, &isNew);
         6954  +	    if (isNew) {
         6955  +		aliasData = ckalloc(sizeof(AliasData));
         6956  +		aliasData->setIndex = i;
         6957  +		aliasData->variableName = varName;
         6958  +		Tcl_SetHashValue(hPtr, aliasData);
         6959  +		continue;
         6960  +	    }
         6961  +
         6962  +	    /*
         6963  +	     * Two variables alias, but that's OK if they're in the same
         6964  +	     * variable set.
         6965  +	     */
         6966  +
         6967  +	    aliasData = Tcl_GetHashValue(hPtr);
         6968  +	    if (aliasData->setIndex != i) {
         6969  +		/*
         6970  +		 * There was a real duplicate! Generate an error message.
         6971  +		 */
         6972  +
         6973  +		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
         6974  +			"\"%s\" aliases to the same variable as \"%s\"",
         6975  +			Tcl_GetString(varName),
         6976  +			Tcl_GetString(aliasData->variableName)));
         6977  +		Tcl_SetErrorCode(interp, "TCL", "VAR_ALIAS", NULL);
         6978  +		TclDecrRefCount(varName);
         6979  +		goto error;
         6980  +	    }
         6981  +	    TclDecrRefCount(varName);
         6982  +	}
         6983  +    }
         6984  +    result = TCL_OK;
         6985  +  error:
         6986  +    for (hPtr = Tcl_FirstHashEntry(&table, &search); hPtr != NULL;
         6987  +	    hPtr = Tcl_NextHashEntry(&search)) {
         6988  +	aliasData = Tcl_GetHashValue(hPtr);
         6989  +	TclDecrRefCount(aliasData->variableName);
         6990  +	ckfree(Tcl_GetHashValue(hPtr));
         6991  +    }
         6992  +    Tcl_DeleteHashTable(&table);
         6993  +    return result;
         6994  +}
  6887   6995   
  6888   6996   /*
  6889   6997    * Local Variables:
  6890   6998    * mode: c
  6891   6999    * c-basic-offset: 4
  6892   7000    * fill-column: 78
  6893   7001    * End:
  6894   7002    */

Changes to tests/cmdMZ.test.

   444    444   	    lindex 5
   445    445   	} on ok res {}
   446    446   	set res
   447    447       }}
   448    448   } -result 5
   449    449   
   450    450   
          451  +# Pragmas
          452  +test cmdMZ-6.1 {tcl::pragma: basics} -returnCodes error -body {
          453  +    tcl::pragma
          454  +} -result {wrong # args: should be "tcl::pragma subcommand ?arg ...?"}
          455  +test cmdMZ-6.2 {tcl::pragma: basics} -returnCodes error -body {
          456  +    tcl::pragma ?
          457  +} -result {unknown or ambiguous subcommand "?": must be noalias, or type}
          458  +
          459  +test cmdMZ-7.1 {tcl::pragma noalias} -body {
          460  +    tcl::pragma noalias
          461  +} -result {}
          462  +test cmdMZ-7.2 {tcl::pragma noalias} -body {
          463  +    tcl::pragma noalias no_such_var
          464  +} -returnCodes error -result {can't resolve "no_such_var": no such variable}
          465  +test cmdMZ-7.3 {tcl::pragma noalias} -body {
          466  +    tcl::pragma noalias ::env
          467  +} -result {}
          468  +test cmdMZ-7.4 {tcl::pragma noalias} -body {
          469  +    tcl::pragma noalias ::env ::tcl_platform
          470  +} -result {}
          471  +test cmdMZ-7.5 {tcl::pragma noalias} -body {
          472  +    tcl::pragma noalias ::env ::tcl_platform ::auto_path
          473  +} -result {}
          474  +test cmdMZ-7.6 {tcl::pragma noalias} -body {
          475  +    tcl::pragma noalias ::env ::env
          476  +} -returnCodes error -result {"::env" aliases to the same variable as "::env"}
          477  +test cmdMZ-7.6 {tcl::pragma noalias} -body {
          478  +    tcl::pragma noalias {::env ::env}
          479  +} -result {}
          480  +test cmdMZ-7.7 {tcl::pragma noalias} -body {
          481  +    tcl::pragma noalias {::env ::tcl_platform}
          482  +} -result {}
          483  +test cmdMZ-7.8 {tcl::pragma noalias} -body {
          484  +    apply {{x y} {
          485  +	tcl::pragma noalias env
          486  +    }} 1 2
          487  +} -returnCodes error -result {can't resolve "env": no such variable}
          488  +test cmdMZ-7.9 {tcl::pragma noalias} -body {
          489  +    apply {{x y} {
          490  +	tcl::pragma noalias {*}[info locals]
          491  +    }} 1 2
          492  +} -result {}
          493  +test cmdMZ-7.10 {tcl::pragma noalias} -body {
          494  +    apply {{x y} {
          495  +	global env
          496  +	tcl::pragma noalias {*}[info locals] env
          497  +    }} 1 2
          498  +} -result {}
          499  +test cmdMZ-7.11 {tcl::pragma noalias} -body {
          500  +    apply {{x y} {
          501  +	global env
          502  +	upvar ::env(PATH) path
          503  +	tcl::pragma noalias [list {*}[info locals] env path]
          504  +    }} 1 2
          505  +} -result {}
          506  +test cmdMZ-7.12 {tcl::pragma noalias} -body {
          507  +    apply {{x y} {
          508  +	upvar 0 x z
          509  +	tcl::pragma noalias x y z
          510  +    }} 1 2
          511  +} -returnCodes error -result {"z" aliases to the same variable as "x"}
          512  +test cmdMZ-7.13 {tcl::pragma noalias} -setup {
          513  +    variable a 3 b 4
          514  +} -body {
          515  +    proc swap {&x &y} {
          516  +	upvar 1 ${&x} x ${&y} y
          517  +	tcl::pragma noalias x y
          518  +	set y $x[set x $y;string cat]
          519  +	return
          520  +    }
          521  +    swap a b
          522  +    list $a $b
          523  +} -cleanup {
          524  +    unset -nocomplain a b
          525  +} -result {4 3}
          526  +test cmdMZ-7.14 {tcl::pragma noalias} -setup {
          527  +    variable a 3
          528  +} -body {
          529  +    proc swap {&x &y} {
          530  +	upvar 1 ${&x} x ${&y} y
          531  +	tcl::pragma noalias x y
          532  +	set y $x[set x $y;string cat]
          533  +	return
          534  +    }
          535  +    swap a a
          536  +} -returnCodes error -cleanup {
          537  +    unset -nocomplain a
          538  +} -result {"y" aliases to the same variable as "x"}
          539  +rename swap {}
          540  +
          541  +test cmdMZ-8.1 {tcl::pragma type} -returnCodes error -body {
          542  +    tcl::pragma type
          543  +} -result {wrong # args: should be "tcl::pragma type typeName ?value...?"}
          544  +test cmdMZ-8.2 {tcl::pragma type} -returnCodes error -body {
          545  +    tcl::pragma type ?
          546  +} -result {bad type "?": must be boolean, dict, double, int32, int64, integer, list, or number}
          547  +test cmdMZ-8.3 {tcl::pragma type} -body {
          548  +    tcl::pragma type boolean
          549  +} -result {}
          550  +test cmdMZ-8.4 {tcl::pragma type} -body {
          551  +    tcl::pragma type boolean gorp
          552  +} -returnCodes error -result {expected boolean value but got "gorp"}
          553  +test cmdMZ-8.5 {tcl::pragma type} -body {
          554  +    tcl::pragma type boolean true false gorp
          555  +} -returnCodes error -result {expected boolean value but got "gorp"}
          556  +test cmdMZ-8.6 {tcl::pragma type} -body {
          557  +    tcl::pragma type boolean yes no 0 1 1.5 true false on off
          558  +} -result {}
          559  +test cmdMZ-8.7 {tcl::pragma type} -body {
          560  +    tcl::pragma type dict gorp
          561  +} -returnCodes error -result {expected dict value but got "gorp"}
          562  +test cmdMZ-8.8 {tcl::pragma type} -body {
          563  +    tcl::pragma type dict {true false} {gorp foo bar}
          564  +} -returnCodes error -result {expected dict value but got "gorp foo bar"}
          565  +test cmdMZ-8.9 {tcl::pragma type} -body {
          566  +    tcl::pragma type dict {} {yes no 0 1 1.5 true} {false on off {}}
          567  +} -result {}
          568  +test cmdMZ-8.10 {tcl::pragma type} -body {
          569  +    tcl::pragma type double gorp
          570  +} -returnCodes error -result {expected floating-point number but got "gorp"}
          571  +test cmdMZ-8.11 {tcl::pragma type} -body {
          572  +    tcl::pragma type double 0.1 -inf gorp
          573  +} -returnCodes error -result {expected floating-point number but got "gorp"}
          574  +test cmdMZ-8.12 {tcl::pragma type} -body {
          575  +    tcl::pragma type double 0 1 0x1 123 1e2 -.0 inf { +inf }
          576  +} -result {}
          577  +test cmdMZ-8.13 {tcl::pragma type} -body {
          578  +    tcl::pragma type int32 gorp
          579  +} -returnCodes error -result {expected integer but got "gorp"}
          580  +test cmdMZ-8.14 {tcl::pragma type} -body {
          581  +    tcl::pragma type int32 123 0x123 gorp
          582  +} -returnCodes error -result {expected integer but got "gorp"}
          583  +test cmdMZ-8.15 {tcl::pragma type} -returnCodes error -body {
          584  +    tcl::pragma type int32 123 0x123 123456123456123
          585  +} -result {integer value too large to represent as non-long integer}
          586  +test cmdMZ-8.16 {tcl::pragma type} -body {
          587  +    tcl::pragma type int32 123 0b10101 0d123 0o123 0x123 { 456 }
          588  +} -result {}
          589  +test cmdMZ-8.17 {tcl::pragma type} -body {
          590  +    tcl::pragma type int64 gorp
          591  +} -returnCodes error -result {expected integer but got "gorp"}
          592  +test cmdMZ-8.18 {tcl::pragma type} -body {
          593  +    tcl::pragma type int64 123 0x123 gorp
          594  +} -returnCodes error -result {expected integer but got "gorp"}
          595  +test cmdMZ-8.19 {tcl::pragma type} -body {
          596  +    tcl::pragma type int64 123 0b10101 0d123 0o123 0x123 { 456 } \
          597  +	123456123456123
          598  +} -result {}
          599  +test cmdMZ-8.20 {tcl::pragma type} -body {
          600  +    tcl::pragma type integer gorp
          601  +} -returnCodes error -result {expected integer but got "gorp"}
          602  +test cmdMZ-8.21 {tcl::pragma type} -body {
          603  +    tcl::pragma type integer 123 0x123 gorp
          604  +} -returnCodes error -result {expected integer but got "gorp"}
          605  +test cmdMZ-8.22 {tcl::pragma type} -body {
          606  +    tcl::pragma type integer 123 0b10101 0d123 0o123 0x123 { 456 } \
          607  +	123456123456123 \
          608  +	123456789012345678901234567890123456789012345678901234567890
          609  +} -result {}
          610  +test cmdMZ-8.23 {tcl::pragma type} -body {
          611  +    tcl::pragma type list \{gorp
          612  +} -returnCodes error -result "expected list value but got \"\{gorp\""
          613  +test cmdMZ-8.24 {tcl::pragma type} -body {
          614  +    tcl::pragma type list true false \{gorp
          615  +} -returnCodes error -result "expected list value but got \"\{gorp\""
          616  +test cmdMZ-8.25 {tcl::pragma type} -body {
          617  +    tcl::pragma type list yes no 0 1 1.5 true false on off
          618  +} -result {}
          619  +test cmdMZ-8.26 {tcl::pragma type} -body {
          620  +    tcl::pragma type number gorp
          621  +} -returnCodes error -result {expected number but got "gorp"}
          622  +test cmdMZ-8.27 {tcl::pragma type} -body {
          623  +    tcl::pragma type number .5 nan gorp
          624  +} -returnCodes error -result {expected number but got "gorp"}
          625  +test cmdMZ-8.28 {tcl::pragma type} -body {
          626  +    tcl::pragma type number 0 1 1.5 inf -25.375e8
          627  +} -result {}
          628  +
   451    629   # The tests for Tcl_WhileObjCmd are in while.test
   452    630   
   453    631   # cleanup
   454    632   cleanupTests
   455    633   }
   456    634   namespace delete ::tcl::test::cmdMZ
   457    635   return
   458    636   
   459    637   # Local Variables:
   460    638   # mode: tcl
   461    639   # End: