|
|
@@ -99,6 +99,9 @@ type
|
|
|
TProcType = (ptProcedure, ptFunction, ptOperator, ptConstructor, ptDestructor,
|
|
|
ptClassProcedure, ptClassFunction);
|
|
|
|
|
|
+
|
|
|
+ TExprKind = (ek_Normal, ek_PropertyIndex);
|
|
|
+
|
|
|
{ TPasParser }
|
|
|
|
|
|
TPasParser = class
|
|
|
@@ -121,11 +124,12 @@ type
|
|
|
AParent: TPasElement): TPasElement;overload;
|
|
|
function CreateElement(AClass: TPTreeElement; const AName: String;
|
|
|
AParent: TPasElement; AVisibility: TPasMemberVisibility): TPasElement;overload;
|
|
|
- Function IsHint(Const S : String; var AHint : TPasMemberHint) : Boolean;
|
|
|
+ Function IsCurTokenHint(out AHint : TPasMemberHint) : Boolean; overload;
|
|
|
+ Function IsCurTokenHint: Boolean; overload;
|
|
|
Function CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
|
|
|
|
|
|
- function ParseParams(paramskind: TPasExprKind): TParamsExpr;
|
|
|
- function ParseExpIdent: TPasExpr;
|
|
|
+ function ParseParams(AParent : TPasElement;paramskind: TPasExprKind): TParamsExpr;
|
|
|
+ function ParseExpIdent(AParent : TPasElement): TPasExpr;
|
|
|
public
|
|
|
Options : set of TPOptions;
|
|
|
CurModule: TPasModule;
|
|
|
@@ -143,9 +147,10 @@ type
|
|
|
function ParseComplexType(Parent : TPasElement = Nil): TPasType;
|
|
|
procedure ParseArrayType(Element: TPasArrayType);
|
|
|
procedure ParseFileType(Element: TPasFileType);
|
|
|
- function DoParseExpression(InitExpr: TPasExpr=nil): TPasExpr;
|
|
|
- function DoParseConstValueExpression: TPasExpr;
|
|
|
- function ParseExpression: String;
|
|
|
+ function isEndOfExp: Boolean;
|
|
|
+ function DoParseExpression(Aparent : TPaselement;InitExpr: TPasExpr=nil): TPasExpr;
|
|
|
+ function DoParseConstValueExpression(AParent : TPasElement): TPasExpr;
|
|
|
+ function ParseExpression(AParent : TPaselement; Kind: TExprKind=ek_Normal): String;
|
|
|
function ParseCommand: String; // single, not compound command like begin..end
|
|
|
procedure AddProcOrFunction(Declarations: TPasDeclarations; AProc: TPasProcedure);
|
|
|
function CheckIfOverloaded(AOwner: TPasClassType;
|
|
|
@@ -231,7 +236,7 @@ end;
|
|
|
|
|
|
procedure TPasParser.ParseExc(const Msg: String);
|
|
|
begin
|
|
|
- raise EParserError.Create(Format(SParserErrorAtToken, [Msg, CurTokenName]),
|
|
|
+ raise EParserError.Create(Format(SParserErrorAtToken, [Msg, CurTokenName]) {$ifdef addlocation}+' ('+inttostr(scanner.currow)+' '+inttostr(scanner.curcolumn)+')'{$endif},
|
|
|
Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn);
|
|
|
end;
|
|
|
|
|
|
@@ -340,30 +345,37 @@ begin
|
|
|
Result:=ParseType(Parent,'');
|
|
|
end;
|
|
|
|
|
|
-Function TPasParser.IsHint(Const S : String; var AHint : TPasMemberHint) : Boolean;
|
|
|
-
|
|
|
+Function TPasParser.IsCurTokenHint(out AHint : TPasMemberHint) : Boolean;
|
|
|
Var
|
|
|
T : string;
|
|
|
-
|
|
|
begin
|
|
|
- T:=LowerCase(S);
|
|
|
- Result:=(T='deprecated');
|
|
|
- If Result then
|
|
|
- Ahint:=hDeprecated
|
|
|
- else
|
|
|
+ if CurToken=tklibrary then
|
|
|
begin
|
|
|
- Result:=(T='library');
|
|
|
- if Result then
|
|
|
- Ahint:=hLibrary
|
|
|
- else
|
|
|
- begin
|
|
|
- Result:=(T='platform');
|
|
|
- If result then
|
|
|
- AHint:=hPlatform;
|
|
|
- end;
|
|
|
- end;
|
|
|
+ AHint:=hLibrary;
|
|
|
+ Result:=True;
|
|
|
+ end
|
|
|
+ else if CurToken=tkIdentifier then
|
|
|
+ begin
|
|
|
+ T:=LowerCase(CurTokenString);
|
|
|
+ Result:=True;
|
|
|
+ if (T='deprecated') then ahint:=hDeprecated
|
|
|
+ else if (T='platform') then ahint:=hPlatform
|
|
|
+ else if (T='experimental') then ahint:=hExperimental
|
|
|
+ else if (T='unimplemented') then ahint:=hUnimplemented
|
|
|
+ else Result:=False;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ Result:=False;
|
|
|
+end;
|
|
|
+
|
|
|
+Function TPasParser.IsCurTokenHint: Boolean;
|
|
|
+var
|
|
|
+ dummy : TPasMemberHint;
|
|
|
+begin
|
|
|
+ Result:=IsCurTokenHint(dummy);
|
|
|
end;
|
|
|
|
|
|
+
|
|
|
Function TPasParser.CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
|
|
|
|
|
|
Var
|
|
|
@@ -374,7 +386,7 @@ begin
|
|
|
Result:=[];
|
|
|
Repeat
|
|
|
NextToken;
|
|
|
- Found:=IsHint(CurTokenString,h);
|
|
|
+ Found:=IsCurTokenHint(h);
|
|
|
If Found then
|
|
|
Include(Result,h)
|
|
|
Until Not Found;
|
|
|
@@ -391,9 +403,9 @@ function TPasParser.ParseType(Parent: TPasElement; Prefix : String): TPasType;
|
|
|
begin
|
|
|
Result := TPasRangeType(CreateElement(TPasRangeType, '', Parent));
|
|
|
try
|
|
|
- TPasRangeType(Result).RangeStart := ParseExpression;
|
|
|
+ TPasRangeType(Result).RangeStart := ParseExpression(Result);
|
|
|
ExpectToken(tkDotDot);
|
|
|
- TPasRangeType(Result).RangeEnd := ParseExpression;
|
|
|
+ TPasRangeType(Result).RangeEnd := ParseExpression(Result);
|
|
|
except
|
|
|
Result.Free;
|
|
|
raise;
|
|
|
@@ -479,6 +491,7 @@ begin
|
|
|
tkFile:
|
|
|
begin
|
|
|
Result := TPasFileType(CreateElement(TPasFileType, '', Parent));
|
|
|
+ ParseFileType(TPasFileType(Result));
|
|
|
end;
|
|
|
tkArray:
|
|
|
begin
|
|
|
@@ -500,7 +513,7 @@ begin
|
|
|
break
|
|
|
else if CurToken in [tkEqual,tkAssign] then
|
|
|
begin
|
|
|
- EnumValue.AssignedValue:=ParseExpression;
|
|
|
+ EnumValue.AssignedValue:=ParseExpression(Result);
|
|
|
NextToken;
|
|
|
if CurToken = tkBraceClose then
|
|
|
Break
|
|
|
@@ -577,7 +590,7 @@ begin
|
|
|
Result := TPasProcedureType(CreateElement(TPasProcedureType, '', Parent));
|
|
|
ParseProcedureOrFunctionHeader(Result,
|
|
|
TPasProcedureType(Result), ptProcedure, True);
|
|
|
- UngetToken; // Unget semicolon
|
|
|
+ if CurToken = tkSemicolon then UngetToken; // Unget semicolon
|
|
|
end;
|
|
|
tkFunction:
|
|
|
begin
|
|
|
@@ -638,17 +651,22 @@ procedure TPasParser.ParseFileType(Element: TPasFileType);
|
|
|
begin
|
|
|
NextToken;
|
|
|
If CurToken=tkOf then
|
|
|
- Element.ElType := ParseType(nil);
|
|
|
+ Element.ElType := ParseType(nil)
|
|
|
+ else
|
|
|
+ ungettoken;
|
|
|
end;
|
|
|
|
|
|
+function TPasParser.isEndOfExp:Boolean;
|
|
|
const
|
|
|
EndExprToken = [
|
|
|
tkEOF, tkBraceClose, tkSquaredBraceClose, tkSemicolon, tkComma, tkColon,
|
|
|
tkdo, tkdownto, tkelse, tkend, tkof, tkthen, tkto
|
|
|
];
|
|
|
+begin
|
|
|
+ Result:=(CurToken in EndExprToken) or IsCurTokenHint;
|
|
|
+end;
|
|
|
|
|
|
-
|
|
|
-function TPasParser.ParseParams(paramskind: TPasExprKind): TParamsExpr;
|
|
|
+function TPasParser.ParseParams(AParent: TPasElement;paramskind: TPasExprKind): TParamsExpr;
|
|
|
var
|
|
|
params : TParamsExpr;
|
|
|
p : TPasExpr;
|
|
|
@@ -663,12 +681,12 @@ begin
|
|
|
PClose:=tkBraceClose;
|
|
|
end;
|
|
|
|
|
|
- params:=TParamsExpr.Create(paramskind);
|
|
|
+ params:=TParamsExpr.Create(AParent,paramskind);
|
|
|
try
|
|
|
NextToken;
|
|
|
- if not (CurToken in EndExprToken) then begin
|
|
|
+ if not isEndOfExp then begin
|
|
|
repeat
|
|
|
- p:=DoParseExpression;
|
|
|
+ p:=DoParseExpression(AParent);
|
|
|
if not Assigned(p) then Exit; // bad param syntax
|
|
|
params.AddParam(p);
|
|
|
|
|
|
@@ -727,7 +745,7 @@ begin
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
-function TPasParser.ParseExpIdent:TPasExpr;
|
|
|
+function TPasParser.ParseExpIdent(AParent : TPasElement):TPasExpr;
|
|
|
var
|
|
|
x : TPasExpr;
|
|
|
prm : TParamsExpr;
|
|
|
@@ -737,13 +755,22 @@ var
|
|
|
begin
|
|
|
Result:=nil;
|
|
|
case CurToken of
|
|
|
- tkString: x:=TPrimitiveExpr.Create(pekString, CurTokenString);
|
|
|
- tkChar: x:=TPrimitiveExpr.Create(pekString, CurTokenText);
|
|
|
- tkNumber: x:=TPrimitiveExpr.Create(pekNumber, CurTokenString);
|
|
|
- tkIdentifier: x:=TPrimitiveExpr.Create(pekIdent, CurTokenText);
|
|
|
- tkfalse, tktrue: x:=TBoolConstExpr.Create(pekBoolConst, CurToken=tktrue);
|
|
|
- tknil: x:=TNilExpr.Create;
|
|
|
- tkSquaredBraceOpen: x:=ParseParams(pekSet);
|
|
|
+ tkString: x:=TPrimitiveExpr.Create(AParent,pekString, CurTokenString);
|
|
|
+ tkChar: x:=TPrimitiveExpr.Create(AParent,pekString, CurTokenText);
|
|
|
+ tkNumber: x:=TPrimitiveExpr.Create(AParent,pekNumber, CurTokenString);
|
|
|
+ tkIdentifier: x:=TPrimitiveExpr.Create(AParent,pekIdent, CurTokenText);
|
|
|
+ tkfalse, tktrue: x:=TBoolConstExpr.Create(Aparent,pekBoolConst, CurToken=tktrue);
|
|
|
+ tknil: x:=TNilExpr.Create(Aparent);
|
|
|
+ tkSquaredBraceOpen: x:=ParseParams(AParent,pekSet);
|
|
|
+ tkCaret: begin
|
|
|
+ // ^A..^_ characters. See #16341
|
|
|
+ NextToken;
|
|
|
+ if not (length(CurTokenText)=1) or not (CurTokenText[1] in ['A'..'_']) then begin
|
|
|
+ UngetToken;
|
|
|
+ ParseExc(SParserExpectedIdentifier);
|
|
|
+ end;
|
|
|
+ x:=TPrimitiveExpr.Create(AParent,pekString, '^'+CurTokenText);
|
|
|
+ end;
|
|
|
else
|
|
|
ParseExc(SParserExpectedIdentifier);
|
|
|
end;
|
|
|
@@ -755,19 +782,19 @@ begin
|
|
|
while CurToken in [tkBraceOpen, tkSquaredBraceOpen, tkCaret] do
|
|
|
case CurToken of
|
|
|
tkBraceOpen: begin
|
|
|
- prm:=ParseParams(pekFuncParams);
|
|
|
+ prm:=ParseParams(AParent,pekFuncParams);
|
|
|
if not Assigned(prm) then Exit;
|
|
|
prm.Value:=x;
|
|
|
x:=prm;
|
|
|
end;
|
|
|
tkSquaredBraceOpen: begin
|
|
|
- prm:=ParseParams(pekArrayParams);
|
|
|
+ prm:=ParseParams(AParent,pekArrayParams);
|
|
|
if not Assigned(prm) then Exit;
|
|
|
prm.Value:=x;
|
|
|
x:=prm;
|
|
|
end;
|
|
|
tkCaret: begin
|
|
|
- u:=TUnaryExpr.Create(x, TokenToExprOp(CurToken));
|
|
|
+ u:=TUnaryExpr.Create(AParent,x, TokenToExprOp(CurToken));
|
|
|
x:=u;
|
|
|
NextToken;
|
|
|
end;
|
|
|
@@ -776,7 +803,7 @@ begin
|
|
|
if CurToken in [tkDot, tkas] then begin
|
|
|
optk:=CurToken;
|
|
|
NextToken;
|
|
|
- b:=TBinaryExpr.Create(x, ParseExpIdent(), TokenToExprOp(optk));
|
|
|
+ b:=TBinaryExpr.Create(AParent,x, ParseExpIdent(AParent), TokenToExprOp(optk));
|
|
|
if not Assigned(b.right) then Exit; // error
|
|
|
x:=b;
|
|
|
end;
|
|
|
@@ -784,7 +811,7 @@ begin
|
|
|
|
|
|
if CurToken = tkDotDot then begin
|
|
|
NextToken;
|
|
|
- b:=TBinaryExpr.CreateRange(x, DoParseExpression);
|
|
|
+ b:=TBinaryExpr.CreateRange(AParent,x, DoParseExpression(AParent));
|
|
|
if not Assigned(b.right) then Exit; // error
|
|
|
x:=b;
|
|
|
end;
|
|
|
@@ -811,7 +838,7 @@ begin
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
-function TPasParser.DoParseExpression(InitExpr: TPasExpr): TPasExpr;
|
|
|
+function TPasParser.DoParseExpression(Aparent : TPaselement;InitExpr: TPasExpr): TPasExpr;
|
|
|
var
|
|
|
expstack : TList;
|
|
|
opstack : TList;
|
|
|
@@ -819,10 +846,15 @@ var
|
|
|
x : TPasExpr;
|
|
|
i : Integer;
|
|
|
tempop : TToken;
|
|
|
- AllowEnd : Boolean;
|
|
|
+ NotBinary : Boolean;
|
|
|
|
|
|
const
|
|
|
PrefixSym = [tkPlus, tkMinus, tknot, tkAt]; // + - not @
|
|
|
+ BinaryOP = [tkMul, tkDivision, tkdiv, tkmod,
|
|
|
+ tkand, tkShl,tkShr, tkas, tkPower,
|
|
|
+ tkPlus, tkMinus, tkor, tkxor, tkSymmetricalDifference,
|
|
|
+ tkEqual, tkNotEqual, tkLessThan, tkLessEqualThan,
|
|
|
+ tkGreaterThan, tkGreaterEqualThan, tkin, tkis];
|
|
|
|
|
|
function PopExp: TPasExpr; inline;
|
|
|
begin
|
|
|
@@ -859,7 +891,7 @@ const
|
|
|
t:=PopOper;
|
|
|
xright:=PopExp;
|
|
|
xleft:=PopExp;
|
|
|
- expstack.Add(TBinaryExpr.Create(xleft, xright, TokenToExprOp(t)));
|
|
|
+ expstack.Add(TBinaryExpr.Create(AParent,xleft, xright, TokenToExprOp(t)));
|
|
|
end;
|
|
|
|
|
|
begin
|
|
|
@@ -868,7 +900,7 @@ begin
|
|
|
opstack := TList.Create;
|
|
|
try
|
|
|
repeat
|
|
|
- AllowEnd:=True;
|
|
|
+ NotBinary:=True;
|
|
|
pcount:=0;
|
|
|
|
|
|
if not Assigned(InitExpr) then
|
|
|
@@ -894,18 +926,18 @@ begin
|
|
|
|
|
|
if CurToken = tkBraceOpen then begin
|
|
|
NextToken;
|
|
|
- x:=DoParseExpression();
|
|
|
+ x:=DoParseExpression(AParent);
|
|
|
if CurToken<>tkBraceClose then Exit;
|
|
|
NextToken;
|
|
|
end else begin
|
|
|
- x:=ParseExpIdent;
|
|
|
+ x:=ParseExpIdent(AParent);
|
|
|
end;
|
|
|
|
|
|
if not Assigned(x) then Exit;
|
|
|
expstack.Add(x);
|
|
|
for i:=1 to pcount do begin
|
|
|
tempop:=PopOper;
|
|
|
- expstack.Add( TUnaryExpr.Create( PopExp, TokenToExprOp(tempop) ));
|
|
|
+ expstack.Add( TUnaryExpr.Create(AParent, PopExp, TokenToExprOp(tempop) ));
|
|
|
end;
|
|
|
|
|
|
end else
|
|
|
@@ -914,9 +946,9 @@ begin
|
|
|
InitExpr:=nil;
|
|
|
end;
|
|
|
|
|
|
- if not (CurToken in EndExprToken) then begin
|
|
|
+ if (CurToken in BinaryOP) then begin
|
|
|
// Adjusting order of the operations
|
|
|
- AllowEnd:=False;
|
|
|
+ NotBinary:=False;
|
|
|
tempop:=PeekOper;
|
|
|
while (opstack.Count>0) and (OpLevel(tempop)>=OpLevel(CurToken)) do begin
|
|
|
PopAndPushOperator;
|
|
|
@@ -926,7 +958,9 @@ begin
|
|
|
NextToken;
|
|
|
end;
|
|
|
|
|
|
- until AllowEnd and (CurToken in EndExprToken);
|
|
|
+ until NotBinary or isEndOfExp;
|
|
|
+
|
|
|
+ if not NotBinary then ParseExc(SParserExpectedIdentifier);
|
|
|
|
|
|
while opstack.Count>0 do PopAndPushOperator;
|
|
|
|
|
|
@@ -944,10 +978,11 @@ begin
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
-function TPasParser.ParseExpression: String;
|
|
|
+function TPasParser.ParseExpression(Aparent : TPaselement;Kind: TExprKind): String;
|
|
|
var
|
|
|
BracketLevel: Integer;
|
|
|
LastTokenWasWord: Boolean;
|
|
|
+ ls: String;
|
|
|
begin
|
|
|
SetLength(Result, 0);
|
|
|
BracketLevel := 0;
|
|
|
@@ -964,11 +999,21 @@ begin
|
|
|
if BracketLevel = 0 then
|
|
|
break;
|
|
|
Dec(BracketLevel);
|
|
|
- end else if (BracketLevel = 0) and (CurToken in [tkComma, tkSemicolon,
|
|
|
- tkColon, tkDotDot, tkthen, tkend, tkelse, tkuntil, tkfinally, tkexcept,
|
|
|
- tkof, tkbegin, tkdo, tkto, tkdownto, tkinitialization, tkfinalization])
|
|
|
- then
|
|
|
- break;
|
|
|
+ end else if (BracketLevel = 0) then
|
|
|
+ begin
|
|
|
+ if (CurToken in [tkComma, tkSemicolon,
|
|
|
+ tkColon, tkDotDot, tkthen, tkend, tkelse, tkuntil, tkfinally, tkexcept,
|
|
|
+ tkof, tkbegin, tkdo, tkto, tkdownto, tkinitialization, tkfinalization])
|
|
|
+ then
|
|
|
+ break;
|
|
|
+
|
|
|
+ if (Kind=ek_PropertyIndex) and (CurToken=tkIdentifier) then begin
|
|
|
+ ls:=LowerCase(CurTokenText);
|
|
|
+ if (ls='read') or (ls ='write') or (ls='default') or (ls='nodefault') or (ls='implements') then
|
|
|
+ Break;
|
|
|
+ end;
|
|
|
+
|
|
|
+ end;
|
|
|
|
|
|
if (CurTokenString<>'') and IsIdentStart[CurTokenString[1]] then
|
|
|
begin
|
|
|
@@ -1000,26 +1045,41 @@ begin
|
|
|
Result:='';
|
|
|
end;
|
|
|
|
|
|
-function TPasParser.DoParseConstValueExpression: TPasExpr;
|
|
|
+function TPasParser.DoParseConstValueExpression(Aparent : TPaselement): TPasExpr;
|
|
|
var
|
|
|
x : TPasExpr;
|
|
|
n : AnsiString;
|
|
|
r : TRecordValues;
|
|
|
a : TArrayValues;
|
|
|
+
|
|
|
+function lastfield:boolean;
|
|
|
+
|
|
|
+begin
|
|
|
+ result:= CurToken<>tkSemicolon;
|
|
|
+ if not result then
|
|
|
+ begin
|
|
|
+ nexttoken;
|
|
|
+ if curtoken=tkbraceclose then
|
|
|
+ result:=true
|
|
|
+ else
|
|
|
+ ungettoken;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
begin
|
|
|
if CurToken <> tkBraceOpen then
|
|
|
- Result:=DoParseExpression
|
|
|
+ Result:=DoParseExpression(AParent)
|
|
|
else begin
|
|
|
NextToken;
|
|
|
- x:=DoParseConstValueExpression();
|
|
|
+ x:=DoParseConstValueExpression(Aparent);
|
|
|
case CurToken of
|
|
|
tkComma: // array of values (a,b,c);
|
|
|
begin
|
|
|
- a:=TArrayValues.Create;
|
|
|
+ a:=TArrayValues.Create(AParent);
|
|
|
a.AddValues(x);
|
|
|
repeat
|
|
|
NextToken;
|
|
|
- x:=DoParseConstValueExpression();
|
|
|
+ x:=DoParseConstValueExpression(AParent);
|
|
|
a.AddValues(x);
|
|
|
until CurToken<>tkComma;
|
|
|
Result:=a;
|
|
|
@@ -1029,23 +1089,23 @@ begin
|
|
|
begin
|
|
|
n:=GetExprIdent(x);
|
|
|
x.Free;
|
|
|
- r:=TRecordValues.Create;
|
|
|
+ r:=TRecordValues.Create(AParent);
|
|
|
NextToken;
|
|
|
- x:=DoParseConstValueExpression();
|
|
|
+ x:=DoParseConstValueExpression(AParent);
|
|
|
r.AddField(n, x);
|
|
|
- if CurToken=tkSemicolon then
|
|
|
+ if not lastfield then
|
|
|
repeat
|
|
|
n:=ExpectIdentifier;
|
|
|
ExpectToken(tkColon);
|
|
|
NextToken;
|
|
|
- x:=DoParseConstValueExpression();
|
|
|
+ x:=DoParseConstValueExpression(AParent);
|
|
|
r.AddField(n, x)
|
|
|
- until CurToken<>tkSemicolon;
|
|
|
+ until lastfield; // CurToken<>tkSemicolon;
|
|
|
Result:=r;
|
|
|
end;
|
|
|
else
|
|
|
// Binary expression! ((128 div sizeof(longint)) - 3); ;
|
|
|
- Result:=DoParseExpression(x);
|
|
|
+ Result:=DoParseExpression(AParent,x);
|
|
|
end;
|
|
|
if CurToken<>tkBraceClose then ParseExc(SParserExpectedCommaRBracket);
|
|
|
NextToken;
|
|
|
@@ -1182,7 +1242,8 @@ begin
|
|
|
Module.PackageName := Engine.Package.Name;
|
|
|
Engine.Package.Modules.Add(Module);
|
|
|
end;
|
|
|
- ExpectToken(tkSemicolon);
|
|
|
+ CheckHint(Module,True);
|
|
|
+// ExpectToken(tkSemicolon);
|
|
|
ExpectToken(tkInterface);
|
|
|
ParseInterface;
|
|
|
finally
|
|
|
@@ -1491,7 +1552,7 @@ begin
|
|
|
begin
|
|
|
AUnitName := ExpectIdentifier;
|
|
|
|
|
|
- Element := Engine.FindModule(AUnitName);
|
|
|
+ Element := Engine.FindModule(AUnitName); // should we resolve module here when "IN" filename is not known yet?
|
|
|
if Assigned(Element) then
|
|
|
Element.AddRef
|
|
|
else
|
|
|
@@ -1505,6 +1566,8 @@ begin
|
|
|
// todo: store unit's file name somewhere
|
|
|
NextToken; // skip in
|
|
|
ExpectToken(tkString); // skip unit's real file name
|
|
|
+ if (Element is TPasModule) and (TPasmodule(Element).filename<>'') then
|
|
|
+ TPasModule(Element).FileName:=curtokenstring;
|
|
|
end;
|
|
|
|
|
|
if CurToken = tkSemicolon then
|
|
|
@@ -1532,7 +1595,7 @@ begin
|
|
|
|
|
|
// using new expression parser!
|
|
|
NextToken; // skip tkEqual
|
|
|
- Result.Expr:=DoParseConstValueExpression;
|
|
|
+ Result.Expr:=DoParseConstValueExpression(Result);
|
|
|
|
|
|
// must unget for the check to be peformed fine!
|
|
|
UngetToken;
|
|
|
@@ -1550,7 +1613,7 @@ begin
|
|
|
Result := TPasResString(CreateElement(TPasResString, CurTokenString, Parent));
|
|
|
try
|
|
|
ExpectToken(tkEqual);
|
|
|
- Result.Value := ParseExpression;
|
|
|
+ Result.Value := ParseExpression(Result);
|
|
|
CheckHint(Result,True);
|
|
|
except
|
|
|
Result.Free;
|
|
|
@@ -1567,9 +1630,9 @@ var
|
|
|
begin
|
|
|
Result := TPasRangeType(CreateElement(TPasRangeType, TypeName, Parent));
|
|
|
try
|
|
|
- TPasRangeType(Result).RangeStart := ParseExpression;
|
|
|
+ TPasRangeType(Result).RangeStart := ParseExpression(Result);
|
|
|
ExpectToken(tkDotDot);
|
|
|
- TPasRangeType(Result).RangeEnd := ParseExpression;
|
|
|
+ TPasRangeType(Result).RangeEnd := ParseExpression(Result);
|
|
|
CheckHint(Result,True);
|
|
|
except
|
|
|
Result.Free;
|
|
|
@@ -1582,7 +1645,6 @@ var
|
|
|
Prefix : String;
|
|
|
HadPackedModifier : Boolean; // 12/04/04 - Dave - Added
|
|
|
IsBitPacked : Boolean;
|
|
|
- H : TPasMemberHint;
|
|
|
|
|
|
begin
|
|
|
TypeName := CurTokenString;
|
|
|
@@ -1651,7 +1713,7 @@ begin
|
|
|
end
|
|
|
else
|
|
|
Prefix:='';
|
|
|
- if (CurToken = tkSemicolon) or IsHint(CurtokenString,h)then
|
|
|
+ if (CurToken = tkSemicolon) or IsCurTokenHint then
|
|
|
begin
|
|
|
UngetToken;
|
|
|
UngetToken;
|
|
|
@@ -1672,7 +1734,7 @@ begin
|
|
|
try
|
|
|
TPasAliasType(Result).DestType :=
|
|
|
TPasUnresolvedTypeRef.Create(CurTokenString, Parent);
|
|
|
- ParseExpression;
|
|
|
+ ParseExpression(Parent);
|
|
|
ExpectToken(tkSquaredBraceClose);
|
|
|
CheckHint(Result,True);
|
|
|
except
|
|
|
@@ -1737,7 +1799,7 @@ begin
|
|
|
break
|
|
|
else if CurToken in [tkEqual,tkAssign] then
|
|
|
begin
|
|
|
- EnumValue.AssignedValue:=ParseExpression;
|
|
|
+ EnumValue.AssignedValue:=ParseExpression(result);
|
|
|
NextToken;
|
|
|
if CurToken = tkBraceClose then
|
|
|
Break
|
|
|
@@ -1885,7 +1947,7 @@ begin
|
|
|
// Writeln(LastVar,': Parsed complex type, next: ',CurtokenText);
|
|
|
If CurToken=tkEqual then
|
|
|
begin
|
|
|
- Value := ParseExpression;
|
|
|
+ Value := ParseExpression(Parent);
|
|
|
for i := 0 to List.Count - 1 do
|
|
|
TPasVariable(List[i]).Value := Value;
|
|
|
NextToken;
|
|
|
@@ -2032,7 +2094,7 @@ begin
|
|
|
NextToken;
|
|
|
if CurToken = tkEqual then
|
|
|
begin
|
|
|
- Value := ParseExpression;
|
|
|
+ Value := ParseExpression(Parent);
|
|
|
end else
|
|
|
UngetToken;
|
|
|
end;
|
|
|
@@ -2059,11 +2121,19 @@ end;
|
|
|
// will get the token after the final ";" as next token.
|
|
|
procedure TPasParser.ParseProcedureOrFunctionHeader(Parent: TPasElement;
|
|
|
Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
|
|
|
+
|
|
|
+procedure ConsumeSemi;
|
|
|
+begin
|
|
|
+ NextToken;
|
|
|
+ if (CurToken <> tksemicolon) and IsCurTokenHint then
|
|
|
+ ungettoken;
|
|
|
+end;
|
|
|
+
|
|
|
Var
|
|
|
Tok : String;
|
|
|
i: Integer;
|
|
|
Proc: TPasProcedure;
|
|
|
-
|
|
|
+ ahint : TPasMemberHint;
|
|
|
begin
|
|
|
NextToken;
|
|
|
case ProcType of
|
|
|
@@ -2142,12 +2212,11 @@ begin
|
|
|
UngetToken;
|
|
|
|
|
|
ExpectToken(tkSemicolon);
|
|
|
-
|
|
|
while True do
|
|
|
begin
|
|
|
// CheckHint(Element,False);
|
|
|
NextToken;
|
|
|
- if (CurToken = tkIdentifier) then
|
|
|
+ if (CurToken = tkIdentifier) or (CurToken=tklibrary) then // library is a token and a directive.
|
|
|
begin
|
|
|
Tok:=UpperCase(CurTokenString);
|
|
|
If (Tok='CDECL') then
|
|
|
@@ -2214,20 +2283,10 @@ begin
|
|
|
TPasProcedure(Parent).AddModifier(pmVarArgs);
|
|
|
ExpectToken(tkSemicolon);
|
|
|
end
|
|
|
- else if (tok='DEPRECATED') then
|
|
|
- begin
|
|
|
- element.hints:=element.hints+[hDeprecated];
|
|
|
- ExpectToken(tkSemicolon);
|
|
|
- end
|
|
|
- else if (tok='PLATFORM') then
|
|
|
- begin
|
|
|
- element.hints:=element.hints+[hPlatform];
|
|
|
- ExpectToken(tkSemicolon);
|
|
|
- end
|
|
|
- else if (tok='LIBRARY') then
|
|
|
+ else if IsCurTokenHint(ahint) then // deprecated,platform,experimental,library, unimplemented etc
|
|
|
begin
|
|
|
- element.hints:=element.hints+[hLibrary];
|
|
|
- ExpectToken(tkSemicolon);
|
|
|
+ element.hints:=element.hints+[ahint];
|
|
|
+ consumesemi;
|
|
|
end
|
|
|
else if (tok='OVERLOAD') then
|
|
|
begin
|
|
|
@@ -2337,6 +2396,9 @@ end;
|
|
|
|
|
|
procedure TPasParser.ParseProperty(Element:TPasElement);
|
|
|
|
|
|
+var
|
|
|
+ isArray : Boolean;
|
|
|
+
|
|
|
procedure MaybeReadFullyQualifiedIdentifier(Var r : String);
|
|
|
|
|
|
begin
|
|
|
@@ -2372,11 +2434,16 @@ procedure TPasParser.ParseProperty(Element:TPasElement);
|
|
|
//writeln(Result);
|
|
|
end;
|
|
|
|
|
|
+var
|
|
|
+ us : String;
|
|
|
+ h : TPasMemberHint;
|
|
|
begin
|
|
|
-
|
|
|
+ isArray:=False;
|
|
|
NextToken;
|
|
|
// if array prop then parse [ arg1:type1;... ]
|
|
|
+
|
|
|
if CurToken = tkSquaredBraceOpen then begin
|
|
|
+ isArray:=True;
|
|
|
// !!!: Parse array properties correctly
|
|
|
ParseArgList(Element, TPasProperty(Element).Args, tkSquaredBraceClose);
|
|
|
NextToken;
|
|
|
@@ -2391,10 +2458,10 @@ begin
|
|
|
|
|
|
if CurToken <> tkSemicolon then begin
|
|
|
// if indexed prop then read the index value
|
|
|
- if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'INDEX') then
|
|
|
+ if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'INDEX') then begin
|
|
|
// read 'index' access modifier
|
|
|
- TPasProperty(Element).IndexValue := ParseExpression
|
|
|
- else
|
|
|
+ TPasProperty(Element).IndexValue := ParseExpression(Element,ek_PropertyIndex);
|
|
|
+ end else
|
|
|
// not indexed prop will be recheck for another token
|
|
|
UngetToken;
|
|
|
|
|
|
@@ -2449,24 +2516,19 @@ begin
|
|
|
end;
|
|
|
|
|
|
// if the specifiers list is not finished
|
|
|
- if CurToken <> tkSemicolon then begin
|
|
|
- if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'DEFAULT') then
|
|
|
+ if (CurToken <> tkSemicolon) and (CurToken = tkIdentifier) then begin
|
|
|
+ us:=UpperCase(CurTokenText);
|
|
|
+ if (us = 'DEFAULT') then begin
|
|
|
+ if isArray then ParseExc('Array properties cannot have default value');
|
|
|
// read 'default' value modifier -> ParseExpression(DEFAULT <value>)
|
|
|
- TPasProperty(Element).DefaultValue := ParseExpression
|
|
|
- else
|
|
|
-// not "default <value>" prop will be recheck for another token
|
|
|
- UngetToken;
|
|
|
-
|
|
|
- NextToken;
|
|
|
- end;
|
|
|
-
|
|
|
-// if the specifiers list is not finished
|
|
|
- if CurToken <> tkSemicolon then begin
|
|
|
- if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'NODEFAULT') then begin
|
|
|
+ TPasProperty(Element).DefaultValue := ParseExpression(Element);
|
|
|
+ NextToken;
|
|
|
+ end else if (us = 'NODEFAULT') then begin
|
|
|
// read 'nodefault' modifier
|
|
|
TPasProperty(Element).IsNodefault:=true;
|
|
|
- end;
|
|
|
-// stop recheck for specifiers - start from next token
|
|
|
+ end else
|
|
|
+// not "default <value>" prop will be recheck for another token
|
|
|
+ UngetToken;
|
|
|
NextToken;
|
|
|
end;
|
|
|
|
|
|
@@ -2477,55 +2539,28 @@ begin
|
|
|
end;
|
|
|
|
|
|
if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'DEFAULT') then begin
|
|
|
+ if not isArray then ParseExc('The default property must be an array property');
|
|
|
// what is after DEFAULT token at the end
|
|
|
NextToken;
|
|
|
if CurToken = tkSemicolon then begin
|
|
|
// ";" then DEFAULT=prop
|
|
|
TPasProperty(Element).IsDefault := True;
|
|
|
- UngetToken;
|
|
|
- end else begin
|
|
|
-// "!;" then a step back to get phrase "DEFAULT <value>"
|
|
|
- UngetToken;
|
|
|
-// DefaultValue -> ParseExpression(DEFAULT <value>) and stay on the <value>
|
|
|
- TPasProperty(Element).DefaultValue := ParseExpression;
|
|
|
- end;
|
|
|
-
|
|
|
-//!! there may be DEPRECATED token
|
|
|
- CheckHint(Element,False);
|
|
|
- NextToken;
|
|
|
-
|
|
|
+ NextToken;
|
|
|
+ end
|
|
|
end;
|
|
|
-
|
|
|
-// after DEFAULT may be a ";"
|
|
|
- if CurToken = tkSemicolon then begin
|
|
|
- // read semicolon
|
|
|
+
|
|
|
+ while IsCurTokenHint(h) do begin
|
|
|
+ Element.Hints:=Element.Hints+[h];
|
|
|
NextToken;
|
|
|
- end;
|
|
|
-
|
|
|
- if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'DEPRECATED') then begin
|
|
|
-// nothing to do on DEPRECATED - just to accept
|
|
|
-// NextToken;
|
|
|
- end else
|
|
|
- UngetToken;;
|
|
|
-
|
|
|
-//!! else
|
|
|
-// not DEFAULT prop accessor will be recheck for another token
|
|
|
-//!! UngetToken;
|
|
|
+ // there can be multiple hints, separated by the, i.e.:
|
|
|
+ // property Prop: integer read FMyProp write FMyProp; platform; library deprecated;
|
|
|
+ if CurToken=tkSemicolon then
|
|
|
+ NextToken;
|
|
|
+ end;
|
|
|
|
|
|
-{
|
|
|
- if CurToken = tkSemicolon then begin
|
|
|
- // read semicolon
|
|
|
- NextToken;
|
|
|
- end;
|
|
|
- if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'DEPRECATED') then begin
|
|
|
-// nothing to do - just to process
|
|
|
- NextToken;
|
|
|
- end;
|
|
|
- if CurToken = tkSemicolon then begin
|
|
|
- // read semicolon
|
|
|
- NextToken;
|
|
|
- end;
|
|
|
-}
|
|
|
+ // property parsing must finish at the LAST Semicolon of the property
|
|
|
+ // since we're parsing "one-step" ahead of the semicolon. we must return one-step
|
|
|
+ UngetToken;
|
|
|
end;
|
|
|
|
|
|
// Starts after the "begin" token
|
|
|
@@ -2620,7 +2655,7 @@ begin
|
|
|
CreateBlock(CurBlock.AddRepeatUntil);
|
|
|
tkIf:
|
|
|
begin
|
|
|
- Condition:=ParseExpression;
|
|
|
+ Condition:=ParseExpression(Parent);
|
|
|
//WriteLn(i,'IF Condition="',Condition,'" Token=',CurTokenText);
|
|
|
CreateBlock(CurBlock.AddIfElse(Condition));
|
|
|
ExpectToken(tkthen);
|
|
|
@@ -2642,7 +2677,7 @@ begin
|
|
|
tkwhile:
|
|
|
begin
|
|
|
// while Condition do
|
|
|
- Condition:=ParseExpression;
|
|
|
+ Condition:=ParseExpression(Parent);
|
|
|
//WriteLn(i,'WHILE Condition="',Condition,'" Token=',CurTokenText);
|
|
|
CreateBlock(CurBlock.AddWhileDo(Condition));
|
|
|
ExpectToken(tkdo);
|
|
|
@@ -2653,7 +2688,7 @@ begin
|
|
|
ExpectIdentifier;
|
|
|
VarName:=CurTokenString;
|
|
|
ExpectToken(tkAssign);
|
|
|
- StartValue:=ParseExpression;
|
|
|
+ StartValue:=ParseExpression(Parent);
|
|
|
//writeln(i,'FOR Start=',StartValue);
|
|
|
NextToken;
|
|
|
if CurToken=tkTo then
|
|
|
@@ -2662,7 +2697,7 @@ begin
|
|
|
ForDownTo:=true
|
|
|
else
|
|
|
ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkTo]]));
|
|
|
- EndValue:=ParseExpression;
|
|
|
+ EndValue:=ParseExpression(Parent);
|
|
|
CreateBlock(CurBlock.AddForLoop(VarName,StartValue,EndValue,ForDownTo));
|
|
|
//WriteLn(i,'FOR "',VarName,'" := ',StartValue,' to ',EndValue,' Token=',CurTokenText);
|
|
|
ExpectToken(tkdo);
|
|
|
@@ -2671,7 +2706,7 @@ begin
|
|
|
begin
|
|
|
// with Expr do
|
|
|
// with Expr, Expr do
|
|
|
- Expr:=ParseExpression;
|
|
|
+ Expr:=ParseExpression(Parent);
|
|
|
//writeln(i,'WITH Expr="',Expr,'" Token=',CurTokenText);
|
|
|
CreateBlock(CurBlock.AddWithDo(Expr));
|
|
|
repeat
|
|
|
@@ -2679,14 +2714,14 @@ begin
|
|
|
if CurToken=tkdo then break;
|
|
|
if CurToken<>tkComma then
|
|
|
ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkdo]]));
|
|
|
- Expr:=ParseExpression;
|
|
|
+ Expr:=ParseExpression(Parent);
|
|
|
//writeln(i,'WITH ...,Expr="',Expr,'" Token=',CurTokenText);
|
|
|
TPasImplWithDo(CurBlock).AddExpression(Expr);
|
|
|
until false;
|
|
|
end;
|
|
|
tkcase:
|
|
|
begin
|
|
|
- Expr:=ParseExpression;
|
|
|
+ Expr:=ParseExpression(Parent);
|
|
|
//writeln(i,'CASE OF Expr="',Expr,'" Token=',CurTokenText);
|
|
|
ExpectToken(tkof);
|
|
|
CreateBlock(CurBlock.AddCaseOf(Expr));
|
|
|
@@ -2706,7 +2741,7 @@ begin
|
|
|
UngetToken;
|
|
|
// read case values
|
|
|
repeat
|
|
|
- Expr:=ParseExpression;
|
|
|
+ Expr:=ParseExpression(Parent);
|
|
|
//writeln(i,'CASE value="',Expr,'" Token=',CurTokenText);
|
|
|
if CurBlock is TPasImplCaseStatement then
|
|
|
TPasImplCaseStatement(CurBlock).Expressions.Add(Expr)
|
|
|
@@ -2715,7 +2750,7 @@ begin
|
|
|
NextToken;
|
|
|
if CurToken=tkDotDot then
|
|
|
begin
|
|
|
- Expr:=Expr+'..'+ParseExpression;
|
|
|
+ Expr:=Expr+'..'+ParseExpression(Parent);
|
|
|
NextToken;
|
|
|
end;
|
|
|
//writeln(i,'CASE after value Token=',CurTokenText);
|
|
|
@@ -2779,13 +2814,13 @@ begin
|
|
|
if CurBlock is TPasImplTryExcept then
|
|
|
begin
|
|
|
VarName:='';
|
|
|
- TypeName:=ParseExpression;
|
|
|
+ TypeName:=ParseExpression(Parent);
|
|
|
//writeln(i,'ON t=',TypeName,' Token=',CurTokenText);
|
|
|
NextToken;
|
|
|
if CurToken=tkColon then
|
|
|
begin
|
|
|
VarName:=TypeName;
|
|
|
- TypeName:=ParseExpression;
|
|
|
+ TypeName:=ParseExpression(Parent);
|
|
|
//writeln(i,'ON v=',VarName,' t=',TypeName,' Token=',CurTokenText);
|
|
|
end else
|
|
|
UngetToken;
|
|
|
@@ -2831,7 +2866,7 @@ begin
|
|
|
end;
|
|
|
if CurBlock is TPasImplRepeatUntil then
|
|
|
begin
|
|
|
- Condition:=ParseExpression;
|
|
|
+ Condition:=ParseExpression(Parent);
|
|
|
TPasImplRepeatUntil(CurBlock).Condition:=Condition;
|
|
|
//WriteLn(i,'UNTIL Condition="',Condition,'" Token=',CurTokenString);
|
|
|
if CloseBlock then break;
|
|
|
@@ -2979,7 +3014,7 @@ begin
|
|
|
Variant.Values := TStringList.Create;
|
|
|
while True do
|
|
|
begin
|
|
|
- Variant.Values.Add(ParseExpression);
|
|
|
+ Variant.Values.Add(ParseExpression(Parent));
|
|
|
NextToken;
|
|
|
if CurToken = tkColon then
|
|
|
break
|
|
|
@@ -3259,7 +3294,8 @@ begin
|
|
|
NextToken;
|
|
|
end;
|
|
|
// Eat semicolon after class...end
|
|
|
- ExpectToken(tkSemicolon);
|
|
|
+ CheckHint(result,true);
|
|
|
+// ExpectToken(tkSemicolon);
|
|
|
end;
|
|
|
except
|
|
|
Result.Free;
|
marco