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

undo

Browse Source 
git-svn-id: trunk@38292 -
This commit is contained in:
mattias 2012-08-21 07:48:52 +00:00
parent 8700716f40
commit ac5fdad655
7 changed files with 129 additions and 296 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
components/codetools/examples/finddeclaration.lpi
View File

@ -29,7 +29,7 @@
<PackageName Value="CodeTools"/>
</Item1>
</RequiredPackages>
<Units Count="5">
<Units Count="4">
<Unit0>
<Filename Value="finddeclaration.lpr"/>
<IsPartOfProject Value="True"/>
@ -49,11 +49,6 @@
<Filename Value="../../../../../amat/test/test.inc"/>
<IsPartOfProject Value="True"/>
</Unit3>
<Unit4>
<Filename Value="scanexamples/commentsidentifiers.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="commentsidentifiers"/>
</Unit4>
</Units>
</ProjectOptions>
<CompilerOptions>

1
components/codetools/examples/finddeclaration.lpr
View File

@ -48,7 +48,6 @@ begin
writeln('Usage:');
writeln(' ',ParamStr(0));
writeln(' ',ParamStr(0),' <filename> <X> <Y>');
Halt(1);
end;
// setup the Options

21
components/codetools/examples/scanexamples/commentsidentifiers.pas
View File

@ -1,21 +0,0 @@
unit commentsidentifiers;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
TMyRange = 1..10;
{$IFDEF doesnotexist}
var
i: TMyRange;
{$ENDIF}
implementation
end.

38
components/codetools/fileprocs.pas
View File

@ -43,7 +43,7 @@ uses
MemCheck,
{$ENDIF}
Classes, SysUtils, LazUTF8, LazDbgLog, LazFileCache, LazFileUtils,
lazutf8classes, LazLogger, AVL_Tree, CodeToolsStrConsts;
lazutf8classes, AVL_Tree, CodeToolsStrConsts;
type
TFPCStreamSeekType = int64;
@ -289,7 +289,6 @@ function dbgMemRange(P: PByte; Count: integer; Width: integer = 0): string; over
function DbgS(const i1,i2,i3,i4: integer): string; overload;
function DbgStr(const StringWithSpecialChars: string): string; overload;
function DbgStr(const StringWithSpecialChars: string; StartPos, Len: PtrInt): string; overload;
function DbgText(const StringWithSpecialChars: string; KeepLines: boolean = true): string; overload;
function MemSizeString(const s: string): PtrUInt; inline;
function MemSizeFPList(const List: TFPList): PtrUInt; inline;
@ -2062,15 +2061,15 @@ var
s: String;
begin
Result:=StringWithSpecialChars;
i:=length(Result);
while (i>0) do begin
i:=1;
while (i<=length(Result)) do begin
case Result[i] of
' '..#126: ;
' '..#126: inc(i);
else
s:='#'+IntToStr(ord(Result[i]));
ReplaceSubstring(Result,i,1,s);
Result:=copy(Result,1,i-1)+s+copy(Result,i+1,length(Result)-i);
inc(i,length(s));
end;
dec(i);
end;
end;
@ -2080,31 +2079,6 @@ begin
Result:=dbgstr(copy(StringWithSpecialChars,StartPos,Len));
end;
function DbgText(const StringWithSpecialChars: string; KeepLines: boolean
): string;
var
i: Integer;
s: String;
begin
Result:=StringWithSpecialChars;
i:=length(Result);
while (i>0) do begin
case Result[i] of
#10,#13:
begin
p:=i;
inc(i);
if (i<=length(Result))
end;
' '..#126: dec(i);
else
s:='#'+IntToStr(ord(Result[i]));
ReplaceSubstring(Result,i,1,s);
dec(i);
end;
end;
end;
function MemSizeString(const s: string): PtrUInt;
begin
Result:=LazDbgLog.MemSizeString(s);

6
components/codetools/finddeclarationtool.pas
View File

@ -1412,12 +1412,10 @@ begin
{$ENDIF}
if DirtySrc<>nil then DirtySrc.Clear;
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos,btCursorPosOutAllowed]);
[btSetIgnoreErrorPos,btLoadDirtySource,btCursorPosOutAllowed]);
{$IFDEF CTDEBUG}
DebugLn('TFindDeclarationTool.FindDeclaration C CleanCursorPos=',dbgs(CleanCursorPos));
{$ENDIF}
debugln(['TFindDeclarationTool.FindDeclaration ',dbgstr]);
// find CodeTreeNode at cursor
if (Tree.Root<>nil) and (Tree.Root.StartPos<=CleanCursorPos) then begin
CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos,true);
@ -5167,7 +5165,7 @@ begin
// build code tree
if DirtySrc<>nil then DirtySrc.Clear;
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos,btCursorPosOutAllowed]);
[btSetIgnoreErrorPos,btLoadDirtySource,btCursorPosOutAllowed]);
// find CodeTreeNode at cursor
if (Tree.Root<>nil) and (Tree.Root.StartPos<=CleanCursorPos) then
CursorNode := BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos, True)

