| ︙ | | | ︙ | |
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
|
int precompiled = 0;
/*
* To report on bad arglists:
* - set to 1 when 0 and optional/args is found
* - set to 2 when 1 and required is found
* - error when 2 and optional/args is found
*/
int arglist_shape = 0;
ProcGetInternalRep(bodyPtr, procPtr);
if (procPtr != NULL) {
/*
* Because the body is a TclProProcBody, the actual body is already
* compiled, and it is not shared with anyone else, so it's OK not to
* unshare it (as a matter of fact, it is bad to unshare it, because
|
|
|
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
|
int precompiled = 0;
/*
* To report on bad arglists:
* - set to 1 when 0 and optional/args is found
* - set to 2 when 1 and required is found
* - error when 2 and optional/args is found
*/
int arglistShape = 0, isArgs, seenArgs = 0;
ProcGetInternalRep(bodyPtr, procPtr);
if (procPtr != NULL) {
/*
* Because the body is a TclProProcBody, the actual body is already
* compiled, and it is not shared with anyone else, so it's OK not to
* unshare it (as a matter of fact, it is bad to unshare it, because
|
| ︙ | | | ︙ | |
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
|
"argument with no name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
argname = Tcl_GetStringFromObj(fieldValues[0], &nameLength);
/*
* Reject invalid argspecs early
*/
if (fieldCount == 2
|| ((nameLength == 4)
&& !strcmp(argname, "args"))) {
if (arglist_shape == 0) {
arglist_shape = 1;
} else if (arglist_shape == 2) {
ckfree(fieldValues);
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"required args in the middle", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
} else {
if (arglist_shape == 1) {
arglist_shape = 2;
}
}
/*
* Check that the formal parameter name is a scalar.
*/
|
>
|
|
>
>
>
>
>
>
|
|
|
|
<
|
|
|
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
|
"argument with no name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
argname = Tcl_GetStringFromObj(fieldValues[0], &nameLength);
isArgs = (nameLength == 4) && !strcmp(argname, "args");
/*
* Reject invalid argspecs early
*/
if (fieldCount == 2 || isArgs) {
if (isArgs && seenArgs) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"repeated \"args\" in argument list", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
seenArgs = seenArgs || isArgs;
if (arglistShape == 0) {
arglistShape = 1;
} else if (arglistShape == 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"required args in the middle", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
} else {
if (arglistShape == 1) {
arglistShape = 2;
}
}
/*
* Check that the formal parameter name is a scalar.
*/
|
| ︙ | | | ︙ | |
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
|
"default value inconsistent with precompiled body", -1);
Tcl_SetObjResult(interp, errorObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"BYTECODELIES", NULL);
goto procError;
}
}
if ((localPtr->nameLength == 4)
&& (localPtr->name[0] == 'a')
&& (strcmp(localPtr->name, "args") == 0)) {
localPtr->flags |= VAR_IS_ARGS;
}
localPtr = localPtr->nextPtr;
} else {
/*
* Allocate an entry in the runtime procedure frame's array of
|
|
<
<
|
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
|
"default value inconsistent with precompiled body", -1);
Tcl_SetObjResult(interp, errorObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"BYTECODELIES", NULL);
goto procError;
}
}
if (isArgs) {
localPtr->flags |= VAR_IS_ARGS;
}
localPtr = localPtr->nextPtr;
} else {
/*
* Allocate an entry in the runtime procedure frame's array of
|
| ︙ | | | ︙ | |
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
|
if (fieldCount == 2) {
localPtr->defValuePtr = fieldValues[1];
Tcl_IncrRefCount(localPtr->defValuePtr);
} else {
localPtr->defValuePtr = NULL;
}
memcpy(localPtr->name, argname, fieldValues[0]->length + 1);
if ((localPtr->nameLength == 4)
&& (localPtr->name[0] == 'a')
&& (memcmp(localPtr->name, "args", 4) == 0)) {
localPtr->flags |= VAR_IS_ARGS;
}
}
}
*procPtrPtr = procPtr;
return TCL_OK;
|
|
<
<
|
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
|
if (fieldCount == 2) {
localPtr->defValuePtr = fieldValues[1];
Tcl_IncrRefCount(localPtr->defValuePtr);
} else {
localPtr->defValuePtr = NULL;
}
memcpy(localPtr->name, argname, fieldValues[0]->length + 1);
if (isArgs) {
localPtr->flags |= VAR_IS_ARGS;
}
}
}
*procPtrPtr = procPtr;
return TCL_OK;
|
| ︙ | | | ︙ | |
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
|
static int
ProcWrongNumArgs(
Tcl_Interp *interp,
int skip)
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
Proc *procPtr = framePtr->procPtr;
int localCt = procPtr->numCompiledLocals, numArgs, i;
Tcl_Obj **desiredObjs;
const char *final = NULL;
/*
* Build up desired argument list for Tcl_WrongNumArgs
*/
numArgs = framePtr->procPtr->numArgs;
desiredObjs = (Tcl_Obj **)TclStackAlloc(interp,
sizeof(Tcl_Obj *) * (numArgs+1));
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
} else {
#ifdef AVOID_HACKS_FOR_ITCL
desiredObjs[0] = framePtr->objv[skip-1];
#else
desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1);
#endif /* AVOID_HACKS_FOR_ITCL */
}
Tcl_IncrRefCount(desiredObjs[0]);
if (localCt > 0) {
Var *defPtr = (Var *)(&framePtr->localCachePtr->varName0 + localCt);
for (i=1 ; i<=numArgs ; i++, defPtr++) {
Tcl_Obj *argObj;
Tcl_Obj *namePtr = localName(framePtr, i-1);
if (defPtr->value.objPtr != NULL) {
TclNewObj(argObj);
Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
} else if (defPtr->flags & VAR_IS_ARGS) {
TclNewLiteralStringObj(argObj, "?arg ...?");
} else {
argObj = namePtr;
Tcl_IncrRefCount(namePtr);
}
desiredObjs[i] = argObj;
}
}
Tcl_ResetResult(interp);
Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, final);
for (i=0 ; i<=numArgs ; i++) {
Tcl_DecrRefCount(desiredObjs[i]);
}
TclStackFree(interp, desiredObjs);
return TCL_ERROR;
}
/*
|
|
|
|
>
>
>
>
>
|
>
>
>
|
|
|
|
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
|
static int
ProcWrongNumArgs(
Tcl_Interp *interp,
int skip)
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
Proc *procPtr = framePtr->procPtr;
int localCt = procPtr->numCompiledLocals, numArgs, i, i2;
Tcl_Obj **desiredObjs;
const char *final = NULL;
/*
* Build up desired argument list for Tcl_WrongNumArgs
*/
numArgs = framePtr->procPtr->numArgs;
desiredObjs = (Tcl_Obj **)TclStackAlloc(interp,
sizeof(Tcl_Obj *) * (numArgs+2));
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
} else {
#ifdef AVOID_HACKS_FOR_ITCL
desiredObjs[0] = framePtr->objv[skip-1];
#else
desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1);
#endif /* AVOID_HACKS_FOR_ITCL */
}
Tcl_IncrRefCount(desiredObjs[0]);
if (localCt > 0) {
Var *defPtr = (Var *)(&framePtr->localCachePtr->varName0 + localCt);
for (i=i2=1 ; i<=numArgs ; i++, i2++, defPtr++) {
Tcl_Obj *argObj;
Tcl_Obj *namePtr = localName(framePtr, i-1);
if (defPtr->value.objPtr != NULL) {
TclNewObj(argObj);
Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
} else if (defPtr->flags & VAR_IS_ARGS) {
/*
* Work around the list quoting in WrongNumArgs which we
* do not want for ?arg ...?.
*/
TclNewLiteralStringObj(argObj, "?arg");
desiredObjs[i2] = argObj;
i2++;
TclNewLiteralStringObj(argObj, "...?");
} else {
argObj = namePtr;
Tcl_IncrRefCount(namePtr);
}
desiredObjs[i2] = argObj;
}
}
Tcl_ResetResult(interp);
Tcl_WrongNumArgs(interp, i2, desiredObjs, final);
for (i=0 ; i<i2 ; i++) {
Tcl_DecrRefCount(desiredObjs[i]);
}
TclStackFree(interp, desiredObjs);
return TCL_ERROR;
}
/*
|
| ︙ | | | ︙ | |