mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-12 03:56:12 +02:00
codetools: h2p: implemented parsing #if and #elif expressions
git-svn-id: trunk@14585 -
This commit is contained in:
mattias
parent
5cf0c4c222
commit
baebd44d83
@ -229,6 +229,7 @@ type
|
||||
function ExtractTypedefName(TypedefNode: TCodeTreeNode): string;
|
||||
function ExtractDirectiveAction(DirectiveNode: TCodeTreeNode): string;
|
||||
function ExtractDirectiveFirstAtom(DirectiveNode: TCodeTreeNode): string;
|
||||
function ExtractDirectiveParams(DirectiveNode: TCodeTreeNode): string;
|
||||
|
||||
procedure Replace(FromPos, ToPos: integer; const NewSrc: string);
|
||||
|
||||
@ -409,8 +410,10 @@ begin
|
||||
ReadRawNextAtom;
|
||||
if not AtomIsIdentifier then
|
||||
RaiseExpectedButAtomFound('identifier');
|
||||
ReadRawNextAtom;
|
||||
if AtomIsChar('(') then begin
|
||||
// if a ( follows immediately (without spaces) then it is a macro function
|
||||
if (SrcPos<=SrcLen) and (Src[SrcPos]='(') then begin
|
||||
AtomStart:=SrcPos;
|
||||
SrcPos:=AtomStart+1;
|
||||
ReadTilBracketClose(true);
|
||||
ReadRawNextAtom;
|
||||
end;
|
||||
@ -1806,12 +1809,23 @@ function TCCodeParserTool.ExtractDirectiveFirstAtom(DirectiveNode: TCodeTreeNode
|
||||
begin
|
||||
MoveCursorToPos(DirectiveNode.StartPos+1);
|
||||
// read action
|
||||
ReadNextAtom;
|
||||
ReadRawNextAtom;
|
||||
// read first atom
|
||||
ReadNextAtom;
|
||||
ReadRawNextAtom;
|
||||
Result:=GetAtom;
|
||||
end;
|
||||
|
||||
function TCCodeParserTool.ExtractDirectiveParams(DirectiveNode: TCodeTreeNode
|
||||
): string;
|
||||
begin
|
||||
MoveCursorToPos(DirectiveNode.StartPos+1);
|
||||
// read action
|
||||
ReadRawNextAtom;
|
||||
// read first atom
|
||||
ReadRawNextAtom;
|
||||
Result:=ExtractCode(AtomStart,DirectiveNode.EndPos);
|
||||
end;
|
||||
|
||||
function TCCodeParserTool.GetAtom: string;
|
||||
begin
|
||||
Result:=copy(Src,AtomStart,SrcPos-AtomStart);
|
||||
|
||||
@ -112,6 +112,9 @@ type
|
||||
procedure ConvertTypedef(CNode: TCodeTreeNode; ParentNode: TH2PNode);
|
||||
procedure ConvertDirective(CNode: TCodeTreeNode; ParentNode: TH2PNode);
|
||||
procedure SetIgnoreCParts(const AValue: TIgnoreCSourceParts);
|
||||
function ConvertCToPascalDirectiveExpression(const CCode: string;
|
||||
StartPos, EndPos: integer; out PasExpr: string;
|
||||
out ErrorPos: integer; out ErrorMsg: string): boolean;
|
||||
public
|
||||
Tree: TH2PTree;
|
||||
CTool: TCCodeParserTool;
|
||||
@ -531,9 +534,13 @@ procedure TH2PasTool.ConvertDirective(CNode: TCodeTreeNode; ParentNode: TH2PNode
|
||||
);
|
||||
var
|
||||
Directive: String;
|
||||
PascalCode: String;
|
||||
H2PNode: TH2PNode;
|
||||
CurName: String;
|
||||
PascalCode: String;
|
||||
ErrorPos: integer;
|
||||
ErrorMsg: string;
|
||||
StartPos: LongInt;
|
||||
EndPos: LongInt;
|
||||
begin
|
||||
Directive:=CTool.ExtractDirectiveAction(CNode);
|
||||
if Directive='include' then begin
|
||||
@ -544,42 +551,46 @@ begin
|
||||
end else if Directive='define' then begin
|
||||
// #define FMAC(a,b) a here, then b
|
||||
// #define NONFMAC some text here
|
||||
end else if Directive='undef' then begin
|
||||
end else if (Directive='undef') or (Directive='ifdef')
|
||||
or (Directive='ifndef') then begin
|
||||
// #undef NAME
|
||||
CurName:=CTool.ExtractDirectiveFirstAtom(CNode);
|
||||
H2PNode:=CreateH2PNode('#undef','#undef',CNode,ctnNone,
|
||||
CurName,ParentNode,false);
|
||||
DebugLn(['TH2PasTool.ConvertDirective added $undef: ',H2PNode.DescAsString]);
|
||||
exit;
|
||||
end else if Directive='if' then begin
|
||||
// #if EXPRESSION
|
||||
end else if Directive='ifdef' then begin
|
||||
// #ifdef NAME
|
||||
CurName:=CTool.ExtractDirectiveFirstAtom(CNode);
|
||||
H2PNode:=CreateH2PNode('#ifdef','#ifdef',CNode,ctnNone,
|
||||
CurName,ParentNode,false);
|
||||
DebugLn(['TH2PasTool.ConvertDirective added $ifdef: ',H2PNode.DescAsString]);
|
||||
exit;
|
||||
end else if Directive='ifndef' then begin
|
||||
// #ifndef NAME
|
||||
CurName:=CTool.ExtractDirectiveFirstAtom(CNode);
|
||||
H2PNode:=CreateH2PNode('#ifndef','#ifndef',CNode,ctnNone,
|
||||
H2PNode:=CreateH2PNode('$'+Directive,'#'+Directive,CNode,ctnNone,
|
||||
CurName,ParentNode,false);
|
||||
DebugLn(['TH2PasTool.ConvertDirective added $ifndef: ',H2PNode.DescAsString]);
|
||||
DebugLn(['TH2PasTool.ConvertDirective added: ',H2PNode.DescAsString]);
|
||||
exit;
|
||||
end else if Directive='elif' then begin
|
||||
end else if (Directive='if') or (Directive='elif') then begin
|
||||
// #if EXPRESSION
|
||||
// #elif EXPRESSION
|
||||
end else if Directive='else' then begin
|
||||
CTool.MoveCursorToPos(CNode.StartPos+1);
|
||||
// read action
|
||||
CTool.ReadRawNextAtom;
|
||||
// convert expression
|
||||
StartPos:=CTool.SrcPos;
|
||||
EndPos:=CNode.EndPos;
|
||||
if not ConvertCToPascalDirectiveExpression(CTool.Src,StartPos,EndPos,
|
||||
PascalCode,ErrorPos,ErrorMsg) then
|
||||
begin
|
||||
DebugLn(['TH2PasTool.ConvertDirective failed to convert expression at ',
|
||||
CTool.CleanPosToStr(ErrorPos)+': '+ErrorMsg]);
|
||||
end else begin
|
||||
if Directive='if' then
|
||||
CurName:='if'
|
||||
else
|
||||
CurName:='elseif';
|
||||
H2PNode:=CreateH2PNode(CurName,'#'+Directive,CNode,ctnNone,
|
||||
PascalCode,ParentNode,false);
|
||||
DebugLn(['TH2PasTool.ConvertDirective added: ',H2PNode.DescAsString]);
|
||||
exit;
|
||||
end;
|
||||
end else if (Directive='else') or (Directive='endif') then begin
|
||||
// #else
|
||||
H2PNode:=CreateH2PNode('#else','#else',CNode,ctnNone,
|
||||
'',ParentNode,false);
|
||||
DebugLn(['TH2PasTool.ConvertDirective added $else: ',H2PNode.DescAsString]);
|
||||
exit;
|
||||
end else if Directive='endif' then begin
|
||||
// #endif
|
||||
H2PNode:=CreateH2PNode('#endif','#endif',CNode,ctnNone,
|
||||
H2PNode:=CreateH2PNode('$'+Directive,'#'+Directive,CNode,ctnNone,
|
||||
'',ParentNode,false);
|
||||
DebugLn(['TH2PasTool.ConvertDirective added $endif: ',H2PNode.DescAsString]);
|
||||
DebugLn(['TH2PasTool.ConvertDirective added: ',H2PNode.DescAsString]);
|
||||
exit;
|
||||
end else if Directive='line' then begin
|
||||
// #line: set the current line number -> ignore
|
||||
@ -588,7 +599,7 @@ begin
|
||||
// #error
|
||||
PascalCode:=CTool.ExtractCode(CNode.StartPos+length('#error'),
|
||||
CNode.EndPos);
|
||||
H2PNode:=CreateH2PNode('#error','#error',CNode,ctnNone,
|
||||
H2PNode:=CreateH2PNode('$'+Directive,'#'+Directive,CNode,ctnNone,
|
||||
PascalCode,ParentNode,false);
|
||||
DebugLn(['TH2PasTool.ConvertDirective added $error: ',H2PNode.DescAsString]);
|
||||
exit;
|
||||
@ -608,6 +619,169 @@ begin
|
||||
FIgnoreCParts:=AValue;
|
||||
end;
|
||||
|
||||
function TH2PasTool.ConvertCToPascalDirectiveExpression(const CCode: string;
|
||||
StartPos, EndPos: integer; out PasExpr: string;
|
||||
out ErrorPos: integer; out ErrorMsg: string): boolean;
|
||||
type
|
||||
TTokenType = (
|
||||
ttNone,
|
||||
ttValue,
|
||||
ttBinaryOperator,
|
||||
ttBracketOpen,
|
||||
ttBracketClose
|
||||
);
|
||||
var
|
||||
p: LongInt;
|
||||
AtomStart: integer;
|
||||
BracketLvl: Integer;
|
||||
LastToken: TTokenType;
|
||||
|
||||
function AtomIs(const s: shortstring): boolean;
|
||||
var
|
||||
len: Integer;
|
||||
i: Integer;
|
||||
begin
|
||||
len:=length(s);
|
||||
if (len<>p-AtomStart) then exit(false);
|
||||
if p>EndPos then exit(false);
|
||||
for i:=1 to len do
|
||||
if CCode[AtomStart+i-1]<>s[i] then exit(false);
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function GetAtom: string;
|
||||
begin
|
||||
Result:=copy(CCode,AtomStart,p-AtomStart);
|
||||
end;
|
||||
|
||||
procedure ErrorExpectedButFound(const s: string);
|
||||
begin
|
||||
ErrorPos:=AtomStart;
|
||||
ErrorMsg:=s+' expected, but '+GetAtom+' found';
|
||||
end;
|
||||
|
||||
procedure Add(NewToken: TTokenType; const s: string);
|
||||
begin
|
||||
LastToken:=NewToken;
|
||||
if s='' then exit;
|
||||
if (IsIdentChar[s[1]])
|
||||
and (PasExpr<>'') and IsIdentChar[PasExpr[length(PasExpr)]] then
|
||||
PasExpr:=PasExpr+' ';
|
||||
PasExpr:=PasExpr+s;
|
||||
end;
|
||||
|
||||
procedure Add(NewToken: TTokenType);
|
||||
begin
|
||||
Add(NewToken,GetAtom);
|
||||
end;
|
||||
|
||||
begin
|
||||
Result:=false;
|
||||
PasExpr:='';
|
||||
ErrorMsg:='';
|
||||
ErrorPos:=StartPos;
|
||||
LastToken:=ttNone;
|
||||
BracketLvl:=0;
|
||||
p:=StartPos;
|
||||
repeat
|
||||
ReadRawNextCAtom(CCode,p,AtomStart);
|
||||
if (AtomStart>=EndPos) or (CCode[AtomStart] in [#10,#13]) then begin
|
||||
if BracketLvl>0 then begin
|
||||
ErrorPos:=EndPos;
|
||||
ErrorMsg:='missing closing bracket';
|
||||
exit;
|
||||
end else if LastToken in [ttNone,ttBinaryOperator] then begin
|
||||
ErrorPos:=EndPos;
|
||||
ErrorMsg:='missing value';
|
||||
exit;
|
||||
end;
|
||||
Result:=true;
|
||||
break;
|
||||
end;
|
||||
if IsIdentChar[CCode[AtomStart]] then begin
|
||||
// value
|
||||
if LastToken in [ttValue,ttBracketClose] then begin
|
||||
ErrorPos:=AtomStart;
|
||||
ErrorMsg:='missing operator';
|
||||
exit;
|
||||
end;
|
||||
Add(ttValue);
|
||||
if AtomIs('defined') then begin
|
||||
// read defined(name)
|
||||
ReadRawNextCAtom(CCode,p,AtomStart);
|
||||
if not AtomIs('(') then begin
|
||||
ErrorExpectedButFound('(');
|
||||
exit;
|
||||
end;
|
||||
Add(ttBracketOpen);
|
||||
ReadRawNextCAtom(CCode,p,AtomStart);
|
||||
if (AtomStart>=EndPos) or (not IsIdentStartChar[CCode[AtomStart]])
|
||||
then begin
|
||||
ErrorExpectedButFound('identifier');
|
||||
exit;
|
||||
end;
|
||||
Add(ttValue);
|
||||
ReadRawNextCAtom(CCode,p,AtomStart);
|
||||
if not AtomIs(')') then begin
|
||||
ErrorExpectedButFound(')');
|
||||
exit;
|
||||
end;
|
||||
Add(ttBracketClose);
|
||||
end;
|
||||
end else if AtomIs('+') or AtomIs('-') or AtomIs('!') then begin
|
||||
if LastToken in [ttValue,ttBracketClose] then begin
|
||||
if AtomIs('!') then
|
||||
Add(ttBinaryOperator,'not')
|
||||
else
|
||||
Add(ttBinaryOperator);
|
||||
end else begin
|
||||
// just a modifier, not important for the type
|
||||
end;
|
||||
end else if AtomIs('*') or AtomIs('/') or AtomIs('!=') or AtomIs('==')
|
||||
then begin
|
||||
if LastToken in [ttValue,ttBracketClose] then begin
|
||||
if AtomIs('!=') then
|
||||
Add(ttBinaryOperator,'<>')
|
||||
else if AtomIs('==') then
|
||||
Add(ttBinaryOperator,'=')
|
||||
else
|
||||
Add(ttBinaryOperator);
|
||||
end else begin
|
||||
ErrorPos:=AtomStart;
|
||||
ErrorMsg:='value expected, but '+GetAtom+' found';
|
||||
exit;
|
||||
end;
|
||||
end else if AtomIs('(') then begin
|
||||
if LastToken in [ttNone,ttBinaryOperator] then begin
|
||||
Add(ttBracketOpen);
|
||||
inc(BracketLvl);
|
||||
end else begin
|
||||
ErrorPos:=AtomStart;
|
||||
ErrorMsg:='operator expected, but '+GetAtom+' found';
|
||||
exit;
|
||||
end;
|
||||
end else if AtomIs(')') then begin
|
||||
if BracketLvl=0 then begin
|
||||
ErrorPos:=AtomStart;
|
||||
ErrorMsg:='missing opening bracket';
|
||||
exit;
|
||||
end;
|
||||
if LastToken in [ttValue] then begin
|
||||
Add(ttBracketClose);
|
||||
dec(BracketLvl);
|
||||
end else begin
|
||||
ErrorPos:=AtomStart;
|
||||
ErrorMsg:='operator expected, but '+GetAtom+' found';
|
||||
exit;
|
||||
end;
|
||||
end else begin
|
||||
ErrorPos:=AtomStart;
|
||||
ErrorMsg:='invalid symbol '+GetAtom+' found';
|
||||
exit;
|
||||
end;
|
||||
until false;
|
||||
end;
|
||||
|
||||
function TH2PasTool.Convert(CCode, PascalCode: TCodeBuffer): boolean;
|
||||
begin
|
||||
Result:=false;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user