fcl-passc: removed testpasutils.pas

packages/fcl-passrc/src/pastree.pp

@@ -1806,6 +1806,7 @@ procedure ReleaseProcNameParts(var NameParts: TProcedureNameParts);
 
 function dbgs(const s: TProcTypeModifiers): string; overload;
 function WritePasElTree(Expr: TPasExpr; FollowPrefix: string = ''): string;
+function GetPasElementDesc(El: TPasElement): string;
 
 {$IFDEF HasPTDumpStack}
 procedure PTDumpStack;
@@ -1991,6 +1992,12 @@ begin
     Result:=C.ClassName+' Kind=';
 end;
 
+function GetPasElementDesc(El: TPasElement): string;
+begin
+  if El=nil then exit('nil');
+  Result:=El.Name+':'+El.ClassName+'['+El.SourceFilename+','+IntToStr(El.SourceLinenumber)+']';
+end;
+
 Function IndentStrings(S : TStrings; indent : Integer) : string;
 Var
   I,CurrLen,CurrPos : Integer;

packages/fcl-passrc/src/pparser.pp

@@ -509,6 +509,8 @@ Function IsHintToken(T : String; Out AHint : TPasMemberHint) : boolean;
 Function IsProcModifier(S : String; Out PM : TProcedureModifier) : Boolean;
 Function IsCallingConvention(S : String; out CC : TCallingConvention) : Boolean;
 Function TokenToAssignKind( tk : TToken) : TAssignKind;
+procedure ReadNextPascalToken(var Position: PChar; out TokenStart: PChar;
+  NestedComments: boolean; SkipDirectives: boolean);
 
 implementation
 
@@ -676,6 +678,264 @@ begin
   end;
 end;
 
