undo

git-svn-id: trunk@38292 -

components/codetools/examples/finddeclaration.lpi

@@ -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>

components/codetools/examples/finddeclaration.lpr

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

components/codetools/examples/scanexamples/commentsidentifiers.pas

@@ -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.
-

components/codetools/fileprocs.pas

@@ -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);
+  i:=1;
-  while (i>0) do begin
+  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);

components/codetools/finddeclarationtool.pas

@@ -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)

components/codetools/linkscanner.pas

@@ -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,
+    slkMissingIncludeFile
-    slkSkipStart,  // start of skipped code due to IFDEFs {#3
-    slkSkipEnd,    // end of skipped code due to IFDEFs #3}
-    slkCompilerString // e.g. {$I %FPCVERSION%}
     );
   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 SkipSpace; {$IFDEF UseInline}inline;{$ENDIF}
-    procedure ReadCurlyComment;
+    procedure SkipCurlyComment;
-    procedure ReadLineComment;
+    procedure SkipLineComment;
-    procedure ReadRoundComment;
+    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
+  if FLinkCount=FLinkCapacity 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
     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}
+      if FSkippingDirectives=lssdNone then begin
-      DebugLn('TLinkScanner.Scan UpdatePos=',DbgS(SrcPos-1));
+        {$IFDEF ShowUpdateCleanedSrc}
-      {$ENDIF}
+        DebugLn('TLinkScanner.Scan UpdatePos=',DbgS(SrcPos-1));
-      if (SrcPos>CopiedSrcPos) then
+        {$ENDIF}
-        UpdateCleanedSource(SrcPos-1);
+        if SrcPos>CopiedSrcPos then
-      if FSkippingDirectives<>lssdNone then begin
+          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
+  if Src[CommentInnerStartPos]='$' then HandleDirectives;
-    HandleDirective;
   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
+  if Src[CommentInnerStartPos]='$' then HandleDirectives;
-    HandleDirective;
   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[FDirectiveName[1]];
-  FDirectiveName:=CompilerSwitchesNames[c];
   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
+      if FDirectiveName<>CompilerSwitchesNames['I'] then
-        Result:=IncludeDirective
+        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;
+        'L': if CompareIdentifiers(p,'ALIGN')=0 then Result:=true;
-        'S': if CompareIdentifiers(p,'ASSERTIONS')=0 then Result:=LongSwitchDirective;
+        '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
+        if CompareIdentifiers(p,'LOCALSYMBOLS')=0 then Result:=true
-        else if CompareIdentifiers(p,'LONGSTRINGS')=0 then Result:=LongSwitchDirective;
+        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
+        if CompareIdentifiers(p,'OPENSTRINGS')=0 then Result:=true
-        else if CompareIdentifiers(p,'OVERFLOWCHECKS')=0 then Result:=LongSwitchDirective;
+        else if CompareIdentifiers(p,'OVERFLOWCHECKS')=0 then Result:=true;
       'R':
-        if CompareIdentifiers(p,'RANGECHECKS')=0 then Result:=LongSwitchDirective
+        if CompareIdentifiers(p,'RANGECHECKS')=0 then Result:=true
-        else if CompareIdentifiers(p,'REFERENCEINFO')=0 then Result:=LongSwitchDirective;
+        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,'TYPEADDRESS')=0 then Result:=true
-        else if CompareIdentifiers(p,'TYPEINFO')=0 then Result:=LongSwitchDirective;
+        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
+  if IfLevel<FSkipIfLevel then begin
-    {$IFDEF ShowUpdateCleanedSrc}
+    FSkippingDirectives:=lssdNone;
-    debugln(['TLinkScanner.EndifDirective end skip']);
-    {$ENDIF}
-    EndSkipping;
   end;
   Result:=true;
 end;
@@ -2855,11 +2829,8 @@ begin
   if IfLevel<=0 then
     RaiseAWithoutB;
   dec(IfLevel);
