FIX: LineIndex after {$I ...} was wrong

Author: PascalCorpsman

src/ufpcparser.pas

@@ -22,7 +22,7 @@
   classes, SysUtils, upascallexer;
 
 Const
-  LookbackCnt = 10; // wie viele sollten das denn sein ??
+  LookbackCnt = 10; // Speichert die Historie der letzten "X" geparsten Tokens, 10 ist dabei ein empirisch ermittelter Wert.
 
 Type
 
@@ -118,7 +118,7 @@     , sInClassStart // Wir haben "= class" gefunden -> Entscheiden ob wir das in
 
 Uses Dialogs, FileUtil;
 
-Procedure Nop();
+Procedure Nop(); // Nur zum Debuggen
 Begin
 
 End;
@@ -497,7 +497,7 @@          * "= class"
     lastCodeLine := 0;
     lastCommentLine := 0;
     lexer.LexFile(aFilename);
-    fFileInfo.NumberOfTotalLines := lexer.TotalLineCount - 1;
+    fFileInfo.NumberOfTotalLines := lexer.TotalParsedLineCount - 1;
     fFileInfo.NumberOfEmptyLines := lexer.EmptyLineCount - 1;
     lexer.free;
     result := true;

src/unit1.pas

@@ -20,8 +20,6 @@
 (*               implementation, nor anything other that could happen         *)
 (*               or go wrong, use at your own risk.                           *)
 (*                                                                            *)
-(* Known Issues: none                                                         *)
-(*                                                                            *)
 (* History     : 0.01 - Initialversion (dependency graph, Klass Analysis,     *)
 (*                      Statistik)                                            *)
 (*               0.02 - Counter ersetzt durch FPCParser                       *)
@@ -65,12 +63,10 @@
 (*                      ADD: more infos to chart statistics                   *)
 (*               0.25 - ADD: Code preview / review feature                    *)
 (*                      ADD: Mark nodes with comments                         *)
+(*               0.26 - FIX: Line index after {$I ...}                        *)
 (*                                                                            *)
 (* Known Bugs  : - if a project holds 2 units with the same name              *)
 (*                 the dependency graph will merge them to one                *)
-(*               - if a file contains a .inc file that is included, all "Line"*)
-(*                 informations, after that .inc file are offsetted by the    *)
-(*                 length of the .inc files content                           *)
 (*                                                                            *)
 (* Missing     : - Callgraphen (über Klassen, über Echte Methoden,            *)
 (*                   über Units ..)                                           *)

src/upascallexer.pas

@@ -1,7 +1,7 @@
 (******************************************************************************)
 (* upascallexer                                                    19.04.2023 *)
 (*                                                                            *)
-(* Version     : 0.04                                                         *)
+(* Version     : 0.05                                                         *)
 (*                                                                            *)
 (* Author      : Uwe Schächterle (Corpsman)                                   *)
 (*                                                                            *)
@@ -26,6 +26,7 @@
 (*               0.02 - Add Total Line Counter, Empty Line Counter            *)
 (*               0.03 - Start with unittests, fix "invalid" ( * Parsing       *)
 (*               0.04 - Berücksichtigen von {$I ...}                          *)
+(*               0.05 - Fix Linecounting von {$I ...}                         *)
 (*                                                                            *)
 (******************************************************************************)
 Unit upascallexer;
@@ -52,7 +53,7 @@
 
   TToken = Record
     Value: String;
-    Line: integer;
+    Line: integer; // Die Zeile in der Datei (Alles was via {$I ...} inkludiert wird, landet in der selben Zeile in der das {$I ...} steht
     Kind: TTokenKind;
   End;
 
@@ -65,6 +66,7 @@
   private
     aToken: String;
     aLine: Integer;
+    aParsedLine: Integer;
     aEmptyLine: integer;
     Procedure HandleToken();
     Procedure DoLex(Const Stream: TStream);
@@ -73,7 +75,8 @@
 
     OnHandleToken: TOnHandleToken;
 
-    Property TotalLineCount: integer read aLine;
+    Property TotalFileLineCount: integer read aLine; // Anzahl an Zeilen innerhalb der Datei
+    Property TotalParsedLineCount: integer read aParsedLine; // Tatsächliche Anzahl an geparsten Zeilen (wenn die Datei ein {$I ...} token hat, dann unterscheiden sich die beiden Line counts)
     Property EmptyLineCount: integer read aEmptyLine;
 
     Constructor Create(); virtual;
@@ -353,8 +356,21 @@
 
 Procedure TPascalLexer.DoLex(Const Stream: TStream);
 
-  Procedure HToken()Inline;
+Var
+  BlockLineCounting: Boolean; // Wenn True, dann werden die ZeilenNummern nicht "Erhöht" wenn CRT gelesen wird.
+
+  Procedure HToken(); //Inline;
   Begin
+    If atoken = '~DisableLineCounter~' Then Begin
+      BlockLineCounting := true;
+      atoken := '';
+      exit;
+    End;
+    If atoken = '~EnableLineCounter~' Then Begin
+      BlockLineCounting := false;
+      atoken := '';
+      exit;
+    End;
     If atoken <> '' Then Begin // Der Token vor dem ersten erkannten Token ist in der Regel leer -> Raus werfen.
       HandleToken();
       aToken := '';
@@ -388,11 +404,13 @@
   i, mSize: Int64;
 Begin
   aToken := '';
+  BlockLineCounting := false;
   State := sCollectToken;
   CommentDetphCounter := 0;
   pc := #0;
   c := #0;
   aLine := 1; // Textdateien sind 1 Basiert
+  aParsedLine := 1;
   aEmptyLine := 0;
   i := 0;
   mSize := Stream.Size;
@@ -653,8 +671,11 @@
     If (c = lb) And ((pc = lb) Or ((ppc = lb) And (pc In [#10, #13]))) Then Begin
       inc(aEmptyLine);
     End;
-    If c = LB Then Begin
-      inc(aLine);
+    If (c = LB) Then Begin
+      If (Not BlockLineCounting) Then Begin
+        inc(aLine);
+      End;
+      inc(aParsedLine);
     End;
     inc(i);
   End;
@@ -673,7 +694,7 @@
   m: TMemoryStream;
   sl2, sl: TStringList;
   i: integer;
-  s: String;
+  s, t: String;
 Begin
   sl := TStringList.Create;
   Try
@@ -684,13 +705,14 @@
         If pos('{$I ', sl[i]) <> 0 Then Begin
           s := sl[i];
           s := copy(s, pos('{$I ', s) + 4, length(s));
+          t := copy(s, pos('}', s) + 1, length(s)); // Retten dessen was nach dem Include kommt.
           s := copy(s, 1, pos('}', s) - 1);
           s := trim(s);
           s := OnResolveFileRequest(self, s);
           If s <> '' Then Begin
             sl2 := TStringList.Create;
             sl2.LoadFromFile(s);
-            sl[i] := sl2.Text; // TODO: das funktioniert nur, wenn in der Zeile sonst nichts anderes Steht
+            sl[i] := ' ~DisableLineCounter~ ' + sl2.Text + ' ~EnableLineCounter~ ' + t;
             sl2.free;
           End;
         End;