Make SIMULATED_FILE_IO and SIMULATED_COMMAND_LINE testable in Lazarus

Author: peterdell

projects/TestMadPascal.lpi

@@ -522,10 +522,16 @@
       </Debugging>
     </Linking>
     <Other>
+      <Verbosity>
+        <ShoLineNum Value="True"/>
+        <ShowHintsForUnusedUnitsInMainSrc Value="True"/>
+      </Verbosity>
       <ConfigFile>
         <StopAfterErrCount Value="100"/>
       </ConfigFile>
-      <CustomOptions Value="-dDEBUG"/>
+      <CustomOptions Value="-dDEBUG
+-dSIMULATED_COMMAND_LINE
+-dSIMULATED_FILE_IO"/>
       <OtherDefines Count="1">
         <Define0 Value="DEBUG"/>
       </OtherDefines>

src/Defines.inc

@@ -17,8 +17,9 @@
 {$ENDIF}
 
 // Special cases for PAS2JS
-{$IFNDEF PAS2JS}
-{$DEFINE UPCASE_STRING}
-{$ELSE}
+{$IFDEF PAS2JS}
 {$DEFINE SIMULATED_FILE_IO}
+{$DEFINE SIMULATED_COMMAND_LINE}
+{$ELSE}
+{$DEFINE UPCASE_STRING}
 {$ENDIF}

src/FileIO.pas

@@ -47,7 +47,7 @@   TPathList = class
     // https://www.freepascal.org/docs-html/rtl/system/filepos.html
     function FilePos(): TInteger;
     procedure Read(var c: Char);
-    procedure Reset(l: Longint); overload;
+    procedure Reset(l: Longint); overload; // l = record size
     procedure Seek2(Pos: TInteger);
   end;
 
@@ -501,6 +501,8 @@ procedure TBinaryFile.Read(var c: Char);
 {$IFNDEF SIMULATED_FILE_IO}
 
   System.Read(f, c);
+{$ELSE}
+ Assert(False, 'Not implemented yet');
 {$ENDIF}
 
 end;
@@ -621,4 +623,26 @@ class function TFileSystem.GetFileMapEntry(const filePath: TFilePath): TFileMapE
   Result := fileMap.GetEntry(filePath);
 end;
 
+
+procedure InitializeFileMap;
+var
+  fileMap: TFileMap;
+  fileMapEntry: TFileMapEntry;
+begin
+{$IFDEF SIMULATED_FILE_IO}
+ fileMap := TFileMap.Create;
+ fileMapEntry:=fileMap.AddEntry('Input.pas', TFileMapEntry.TFileType.TextFile);
+ fileMapEntry.content := 'Program program; end.';
+ fileMapEntry := fileMap.AddEntry('lib', TFileMapEntry.TFileType.Folder);
+ fileMapEntry.content := 'SubFolder1;SubFolder2';
+ fileMapEntry := fileMap.AddEntry('Input.bin', TFileMapEntry.TFileType.BinaryFile);
+ fileMapEntry.content := '01010110101';
+ TFileSystem.Init(fileMap);
+{$ENDIF}
+end;
+
+initialization
+
+  InitializeFileMap;
+
 end.

src/Messages.pas

