paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 04:07:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: started skipping codetools skip comments

Browse Source 
git-svn-id: trunk@38190 -
This commit is contained in:
mattias 2012-08-06 22:37:08 +00:00
parent a5f1df8c7c
commit d21465be10
7 changed files with 457 additions and 462 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

608
components/codetools/basiccodetools.pas
View File

@ -329,12 +329,14 @@ function SearchCodeInSource(const Source, Find: string; StartPos: integer;
out EndFoundPosition: integer; CaseSensitive: boolean;
NestedComments: boolean = false): integer;
function ReadNextPascalAtom(const Source: string;
var Position, AtomStart: integer; NestedComments: boolean = false): string;
var Position, AtomStart: integer; NestedComments: boolean = false;
SkipDirectives: boolean = false): string;
procedure ReadRawNextPascalAtom(const Source: string;
var Position: integer; out AtomStart: integer;
NestedComments: boolean = false);
NestedComments: boolean = false; SkipDirectives: boolean = false);
procedure ReadRawNextPascalAtom(var Position: PChar; out AtomStart: PChar;
const SrcEnd: PChar = nil; NestedComments: boolean = false);
const SrcEnd: PChar = nil; NestedComments: boolean = false;
SkipDirectives: boolean = false);
function ReadTilPascalBracketClose(const Source: string;
var Position: integer; NestedComments: boolean = false): boolean;
function GetAtomLength(p: PChar; NestedComments: boolean): integer;
@ -1042,7 +1044,7 @@ end;
function SearchCodeInSource(const Source, Find: string; StartPos: integer;
out EndFoundPosition: integer; CaseSensitive: boolean;
NestedComments: boolean):integer;
// search pascal atoms of Find in Source
// search pascal atoms of <Find> in <Source>
// returns the start pos
// -1 on failure
var
@ -1128,27 +1130,44 @@ begin
'{':
begin
CommentLvl:=1;
inc(Result);
repeat
case Result^ of
#0: break;
'{':
if NestedComments then
inc(CommentLvl);
'}':
begin
dec(CommentLvl);
if CommentLvl=0 then begin
inc(Result);
if Result^=#3 then begin
// codetools skip comment
inc(Result);
repeat
case Result^ of
#0: break;
#3:
if Result[1]='}' then begin
inc(Result,2);
break;
end;
end;
inc(Result);
until false;
end else begin
// pascal comment {}
CommentLvl:=1;
repeat
case Result^ of
#0: break;
'{':
if NestedComments then
inc(CommentLvl);
end;
inc(Result);
until false;
'}':
begin
dec(CommentLvl);
if CommentLvl=0 then begin
inc(Result);
break;
end;
end;
end;
inc(Result);
until false;
end;
end;
'(':
@ -1162,10 +1181,9 @@ begin
dec(CommentLvl);
if CommentLvl=0 then
break;
end else if (Result^='(') and (Result[1]='*') then begin
end else if (Result^='(') and (Result[1]='*') and NestedComments then begin
inc(Result,2);
if NestedComments then
inc(CommentLvl);
inc(CommentLvl);
end else
inc(Result);
until false;
@ -1177,15 +1195,13 @@ end;
function IsCommentEnd(const ASource: string; EndPos: integer): boolean;
// return true if EndPos on } or on *) or in a // comment
var
l: Integer;
LineStart: LongInt;
begin
Result:=false;
if EndPos<1 then exit;
l:=length(ASource);
if EndPos>l then exit;
if EndPos>length(ASource) then exit;
if ASource[EndPos]='}' then begin
// delphi comment end
// delphi or codetools comment end
Result:=true;
exit;
end;
@ -1194,7 +1210,7 @@ begin
Result:=true;
exit;
end;
// test for Delphi comment
// test for Delphi comment //
// skip line end
LineStart:=EndPos;
if ASource[LineStart] in [#10,#13] then begin
@ -1419,59 +1435,87 @@ function FindCommentEnd(const ASource: string; StartPos: integer;
NestedComments: boolean): integer;
// returns position after the comment end, e.g. after }
var
MaxPos, CommentLvl: integer;
CommentLvl: integer;
p: PChar;
begin
MaxPos:=length(ASource);
Result:=StartPos;
if Result>MaxPos then exit;
case ASource[Result] of
if Result<1 then exit;
if Result>length(ASource) then exit;
p:=PChar(ASource);
case p^ of
'/':
begin
if (Result<MaxPos) and (ASource[Result+1]='/') then begin
if p[1]='/' then begin
// skip Delphi comment
while (Result<=MaxPos) and (not (ASource[Result] in [#10,#13])) do
inc(Result);
while (not (p^ in [#0,#10,#13])) do
inc(p);
end;
end;
'{':
begin
CommentLvl:=1;
inc(Result);
while Result<=MaxPos do begin
case ASource[Result] of
'{':
if NestedComments then
inc(CommentLvl);
'}':
begin
dec(CommentLvl);
if CommentLvl=0 then begin
inc(Result);
inc(p);
if p^=#3 then begin
// Codetools skip comment {#3 #3}
inc(p);
repeat
case p^ of
#0:
if p-PChar(ASource)>=length(ASource) then break;
#3:
if p[1]='}' then begin
inc(p,2);
break;
end;
end;
end;
inc(Result);
inc(p);
until false;
end else begin
// Pascal comment {}
CommentLvl:=1;
repeat
case p^ of
#0:
if p-PChar(ASource)>=length(ASource) then break;
'{':
if NestedComments then
inc(CommentLvl);
'}':
begin
dec(CommentLvl);
if CommentLvl=0 then begin
inc(p);
break;
end;
end;
end;
inc(p);
until false;
end;
end;
'(':
if (Result<MaxPos) and (ASource[Result+1]='*') then begin
inc(Result,2);
while (Result<=MaxPos) do begin
if (Result<MaxPos) and (ASource[Result]='*') and (ASource[Result+1]=')')
then begin
inc(Result,2);
break;
end;
inc(Result);
end;
if (p[1]='*') then begin
inc(p,2);
CommentLvl:=1;
repeat
if (p^=#0) then begin
if p-PChar(ASource)>=length(ASource) then break;
inc(p);
end else if (p^='(') and (p[1]='*') and NestedComments then begin
inc(p,2);
inc(CommentLvl);
end else if (p^='*') and (p[1]=')') then begin
inc(p,2);
dec(CommentLvl);
if CommentLvl=0 then break;
end else
inc(p);
until false;
end;
end;
Result:=p-PChar(ASource)+1;
end;
procedure GetLineStartEndAtPosition(const Source:string; Position:integer;
@ -1535,55 +1579,10 @@ function EmptyCodeLineCount(const Source: string; StartPos, EndPos: integer;
ignore line ends in comments
Result is Position of Start of Line End
}
var SrcLen: integer;
var
SrcLen: integer;
SrcPos: Integer;
procedure ReadComment(var P: integer);
begin
case Source[P] of
'{':
begin
inc(P);
while (P<=SrcLen) and (Source[P]<>'}') do begin
if NestedComments and (Source[P] in ['{','(','/']) then
ReadComment(P)
else
inc(P);
end;
inc(P);
end;
'(':
begin
inc(P);
if (P<=SrcLen) and (Source[P]='*') then begin
inc(P);
while (P<=SrcLen-1)
and ((Source[P]<>'*') or (Source[P-1]<>')')) do begin
if NestedComments and (Source[P] in ['{','(','/']) then
ReadComment(P)
else
inc(P);
end;
inc(P,2);
end;
end;
'/':
begin
inc(P);
if (P<=SrcLen) and (Source[P]='/') then begin
inc(P);
while (P<=SrcLen)
and (not (Source[P] in [#10,#13])) do begin
if NestedComments and (Source[P] in ['{','(','/']) then
ReadComment(P)
else
inc(P);
end;
end;
end;
end;
end;
CommentEndPos: Integer;
begin
Result:=0;
SrcLen:=length(Source);
@ -1592,7 +1591,13 @@ begin
while (SrcPos<EndPos) do begin
case Source[SrcPos] of
'{','(','/':
ReadComment(SrcPos);
begin
CommentEndPos:=FindCommentEnd(Source,SrcPos,NestedComments);
if CommentEndPos>SrcPos then
SrcPos:=CommentEndPos
else
inc(SrcPos); // not a comment start => skip char
end;
#10,#13:
begin
// skip line end
@ -1684,13 +1689,13 @@ begin
// read till first semicolon
p:=1;
while p<=length(ProcText) do begin
ReadRawNextPascalAtom(ProcText,p,AtomStart,NestedComments);
ReadRawNextPascalAtom(ProcText,p,AtomStart,NestedComments,true);
if AtomStart>length(ProcText) then exit;
if ProcText[AtomStart] in ['[','('] then begin
if not ReadTilPascalBracketClose(ProcText,p,NestedComments) then
exit;
end else if ProcText[AtomStart]=';' then begin
ReadRawNextPascalAtom(ProcText,p,AtomStart,NestedComments);
ReadRawNextPascalAtom(ProcText,p,AtomStart,NestedComments,true);
Result:=AtomStart;
exit;
end;
@ -1709,7 +1714,7 @@ var
begin
Result:=FindFirstProcSpecifier(ProcText,NestedComments);
while Result<=length(ProcText) do begin
ReadRawNextPascalAtom(ProcText,Result,AtomStart,NestedComments);
ReadRawNextPascalAtom(ProcText,Result,AtomStart,NestedComments,true);
if AtomStart>length(ProcText) then exit(-1);
if CompareIdentifiers(@ProcText[AtomStart],@Specifier[1])=0 then begin
Result:=AtomStart;
@ -1724,7 +1729,7 @@ begin
SpecifierEndPosition:=Result;
while (SpecifierEndPosition<=length(ProcText))
and (ProcText[SpecifierEndPosition]<>';') do begin
ReadRawNextPascalAtom(ProcText,SpecifierEndPosition,AtomStart,NestedComments);
ReadRawNextPascalAtom(ProcText,SpecifierEndPosition,AtomStart,NestedComments,true);
if AtomStart>length(ProcText) then exit;
if ProcText[AtomStart] in ['[','('] then begin
if not ReadTilPascalBracketClose(ProcText,SpecifierEndPosition,NestedComments)
@ -1753,39 +1758,16 @@ begin
end;
function ReadNextPascalAtom(const Source:string;
var Position, AtomStart: integer; NestedComments: boolean):string;
var DirectiveName:string;
DirStart,DirEnd,EndPos:integer;
var Position, AtomStart: integer; NestedComments: boolean;
SkipDirectives: boolean):string;
begin
repeat
ReadRawNextPascalAtom(Source,Position,AtomStart,NestedComments);
Result:=copy(Source,AtomStart,Position-AtomStart);
if (length(Result)>=2)
and (Result[1] in ['{','(']) and (Result[2]='*') then begin
if copy(Result,1,2)='{$' then begin
DirStart:=3;
DirEnd:=length(Result);
end else begin
DirStart:=4;
DirEnd:=length(Result)-1;
end;
EndPos:=DirStart;
while (EndPos<DirEnd) and (IsIdentChar[Result[EndPos]]) do inc(EndPos);
DirectiveName:=lowercase(copy(Result,DirStart,EndPos-DirStart));
if (length(DirectiveName)=1) and (Result[DirEnd] in ['+','-']) then begin
// switch
break;
end else if (DirectiveName='i') or (DirectiveName='include') then begin
// include directive
break;
end;
end else
break;
until false;
ReadRawNextPascalAtom(Source,Position,AtomStart,NestedComments,SkipDirectives);
Result:=copy(Source,AtomStart,Position-AtomStart);
end;
procedure ReadRawNextPascalAtom(const Source: string;
var Position: integer; out AtomStart: integer; NestedComments: boolean);
var Position: integer; out AtomStart: integer; NestedComments: boolean;
SkipDirectives: boolean);
var
Len:integer;
SrcPos, SrcStart, SrcAtomStart: PChar;
@ -1800,14 +1782,14 @@ begin
end;
SrcStart:=PChar(Source);
SrcPos:=@Source[Position];
ReadRawNextPascalAtom(SrcPos,SrcAtomStart,SrcStart+len);
ReadRawNextPascalAtom(SrcPos,SrcAtomStart,SrcStart+len,SkipDirectives);
Position:=SrcPos-SrcStart+1;
AtomStart:=SrcAtomStart-SrcStart+1;
{$IFDEF RangeChecking}{$R+}{$UNDEF RangeChecking}{$ENDIF}
end;
procedure ReadRawNextPascalAtom(var Position: PChar; out AtomStart: PChar;
const SrcEnd: PChar; NestedComments: boolean);
const SrcEnd: PChar; NestedComments: boolean; SkipDirectives: boolean);
var
c1,c2:char;
CommentLvl: Integer;
@ -1834,20 +1816,34 @@ begin
end;
'{': // comment start or compiler directive
begin
if (Src[1]='$') then
if (Src[1]='$') and (not SkipDirectives) then
// compiler directive
break
else begin
// read till comment end
else if Src[1]=#3 then begin
// codetools comment => skip
inc(Src,2);
repeat
case Src^ of
#0:
if (SrcEnd=nil) or (Src>=SrcEnd) then
break;
#3:
if Src[1]='}' then begin
inc(Src,2);
break;
end;
end;
inc(Src);
until false;
end else begin
// Pascal comment => skip
CommentLvl:=1;
while true do begin
inc(Src);
case Src^ of
#0:
if (SrcEnd=nil) or (Src>=SrcEnd) then
break
else
inc(Src);
break;
'{':
if NestedComments then
inc(CommentLvl);
@ -1873,7 +1869,7 @@ begin
break;
'(': // comment, bracket or compiler directive
if (Src[1]='*') then begin
if (Src[2]='$') then
if (Src[2]='$') and (not SkipDirectives) then
// compiler directive
break
else begin
@ -1989,7 +1985,7 @@ begin
inc(Src);
end;
end;
'{': // compiler directive
'{': // compiler directive (it can not be a comment, because see above)
begin
CommentLvl:=1;
while true do begin
@ -1997,9 +1993,7 @@ begin
case Src^ of
#0:
if (SrcEnd=nil) or (Src>=SrcEnd) then
break
else
inc(Src);
break;
'{':
if NestedComments then
inc(CommentLvl);
@ -2089,7 +2083,7 @@ begin
end;
AtomStart:=Position;
while Position<=Len do begin
ReadRawNextPascalAtom(Source,Position,AtomStart,NestedComments);
ReadRawNextPascalAtom(Source,Position,AtomStart,NestedComments,true);
//DebugLn(['ReadTilPascalBracketClose ',copy(Source,AtomStart,Position-AtomStart)]);
if Position>Len then
exit; // CloseBracket not found
@ -2185,9 +2179,7 @@ begin
case p^ of
#0: break;
'{': if NestedComments then
begin
inc(CommentLvl);
end;
'}':
begin
dec(CommentLvl);
@ -2475,6 +2467,7 @@ begin
end;
function FindEndOfAtom(const Source: string; Position: integer): integer;
// comments have length 0
var
p: PChar;
begin
@ -2566,57 +2559,6 @@ function FindLineEndOrCodeAfterPosition(const Source: string;
}
var SrcLen: integer;
function ReadComment(var P: integer): boolean;
// true if it is a comment
// false if it is a directive
begin
case Source[P] of
'{':
begin
if StopAtDirectives and (P<length(Source)) and (Source[P+1]='$') then
exit(false);
inc(P);
while (P<=SrcLen) and (Source[P]<>'}') do begin
if NestedComments and (Source[P] in ['{','(','/']) then
ReadComment(P)
else
inc(P);
end;
inc(P);
end;
'(':
begin
inc(P);
if (P<=SrcLen) and (Source[P]='*') then begin
inc(P);
while (P<=SrcLen-1)
and ((Source[P]<>'*') or (Source[P+1]<>')')) do begin
if NestedComments and (Source[P] in ['{','(','/']) then
ReadComment(P)
else
inc(P);
end;
inc(P,2);
end;
end;
'/':
begin
inc(P);
if (P<=SrcLen) and (Source[P]='/') then begin
inc(P);
while (P<=SrcLen)
and (not (Source[P] in [#10,#13])) do begin
if NestedComments and (Source[P] in ['{','(','/']) then
ReadComment(P)
else
inc(P);
end;
end;
end;
end;
Result:=true;
end;
procedure DoSkipEmptyLines(var p: integer);
var
r: LongInt;
@ -2644,8 +2586,23 @@ begin
if Result=0 then exit;
while (Result<=SrcLen) do begin
case Source[Result] of
'{','(','/':
if not ReadComment(Result) then exit;
'/':
if (Result<SrcLen) and (Source[Result+1]='/') then
Result:=FindCommentEnd(Source,Result,NestedComments)
else
inc(Result);
'{':
if (Result<SrcLen) and (Source[Result+1]='$') and StopAtDirectives then
exit // stop at directive {$ }
else
Result:=FindCommentEnd(Source,Result,NestedComments);
'(':
if (Result<SrcLen) and (Source[Result+1]='*') then begin
if (Result+1<SrcLen) and (Source[Result+2]='$') and StopAtDirectives then
exit; // stop at directive (*$ *)
Result:=FindCommentEnd(Source,Result,NestedComments);
end else
inc(Result); // normal bracket (
#10,#13:
begin
if SkipEmptyLines then DoSkipEmptyLines(Result);
@ -2733,19 +2690,34 @@ var SrcStart: integer;
'}':
begin
dec(p);
while (p>SrcStart) and (Source[p]<>'{') do begin
if NestedComments and (Source[p]='}') then
ReadComment(p,true)
else
if (p>SrcStart) and (Source[p]=#3) then begin
// codetools skip comment
dec(p);
while (p>SrcStart) do begin
if (Source[p]=#3)
and (Source[p-1]='{') then begin
dec(p);
break;
end;
dec(p);
end;
end else begin
// Pascal comment {}
while (p>SrcStart) and (Source[p]<>'{') do begin
if NestedComments and (Source[p]='}') then
ReadComment(p,true)
else
dec(p);
end;
IsDirective:=(p>=SrcStart) and (Source[p+1]='$');
dec(p);
end;
IsDirective:=(p>=SrcStart) and (Source[p+1]='$');
dec(p);
end;
')':
begin
dec(p);
if (p>SrcStart) and (Source[p]='*') then begin
// tp comment (* *)
dec(p);
while (p>SrcStart)
and ((Source[p-1]<>'(') or (Source[p]<>'*')) do begin
@ -2898,54 +2870,9 @@ function FindFirstLineEndAfterInCode(const Source: string;
ignore line ends in comments
Result is Position of Start of Line End
}
var SrcLen: integer;
procedure ReadComment(var P: integer);
begin
case Source[P] of
'{':
begin
inc(P);
while (P<=SrcLen) and (Source[P]<>'}') do begin
if NestedComments and (Source[P] in ['{','(','/']) then
ReadComment(P)
else
inc(P);
end;
inc(P);
end;
'(':
begin
inc(P);
if (P<=SrcLen) and (Source[P]='*') then begin
inc(P);
while (P<=SrcLen-1)
and ((Source[P]<>'*') or (Source[P-1]<>')')) do begin
if NestedComments and (Source[P] in ['{','(','/']) then
ReadComment(P)
else
inc(P);
end;
inc(P,2);
end;
end;
'/':
begin
inc(P);
if (P<=SrcLen) and (Source[P]='/') then begin
inc(P);
while (P<=SrcLen)
and (not (Source[P] in [#10,#13])) do begin
if NestedComments and (Source[P] in ['{','(','/']) then
ReadComment(P)
else
inc(P);
end;
end;
end;
end;
end;
var
SrcLen: integer;
CommentEndPos: Integer;
begin
SrcLen:=length(Source);
if SrcLen>MaxPosition then SrcLen:=MaxPosition;
@ -2953,7 +2880,13 @@ begin
while (Result<=SrcLen) do begin
case Source[Result] of
'{','(','/':
ReadComment(Result);
begin
CommentEndPos:=FindCommentEnd(Source,Result,NestedComments);
if CommentEndPos>Result then
Result:=CommentEndPos
else
inc(Result);
end;
#10,#13:
exit;
else
@ -3157,13 +3090,26 @@ var
'}':
begin
dec(P);
while (P>=SrcStart) and (Source[P]<>'{') do begin
if NestedComments and (Source[P] in ['}',')']) then
ReadComment(P)
else
if (P>=SrcStart) and (Source[P]=#3) then begin
// codetools comment {#3 #3}
dec(p);
while (P>SrcStart) do begin
if (Source[P]=#3) and (Source[P-1]='{') then begin
dec(P,2);
break;
end;
dec(P);
end;
end else begin
// Pascal comment {}
while (P>=SrcStart) and (Source[P]<>'{') do begin
if NestedComments and (Source[P] in ['}',')']) then
ReadComment(P)
else
dec(P);
end;
dec(P);
end;
dec(P);
end;
')':
begin
@ -3460,69 +3406,23 @@ end;
function CleanCodeFromComments(const DirtyCode: string;
NestedComments: boolean): string;
var DirtyPos, CleanPos, DirtyLen: integer;
c: char;
procedure ReadComment(var P: integer);
begin
case DirtyCode[P] of
'{':
begin
inc(P);
while (P<=DirtyLen) and (DirtyCode[P]<>'}') do begin
if NestedComments and (DirtyCode[P] in ['{','(','/']) then
ReadComment(P)
else
inc(P);
end;
inc(P);
end;
'(':
begin
inc(P);
if (P<=DirtyLen) and (DirtyCode[P]='*') then begin
inc(P);
while (P<=DirtyLen-1)
and ((DirtyCode[P]<>'*') or (DirtyCode[P-1]<>')')) do begin
if NestedComments and (DirtyCode[P] in ['{','(','/']) then
ReadComment(P)
else
inc(P);
end;
inc(P,2);
end;
end;
'/':
begin
inc(P);
if (P<=DirtyLen) and (DirtyCode[P]='/') then begin
inc(P);
while (P<=DirtyLen)
and (not (DirtyCode[P] in [#10,#13])) do begin
if NestedComments and (DirtyCode[P] in ['{','(','/']) then
ReadComment(P)
else
inc(P);
end;
end;
end;
end;
end;
var
DirtyPos: Integer;
CleanPos: Integer;
StartPos: Integer;
l: Integer;
begin
DirtyLen:=length(DirtyCode);
SetLength(Result,DirtyLen);
SetLength(Result,length(DirtyCode));
DirtyPos:=1;
CleanPos:=1;
while (DirtyPos<=DirtyLen) do begin
c:=DirtyCode[DirtyPos];
if not (c in ['/','{','(']) then begin
Result[CleanPos]:=c;
inc(DirtyPos);
inc(CleanPos);
end else begin
ReadComment(DirtyPos);
while DirtyPos<=length(DirtyCode) do begin
StartPos:=FindNextComment(DirtyCode,DirtyPos);
l:=StartPos-DirtyPos;
if l>0 then begin
System.Move(DirtyCode[DirtyPos],Result[CleanPos],l);
inc(CleanPos,l);
end;
DirtyPos:=FindCommentEnd(DirtyCode,StartPos,NestedComments);
end;
SetLength(Result,CleanPos-1);
end;
@ -3550,8 +3450,19 @@ begin
end;
end else if (ASource[StartPos]='{') then begin
inc(StartPos);
if (EndPos<=length(ASource)) and (ASource[EndPos-1]='}') then
dec(EndPos);
if (StartPos<=length(ASource)) and (ASource[StartPos]=#3) then begin
// codetools skip comment {#3#3}
inc(StartPos);
if (EndPos<=length(ASource)) and (ASource[EndPos-1]='}') then begin
dec(EndPos);
if (EndPos<=length(ASource)) and (ASource[EndPos-1]=#3) then
dec(EndPos);
end;
end else begin
// Pascal comment {}
if (EndPos<=length(ASource)) and (ASource[EndPos-1]='}') then
dec(EndPos);
end;
end else if (ASource[StartPos]='(') then begin
inc(StartPos);
if (StartPos<=length(ASource)) and (ASource[StartPos]='*') then
@ -3874,6 +3785,7 @@ end;
function CompareComments(p1, p2: PChar; NestedComments: boolean): integer;
var
CommentLvl: Integer;
IsCodetoolsComment: Boolean;
begin
if p1^<>p2^ then begin
if p1^<p2^ then
@ -3921,6 +3833,7 @@ begin
inc(p1);
inc(p2);
CommentLvl:=1;
IsCodetoolsComment:=p1^=#3;
while true do begin
if p1^<>p2^ then begin
if p1^<p2^ then
@ -3930,15 +3843,22 @@ begin
end;
inc(p1);
inc(p2);
case p1^ of
#0: exit(0);
'{': if NestedComments then
inc(CommentLvl);
'}':
begin
dec(CommentLvl);
if CommentLvl=0 then
exit(0);
if IsCodetoolsComment then begin
case p1^ of
#0: exit(0);
'}': if p1[-1]=#3 then exit(0);
end;
end else begin
case p1^ of
#0: exit(0);
'{': if NestedComments then
inc(CommentLvl);
'}':
begin
dec(CommentLvl);
if CommentLvl=0 then
exit(0);
end;
end;
end;
end;
@ -4841,7 +4761,7 @@ begin
AtomEndPos:=1;
repeat
AtomStartPos:=AtomEndPos;
ReadRawNextPascalAtom(ACode,AtomEndPos,AtomStartPos);
ReadRawNextPascalAtom(ACode,AtomEndPos,AtomStartPos,true);
if (AtomEndPos>StartPos) then begin
// token found
Len:=length(ACode);
@ -4897,7 +4817,7 @@ begin
AtomEndPos:=1;
repeat
AtomStartPos:=AtomEndPos;
ReadRawNextPascalAtom(ACode,AtomEndPos,AtomStartPos);
ReadRawNextPascalAtom(ACode,AtomEndPos,AtomStartPos,true);
if (AtomEndPos>=EndPos) then begin
// token found
Len:=length(ACode);

2
components/codetools/codecompletiontool.pas
View File

@ -3601,7 +3601,7 @@ var
// read atom behind identifier name
NewPos:=PtrInt(PtrUInt(Identifier))-PtrInt(PtrUInt(@Src[1]))+1;
inc(NewPos,GetIdentLen(Identifier));
ReadRawNextPascalAtom(Src,NewPos,AtomStart,Scanner.NestedComments);
ReadRawNextPascalAtom(Src,NewPos,AtomStart,Scanner.NestedComments,true);
if (AtomStart<=SrcLen) and (Src[AtomStart]<>'(') then begin
// no parameters
// this is the function pointer, not the result => constant

44
components/codetools/codetoolscfgscript.pas
View File

@ -302,7 +302,7 @@ begin
p:=PChar(Src);
//debugln(['RenameCTCSVariable START ',dbgstr(Src)]);
repeat
ReadRawNextPascalAtom(p,AtomStart);
ReadRawNextPascalAtom(p,AtomStart,nil,false,true);
if (p=AtomStart) then break;
if IsIdentStartChar[AtomStart^]
and (CompareIdentifierPtrs(PChar(OldName),AtomStart)=0)
@ -1406,18 +1406,18 @@ begin
BeginStart:=AtomStart;
StartTop:=FStack.Top;
FStack.Push(ctcssBegin,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
repeat
if (AtomStart^=#0) then begin
ErrorMissingEnd;
break;
end else if CompareIdentifiers('END',AtomStart)=0 then begin
FStack.Pop;
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
break;
end else if AtomStart^=';' then begin
// skip
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
end else begin
RunStatement(Skip);
end;
@ -1438,7 +1438,7 @@ begin
IfStart:=AtomStart;
StartTop:=FStack.Top;
FStack.Push(ctcssIf,IfStart);
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
ExprIsTrue:=false;
if RunExpression then begin
ExprIsTrue:=CTCSVariableIsTrue(FStack.TopItemOperand);
@ -1452,11 +1452,11 @@ begin
if CompareIdentifiers(AtomStart,'then')<>0 then
AddError(Format(ctsThenExpectedButFound, [GetAtomOrNothing]));
// then statement
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
RunStatement(Skip or not ExprIsTrue);
if CompareIdentifiers(AtomStart,'else')=0 then begin
// else statement
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
RunStatement(Skip or ExprIsTrue);
end;
// clean up stack
@ -1467,25 +1467,25 @@ procedure TCTConfigScriptEngine.RunUndefine(Skip: boolean);
var
VarStart: PChar;
begin
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
if AtomStart^<>'(' then begin
AddError(Format(ctsExpectedButFound, [GetAtomOrNothing]));
exit;
end;
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
if (not IsIdentStartChar[AtomStart^]) or IsKeyWord(AtomStart) then begin
AddError(Format(ctsExpectedIdentifierButFound, [GetAtomOrNothing]));
exit;
end;
VarStart:=AtomStart;
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
if AtomStart^<>')' then begin
AddError(Format(ctsExpectedButFound2, [GetAtomOrNothing]));
exit;
end;
if not Skip then
Variables.Undefine(VarStart);
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
end;
procedure TCTConfigScriptEngine.RunAssignment(Skip: boolean);
@ -1504,7 +1504,7 @@ begin
{$ENDIF}
StartTop:=FStack.Top;
FStack.Push(ctcssAssignment,VarStart);
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
{$IFDEF VerboseCTCfgScript}
debugln(['TCTConfigScriptEngine.RunAssignment Operator=',GetAtom]);
{$ENDIF}
@ -1519,7 +1519,7 @@ begin
exit;
end;
// read expression
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
if RunExpression and (not Skip) then begin
Variable:=Variables.GetVariable(VarStart,true);
{$IFDEF VerboseCTCfgScript}
@ -1557,18 +1557,18 @@ var
b: Boolean;
begin
Result:=false;
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
if AtomStart^<>'(' then begin
AddError(Format(ctsExpectedButFound, [GetAtomOrNothing]));
exit;
end;
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
if (not IsIdentStartChar[AtomStart^]) or IsKeyWord(AtomStart) then begin
AddError(Format(ctsExpectedIdentifierButFound, [GetAtomOrNothing]));
exit;
end;
VarStart:=AtomStart;
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
if AtomStart^<>')' then begin
AddError(Format(ctsExpectedButFound2, [GetAtomOrNothing]));
exit;
@ -1588,12 +1588,12 @@ begin
Result:=false;
FunctionName:=AtomStart;
StartTop:=FStack.Top;
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
if AtomStart^<>'(' then begin
AddError(Format(ctsExpectedButFound, [GetAtomOrNothing]));
exit;
end;
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
FStack.Push(ctcssRoundBracketOpen,AtomStart);
FillByte(Value{%H-},SizeOf(Value),0);
@ -2029,7 +2029,7 @@ begin
end;
break;
end;
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
end;
if Result then begin
@ -2341,12 +2341,12 @@ begin
try
// execute all statements
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
while Src^<>#0 do begin
RunStatement(false);
if not (AtomStart^ in [#0,';']) then
ExpectedSemicolon;
ReadRawNextPascalAtom(Src,AtomStart);
ReadRawNextPascalAtom(Src,AtomStart,nil,false,true);
end;
except
on E: Exception do begin
@ -2391,7 +2391,7 @@ var
begin
if P=nil then
exit('');
ReadRawNextPascalAtom(P,StartPos);
ReadRawNextPascalAtom(P,StartPos,nil,false,true);
SetLength(Result,p-StartPos);
if Result<>'' then
System.Move(StartPos^,Result[1],length(Result));

179
components/codetools/customcodetool.pas
View File

@ -1122,28 +1122,47 @@ begin
end;
'{': // pascal comment
begin
CommentLvl:=1;
while true do begin
inc(p);
case p^ of
#0:
begin
CurPos.StartPos:=p-PChar(Src)+1;
if CurPos.StartPos>SrcLen then break;
end;
'{':
if Scanner.NestedComments then begin
//debugln('TCustomCodeTool.ReadNextAtom ',copy(Src,CurPos.StartPos,CurPos.StartPos-CurPos.EndPos));
inc(CommentLvl);
end;
'}':
begin
dec(CommentLvl);
if CommentLvl=0 then begin
inc(p);
inc(p);
if p^=#3 then begin
// codetools skip comment {#3 #3}
repeat
case p^ of
#0:
begin
CurPos.StartPos:=p-PChar(Src)+1;
if CurPos.StartPos>SrcLen then break;
end;
#3:
if p[1]='}' then begin
inc(p,2);
break;
end;
end;
inc(p);
until false;
end else begin
// pascal comment {}
CommentLvl:=1;
while true do begin
case p^ of
#0:
begin
CurPos.StartPos:=p-PChar(Src)+1;
if CurPos.StartPos>SrcLen then break;
end;
'{':
if Scanner.NestedComments then
inc(CommentLvl);
'}':
begin
dec(CommentLvl);
if CommentLvl=0 then begin
inc(p);
break;
end;
end;
end;
inc(p);
end;
end;
end;
@ -1488,32 +1507,43 @@ var
'{':
begin
// skip pascal comment
CommentLvl:=1;
inc(PrePos);
while (PrePos<=CurPos.StartPos) do begin
case Src[PrePos] of
'{': if Scanner.NestedComments then inc(CommentLvl);
'}':
begin
dec(CommentLvl);
if CommentLvl=0 then break;
end;
end;
if (PrePos<=CurPos.StartPos) and (Src[PrePos]=#3) then begin
// skip codetools comment
inc(PrePos);
while (PrePos<=CurPos.StartPos) do begin
if (Src[PrePos]=#3) and (PrePos<CurPos.StartPos)
and (Src[PrePos+1]='}') then begin
inc(PrePos,2);
break;
end;
inc(PrePos);
end;
end else begin
// skip pascal comment
CommentLvl:=1;
while (PrePos<=CurPos.StartPos) do begin
case Src[PrePos] of
'{': if Scanner.NestedComments then inc(CommentLvl);
'}':
begin
dec(CommentLvl);
if CommentLvl=0 then break;
end;
end;
inc(PrePos);
end;
end;
end;
'(':
begin
if Src[PrePos+1]='*' then begin
// skip turbo pascal comment
inc(PrePos,2);
while (PrePos<CurPos.StartPos)
and ((Src[PrePos]<>'*') or (Src[PrePos+1]<>')')) do
inc(PrePos);
if Src[PrePos+1]='*' then begin
// skip turbo pascal comment
inc(PrePos,2);
while (PrePos<CurPos.StartPos)
and ((Src[PrePos]<>'*') or (Src[PrePos+1]<>')')) do
inc(PrePos);
end;
inc(PrePos);
end;
'''':
@ -1574,16 +1604,30 @@ begin
if IsCommentEndChar[Src[CurPos.StartPos]] then begin
case Src[CurPos.StartPos] of
'}': // pascal comment
'}':
begin
CommentLvl:=1;
dec(CurPos.StartPos);
while (CurPos.StartPos>=1) and (CommentLvl>0) do begin
case Src[CurPos.StartPos] of
'}': if Scanner.NestedComments then inc(CommentLvl);
'{': dec(CommentLvl);
end;
if (CurPos.StartPos>=1) and (Src[CurPos.StartPos]=#3) then begin
// codetools skip comment {#3 #3}
dec(CurPos.StartPos);
while (CurPos.StartPos>=1) do begin
if (Src[CurPos.StartPos]=#3) and (CurPos.StartPos>1)
and (Src[CurPos.StartPos-1]='}') then begin
dec(CurPos.StartPos,2);
break;
end;
dec(CurPos.StartPos);
end;
end else begin
// pascal comment {}
CommentLvl:=1;
while (CurPos.StartPos>=1) and (CommentLvl>0) do begin
case Src[CurPos.StartPos] of
'}': if Scanner.NestedComments then inc(CommentLvl);
'{': dec(CommentLvl);
end;
dec(CurPos.StartPos);
end;
end;
end;
@ -2010,49 +2054,10 @@ end;
procedure TCustomCodeTool.ReadTillCommentEnd;
var
CommentLvl: Integer;
EndP: PChar;
begin
{$IFOPT R+}{$DEFINE RangeChecking}{$ENDIF}
{$R-}
case Src[CurPos.StartPos] of
'{': // pascal comment
begin
CommentLvl:=1;
inc(CurPos.StartPos);
while true do begin
case Src[CurPos.StartPos] of
#0: if CurPos.StartPos>SrcLen then break;
'{': if Scanner.NestedComments then inc(CommentLvl);
'}':
begin
dec(CommentLvl);
if CommentLvl=0 then break;
end;
end;
inc(CurPos.StartPos);
end;
inc(CurPos.StartPos);
end;
'/': // Delphi comment
if (Src[CurPos.StartPos+1]='/') then begin
inc(CurPos.StartPos,2);
while (not (Src[CurPos.StartPos] in [#10,#13,#0])) do
inc(CurPos.StartPos);
inc(CurPos.StartPos);
if (CurPos.StartPos<=SrcLen) and (Src[CurPos.StartPos] in [#10,#13])
and (Src[CurPos.StartPos-1]<>Src[CurPos.StartPos]) then
inc(CurPos.StartPos);
end;
'(': // old turbo pascal comment
if (Src[CurPos.StartPos+1]='*') then begin
inc(CurPos.StartPos,3);
while (CurPos.StartPos<=SrcLen)
and ((Src[CurPos.StartPos-1]<>'*') or (Src[CurPos.StartPos]<>')')) do
inc(CurPos.StartPos);
inc(CurPos.StartPos);
end;
end;
{$IFDEF RangeChecking}{$R+}{$UNDEF RangeChecking}{$ENDIF}
EndP:=FindCommentEnd(PChar(Src)+CurPos.StartPos,Scanner.NestedComments);
CurPos.StartPos:=EndP-PChar(Src)+1;
end;
procedure TCustomCodeTool.BeginParsing(Range: TLinkScannerRange);

3
components/codetools/methodjumptool.pas
View File

@ -1102,7 +1102,8 @@ begin
CurLine:=LinkCode.GetLine(SourceLine-1);
EndPos:=1;
while (EndPos<=length(CurLine)) do begin
BasicCodeTools.ReadRawNextPascalAtom(CurLine,EndPos,StartPos);
BasicCodeTools.ReadRawNextPascalAtom(CurLine,EndPos,StartPos,
Scanner.NestedComments,true);
if (EndPos<=length(CurLine))
and (CompareIdentifiers(@CurLine[StartPos],PChar(Identifier))=0)
then begin

32
components/codetools/sourcechanger.pas
View File

@ -119,11 +119,12 @@ type
HiddenIndent: integer; // the next indent is the sum of the current line indent plus HiddenIndent
CommentLvl: integer;
CommentStartPos: array of integer;
CommentType: char; // {, (, /, #3
Src: string;
procedure AddAtom(var CurCode: string; NewAtom: string);
procedure ReadNextAtom;
procedure ReadTilCommentEnd;
function IsCommentType(CommentStart: char): boolean;
function IsCommentType(aCommentType: char): boolean;
procedure StartComment(p: integer);
function EndComment(CommentStart: char; p: integer): boolean;
public
@ -1441,8 +1442,14 @@ begin
inc(CurPos);
until (CurPos>SrcLen) or (not IsHexNumberChar[Src[CurPos]]);
end;
'{': // curly bracket comment or directive
if (CommentLvl=0) or (NestedComments and IsCommentType('{')) then begin
'{':
if (CurPos<SrcLen) and (Src[CurPos+1]=#3) then begin
// codetools skip comment {#3#3}
StartComment(CurPos);
inc(CurPos,2);
CurAtomType:=atCommentStart;
end else if (CommentLvl=0) or (NestedComments and IsCommentType('{')) then begin
// curly bracket comment or directive {}
StartComment(CurPos);
inc(CurPos);
if (CurPos<=SrcLen) and (Src[CurPos]='$') then begin
@ -1460,8 +1467,14 @@ begin
inc(CurPos);
CurAtomType:=atSymbol;
end;
'}': // curly bracket comment end
begin
'}':
if IsCommentType(#3) and (CurPos<SrcLen) and (Src[CurPos+1]=#3) then begin
// codetools skip comment
EndComment(#3,CurPos);
inc(CurPos,2);
CurAtomType:=atCommentEnd;
end else begin
// curly bracket comment end
if EndComment('{',CurPos) then
CurAtomType:=atCommentEnd
else
@ -1571,14 +1584,19 @@ begin
until (CurAtomType=atNone) or (CommentLvl<Lvl);
end;
function TBeautifyCodeOptions.IsCommentType(CommentStart: char): boolean;
function TBeautifyCodeOptions.IsCommentType(aCommentType: char): boolean;
begin
Result:=(CommentLvl>0) and (Src[CommentStartPos[CommentLvl-1]]=CommentStart);
Result:=(CommentLvl>0) and (CommentType=aCommentType);
end;
procedure TBeautifyCodeOptions.StartComment(p: integer);
begin
inc(CommentLvl);
if CommentLvl=1 then begin
CommentType:=Src[p];
if (CommentType='{') and (p<SrcLen) and (Src[p+1]=#3) then
CommentType:=#3;
end;
if length(CommentStartPos)<CommentLvl then
SetLength(CommentStartPos,length(CommentStartPos)*2+10);
CommentStartPos[CommentLvl-1]:=p;

51
test/codetoolstests/testbasiccodetools.pas
View File

@ -3,6 +3,8 @@
./runtests --format=plain --suite=TTestBasicCodeTools
./runtests --format=plain --suite=TestFindLineEndOrCodeInFrontOfPosition
./runtests --format=plain --suite=TestHasTxtWord
./runtests --format=plain --suite=TestBasicFindCommentEnd
./runtests --format=plain --suite=TestBasicFindNextComment
}
unit TestBasicCodetools;
@ -21,6 +23,8 @@ type
published
procedure TestFindLineEndOrCodeInFrontOfPosition;
procedure TestHasTxtWord;
procedure TestBasicFindCommentEnd;
procedure TestBasicFindNextComment;
end;
implementation
@ -90,6 +94,53 @@ begin
t('ab','abab',false,2);
end;
procedure TTestBasicCodeTools.TestBasicFindCommentEnd;
procedure TestFindCommentEnd(Src: string;
NestedComments: boolean; ExpectedEndPos: integer);
var
EndPos: Integer;
p: PChar;
EndP: PChar;
begin
EndPos:=FindCommentEnd(Src,1,NestedComments);
AssertEquals('FindCommentEnd(string) '+dbgstr(Src),ExpectedEndPos,EndPos);
p:=PChar(Src);
EndP:=FindCommentEnd(p,NestedComments);
EndPos:=EndP-PChar(Src)+1;
AssertEquals('FindCommentEnd(pchar) '+dbgstr(Src),ExpectedEndPos,EndPos);
end;
begin
TestFindCommentEnd(' ',false,1);
TestFindCommentEnd('{}',false,3);
TestFindCommentEnd('(**)',false,5);
TestFindCommentEnd('(*)',false,4);
TestFindCommentEnd('{{}}',false,4);
TestFindCommentEnd('{{}}',true,5);
TestFindCommentEnd('{'#3#3'}',false,5);
TestFindCommentEnd('{'#3'}'#3'}',false,6);
TestFindCommentEnd('//',false,3);
end;
procedure TTestBasicCodeTools.TestBasicFindNextComment;
procedure TestFindNextComment(Src: string; ExpectedPos: integer);
var
StartPos: Integer;
begin
StartPos:=FindNextComment(Src,1);
AssertEquals('FindNextComment '+dbgstr(Src),ExpectedPos,StartPos);
end;
begin
TestFindNextComment('{',1);
TestFindNextComment('//',1);
TestFindNextComment('(*',1);
TestFindNextComment('(',2);
TestFindNextComment('/',2);
end;
initialization
AddToCodetoolsTestSuite(TTestBasicCodeTools);