mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-01 13:50:29 +02:00
* misc patches from mantis 17058, which fixes 70% of the fpdoc errors.
git-svn-id: trunk@15676 -
This commit is contained in:
parent
15efa8152b
commit
443b4ad8dc
@ -67,8 +67,8 @@ resourcestring
|
||||
SPasTreeDestructorImpl = 'destructor implementation';
|
||||
|
||||
type
|
||||
TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekRange,
|
||||
pekUnary, pekBinary, pekFuncParams, pekArrayParams);
|
||||
TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekBoolConst, pekRange,
|
||||
pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp);
|
||||
|
||||
TExprOpCode = (eopNone,
|
||||
eopAdd,eopSubtract,eopMultiply,eopDivide, eopDiv,eopMod, eopPower,// arithmetic
|
||||
@ -77,7 +77,8 @@ type
|
||||
eopEqual, eopNotEqual, // Logical
|
||||
eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual, // ordering
|
||||
eopIn,eopIs,eopAs, eopSymmetricaldifference, // Specials
|
||||
eopAddress);
|
||||
eopAddress,
|
||||
eopSubIdent); // SomeRec.A, A is subIdent of SomeRec
|
||||
|
||||
{ TPasExpr }
|
||||
|
||||
@ -107,6 +108,11 @@ type
|
||||
Value : AnsiString;
|
||||
constructor Create(AKind: TPasExprKind; const AValue : Ansistring);
|
||||
end;
|
||||
|
||||
TBoolConstExpr = class(TPasExpr)
|
||||
Value : Boolean;
|
||||
constructor Create(AKind: TPasExprKind; const ABoolValue : Boolean);
|
||||
end;
|
||||
|
||||
{ TParamsExpr }
|
||||
|
||||
@ -119,6 +125,30 @@ type
|
||||
procedure AddParam(xp: TPasExpr);
|
||||
end;
|
||||
|
||||
{ TRecordValues }
|
||||
|
||||
TRecordValuesItem = record
|
||||
Name : AnsiString;
|
||||
ValueExp : TPasExpr;
|
||||
end;
|
||||
|
||||
TRecordValues = class(TPasExpr)
|
||||
Fields : array of TRecordValuesItem;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure AddField(const Name: AnsiString; Value: TPasExpr);
|
||||
end;
|
||||
|
||||
{ TArrayValues }
|
||||
|
||||
TArrayValues = class(TPasExpr)
|
||||
Values : array of TPasExpr;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure AddValues(AValue: TPasExpr);
|
||||
end;
|
||||
|
||||
|
||||
// Visitor pattern.
|
||||
TPassTreeVisitor = class;
|
||||
|
||||
@ -2352,6 +2382,15 @@ begin
|
||||
Value:=AValue;
|
||||
end;
|
||||
|
||||
{ TBoolConstExpr }
|
||||
|
||||
constructor TBoolConstExpr.Create(AKind: TPasExprKind; const ABoolValue : Boolean);
|
||||
begin
|
||||
inherited Create(AKind, eopNone);
|
||||
Value:=ABoolValue;
|
||||
end;
|
||||
|
||||
|
||||
{ TUnaryExpr }
|
||||
|
||||
constructor TUnaryExpr.Create(AOperand: TPasExpr; AOpCode: TExprOpCode);
|
||||
@ -2412,4 +2451,53 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TRecordValues }
|
||||
|
||||
constructor TRecordValues.Create;
|
||||
begin
|
||||
inherited Create(pekListOfExp, eopNone);
|
||||
end;
|
||||
|
||||
destructor TRecordValues.Destroy;
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
for i:=0 to length(Fields)-1 do Fields[i].ValueExp.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TRecordValues.AddField(const Name:AnsiString;Value:TPasExpr);
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
i:=length(Fields);
|
||||
SetLength(Fields, i+1);
|
||||
Fields[i].Name:=Name;
|
||||
Fields[i].ValueExp:=Value;
|
||||
end;
|
||||
|
||||
{ TArrayValues }
|
||||
|
||||
constructor TArrayValues.Create;
|
||||
begin
|
||||
inherited Create(pekListOfExp, eopNone)
|
||||
end;
|
||||
|
||||
destructor TArrayValues.Destroy;
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
for i:=0 to length(Values)-1 do Values[i].Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TArrayValues.AddValues(AValue:TPasExpr);
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
i:=length(Values);
|
||||
SetLength(Values, i+1);
|
||||
Values[i]:=AValue;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
@ -144,6 +144,7 @@ type
|
||||
procedure ParseArrayType(Element: TPasArrayType);
|
||||
procedure ParseFileType(Element: TPasFileType);
|
||||
function DoParseExpression: TPasExpr;
|
||||
function DoParseConstValueExpression: TPasExpr;
|
||||
function ParseExpression: String;
|
||||
function ParseCommand: String; // single, not compound command like begin..end
|
||||
procedure AddProcOrFunction(Declarations: TPasDeclarations; AProc: TPasProcedure);
|
||||
@ -642,7 +643,7 @@ end;
|
||||
|
||||
const
|
||||
EndExprToken = [
|
||||
tkEOF, tkBraceClose, tkSquaredBraceClose, tkSemicolon, tkComma,
|
||||
tkEOF, tkBraceClose, tkSquaredBraceClose, tkSemicolon, tkComma, tkColon,
|
||||
tkdo, tkdownto, tkelse, tkend, tkof, tkthen, tkto
|
||||
];
|
||||
|
||||
@ -719,6 +720,7 @@ begin
|
||||
tkDiv : Result:=eopDiv;
|
||||
tkNot : Result:=eopNot;
|
||||
tkIn : Result:=eopIn;
|
||||
tkDot : Result:=eopSubIdent;
|
||||
else
|
||||
ParseExc(format('Not an operand: (%d : %s)',[AToken,TokenInfos[AToken]]));
|
||||
end;
|
||||
@ -730,6 +732,7 @@ var
|
||||
prm : TParamsExpr;
|
||||
u : TUnaryExpr;
|
||||
b : TBinaryExpr;
|
||||
optk : TToken;
|
||||
begin
|
||||
Result:=nil;
|
||||
case CurToken of
|
||||
@ -737,6 +740,7 @@ begin
|
||||
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);
|
||||
tkSquaredBraceOpen: x:=ParseParams(pekSet);
|
||||
else
|
||||
ParseExc(SParserExpectedIdentifier);
|
||||
@ -768,8 +772,9 @@ begin
|
||||
end;
|
||||
|
||||
if CurToken in [tkDot, tkas] then begin
|
||||
optk:=CurToken;
|
||||
NextToken;
|
||||
b:=TBinaryExpr.Create(x, ParseExpIdent, TokenToExprOp(CurToken));
|
||||
b:=TBinaryExpr.Create(x, ParseExpIdent(), TokenToExprOp(optk));
|
||||
if not Assigned(b.right) then Exit; // error
|
||||
x:=b;
|
||||
end;
|
||||
@ -963,6 +968,65 @@ begin
|
||||
UngetToken;
|
||||
end;
|
||||
|
||||
function GetExprIdent(p: TPasExpr): String;
|
||||
begin
|
||||
if Assigned(p) and (p is TPrimitiveExpr) and (p.Kind=pekIdent) then
|
||||
Result:=TPrimitiveExpr(p).Value
|
||||
else
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
function TPasParser.DoParseConstValueExpression: TPasExpr;
|
||||
var
|
||||
x : TPasExpr;
|
||||
n : AnsiString;
|
||||
r : TRecordValues;
|
||||
a : TArrayValues;
|
||||
begin
|
||||
if CurToken <> tkBraceOpen then
|
||||
Result:=DoParseExpression
|
||||
else begin
|
||||
NextToken;
|
||||
x:=DoParseConstValueExpression();
|
||||
case CurToken of
|
||||
tkComma: // array of values (a,b,c);
|
||||
begin
|
||||
a:=TArrayValues.Create;
|
||||
a.AddValues(x);
|
||||
repeat
|
||||
NextToken;
|
||||
x:=DoParseConstValueExpression();
|
||||
a.AddValues(x);
|
||||
until CurToken<>tkComma;
|
||||
Result:=a;
|
||||
end;
|
||||
|
||||
tkColon: // record field (a:xxx;b:yyy;c:zzz);
|
||||
begin
|
||||
n:=GetExprIdent(x);
|
||||
x.Free;
|
||||
r:=TRecordValues.Create;
|
||||
NextToken;
|
||||
x:=DoParseConstValueExpression();
|
||||
r.AddField(n, x);
|
||||
if CurToken=tkSemicolon then
|
||||
repeat
|
||||
n:=ExpectIdentifier;
|
||||
ExpectToken(tkColon);
|
||||
NextToken;
|
||||
x:=DoParseConstValueExpression();
|
||||
r.AddField(n, x)
|
||||
until CurToken<>tkSemicolon;
|
||||
Result:=r;
|
||||
end;
|
||||
else
|
||||
Result:=x;
|
||||
end;
|
||||
if CurToken<>tkBraceClose then ParseExc(SParserExpectedCommaRBracket);
|
||||
NextToken;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPasParser.ParseCommand: String;
|
||||
var
|
||||
BracketLevel: Integer;
|
||||
@ -1443,7 +1507,7 @@ begin
|
||||
|
||||
// using new expression parser!
|
||||
NextToken; // skip tkEqual
|
||||
Result.Expr:=DoParseExpression;
|
||||
Result.Expr:=DoParseConstValueExpression;
|
||||
|
||||
// must unget for the check to be peformed fine!
|
||||
UngetToken;
|
||||
|
@ -661,7 +661,7 @@ begin
|
||||
TokenStart := TokenStr;
|
||||
repeat
|
||||
Inc(TokenStr);
|
||||
until not (TokenStr[0] in ['0'..'9', 'A'..'F', 'a'..'F']);
|
||||
until not (TokenStr[0] in ['0'..'9', 'A'..'F', 'a'..'f']);
|
||||
SectionLength := TokenStr - TokenStart;
|
||||
SetLength(FCurTokenString, SectionLength);
|
||||
if SectionLength > 0 then
|
||||
|
Loading…
Reference in New Issue
Block a user