* patch from Dmitry for bug #16342, slightly extended by me.

Fixes const node deprecated problems from that bugreport.

git-svn-id: trunk@15726 -
This commit is contained in:
marco 2010-08-06 13:58:45 +00:00
parent 737d373be3
commit a39525f341
2 changed files with 53 additions and 46 deletions

View File

@ -173,7 +173,7 @@ type
TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall); TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall);
TPasMemberVisibilities = set of TPasMemberVisibility; TPasMemberVisibilities = set of TPasMemberVisibility;
TPasMemberHint = (hDeprecated,hLibrary,hPlatform); TPasMemberHint = (hDeprecated,hLibrary,hPlatform,hExperimental,hUnimplemented);
TPasMemberHints = set of TPasMemberHint; TPasMemberHints = set of TPasMemberHint;
TPTreeElement = class of TPasElement; TPTreeElement = class of TPasElement;

View File

@ -121,7 +121,8 @@ type
AParent: TPasElement): TPasElement;overload; AParent: TPasElement): TPasElement;overload;
function CreateElement(AClass: TPTreeElement; const AName: String; function CreateElement(AClass: TPTreeElement; const AName: String;
AParent: TPasElement; AVisibility: TPasMemberVisibility): TPasElement;overload; 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 CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
function ParseParams(paramskind: TPasExprKind): TParamsExpr; function ParseParams(paramskind: TPasExprKind): TParamsExpr;
@ -143,6 +144,7 @@ type
function ParseComplexType(Parent : TPasElement = Nil): TPasType; function ParseComplexType(Parent : TPasElement = Nil): TPasType;
procedure ParseArrayType(Element: TPasArrayType); procedure ParseArrayType(Element: TPasArrayType);
procedure ParseFileType(Element: TPasFileType); procedure ParseFileType(Element: TPasFileType);
function isEndOfExp: Boolean;
function DoParseExpression(InitExpr: TPasExpr=nil): TPasExpr; function DoParseExpression(InitExpr: TPasExpr=nil): TPasExpr;
function DoParseConstValueExpression: TPasExpr; function DoParseConstValueExpression: TPasExpr;
function ParseExpression: String; function ParseExpression: String;
@ -340,30 +342,37 @@ begin
Result:=ParseType(Parent,''); Result:=ParseType(Parent,'');
end; end;
Function TPasParser.IsHint(Const S : String; var AHint : TPasMemberHint) : Boolean; Function TPasParser.IsCurTokenHint(out AHint : TPasMemberHint) : Boolean;
Var Var
T : string; T : string;
begin
if CurToken=tklibrary then
begin
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 begin
T:=LowerCase(S); Result:=IsCurTokenHint(dummy);
Result:=(T='deprecated');
If Result then
Ahint:=hDeprecated
else
begin
Result:=(T='library');
if Result then
Ahint:=hLibrary
else
begin
Result:=(T='platform');
If result then
AHint:=hPlatform;
end;
end;
end; end;
Function TPasParser.CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints; Function TPasParser.CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
Var Var
@ -374,7 +383,7 @@ begin
Result:=[]; Result:=[];
Repeat Repeat
NextToken; NextToken;
Found:=IsHint(CurTokenString,h); Found:=IsCurTokenHint(h);
If Found then If Found then
Include(Result,h) Include(Result,h)
Until Not Found; Until Not Found;
@ -577,7 +586,7 @@ begin
Result := TPasProcedureType(CreateElement(TPasProcedureType, '', Parent)); Result := TPasProcedureType(CreateElement(TPasProcedureType, '', Parent));
ParseProcedureOrFunctionHeader(Result, ParseProcedureOrFunctionHeader(Result,
TPasProcedureType(Result), ptProcedure, True); TPasProcedureType(Result), ptProcedure, True);
UngetToken; // Unget semicolon if CurToken = tkSemicolon then UngetToken; // Unget semicolon
end; end;
tkFunction: tkFunction:
begin begin
@ -641,12 +650,15 @@ begin
Element.ElType := ParseType(nil); Element.ElType := ParseType(nil);
end; end;
function TPasParser.isEndOfExp:Boolean;
const const
EndExprToken = [ EndExprToken = [
tkEOF, tkBraceClose, tkSquaredBraceClose, tkSemicolon, tkComma, tkColon, tkEOF, tkBraceClose, tkSquaredBraceClose, tkSemicolon, tkComma, tkColon,
tkdo, tkdownto, tkelse, tkend, tkof, tkthen, tkto tkdo, tkdownto, tkelse, tkend, tkof, tkthen, tkto
]; ];
begin
Result:=(CurToken in EndExprToken) or IsCurTokenHint;
end;
function TPasParser.ParseParams(paramskind: TPasExprKind): TParamsExpr; function TPasParser.ParseParams(paramskind: TPasExprKind): TParamsExpr;
var var
@ -666,7 +678,7 @@ begin
params:=TParamsExpr.Create(paramskind); params:=TParamsExpr.Create(paramskind);
try try
NextToken; NextToken;
if not (CurToken in EndExprToken) then begin if not isEndOfExp then begin
repeat repeat
p:=DoParseExpression; p:=DoParseExpression;
if not Assigned(p) then Exit; // bad param syntax if not Assigned(p) then Exit; // bad param syntax
@ -819,10 +831,15 @@ var
x : TPasExpr; x : TPasExpr;
i : Integer; i : Integer;
tempop : TToken; tempop : TToken;
AllowEnd : Boolean; NotBinary : Boolean;
const const
PrefixSym = [tkPlus, tkMinus, tknot, tkAt]; // + - not @ 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; function PopExp: TPasExpr; inline;
begin begin
@ -868,7 +885,7 @@ begin
opstack := TList.Create; opstack := TList.Create;
try try
repeat repeat
AllowEnd:=True; NotBinary:=True;
pcount:=0; pcount:=0;
if not Assigned(InitExpr) then if not Assigned(InitExpr) then
@ -914,9 +931,9 @@ begin
InitExpr:=nil; InitExpr:=nil;
end; end;
if not (CurToken in EndExprToken) then begin if (CurToken in BinaryOP) then begin
// Adjusting order of the operations // Adjusting order of the operations
AllowEnd:=False; NotBinary:=False;
tempop:=PeekOper; tempop:=PeekOper;
while (opstack.Count>0) and (OpLevel(tempop)>=OpLevel(CurToken)) do begin while (opstack.Count>0) and (OpLevel(tempop)>=OpLevel(CurToken)) do begin
PopAndPushOperator; PopAndPushOperator;
@ -926,7 +943,9 @@ begin
NextToken; NextToken;
end; end;
until AllowEnd and (CurToken in EndExprToken); until NotBinary or isEndOfExp;
if not NotBinary then ParseExc(SParserExpectedIdentifier);
while opstack.Count>0 do PopAndPushOperator; while opstack.Count>0 do PopAndPushOperator;
@ -1583,7 +1602,6 @@ var
Prefix : String; Prefix : String;
HadPackedModifier : Boolean; // 12/04/04 - Dave - Added HadPackedModifier : Boolean; // 12/04/04 - Dave - Added
IsBitPacked : Boolean; IsBitPacked : Boolean;
H : TPasMemberHint;
begin begin
TypeName := CurTokenString; TypeName := CurTokenString;
@ -1652,7 +1670,7 @@ begin
end end
else else
Prefix:=''; Prefix:='';
if (CurToken = tkSemicolon) or IsHint(CurtokenString,h)then if (CurToken = tkSemicolon) or IsCurTokenHint then
begin begin
UngetToken; UngetToken;
UngetToken; UngetToken;
@ -2062,10 +2080,9 @@ procedure TPasParser.ParseProcedureOrFunctionHeader(Parent: TPasElement;
Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean); Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
procedure ConsumeSemi; procedure ConsumeSemi;
var bl : TPasMemberHint;
begin begin
NextToken; NextToken;
if (CurToken <> tksemicolon) and ishint(curtokenstring,bl) then if (CurToken <> tksemicolon) and IsCurTokenHint then
ungettoken; ungettoken;
end; end;
@ -2073,7 +2090,7 @@ Var
Tok : String; Tok : String;
i: Integer; i: Integer;
Proc: TPasProcedure; Proc: TPasProcedure;
ahint : TPasMemberHint;
begin begin
NextToken; NextToken;
case ProcType of case ProcType of
@ -2223,19 +2240,9 @@ begin
TPasProcedure(Parent).AddModifier(pmVarArgs); TPasProcedure(Parent).AddModifier(pmVarArgs);
ExpectToken(tkSemicolon); ExpectToken(tkSemicolon);
end end
else if (tok='DEPRECATED') then else if IsCurTokenHint(ahint) then // deprecated,platform,experimental,library, unimplemented etc
begin begin
element.hints:=element.hints+[hDeprecated]; element.hints:=element.hints+[ahint];
consumesemi;
end
else if (tok='PLATFORM') then
begin
element.hints:=element.hints+[hPlatform];
consumesemi;
end
else if (tok='LIBRARY') then
begin
element.hints:=element.hints+[hLibrary];
consumesemi; consumesemi;
end end
else if (tok='OVERLOAD') then else if (tok='OVERLOAD') then