347
components/codetools/linkscanner.pas
View File

@ -26,6 +26,9 @@
resulting source is called the cleaned source. A link points from a position
of the cleaned source to its position in the real source.
The link list makes it possible to change scanned code in the source files.
ToDo:
- macros
}
unit LinkScanner;
@ -41,6 +44,7 @@ unit LinkScanner;
{$I codetools.inc}
{ $DEFINE ShowIgnoreErrorAfter}
{ $DEFINE EnableIncludeSkippedCode}
// debugging
{ $DEFINE ShowUpdateCleanedSrc}
@ -91,10 +95,7 @@ type
{ TSourceLink is used to map between the codefiles and the cleaned source }
TSourceLinkKind = (
slkCode,
slkMissingIncludeFile,
slkSkipStart, // start of skipped code due to IFDEFs {#3
slkSkipEnd, // end of skipped code due to IFDEFs #3}
slkCompilerString // e.g. {$I %FPCVERSION%}
slkMissingIncludeFile
);
TSourceLinkKinds = set of TSourceLinkKind;
PSourceLink = ^TSourceLink;
@ -348,15 +349,15 @@ type
function ReturnFromIncludeFileAndIsEnd: boolean;
function ReadIdentifier: string;
function ReadUpperIdentifier: string;
procedure ReadSpace; {$IFDEF UseInline}inline;{$ENDIF}
procedure ReadCurlyComment;
procedure ReadLineComment;
procedure ReadRoundComment;
procedure SkipSpace; {$IFDEF UseInline}inline;{$ENDIF}
procedure SkipCurlyComment;
procedure SkipLineComment;
procedure SkipRoundComment;
procedure CommentEndNotFound;
procedure EndComment; {$IFDEF UseInline}inline;{$ENDIF}
procedure IncCommentLevel; {$IFDEF UseInline}inline;{$ENDIF}
procedure DecCommentLevel; {$IFDEF UseInline}inline;{$ENDIF}
procedure HandleDirective;
procedure HandleDirectives;
procedure UpdateCleanedSource(NewCopiedSrcPos: integer);
function ReturnFromIncludeFile: boolean;
function ParseKeyWord(StartPos, WordLen: integer; LastTokenType: TLSTokenType
@ -386,9 +387,7 @@ type
procedure SetCompilerMode(const AValue: TCompilerMode);
procedure SkipTillEndifElse(SkippingUntil: TLSSkippingDirective);
function InternalIfDirective: boolean;
procedure EndSkipping;
procedure AddSkipComment(IsStart: boolean);
function IfdefDirective: boolean;
function IfCDirective: boolean;
function IfndefDirective: boolean;
@ -426,7 +425,6 @@ type
function MissingIncludeFilesNeedsUpdate: boolean;
procedure ClearMissingIncludeFiles;
// code macros
procedure AddMacroValue(MacroName: PChar;
ValueStart, ValueEnd: integer);
procedure ClearMacros;
@ -625,7 +623,6 @@ function IndexOfCodeInUniqueList(ACode: Pointer;
UniqueSortedCodeList: TFPList): integer;
function dbgs(r: TLinkScannerRange): string; overload;
function dbgs(const ModeSwitches: TCompilerModeSwitches): string; overload;
function dbgs(k: TSourceLinkKind): string; overload;
implementation
@ -692,17 +689,6 @@ begin
Result:='['+Result+']';
end;
function dbgs(k: TSourceLinkKind): string;
begin
case k of
slkCode: Result:='Code';
slkMissingIncludeFile: Result:='MissingInc';
slkSkipStart: Result:='SkipStart';
slkSkipEnd: Result:='SkipEnd';
else Result:='?';
end;
end;
procedure AddCodeToUniqueList(ACode: Pointer; UniqueSortedCodeList: TFPList);
var l,m,r: integer;
begin
@ -765,14 +751,7 @@ var
NewCapacity: Integer;
Link: PSourceLink;
begin
if (LinkCount>0) and (FLinks[FLinkCount-1].CleanedPos=CleanedLen+1) then begin
// last link is empty => remove
{$IFDEF ShowUpdateCleanedSrc}
Link:=@FLinks[FLinkCount-1];
debugln(['TLinkScanner.AddLink removing empty link: ',dbgs(Link^.Kind)]);
{$ENDIF}
dec(FLinkCount);
end else if FLinkCount=FLinkCapacity then begin
if FLinkCount=FLinkCapacity then begin
NewCapacity:=FLinkCapacity*2;
if NewCapacity<16 then NewCapacity:=16;
ReAllocMem(FLinks,NewCapacity*SizeOf(TSourceLink));
@ -899,6 +878,8 @@ function TLinkScanner.FindFirstSiblingLink(LinkIndex: integer): integer;
if LinkIndex is in an include file, the result will be the first link of
the include file. If the include file is included multiple times, it is
treated as if they are different files.
ToDo: if include file includes itself, directly or indirectly
}
var
LastIndex: integer;
@ -1062,7 +1043,7 @@ begin
end;
end;
procedure TLinkScanner.HandleDirective;
procedure TLinkScanner.HandleDirectives;
var DirStart, DirLen: integer;
begin
SrcPos:=CommentInnerStartPos+1;
@ -1071,7 +1052,7 @@ begin
inc(SrcPos);
DirLen:=SrcPos-DirStart;
if DirLen>255 then DirLen:=255;
FDirectiveName:=copy(Src,DirStart,DirLen);
FDirectiveName:=UpperCaseStr(copy(Src,DirStart,DirLen));
DoDirective(DirStart,DirLen);
SrcPos:=CommentEndPos;
end;
@ -1127,20 +1108,20 @@ begin
'{' :
begin
SrcPos:=p-PChar(Src)+1;
ReadCurlyComment;
SkipCurlyComment;
p:=@Src[SrcPos];
end;
'/':
if p[1]='/' then begin
SrcPos:=p-PChar(Src)+1;
ReadLineComment;
SkipLineComment;
p:=@Src[SrcPos];
end else
break;
'(':
if p[1]='*' then begin
SrcPos:=p-PChar(Src)+1;
ReadRoundComment;
SkipRoundComment;
p:=@Src[SrcPos];
end else
break;
@ -1416,12 +1397,13 @@ begin
LastTokenType:=TokenType;
end;
finally
{$IFDEF ShowUpdateCleanedSrc}
DebugLn('TLinkScanner.Scan UpdatePos=',DbgS(SrcPos-1));
{$ENDIF}
if (SrcPos>CopiedSrcPos) then
UpdateCleanedSource(SrcPos-1);
if FSkippingDirectives<>lssdNone then begin
if FSkippingDirectives=lssdNone then begin
{$IFDEF ShowUpdateCleanedSrc}
DebugLn('TLinkScanner.Scan UpdatePos=',DbgS(SrcPos-1));
{$ENDIF}
if SrcPos>CopiedSrcPos then
UpdateCleanedSource(SrcPos-1);
end else begin
{$IFDEF ShowUpdateCleanedSrc}
DebugLn(['TLinkScanner.Scan missing $ENDIF']);
{$ENDIF}
@ -1449,7 +1431,7 @@ begin
FLinks[Index]:=Value;
end;
procedure TLinkScanner.ReadCurlyComment;
procedure TLinkScanner.SkipCurlyComment;
// a normal pascal {} comment
var
p: PChar;
@ -1487,12 +1469,11 @@ begin
CommentInnerEndPos:=SrcPos-1;
if (CommentLevel>0) then CommentEndNotFound;
// handle compiler switches
if Src[CommentInnerStartPos]='$' then
HandleDirective;
if Src[CommentInnerStartPos]='$' then HandleDirectives;
EndComment;
end;
procedure TLinkScanner.ReadLineComment;
procedure TLinkScanner.SkipLineComment;
// a // newline comment
var
p: PChar;
@ -1513,7 +1494,7 @@ begin
EndComment;
end;
procedure TLinkScanner.ReadRoundComment;
procedure TLinkScanner.SkipRoundComment;
// a delphi comment (* *)
var
p: PChar;
@ -1558,8 +1539,7 @@ begin
CommentInnerEndPos:=SrcPos-2;
if (CommentLevel>0) then CommentEndNotFound;
// handle compiler switches
if Src[CommentInnerStartPos]='$' then
HandleDirective;
if Src[CommentInnerStartPos]='$' then HandleDirectives;
EndComment;
end;
@ -2372,6 +2352,7 @@ begin
else if InitialValues.IsDefined('WIN32') then
FHiddenUsedUnits:='SYSWIN32';
end;
// ToDo: heaptrc
if InitialValues.IsDefined(MacroUseLineInfo) then
FHiddenUsedUnits:=FHiddenUsedUnits+',lineinfo'
else if InitialValues.IsDefined(MacroUselnfodwrf) then
@ -2452,24 +2433,20 @@ end;
function TLinkScanner.ShortSwitchDirective: boolean;
// example: {$H+} or {$H+, R- comment}
var
c: Char;
begin
c:=UpChars[FDirectiveName[1]];
FDirectiveName:=CompilerSwitchesNames[c];
FDirectiveName:=CompilerSwitchesNames[FDirectiveName[1]];
if FDirectiveName<>'' then begin
if (SrcPos<=SrcLen) and (Src[SrcPos] in ['-','+']) then begin
if Src[SrcPos]='-' then
Values.Variables[FDirectiveName]:='0'
else
Values.Variables[FDirectiveName]:='1';
inc(SrcPos);
Result:=ReadNextSwitchDirective;
end else begin
if c='I' then
Result:=IncludeDirective
if FDirectiveName<>CompilerSwitchesNames['I'] then
Result:=LongSwitchDirective
else
Result:=LongSwitchDirective;
Result:=IncludeDirective;
end;
end else
Result:=true;
@ -2491,17 +2468,17 @@ begin
case UpChars[p^] of
'A':
case UpChars[p[1]] of
'L': if CompareIdentifiers(p,'ALIGN')=0 then Result:=LongSwitchDirective;
'S': if CompareIdentifiers(p,'ASSERTIONS')=0 then Result:=LongSwitchDirective;
'L': if CompareIdentifiers(p,'ALIGN')=0 then Result:=true;
'S': if CompareIdentifiers(p,'ASSERTIONS')=0 then Result:=true;
end;
'B':
if CompareIdentifiers(p,'BOOLEVAL')=0 then Result:=LongSwitchDirective;
if CompareIdentifiers(p,'BOOLEVAL')=0 then Result:=true;
'D':
case UpChars[p[1]] of
'E':
case UpChars[p[2]] of
'F': if CompareIdentifiers(p,'DEFINE')=0 then Result:=DefineDirective;
'B': if CompareIdentifiers(p,'DEBUGINFO')=0 then Result:=LongSwitchDirective;
'B': if CompareIdentifiers(p,'DEBUGINFO')=0 then Result:=true;
end;
end;
'E':
@ -2521,7 +2498,7 @@ begin
if CompareIdentifiers(p,'ENDC')=0 then Result:=EndCDirective
else if CompareIdentifiers(p,'ENDIF')=0 then Result:=EndIfDirective;
'X':
if CompareIdentifiers(p,'EXTENDEDSYNTAX')=0 then Result:=LongSwitchDirective;
if CompareIdentifiers(p,'EXTENDEDSYNTAX')=0 then Result:=true;
end;
'I':
case UpChars[p[1]] of
@ -2537,36 +2514,36 @@ begin
'N':
if CompareIdentifiers(p,'INCLUDE')=0 then Result:=IncludeDirective
else if CompareIdentifiers(p,'INCLUDEPATH')=0 then Result:=IncludePathDirective;
'O': if CompareIdentifiers(p,'IOCHECKS')=0 then Result:=LongSwitchDirective;
'O': if CompareIdentifiers(p,'IOCHECKS')=0 then Result:=true;
end;
'L':
if CompareIdentifiers(p,'LOCALSYMBOLS')=0 then Result:=LongSwitchDirective
else if CompareIdentifiers(p,'LONGSTRINGS')=0 then Result:=LongSwitchDirective;
if CompareIdentifiers(p,'LOCALSYMBOLS')=0 then Result:=true
else if CompareIdentifiers(p,'LONGSTRINGS')=0 then Result:=true;
'M':
if CompareIdentifiers(p,'MODE')=0 then Result:=ModeDirective
else if CompareIdentifiers(p,'MODESWITCH')=0 then Result:=ModeSwitchDirective
else if CompareIdentifiers(p,'MACRO')=0 then Result:=MacroDirective;
'O':
if CompareIdentifiers(p,'OPENSTRINGS')=0 then Result:=LongSwitchDirective
else if CompareIdentifiers(p,'OVERFLOWCHECKS')=0 then Result:=LongSwitchDirective;
if CompareIdentifiers(p,'OPENSTRINGS')=0 then Result:=true
else if CompareIdentifiers(p,'OVERFLOWCHECKS')=0 then Result:=true;
'R':
if CompareIdentifiers(p,'RANGECHECKS')=0 then Result:=LongSwitchDirective
else if CompareIdentifiers(p,'REFERENCEINFO')=0 then Result:=LongSwitchDirective;
if CompareIdentifiers(p,'RANGECHECKS')=0 then Result:=true
else if CompareIdentifiers(p,'REFERENCEINFO')=0 then Result:=true;
'S':
if CompareIdentifiers(p,'SETC')=0 then Result:=SetCDirective
else if CompareIdentifiers(p,'STACKFRAMES')=0 then Result:=LongSwitchDirective;
else if CompareIdentifiers(p,'STACKFRAMES')=0 then Result:=true;
'T':
if CompareIdentifiers(p,'THREADING')=0 then Result:=ThreadingDirective
else if CompareIdentifiers(p,'TYPEADDRESS')=0 then Result:=LongSwitchDirective
else if CompareIdentifiers(p,'TYPEINFO')=0 then Result:=LongSwitchDirective;
else if CompareIdentifiers(p,'TYPEADDRESS')=0 then Result:=true
else if CompareIdentifiers(p,'TYPEINFO')=0 then Result:=true;
'U':
if CompareIdentifiers(p,'UNDEF')=0 then Result:=UndefDirective;
'V':
if CompareIdentifiers(p,'VARSTRINGCHECKS')=0 then Result:=LongSwitchDirective;
if CompareIdentifiers(p,'VARSTRINGCHECKS')=0 then Result:=true;
end;
end;
end else begin
// skipping code => read only IF directives
// skipping code, but still have to read if directives
case UpChars[p^] of
'E':
case UpChars[p[1]] of
@ -2605,7 +2582,7 @@ function TLinkScanner.LongSwitchDirective: boolean;
// example: {$ASSERTIONS ON comment}
var ValStart: integer;
begin
ReadSpace;
SkipSpace;
ValStart:=SrcPos;
while (SrcPos<=SrcLen) and IsWordChar[Src[SrcPos]] do
inc(SrcPos);
@ -2617,9 +2594,9 @@ begin
and (FDirectiveName='ASSERTIONS') then
Values.Variables[FDirectiveName]:='PRELOAD'
else if (FDirectiveName='LOCALSYMBOLS') then
// ignore "localsymbols <something>"
// ignore link object directive
else if (FDirectiveName='RANGECHECKS') then
// ignore "rangechecks <something>"
// ignore link object directive
else if (FDirectiveName='ALIGN') then
// set record align size
else begin
@ -2633,7 +2610,7 @@ function TLinkScanner.MacroDirective: boolean;
var
ValStart: LongInt;
begin
ReadSpace;
SkipSpace;
ValStart:=SrcPos;
while (SrcPos<=SrcLen) and (IsWordChar[Src[SrcPos]]) do
inc(SrcPos);
@ -2653,7 +2630,7 @@ var ValStart: integer;
AMode: TCompilerMode;
ModeValid: boolean;
begin
ReadSpace;
SkipSpace;
ValStart:=SrcPos;
while (SrcPos<=SrcLen) and (IsWordChar[Src[SrcPos]]) do
inc(SrcPos);
@ -2692,7 +2669,7 @@ var
ModeSwitch: TCompilerModeSwitch;
s: TCompilerModeSwitches;
begin
ReadSpace;
SkipSpace;
ValStart:=SrcPos;
while (SrcPos<=SrcLen) and (IsIdentChar[Src[SrcPos]]) do
inc(SrcPos);
@ -2719,7 +2696,7 @@ function TLinkScanner.ThreadingDirective: boolean;
var
ValStart: integer;
begin
ReadSpace;
SkipSpace;
ValStart:=SrcPos;
while (SrcPos<=SrcLen) and (IsWordChar[Src[SrcPos]]) do
inc(SrcPos);
@ -2736,7 +2713,7 @@ end;
function TLinkScanner.ReadNextSwitchDirective: boolean;
var DirStart, DirLen: integer;
begin
ReadSpace;
SkipSpace;
if (SrcPos<=SrcLen) and (Src[SrcPos]=',') then begin
inc(SrcPos);
DirStart:=SrcPos;
@ -2744,7 +2721,7 @@ begin
inc(SrcPos);
DirLen:=SrcPos-DirStart;
if DirLen>255 then DirLen:=255;
FDirectiveName:=copy(Src,DirStart,DirLen);
FDirectiveName:=UpperCaseStr(copy(Src,DirStart,DirLen));
Result:=DoDirective(DirStart,DirLen);
end else
Result:=true;
@ -2756,7 +2733,7 @@ var VariableName: string;
begin
inc(IfLevel);
if FSkippingDirectives<>lssdNone then exit(true);
ReadSpace;
SkipSpace;
VariableName:=ReadUpperIdentifier;
if (VariableName<>'') and (not Values.IsDefined(VariableName)) then
SkipTillEndifElse(lssdTillElse);
@ -2772,7 +2749,7 @@ begin
Result:=InternalIfDirective;
end;
procedure TLinkScanner.ReadSpace;
procedure TLinkScanner.SkipSpace;
begin
while (SrcPos<=SrcLen) and (IsSpaceChar[Src[SrcPos]]) do inc(SrcPos);
end;
@ -2814,7 +2791,7 @@ var VariableName: string;
begin
inc(IfLevel);
if FSkippingDirectives<>lssdNone then exit(true);
ReadSpace;
SkipSpace;
VariableName:=ReadUpperIdentifier;
if (VariableName<>'') and (Values.IsDefined(VariableName)) then
SkipTillEndifElse(lssdTillElse);
@ -2833,11 +2810,8 @@ begin
if IfLevel<=0 then
RaiseAWithoutB;
dec(IfLevel);
if (IfLevel<FSkipIfLevel) and (FSkippingDirectives<>lssdNone) then begin
{$IFDEF ShowUpdateCleanedSrc}
debugln(['TLinkScanner.EndifDirective end skip']);
{$ENDIF}
EndSkipping;
if IfLevel<FSkipIfLevel then begin
FSkippingDirectives:=lssdNone;
end;
Result:=true;
end;
@ -2855,11 +2829,8 @@ begin
if IfLevel<=0 then
RaiseAWithoutB;
dec(IfLevel);
if (IfLevel<FSkipIfLevel) and (FSkippingDirectives<>lssdNone) then begin
{$IFDEF ShowUpdateCleanedSrc}
debugln(['TLinkScanner.EndCDirective end skip']);
{$ENDIF}
EndSkipping;
if IfLevel<FSkipIfLevel then begin
FSkippingDirectives:=lssdNone;
end;
Result:=true;
end;
@ -2876,11 +2847,8 @@ begin
if IfLevel<=0 then
RaiseAWithoutB;
dec(IfLevel);
if (IfLevel<FSkipIfLevel) and (FSkippingDirectives<>lssdNone) then begin
{$IFDEF ShowUpdateCleanedSrc}
debugln(['TLinkScanner.IfEndDirective end skip']);
{$ENDIF}
EndSkipping;
if IfLevel<FSkipIfLevel then begin
FSkippingDirectives:=lssdNone;
end;
Result:=true;
end;
@ -2898,15 +2866,12 @@ begin
RaiseAWithoutB;
case FSkippingDirectives of
lssdNone:
// last block was executed, skip all other
SkipTillEndifElse(lssdTillEndIf);
lssdTillElse:
if IfLevel=FSkipIfLevel then begin
{$IFDEF ShowUpdateCleanedSrc}
debugln(['TLinkScanner.ElseDirective skipped front, using ELSE part']);
{$ENDIF}
EndSkipping;
end;
if IfLevel=FSkipIfLevel then
FSkippingDirectives:=lssdNone;
// else: continue skip;
lssdTillEndIf: ; // continue skip
end;
Result:=true;
end;
@ -2925,15 +2890,12 @@ begin
RaiseAWithoutB;
case FSkippingDirectives of
lssdNone:
// last block was executed, skip all other
SkipTillEndifElse(lssdTillEndIf);
lssdTillElse:
if IfLevel=FSkipIfLevel then begin
{$IFDEF ShowUpdateCleanedSrc}
debugln(['TLinkScanner.ElseCDirective skipped front, using ELSEC part']);
{$ENDIF}
EndSkipping;
end;
if IfLevel=FSkipIfLevel then
FSkippingDirectives:=lssdNone;
// else: continue skip;
lssdTillEndIf: ; // continue skip
end;
Result:=true;
end;
@ -2949,15 +2911,13 @@ function TLinkScanner.ElseIfDirective: boolean;
begin
if IfLevel=0 then
RaiseAWithoutB;
case FSkippingDirectives of
lssdNone:
// last block was executed, skip all other
SkipTillEndifElse(lssdTillEndIf);
lssdTillElse:
if IfLevel=FSkipIfLevel then
exit(InternalIfDirective);
if (FSkippingDirectives=lssdTillElse) and (IfLevel=FSkipIfLevel) then begin
Result:=InternalIfDirective;
end else begin
if (FSkippingDirectives=lssdNone) then
SkipTillEndifElse(lssdTillEndIf);
Result:=true;
end;
Result:=true;
end;
function TLinkScanner.ElIfCDirective: boolean;
@ -2972,15 +2932,13 @@ begin
//DebugLn(['TLinkScanner.ElIfCDirective FSkippingDirectives=',ord(FSkippingDirectives),' IfLevel=',IfLevel]);
if IfLevel=0 then
RaiseAWithoutB;
case FSkippingDirectives of
lssdNone:
// last block was executed, skip all other
SkipTillEndifElse(lssdTillEndIf);
lssdTillElse:
if IfLevel=FSkipIfLevel then
exit(InternalIfDirective);
if (FSkippingDirectives=lssdTillElse) and (IfLevel=FSkipIfLevel) then begin
Result:=InternalIfDirective;
end else begin
if (FSkippingDirectives=lssdNone) then
SkipTillEndifElse(lssdTillEndIf);
Result:=true;
end;
Result:=true;
end;
function TLinkScanner.DefineDirective: boolean;
@ -2988,17 +2946,17 @@ function TLinkScanner.DefineDirective: boolean;
var VariableName, NewValue: string;
NamePos: LongInt;
begin
ReadSpace;
SkipSpace;
NamePos:=SrcPos;
VariableName:=ReadUpperIdentifier;
if (VariableName<>'') then begin
ReadSpace;
SkipSpace;
if FMacrosOn and (SrcPos<SrcLen)
and (Src[SrcPos]=':') and (Src[SrcPos+1]='=')
then begin
// makro => store the value
inc(SrcPos,2);
ReadSpace;
SkipSpace;
NewValue:=copy(Src,SrcPos,CommentInnerEndPos-SrcPos);
if CompareIdentifiers(PChar(NewValue),'false')=0 then
NewValue:='0'
@ -3018,7 +2976,7 @@ function TLinkScanner.UndefDirective: boolean;
// {$undefine name}
var VariableName: string;
begin
ReadSpace;
SkipSpace;
VariableName:=ReadUpperIdentifier;
if (VariableName<>'') then
Values.Undefine(VariableName);
@ -3029,15 +2987,15 @@ function TLinkScanner.SetCDirective: boolean;
// {$setc name} or {$setc name:=value}
var VariableName, NewValue: string;
begin
ReadSpace;
SkipSpace;
VariableName:=ReadUpperIdentifier;
if (VariableName<>'') then begin
ReadSpace;
SkipSpace;
if FMacrosOn and (SrcPos<SrcLen)
and (Src[SrcPos]=':') and (Src[SrcPos+1]='=')
then begin
inc(SrcPos,2);
ReadSpace;
SkipSpace;
NewValue:=copy(Src,SrcPos,CommentInnerEndPos-SrcPos);
if CompareIdentifiers(PChar(NewValue),'false')=0 then
NewValue:='0'
@ -3058,23 +3016,7 @@ var IncFilename: string;
DynamicExtension: Boolean;
begin
inc(SrcPos);
if (Src[SrcPos]='%') then begin
// ToDo: insert string constant: %date%, %fpcversion%
UpdateCleanedSource(CommentStartPos-1);
// insert ''
if 2>length(FCleanedSrc)-CleanedLen then begin
// expand cleaned source string by at least 1024
SetLength(FCleanedSrc,length(FCleanedSrc)+1024);
end;
AddLink(1,nil,slkCompilerString);
inc(CleanedLen);
FCleanedSrc[CleanedLen]:='''';
inc(CleanedLen);
FCleanedSrc[CleanedLen]:='''';
// continue after directive
CopiedSrcPos:=CommentEndPos-1;
AddLink(CommentEndPos,Code);
end else begin
if (Src[SrcPos]<>'%') then begin
IncFilename:=Trim(copy(Src,SrcPos,CommentInnerEndPos-SrcPos));
if (IncFilename<>'') and (IncFilename[1]='''')
and (IncFilename[length(IncFilename)]='''') then
@ -3539,35 +3481,10 @@ begin
//DebugLn(['TLinkScanner.AddMacroSource END Token=',copy(Src,TokenStart,SrcPos-TokenStart)]);
end;
procedure TLinkScanner.AddSkipComment(IsStart: boolean);
begin
//DebugLn(['TLinkScanner.AddSkipComment InFront="',dbgstr(CleanedSrc,CleanedLen-12,13),'" isstart=',IsStart]);
// insert {#3 or #3}
if 2>length(FCleanedSrc)-CleanedLen then begin
// expand cleaned source string by at least 1024
SetLength(FCleanedSrc,length(FCleanedSrc)+1024);
end;
if IsStart then begin
AddLink(1,nil,slkSkipStart);
inc(CleanedLen);
FCleanedSrc[CleanedLen]:='{';
inc(CleanedLen);
FCleanedSrc[CleanedLen]:=#3;
end else begin
AddLink(1,nil,slkSkipEnd);
inc(CleanedLen);
FCleanedSrc[CleanedLen]:=#3;
inc(CleanedLen);
FCleanedSrc[CleanedLen]:='}';
end;
// SrcPos was not touched and still stands at the same position
//DebugLn(['TLinkScanner.AddSkipComment END']);
end;
function TLinkScanner.ReturnFromIncludeFile: boolean;
var OldPos: TSourceLink;
begin
if (SrcPos-1>CopiedSrcPos) then begin
if FSkippingDirectives=lssdNone then begin
{$IFDEF ShowUpdateCleanedSrc}
DebugLn('TLinkScanner.ReturnFromIncludeFile A UpdatePos=',DbgS(SrcPos-1));
{$ENDIF}
@ -3630,7 +3547,7 @@ end;
function TLinkScanner.DoSourceTypeToken: boolean;
// program, unit, library, package
// unit unit1;
// unit a.b.unit1 platform;
// unit unit1 platform;
// unit unit1 unimplemented;
begin
if ScannedRange<>lsrInit then exit(false);
@ -3736,11 +3653,10 @@ begin
SrcPos:=CommentEndPos;
{$IFDEF ShowUpdateCleanedSrc}
DebugLn('TLinkScanner.SkipTillEndifElse A UpdatePos=',DbgS(SrcPos-1),' Src=',DbgStr(Src,SrcPos-15,15)+'|'+DbgStr(Src,SrcPos,15));
DebugLn('TLinkScanner.SkipTillEndifElse A UpdatePos=',DbgS(SrcPos-1),' Src=',DbgStr(copy(Src,SrcPos-15,15))+'|'+DbgStr(copy(Src,SrcPos,15)));
{$ENDIF}
UpdateCleanedSource(SrcPos-1);
AddSkipComment(true);
// parse till $else, $elseif or $endif
FSkipIfLevel:=IfLevel;
if (SrcPos<=SrcLen) then begin
@ -3750,14 +3666,14 @@ begin
'{':
begin
SrcPos:=p-PChar(Src)+1;
ReadCurlyComment;
SkipCurlyComment;
if (FSkippingDirectives=lssdNone) or (SrcPos>SrcLen) then break;
p:=@Src[SrcPos];
end;
'/':
if p[1]='/' then begin
SrcPos:=p-PChar(Src)+1;
ReadLineComment;
SkipLineComment;
if (FSkippingDirectives=lssdNone) or (SrcPos>SrcLen) then break;
p:=@Src[SrcPos];
end else
@ -3765,7 +3681,7 @@ begin
'(':
if p[1]='*' then begin
SrcPos:=p-PChar(Src)+1;
ReadRoundComment;
SkipRoundComment;
if (FSkippingDirectives=lssdNone) or (SrcPos>SrcLen) then break;
p:=@Src[SrcPos];
end else
@ -3780,11 +3696,10 @@ begin
end;
#0:
begin
// FPC allows that corresponding IFDEF and ENDIF are in different files
SrcPos:=p-PChar(Src)+1;
if (SrcPos>SrcLen) then begin
if not ReturnFromIncludeFile then begin
CopiedSrcPos:=SrcLen+1;
CommentStartPos:=0;
break;
end;
p:=@Src[SrcPos];
@ -3796,6 +3711,10 @@ begin
end;
end;
SrcPos:=p-PChar(Src)+1;
end;
if CommentStartPos>0 then begin
CopiedSrcPos:=CommentStartPos-1;
AddLink(CommentStartPos,Code);
end else begin
CopiedSrcPos:=SrcLen+1;
end;
@ -3821,60 +3740,24 @@ begin
end;
function TLinkScanner.InternalIfDirective: boolean;
// {$if expression} or {$ifc expression}
// or indirectly called by {$elifc expression} or {$elseif expression}
procedure RaiseMissingExpr;
begin
RaiseException('missing expression');
end;
// {$if expression} or {$ifc expression} or indirectly called by {$elifc expression}
var
ExprResult: Boolean;
begin
//DebugLn(['TLinkScanner.InternalIfDirective FSkippingDirectives=',ord(FSkippingDirectives),' IfLevel=',IfLevel]);
inc(SrcPos);
if SrcPos>SrcLen then
RaiseMissingExpr;
ExprResult:=Values.EvalBoolean(@Src[SrcPos],CommentInnerEndPos-SrcPos);
Result:=true;
//DebugLn(['TLinkScanner.InternalIfDirective ExprResult=',ExprResult]);
if Values.ErrorPosition>=0 then begin
inc(SrcPos,Values.ErrorPosition);
RaiseException(Values.ErrorMsg)
end else if ExprResult then begin
// expression evaluates to true => stop skipping and parse block
if FSkippingDirectives<>lssdNone then begin
{$IFDEF ShowUpdateCleanedSrc}
debugln(['TLinkScanner.InternalIfDirective skipped front, using ELIFC part']);
{$ENDIF}
EndSkipping;
end;
end else
// expression evaluates to false => skip this block
end else if ExprResult then
FSkippingDirectives:=lssdNone
else
SkipTillEndifElse(lssdTillElse);
end;
procedure TLinkScanner.EndSkipping;
procedure ErrorNotSkipping;
begin
debugln(['ErrorNotSkipping internal error, please report this bug']);
CTDumpStack;
end;
begin
if FSkippingDirectives=lssdNone then begin
ErrorNotSkipping;
exit;
end;
FSkippingDirectives:=lssdNone;
UpdateCleanedSource(CommentStartPos-1);
AddSkipComment(false);
AddLink(CommentStartPos,Code);
FSkipIfLevel:=-1;
end;
function TLinkScanner.CursorToCleanPos(ACursorPos: integer; ACode: pointer;
out ACleanPos: integer): integer;
// 0=valid CleanPos

5
components/codetools/pascalparsertool.pas
View File

@ -106,6 +106,7 @@ type
TBuildTreeFlag = (
btSetIgnoreErrorPos,
btKeepIgnoreErrorPos,
btLoadDirtySource,
btCursorPosOutAllowed
);
TBuildTreeFlags = set of TBuildTreeFlag;
@ -5133,6 +5134,10 @@ begin
CaretType:=CaretToCleanPos(CursorPos, CleanCursorPos);
if (CaretType=0) or (CaretType=-1) then begin
BuildSubTree(CleanCursorPos);
if (CaretType=-1) and (btLoadDirtySource in BuildTreeFlags) then begin
// cursor position lies in dead code (skipped code between IFDEF/ENDIF)
LoadDirtySource(CursorPos);
end;
exit;
end
else if (CaretType=-2) or (not (btCursorPosOutAllowed in BuildTreeFlags)) then