@@ -161,7 +161,7 @@ constructor TMessage.Create(const errorCode: TErrorCode; const Text: String; con
           '8': Self.Text := Self.Text + variable8;
           '9': Self.Text := Self.Text + variable9;
           else
-            Assert(False, 'Support for ' + c + ' not implemented yet');
+            Assert(False, 'Internal program error.');
         end;
       end;
     end

src/Scanner.pas

@@ -1196,6 +1196,7 @@ procedure TokenizeProgram(UsesOn: Boolean = True);
     inFile.Reset(1);
 
     Text := '';
+    ch:=' ';
 
     try
       while True do

src/Tokens.pas

@@ -464,8 +464,6 @@ procedure AssertTokenOrd(const tokenKind: TTokenKind; Value: Byte);
 procedure AssertTokensOrd;
 var
   tokenKind: TTokenKind;
-var
-  Value: Byte;
 begin
   for tokenKind := Low(TTokenKind) to High(TTokenKind) do
   begin

src/Utilities.pas

@@ -49,16 +49,16 @@ implementation
 
 class function TEnvironment.GetParameterCount(): Longint;
 begin
-{$IFNDEF PAS2JS}
+{$IFNDEF SIMULATED_COMMAND_LINE}
   Result := ParamCount;
 {$ELSE}
-  Result := 3;
+  Result := 4;
 {$ENDIF}
 end;
 
 class function TEnvironment.GetParameterString(const i: Longint): String;
 begin
-   {$IFNDEF PAS2JS}
+   {$IFNDEF SIMULATED_COMMAND_LINE}
   Result := ParamStr(i);
    {$ELSE}
   case i of

src/include/pas2js/FileIO-PAS2JS-Implementation.inc

@@ -2,63 +2,68 @@ uses SysUtils, Messages;
 
 function FileExists(const FileName: TFilePath; FollowLink: Boolean = True): Boolean;
 begin
-  Assert(False);
+  Assert(False, 'Not yet implemented');
 end;
 
 procedure AssignFile(f: TTextFile; fName: TFilePath); overload;
 begin
-  Assert(False);
+  Assert(False, 'Not yet implemented');
 end;
 
 procedure AssignFile(f: TBinaryFile; fName: TFilePath); overload;
 begin
+  Assert(False, 'Not yet implemented');
 end;
 
 procedure BlockRead(var f: TBinaryFile; var Buf; Count: Longint; var Result: Longint);
 begin
-  Assert(False);
+  Assert(False, 'Not yet implemented');
 end;
 
 procedure CloseFile(f: TTextFile); overload;
 begin
-  Assert(False);
+  Assert(False, 'Not yet implemented');
 end;
 
 procedure CloseFile(f: TBinaryFile); overload;
 begin
-  Assert(False);
+  Assert(False, 'Not yet implemented');
 end;
 
 procedure Flush(f: TTextFile);
 begin
-  Assert(False);
+  Assert(False, 'Not yet implemented');
 end;
 
 
 procedure Reset(f: TTextFile); overload;
 begin
+  Assert(False, 'Not yet implemented');
 end;
 
 procedure Reset(f: TBinaryFile); overload;
 begin
+  Assert(False, 'Not yet implemented');
 end;
 
 procedure Reset(var f: TBinaryFile; l: Longint); overload;
 begin
-  Assert(False);
+  Assert(False, 'Not yet implemented');
 end;
 
 function FilePos(var f: TBinaryFile): TInteger;
 begin
-  Assert(False);
+  Assert(False, 'Not yet implemented');
 end;
 
 procedure Seek(var f: TBinaryFile; Pos: TInteger);
 begin
+  Assert(False, 'Not yet implemented');
 end;
 
 procedure ReadLn(var F: TTextFile; Args: String);
 begin
+  Assert(False, 'Not yet implemented');
 end;
 
 procedure Read(var F: TTextFile; Args: Char);
@@ -67,7 +72,7 @@ end;
 
 procedure Read(var F: TBinaryFile; Args: Char);
 begin
-  Assert(False);
+  Assert(False, 'Not yet implemented');
 end;
 
 procedure Rewrite(f: TTextFile); overload;
@@ -76,25 +81,27 @@ end;
 
 procedure Rewrite(f: TBinaryFile); overload;
 begin
-  Assert(False);
+  Assert(False, 'Not yet implemented');
 end;
 
 procedure Erase(var f: TTextFile); overload;
 begin
-  Assert(False);
+  Assert(False, 'Not yet implemented');
 end;
 
 procedure Erase(var f: TBinaryFile); overload;
 begin
-  ;
+  Assert(False, 'Not yet implemented');
 end;
 
 function EOF(f: TTextFile): Boolean; overload;
 begin
+    Assert(False, 'Not yet implemented');
 end;
 
 function EOF(f: TBinaryFile): Boolean; overload;
 begin
+    Assert(False, 'Not yet implemented');
 end;
 
 procedure WriteLn(s: String); overload;
@@ -105,18 +112,20 @@ end;
 
 procedure WriteLn(f: TTextFile); overload;
 begin
+  Assert(False, 'Not yet implemented');
 end;
 
 procedure WriteLn(f: TTextFile; s: String); overload;
 begin
-  Assert(False);
+  Assert(False, 'Not yet implemented');
 end;
 
 procedure WriteLn(f: TTextFile; s1: String; s2: String); overload;
 begin
+  Assert(False, 'Not yet implemented');
 end;
 
 procedure WriteLn(f: TTextFile; s1: String; s2: String; s3: String); overload;
 begin
-  Assert(False);
+  Assert(False, 'Not yet implemented');
 end;