mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-06 00:12:46 +02:00
implemented ... VarArgs parameter for mode MacPas
git-svn-id: trunk@7914 -
This commit is contained in:
mattias
parent
b65cecfde7
commit
28e54af177
@ -1018,10 +1018,16 @@ begin
|
||||
begin
|
||||
inc(CurPos.EndPos);
|
||||
if (Src[CurPos.EndPos]<>'.') then begin
|
||||
// '.'
|
||||
CurPos.Flag:=cafPoint;
|
||||
end else begin
|
||||
// ..
|
||||
inc(CurPos.EndPos);
|
||||
if (Src[CurPos.EndPos]<>'.') then begin
|
||||
// '..'
|
||||
end else begin
|
||||
// '...'
|
||||
inc(CurPos.EndPos);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
@ -1029,12 +1035,15 @@ begin
|
||||
c2:=Src[CurPos.EndPos];
|
||||
// test for double char operators :=, +=, -=, /=, *=, <>, <=, >=, **, ><
|
||||
if ((c2='=') and (IsEqualOperatorStartChar[c1]))
|
||||
or ((c1='<') and (c2='>')) // not equal
|
||||
or ((c1='>') and (c2='<'))
|
||||
or ((c1='.') and (c2='.')) // subrange
|
||||
or ((c1='*') and (c2='*'))
|
||||
then inc(CurPos.EndPos);
|
||||
if ((c1='@') and (c2='@')) then begin
|
||||
or ((c1='<') and (c2='>')) // not equal
|
||||
or ((c1='>') and (c2='<'))
|
||||
or ((c1='.') and (c2='.'))
|
||||
or ((c1='*') and (c2='*'))
|
||||
then begin
|
||||
// 2 character operator/symbol
|
||||
inc(CurPos.EndPos);
|
||||
end
|
||||
else if ((c1='@') and (c2='@')) then begin
|
||||
// @@ label
|
||||
repeat
|
||||
inc(CurPos.EndPos);
|
||||
|
||||
@ -983,10 +983,38 @@ end;
|
||||
|
||||
function TPascalParserTool.ReadParamList(ExceptionOnError, Extract: boolean;
|
||||
const Attr: TProcHeadAttributes): boolean;
|
||||
{ parse parameter list
|
||||
|
||||
examples:
|
||||
procedure ProcName; virtual; abstract;
|
||||
function FuncName(Parameter1: Type1; Parameter2: Type2): ResultType;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
class function X: integer;
|
||||
function QWidget_mouseGrabber(): QWidgetH; cdecl;
|
||||
procedure Intf.Method = ImplementingMethodName;
|
||||
function CommitUrlCacheEntry; // only Delphi
|
||||
procedure MacProcName(c: char; ...); external;
|
||||
|
||||
proc specifiers without parameters:
|
||||
stdcall, virtual, abstract, dynamic, overload, override, cdecl, inline
|
||||
|
||||
proc specifiers with parameters:
|
||||
message <id or number>;
|
||||
external;
|
||||
external <id>;
|
||||
external name <id>;
|
||||
external <id or number> name <id>;
|
||||
external <id or number> index <id>;
|
||||
[alias: <string constant>]
|
||||
[external name <string constant>]
|
||||
[internconst:in_const_round, external name 'FPC_ROUND'];
|
||||
dispid <id>;
|
||||
}
|
||||
var CloseBracket: char;
|
||||
Desc: TCodeTreeNodeDesc;
|
||||
Node: TCodeTreeNode;
|
||||
|
||||
|
||||
procedure ReadPrefixModifier;
|
||||
begin
|
||||
// read parameter prefix modifier
|
||||
@ -1038,56 +1066,74 @@ begin
|
||||
CloseBracket:=#0;
|
||||
if not (CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose]) then begin
|
||||
repeat
|
||||
ReadPrefixModifier;
|
||||
// read parameter name(s)
|
||||
repeat
|
||||
if not AtomIsIdentifier(ExceptionOnError) then exit;
|
||||
if (phpCreateNodes in Attr) then begin
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=Desc;
|
||||
if AtomIs('...') then begin
|
||||
// MacPas '...' VarArgs parameter
|
||||
if (Scanner.CompilerMode<>cmMacPas) then begin
|
||||
if ExceptionOnError then
|
||||
RaiseIdentExpectedButAtomFound
|
||||
else
|
||||
exit;
|
||||
end;
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
else
|
||||
ExtractNextAtom(phpWithParameterNames in Attr,Attr);
|
||||
if CurPos.Flag<>cafComma then
|
||||
break
|
||||
else begin
|
||||
ReadNextAtom;
|
||||
// parse end of parameter list
|
||||
if (CurPos.StartPos>SrcLen)
|
||||
or (Src[CurPos.StartPos]<>CloseBracket) then
|
||||
if ExceptionOnError then
|
||||
RaiseCharExpectedButAtomFound(CloseBracket)
|
||||
else exit;
|
||||
break;
|
||||
end else begin
|
||||
ReadPrefixModifier;
|
||||
// read parameter name(s)
|
||||
repeat
|
||||
if not AtomIsIdentifier(ExceptionOnError) then exit;
|
||||
if (phpCreateNodes in Attr) then begin
|
||||
CurNode.EndPos:=LastAtoms.GetValueAt(0).EndPos;
|
||||
EndChildNode;
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=Desc;
|
||||
end;
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
else
|
||||
ExtractNextAtom(not (phpWithoutParamList in Attr),Attr);
|
||||
ExtractNextAtom(phpWithParameterNames in Attr,Attr);
|
||||
if CurPos.Flag<>cafComma then
|
||||
break
|
||||
else begin
|
||||
if (phpCreateNodes in Attr) then begin
|
||||
CurNode.EndPos:=LastAtoms.GetValueAt(0).EndPos;
|
||||
EndChildNode;
|
||||
end;
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
else
|
||||
ExtractNextAtom(not (phpWithoutParamList in Attr),Attr);
|
||||
end;
|
||||
until false;
|
||||
// read type
|
||||
if CurPos.Flag=cafColon then begin
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
else
|
||||
ExtractNextAtom([phpWithoutParamList,phpWithoutParamTypes]*Attr=[],
|
||||
Attr);
|
||||
if not ReadParamType(ExceptionOnError,Extract,Attr) then exit;
|
||||
if CurPos.Flag=cafEqual then begin
|
||||
// read default value
|
||||
ReadDefaultValue;
|
||||
end;
|
||||
end else begin
|
||||
// no type -> variant
|
||||
if (phpCreateNodes in Attr) then begin
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=ctnVariantType;
|
||||
CurNode.EndPos:=CurNode.StartPos;
|
||||
EndChildNode;
|
||||
end;
|
||||
end;
|
||||
until false;
|
||||
// read type
|
||||
if CurPos.Flag=cafColon then begin
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
else
|
||||
ExtractNextAtom([phpWithoutParamList,phpWithoutParamTypes]*Attr=[],
|
||||
Attr);
|
||||
if not ReadParamType(ExceptionOnError,Extract,Attr) then exit;
|
||||
if CurPos.Flag=cafEqual then begin
|
||||
// read default value
|
||||
ReadDefaultValue;
|
||||
end;
|
||||
end else begin
|
||||
// no type -> variant
|
||||
if (phpCreateNodes in Attr) then begin
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=ctnVariantType;
|
||||
CurNode.EndPos:=CurNode.StartPos;
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
EndChildNode;
|
||||
end;
|
||||
end;
|
||||
if (phpCreateNodes in Attr) then begin
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
EndChildNode;
|
||||
end;
|
||||
// read next parameter
|
||||
if (CurPos.StartPos>SrcLen) then
|
||||
if ExceptionOnError then
|
||||
@ -1097,7 +1143,7 @@ begin
|
||||
break;
|
||||
if (CurPos.Flag<>cafSemicolon) then
|
||||
if ExceptionOnError then
|
||||
RaiseCharExpectedButAtomFound(CloseBracket)
|
||||
RaiseCharExpectedButAtomFound(';')
|
||||
else exit;
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
@ -1200,10 +1246,6 @@ function TPascalParserTool.ReadTilProcedureHeadEnd(
|
||||
var HasForwardModifier: boolean): boolean;
|
||||
{ parse parameter list, result type, of object, method specifiers
|
||||
|
||||
IsMethod: true if parsing in a class/object
|
||||
IsFunction: 'function'
|
||||
IsType: parsing type definition. e.g. 'Event: procedure of object'
|
||||
|
||||
|
||||
examples:
|
||||
procedure ProcName; virtual; abstract;
|
||||
@ -1214,6 +1256,7 @@ function TPascalParserTool.ReadTilProcedureHeadEnd(
|
||||
function QWidget_mouseGrabber(): QWidgetH; cdecl;
|
||||
procedure Intf.Method = ImplementingMethodName;
|
||||
function CommitUrlCacheEntry; // only Delphi
|
||||
procedure MacProcName(c: char; ...); external;
|
||||
|
||||
proc specifiers without parameters:
|
||||
stdcall, virtual, abstract, dynamic, overload, override, cdecl, inline
|
||||
|
||||
Loading…
Reference in New Issue
Block a user