-  if (IfLevel<FSkipIfLevel) and (FSkippingDirectives<>lssdNone) then begin
+  if IfLevel<FSkipIfLevel then begin
-    {$IFDEF ShowUpdateCleanedSrc}
+    FSkippingDirectives:=lssdNone;
-    debugln(['TLinkScanner.EndCDirective end skip']);
-    {$ENDIF}
-    EndSkipping;
   end;
   Result:=true;
 end;
@@ -2876,11 +2847,8 @@ begin
   if IfLevel<=0 then
     RaiseAWithoutB;
   dec(IfLevel);
-  if (IfLevel<FSkipIfLevel) and (FSkippingDirectives<>lssdNone) then begin
+  if IfLevel<FSkipIfLevel then begin
-    {$IFDEF ShowUpdateCleanedSrc}
+    FSkippingDirectives:=lssdNone;
-    debugln(['TLinkScanner.IfEndDirective end skip']);
-    {$ENDIF}
-    EndSkipping;
   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
+    if IfLevel=FSkipIfLevel then
-      {$IFDEF ShowUpdateCleanedSrc}
+      FSkippingDirectives:=lssdNone;
-      debugln(['TLinkScanner.ElseDirective skipped front, using ELSE part']);
+    // else: continue skip;
-      {$ENDIF}
+  lssdTillEndIf: ; // continue skip
-      EndSkipping;
-    end;
   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
+    if IfLevel=FSkipIfLevel then
-      {$IFDEF ShowUpdateCleanedSrc}
+      FSkippingDirectives:=lssdNone;
-      debugln(['TLinkScanner.ElseCDirective skipped front, using ELSEC part']);
+    // else: continue skip;
-      {$ENDIF}
+  lssdTillEndIf: ; // continue skip
-      EndSkipping;
-    end;
   end;
   Result:=true;
 end;
@@ -2949,15 +2911,13 @@ function TLinkScanner.ElseIfDirective: boolean;
 begin
   if IfLevel=0 then
     RaiseAWithoutB;
-  case FSkippingDirectives of
+  if (FSkippingDirectives=lssdTillElse) and (IfLevel=FSkipIfLevel) then begin
-  lssdNone:
+    Result:=InternalIfDirective;
-    // last block was executed, skip all other
+  end else begin
-    SkipTillEndifElse(lssdTillEndIf);
+    if (FSkippingDirectives=lssdNone) then
-  lssdTillElse:
+      SkipTillEndifElse(lssdTillEndIf);
-    if IfLevel=FSkipIfLevel then
+    Result:=true;
-      exit(InternalIfDirective);
   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
+  if (FSkippingDirectives=lssdTillElse) and (IfLevel=FSkipIfLevel) then begin
-  lssdNone:
+    Result:=InternalIfDirective;
-    // last block was executed, skip all other
+  end else begin
-    SkipTillEndifElse(lssdTillEndIf);
+    if (FSkippingDirectives=lssdNone) then
-  lssdTillElse:
+      SkipTillEndifElse(lssdTillEndIf);
-    if IfLevel=FSkipIfLevel then
+    Result:=true;
-      exit(InternalIfDirective);
   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
+  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
     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}
+// {$if expression} or {$ifc expression} or indirectly called by {$elifc expression}
-// or indirectly called by {$elifc expression} or {$elseif expression}
-
-  procedure RaiseMissingExpr;
-  begin
-    RaiseException('missing expression');
-  end;
-
 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
+  end else if ExprResult then
-    // expression evaluates to true => stop skipping and parse block
+    FSkippingDirectives:=lssdNone
-    if FSkippingDirectives<>lssdNone then begin
+  else
-      {$IFDEF ShowUpdateCleanedSrc}
-      debugln(['TLinkScanner.InternalIfDirective skipped front, using ELIFC part']);
-      {$ENDIF}
-      EndSkipping;
-    end;
-  end else
-    // expression evaluates to false => skip this block
     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

components/codetools/pascalparsertool.pas

@@ -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