+procedure ReadNextPascalToken(var Position: PChar; out TokenStart: PChar;
+  NestedComments: boolean; SkipDirectives: boolean);
+const
+  IdentChars = ['a'..'z','A'..'Z','_','0'..'9'];
+  HexNumberChars = ['0'..'9','a'..'f','A'..'F'];
+var
+  c1:char;
+  CommentLvl: Integer;
+  Src: PChar;
+begin
+  Src:=Position;
+  // read till next atom
+  while true do
+    begin
+    case Src^ of
+    #0: break;
+    #1..#32:  // spaces and special characters
+      inc(Src);
+    #$EF:
+      if (Src[1]=#$BB)
+      and (Src[2]=#$BF) then
+        begin
+        // skip UTF BOM
+        inc(Src,3);
+        end
+      else
+        break;
+    '{':    // comment start or compiler directive
+      if (Src[1]='$') and (not SkipDirectives) then
+        // compiler directive
+        break
+      else begin
+        // Pascal comment => skip
+        CommentLvl:=1;
+        while true do
+          begin
+          inc(Src);
+          case Src^ of
+          #0: break;
+          '{':
+            if NestedComments then
+              inc(CommentLvl);
+          '}':
+            begin
+            dec(CommentLvl);
+            if CommentLvl=0 then
+              begin
+              inc(Src);
+              break;
+              end;
+            end;
+          end;
+        end;
+      end;
+    '/':  // comment or real division
+      if (Src[1]='/') then
+        begin
+        // comment start -> read til line end
+        inc(Src);
+        while not (Src^ in [#0,#10,#13]) do
+          inc(Src);
+        end
+      else
+        break;
+    '(':  // comment, bracket or compiler directive
+      if (Src[1]='*') then
+        begin
+        if (Src[2]='$') and (not SkipDirectives) then
+          // compiler directive
+          break
+        else
+          begin
+          // comment start -> read til comment end
+          inc(Src,2);
+          CommentLvl:=1;
+          while true do
+            begin
+            case Src^ of
+            #0: break;
+            '(':
+              if NestedComments and (Src[1]='*') then
+                inc(CommentLvl);
+            '*':
+              if (Src[1]=')') then
+                begin
+                dec(CommentLvl);
+                if CommentLvl=0 then
+                  begin
+                  inc(Src,2);
+                  break;
+                  end;
+                inc(Position);
+                end;
+            end;
+            inc(Src);
+            end;
+        end;
+      end else
+        // round bracket open
+        break;
+    else
+      break;
+    end;
+    end;
+  // read token
+  TokenStart:=Src;
+  c1:=Src^;
+  case c1 of
+  #0:
+    ;
+  'A'..'Z','a'..'z','_':
+    begin
+    // identifier
+    inc(Src);
+    while Src^ in IdentChars do
+      inc(Src);
+    end;
+  '0'..'9': // number
+    begin
+    inc(Src);
+    // read numbers
+    while (Src^ in ['0'..'9']) do
+      inc(Src);
+    if (Src^='.') and (Src[1]<>'.') then
+      begin
+      // real type number
+      inc(Src);
+      while (Src^ in ['0'..'9']) do
+        inc(Src);
+      end;
+    if (Src^ in ['e','E']) then
+      begin
+      // read exponent
+      inc(Src);
+      if (Src^='-') then inc(Src);
+      while (Src^ in ['0'..'9']) do
+        inc(Src);
+      end;
+    end;
+  '''','#':  // string constant
+    while true do
+      case Src^ of
+      #0: break;
+      '#':
+        begin
+        inc(Src);
+        while Src^ in ['0'..'9'] do
+          inc(Src);
+        end;
+      '''':
+        begin
+        inc(Src);
+        while not (Src^ in ['''',#0]) do
+          inc(Src);
+        if Src^='''' then
+          inc(Src);
+        end;
+      else
+        break;
+      end;
+  '$':  // hex constant
+    begin
+    inc(Src);
+    while Src^ in HexNumberChars do
+      inc(Src);
+    end;
+  '&':  // octal constant or keyword as identifier (e.g. &label)
+    begin
+    inc(Src);
+    if Src^ in ['0'..'7'] then
+      while Src^ in ['0'..'7'] do
+        inc(Src)
+    else
+      while Src^ in IdentChars do
+        inc(Src);
+    end;
+  '{':  // compiler directive (it can't be a comment, because see above)
+    begin
+    CommentLvl:=1;
+    while true do
+      begin
+      inc(Src);
+      case Src^ of
+      #0: break;
+      '{':
+        if NestedComments then
+          inc(CommentLvl);
+      '}':
+        begin
+        dec(CommentLvl);
+        if CommentLvl=0 then
+          begin
+          inc(Src);
+          break;
+          end;
+        end;
+      end;
+      end;
+    end;
+  '(':  // bracket or compiler directive
+    if (Src[1]='*') then
+      begin
+      // compiler directive -> read til comment end
+      inc(Src,2);
+      while (Src^<>#0) and ((Src^<>'*') or (Src[1]<>')')) do
+        inc(Src);
+      inc(Src,2);
+      end
+    else
+      // round bracket open
+      inc(Src);
+  #192..#255:
+    begin
+    // read UTF8 character
+    inc(Src);
+    if ((ord(c1) and %11100000) = %11000000) then
+      begin
+      // could be 2 byte character
+      if (ord(Src[0]) and %11000000) = %10000000 then
+        inc(Src);
+      end
+    else if ((ord(c1) and %11110000) = %11100000) then
+      begin
+      // could be 3 byte character
+      if ((ord(Src[0]) and %11000000) = %10000000)
+      and ((ord(Src[1]) and %11000000) = %10000000) then
+        inc(Src,2);
+      end
+    else if ((ord(c1) and %11111000) = %11110000) then
+      begin
+      // could be 4 byte character
+      if ((ord(Src[0]) and %11000000) = %10000000)
+      and ((ord(Src[1]) and %11000000) = %10000000)
+      and ((ord(Src[2]) and %11000000) = %10000000) then
+        inc(Src,3);
+      end;
+    end;
+  else
+    inc(Src);
+    case c1 of
+    '<': if Src^ in ['>','='] then inc(Src);
+    '.': if Src^='.' then inc(Src);
+    '@':
+      if Src^='@' then
+        begin
+        // @@ label
+        repeat
+          inc(Src);
+        until not (Src^ in IdentChars);
+        end
+    else
+      if (Src^='=') and (c1 in [':','+','-','/','*','<','>']) then
+        inc(Src);
+    end;
+  end;
+  Position:=Src;
+end;
+
 function ParseSource(AEngine: TPasTreeContainer;
   const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
 var

packages/fcl-passrc/src/pscanner.pp

@@ -1251,6 +1251,7 @@ function FilenameIsWinAbsolute(const TheFilename: string): boolean;
 function FilenameIsUnixAbsolute(const TheFilename: string): boolean;
 function IsNamedToken(Const AToken : String; Out T : TToken) : Boolean;
 Function ExtractFilenameOnly(Const AFileName : String) : String;
+function ExtractFileUnitName(aFilename: string): string;
 
 procedure CreateMsgArgs(var MsgArgs: TMessageArgs; Args: array of const);
 function SafeFormat(const Fmt: string; Args: array of const): string;
@@ -1272,6 +1273,22 @@ begin
   Result:=ChangeFileExt(ExtractFileName(aFileName),'');
 end;
 
+function ExtractFileUnitName(aFilename: string): string;
+var
+  p: Integer;
+begin
+  Result:=ExtractFileName(aFilename);
+  if Result='' then exit;
+  for p:=length(Result) downto 1 do
+    case Result[p] of
+    '/','\': exit;
+    '.':
+      begin
+      Delete(Result,p,length(Result));
+      exit;
+      end;
+    end;
+end;
 
 Procedure SortTokenInfo;
 

packages/fcl-passrc/tests/.gitignore

@@ -0,0 +1,2 @@
+testpassrc
+testpassrc.compiled

packages/fcl-passrc/tests/tcbaseparser.pas

@@ -5,8 +5,7 @@ unit tcbaseparser;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, pastree, pscanner, pparser, TestPasUtils,
-  testregistry;
+  Classes, SysUtils, fpcunit, pastree, pscanner, pparser, testregistry;
 
 const
   DefaultMainFilename = 'afile.pp';

packages/fcl-passrc/tests/tcexprparser.pas

@@ -5,7 +5,7 @@ unit tcexprparser;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testregistry, tcbaseparser, TestPasUtils, pastree;
+  Classes, SysUtils, fpcunit, testregistry, tcbaseparser, pastree, PScanner;
 
 type
 

packages/fcl-passrc/tests/tcresolver.pas

@@ -20,7 +20,7 @@ interface
 uses
   Classes, SysUtils, contnrs, strutils, fpcunit, testregistry,
   PasTree, PScanner, PParser, PasResolver, PasResolveEval,
-  tcbaseparser, TestPasUtils;
+  tcbaseparser;
 
 type
   TSrcMarkerKind = (

packages/fcl-passrc/tests/tcstatements.pas

@@ -10,7 +10,7 @@ interface
 
 uses
   Classes, SysUtils, fpcunit, pastree, pscanner, pparser,
-  tcbaseparser, TestPasUtils, testregistry;
+  tcbaseparser, testregistry;
 
 Type
   { TTestStatementParser }

packages/fcl-passrc/tests/testpassrc.lpr

@@ -7,7 +7,7 @@ uses
   Classes, consoletestrunner, tcscanner,  tctypeparser, tcstatements,
   tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
   tcexprparser, tcprocfunc, tcpassrcutil, tcresolver,
-  tcuseanalyzer, pasresolveeval, tcresolvegenerics, tcgenerics, TestPasUtils;
+  tcuseanalyzer, pasresolveeval, tcresolvegenerics, tcgenerics;
 
 type
 

packages/fcl-passrc/tests/testpasutils.pas

@@ -1,299 +0,0 @@
-unit TestPasUtils;
-
-{$mode ObjFPC}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, PasTree;
-
-function ExtractFileUnitName(aFilename: string): string;
-function GetPasElementDesc(El: TPasElement): string;
-procedure ReadNextPascalToken(var Position: PChar; out TokenStart: PChar;
-  NestedComments: boolean; SkipDirectives: boolean);
-
-implementation
-
-function ExtractFileUnitName(aFilename: string): string;
-var
-  p: Integer;
-begin
-  Result:=ExtractFileName(aFilename);
-  if Result='' then exit;
-  for p:=length(Result) downto 1 do
-    case Result[p] of
-    '/','\': exit;
-    '.':
-      begin
-      Delete(Result,p,length(Result));
-      exit;
-      end;
-    end;
-end;
-
-function GetPasElementDesc(El: TPasElement): string;
-begin
-  if El=nil then exit('nil');
-  Result:=El.Name+':'+El.ClassName+'['+El.SourceFilename+','+IntToStr(El.SourceLinenumber)+']';
-end;
-
-procedure ReadNextPascalToken(var Position: PChar; out TokenStart: PChar;
-  NestedComments: boolean; SkipDirectives: boolean);
-const
-  IdentChars = ['a'..'z','A'..'Z','_','0'..'9'];
-  HexNumberChars = ['0'..'9','a'..'f','A'..'F'];
-var
-  c1:char;
-  CommentLvl: Integer;
-  Src: PChar;
-begin
-  Src:=Position;
-  // read till next atom
-  while true do
-    begin
-    case Src^ of
-    #0: break;
-    #1..#32:  // spaces and special characters
-      inc(Src);
-    #$EF:
-      if (Src[1]=#$BB)
-      and (Src[2]=#$BF) then
-        begin
-        // skip UTF BOM
-        inc(Src,3);
-        end
-      else
-        break;
-    '{':    // comment start or compiler directive
-      if (Src[1]='$') and (not SkipDirectives) then
-        // compiler directive
-        break
-      else begin
-        // Pascal comment => skip
-        CommentLvl:=1;
-        while true do
-          begin
-          inc(Src);
-          case Src^ of
-          #0: break;
-          '{':
-            if NestedComments then
-              inc(CommentLvl);
-          '}':
-            begin
-            dec(CommentLvl);
-            if CommentLvl=0 then
-              begin
-              inc(Src);
-              break;
-              end;
-            end;
-          end;
-        end;
-      end;
-    '/':  // comment or real division
-      if (Src[1]='/') then
-        begin
-        // comment start -> read til line end
-        inc(Src);
-        while not (Src^ in [#0,#10,#13]) do
-          inc(Src);
-        end
-      else
-        break;
-    '(':  // comment, bracket or compiler directive
-      if (Src[1]='*') then
-        begin
-        if (Src[2]='$') and (not SkipDirectives) then
-          // compiler directive
-          break
-        else
-          begin
-          // comment start -> read til comment end
-          inc(Src,2);
-          CommentLvl:=1;
-          while true do
-            begin
-            case Src^ of
-            #0: break;
-            '(':
-              if NestedComments and (Src[1]='*') then
-                inc(CommentLvl);
-            '*':
-              if (Src[1]=')') then
-                begin
-                dec(CommentLvl);
-                if CommentLvl=0 then
-                  begin
-                  inc(Src,2);
-                  break;
-                  end;
-                inc(Position);
-                end;
-            end;
-            inc(Src);
-            end;
-        end;
-      end else
-        // round bracket open
-        break;
-    else
-      break;
-    end;
-    end;
-  // read token
-  TokenStart:=Src;
-  c1:=Src^;
-  case c1 of
-  #0:
-    ;
-  'A'..'Z','a'..'z','_':
-    begin
-    // identifier
-    inc(Src);
-    while Src^ in IdentChars do
-      inc(Src);
-    end;
-  '0'..'9': // number
-    begin
-    inc(Src);
-    // read numbers
-    while (Src^ in ['0'..'9']) do
-      inc(Src);
-    if (Src^='.') and (Src[1]<>'.') then
-      begin
-      // real type number
-      inc(Src);
-      while (Src^ in ['0'..'9']) do
-        inc(Src);
-      end;
-    if (Src^ in ['e','E']) then
-      begin
-      // read exponent
-      inc(Src);
-      if (Src^='-') then inc(Src);
-      while (Src^ in ['0'..'9']) do
-        inc(Src);
-      end;
-    end;
-  '''','#':  // string constant
-    while true do
-      case Src^ of
-      #0: break;
-      '#':
-        begin
-        inc(Src);
-        while Src^ in ['0'..'9'] do
-          inc(Src);
-        end;
-      '''':
-        begin
-        inc(Src);
-        while not (Src^ in ['''',#0]) do
-          inc(Src);
-        if Src^='''' then
-          inc(Src);
-        end;
-      else
-        break;
-      end;
-  '$':  // hex constant
-    begin
-    inc(Src);
-    while Src^ in HexNumberChars do
-      inc(Src);
-    end;
-  '&':  // octal constant or keyword as identifier (e.g. &label)
-    begin
-    inc(Src);
-    if Src^ in ['0'..'7'] then
-      while Src^ in ['0'..'7'] do
-        inc(Src)
-    else
-      while Src^ in IdentChars do
-        inc(Src);
-    end;
-  '{':  // compiler directive (it can't be a comment, because see above)
-    begin
-    CommentLvl:=1;
-    while true do
-      begin
-      inc(Src);
-      case Src^ of
-      #0: break;
-      '{':
-        if NestedComments then
-          inc(CommentLvl);
-      '}':
-        begin
-        dec(CommentLvl);
-        if CommentLvl=0 then
-          begin
-          inc(Src);
-          break;
-          end;
-        end;
-      end;
-      end;
-    end;
-  '(':  // bracket or compiler directive
-    if (Src[1]='*') then
-      begin
-      // compiler directive -> read til comment end
-      inc(Src,2);
-      while (Src^<>#0) and ((Src^<>'*') or (Src[1]<>')')) do
-        inc(Src);
-      inc(Src,2);
-      end
-    else
-      // round bracket open
-      inc(Src);
-  #192..#255:
-    begin
-    // read UTF8 character
-    inc(Src);
-    if ((ord(c1) and %11100000) = %11000000) then
-      begin
-      // could be 2 byte character
-      if (ord(Src[0]) and %11000000) = %10000000 then
-        inc(Src);
-      end
-    else if ((ord(c1) and %11110000) = %11100000) then
-      begin
-      // could be 3 byte character
-      if ((ord(Src[0]) and %11000000) = %10000000)
-      and ((ord(Src[1]) and %11000000) = %10000000) then
-        inc(Src,2);
-      end
-    else if ((ord(c1) and %11111000) = %11110000) then
-      begin
-      // could be 4 byte character
-      if ((ord(Src[0]) and %11000000) = %10000000)
-      and ((ord(Src[1]) and %11000000) = %10000000)
-      and ((ord(Src[2]) and %11000000) = %10000000) then
-        inc(Src,3);
-      end;
-    end;
-  else
-    inc(Src);
-    case c1 of
-    '<': if Src^ in ['>','='] then inc(Src);
-    '.': if Src^='.' then inc(Src);
-    '@':
-      if Src^='@' then
-        begin
-        // @@ label
-        repeat
-          inc(Src);
-        until not (Src^ in IdentChars);
-        end
-    else
-      if (Src^='=') and (c1 in [':','+','-','/','*','<','>']) then
-        inc(Src);
-    end;
-  end;
-  Position:=Src;
-end;
-
-end.
-

packages/pastojs/tests/tcmodules.pas

@@ -26,8 +26,7 @@ interface
 uses
   Classes, SysUtils, fpcunit, testregistry, contnrs,
   jstree, jswriter, jsbase,
-  PasTree, PScanner, PasResolver, PParser, PasResolveEval, TestPasUtils,
-  FPPas2Js;
+  PasTree, PScanner, PasResolver, PParser, PasResolveEval, FPPas2Js;
 
 const
   // default parser+scanner options

packages/pastojs/tests/testpas2js.lpi

@@ -37,7 +37,7 @@
         <PackageName Value="FCL"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="15">
+    <Units Count="14">
       <Unit0>
         <Filename Value="testpas2js.pp"/>
         <IsPartOfProject Value="True"/>
@@ -106,11 +106,6 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="TCPas2JSAnalyzer"/>
       </Unit13>
-      <Unit14>
-        <Filename Value="../../fcl-passrc/tests/testpasutils.pas"/>
-        <IsPartOfProject Value="True"/>
-        <UnitName Value="TestPasUtils"/>
-      </Unit14>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -120,7 +115,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="../src;../../fcl-js/src;../../fcl-json/src;../../fcl-passrc/src;../../pastojs/tests;../../fcl-passrc/tests"/>
+      <OtherUnitFiles Value="../src;../../fcl-js/src;../../fcl-json/src;../../fcl-passrc/src;../../pastojs/tests"/>
       <UnitOutputDirectory Value="lib"/>
     </SearchPaths>
     <CodeGeneration>

packages/pastojs/tests/testpas2js.pp

@@ -23,7 +23,7 @@ uses
   {$ENDIF}
   Classes, consoletestrunner, tcconverter, TCModules, TCSrcMap,
   TCFiler, TCUnitSearch, TCOptimizations, TCGenerics, TCPrecompile, 
-  TCPas2JSAnalyzer, TestPasUtils;
+  TCPas2JSAnalyzer;
 
 type