Browse Source

pastojs: debug log for pas2jslib

mattias 3 years ago
parent
commit
672c9b1466
1 changed files with 85 additions and 21 deletions
  1. 85 21
      packages/pastojs/src/pas2jslibcompiler.pp

+ 85 - 21
packages/pastojs/src/pas2jslibcompiler.pp

@@ -15,8 +15,7 @@
 }
 }
 unit pas2jslibcompiler;
 unit pas2jslibcompiler;
 
 
-{$mode objfpc}
-{$H+}
+{$mode objfpc}{$H+}
 
 
 {$IFDEF darwin}
 {$IFDEF darwin}
 {$DEFINE UseCDecl}
 {$DEFINE UseCDecl}
@@ -79,6 +78,9 @@ Type
     Function ReadFile(aFilename: string; var aSource: string): boolean; virtual;
     Function ReadFile(aFilename: string; var aSource: string): boolean; virtual;
     Function ReadDirectory(Dir: TPas2jsCachedDirectory): boolean; virtual;
     Function ReadDirectory(Dir: TPas2jsCachedDirectory): boolean; virtual;
     procedure GetFileSrcAttr(AFilename: string; var AAttr: TPas2jsFileSrcAttr);
     procedure GetFileSrcAttr(AFilename: string; var AAttr: TPas2jsFileSrcAttr);
+    {$IFDEF DebugLib}
+    procedure LibDbgLog(Msg: string);
+    {$ENDIF}
   Public
   Public
     Constructor Create; override;
     Constructor Create; override;
     procedure CheckUnitAlias(var UseUnitName: string); override;
     procedure CheckUnitAlias(var UseUnitName: string); override;
@@ -123,21 +125,6 @@ implementation
 
 
 { TLibraryPas2JSCompiler }
 { TLibraryPas2JSCompiler }
 
 
-function TLibraryPas2JSCompiler.ReadDirectory(Dir: TPas2jsCachedDirectory
-  ): boolean;
-begin
-  Result:=false; // return false to call the default TPas2jsCachedDirectory.DoReadDir
-  if Assigned(OnReadDir) then
-    Result:=OnReadDir(FOnReadDirData,Dir,PAnsiChar(Dir.Path));
-end;
-
-procedure TLibraryPas2JSCompiler.GetFileSrcAttr(AFilename: string; var AAttr: TPas2jsFileSrcAttr);
-begin
-  AAttr.AllowSrcMap := True;
-  if Assigned(OnGetFileSrcAttr) then
-    OnGetFileSrcAttr(FOnGetFileSrcAttrData, PAnsiChar(AFilename), Length(AFileName), @AAttr);
-end;
-
 function TLibraryPas2JSCompiler.GetLogEncoding: String;
 function TLibraryPas2JSCompiler.GetLogEncoding: String;
 begin
 begin
   Result := Log.Encoding;
   Result := Log.Encoding;
@@ -150,11 +137,9 @@ end;
 
 
 function TLibraryPas2JSCompiler.DoWriteJSFile(const DestFilename,
 function TLibraryPas2JSCompiler.DoWriteJSFile(const DestFilename,
   MapFilename: String; aWriter: TPas2JSMapper): Boolean;
   MapFilename: String; aWriter: TPas2JSMapper): Boolean;
-
-Var
+var
   WithUTF8BOM: Boolean;
   WithUTF8BOM: Boolean;
   ms: TMemoryStream;
   ms: TMemoryStream;
-
 begin
 begin
   Result:=Assigned(OnWriteJSCallBack);
   Result:=Assigned(OnWriteJSCallBack);
   if Result then
   if Result then
@@ -164,6 +149,9 @@ begin
       try
       try
         WithUTF8BOM:=(Log.Encoding='') or (Log.Encoding='utf8');
         WithUTF8BOM:=(Log.Encoding='') or (Log.Encoding='utf8');
         aWriter.SaveJSToStream(WithUTF8BOM,ExtractFilename(MapFilename),ms);
         aWriter.SaveJSToStream(WithUTF8BOM,ExtractFilename(MapFilename),ms);
+        {$IFDEF DebugLib}
+        LibDbgLog('DoWriteJSFile: DestFile="'+DestFilename+'" Map="'+MapFilename+'" '+IntToStr(ms.Position));
+        {$ENDIF}
         OnWriteJSCallBack(OnWriteJSData,PAnsiChar(DestFileName),Length(DestFileName),PAnsiChar(ms.Memory),ms.Position);
         OnWriteJSCallBack(OnWriteJSData,PAnsiChar(DestFileName),Length(DestFileName),PAnsiChar(ms.Memory),ms.Position);
       except
       except
         Result:=False;
         Result:=False;
@@ -210,10 +198,13 @@ begin
   try
   try
     if ReadBufferLen=0 then
     if ReadBufferLen=0 then
       ReadBufferLen:=DefaultReadBufferSize;
       ReadBufferLen:=DefaultReadBufferSize;
-    SetLength(Buf,ReadBufferLen);
+    SetLength(Buf{%H-},ReadBufferLen);
     S:=TStringStream.Create(''{$IF FPC_FULLVERSION>=30101},CP_ACP{$ENDIF});
     S:=TStringStream.Create(''{$IF FPC_FULLVERSION>=30101},CP_ACP{$ENDIF});
     Repeat
     Repeat
       BytesRead:=ReadBufferLen;
       BytesRead:=ReadBufferLen;
+      {$IFDEF DebugLib}
+      LibDbgLog('ReadFile File="'+aFilename+'" BufferLen='+IntToStr(ReadBufferLen));
+      {$ENDIF}
       FOnReadPasFile(OnReadPasData,PAnsiChar(aFileName),Length(aFileName),@Buf[0],BytesRead);
       FOnReadPasFile(OnReadPasData,PAnsiChar(aFileName),Length(aFileName),@Buf[0],BytesRead);
       If BytesRead>0 then
       If BytesRead>0 then
         S.Write(Buf[0],BytesRead);
         S.Write(Buf[0],BytesRead);
@@ -227,6 +218,54 @@ begin
   end;
   end;
 end;
 end;
 
 
+function TLibraryPas2JSCompiler.ReadDirectory(Dir: TPas2jsCachedDirectory
+  ): boolean;
+begin
+  Result:=false; // return false to call the default TPas2jsCachedDirectory.DoReadDir
+  if not Assigned(OnReadDir) then exit;
+  {$IFDEF DebugLib}
+  LibDbgLog('ReadDirectory Dir="'+Dir.Path+'"...');
+  {$ENDIF}
+  Result:=OnReadDir(FOnReadDirData,Dir,PAnsiChar(Dir.Path));
+  {$IFDEF DebugLib}
+  LibDbgLog('ReadDirectory Dir="'+Dir.Path+'" '+IntToStr(Dir.Count));
+  {$ENDIF}
+end;
+
+procedure TLibraryPas2JSCompiler.GetFileSrcAttr(AFilename: string; var AAttr: TPas2jsFileSrcAttr);
+begin
+  AAttr.AllowSrcMap := True;
+  if Assigned(OnGetFileSrcAttr) then
+    begin
+    {$IFDEF DebugLib}
+    LibDbgLog('GetFileSrcAttr: File="'+AFilename+'"...');
+    {$ENDIF}
+    OnGetFileSrcAttr(FOnGetFileSrcAttrData, PAnsiChar(AFilename), Length(AFileName), @AAttr);
+    end;
+end;
+
+{$IFDEF DebugLib}
+procedure TLibraryPas2JSCompiler.LibDbgLog(Msg: string);
+const
+  LogFilename = 'pas2jslib-log.txt';
+var
+  s: TFileStream;
+begin
+  if Msg='' then exit;
+  Msg:=Msg+sLineBreak;
+  if FileExists(LogFilename) then
+    s:=TFileStream.Create(LogFilename,fmOpenWrite or fmShareDenyNone)
+  else
+    s:=TFileStream.Create(LogFilename,fmCreate or fmShareDenyNone);
+  try
+    s.Seek(0,soEnd);
+    s.Write(Msg[1],length(Msg));
+  finally
+    s.Free;
+  end;
+end;
+{$ENDIF}
+
 constructor TLibraryPas2JSCompiler.Create;
 constructor TLibraryPas2JSCompiler.Create;
 begin
 begin
   inherited Create;
   inherited Create;
@@ -243,6 +282,9 @@ procedure TLibraryPas2JSCompiler.CheckUnitAlias(var UseUnitName: string);
 var
 var
   UnitNameLen, UnitNameMaxLen: Integer;
   UnitNameLen, UnitNameMaxLen: Integer;
   s: String;
   s: String;
+  {$IFDEF DebugLib}
+  OldUnitName: string;
+  {$ENDIF}
 begin
 begin
   inherited CheckUnitAlias(UseUnitName);
   inherited CheckUnitAlias(UseUnitName);
   UnitNameLen:=length(UseUnitName);
   UnitNameLen:=length(UseUnitName);
@@ -250,8 +292,18 @@ begin
     begin
     begin
     UnitNameMaxLen:=Max(UnitNameLen,255);
     UnitNameMaxLen:=Max(UnitNameLen,255);
     s:=UseUnitName+StringOfChar(#0,UnitNameMaxLen-UnitNameLen);
     s:=UseUnitName+StringOfChar(#0,UnitNameMaxLen-UnitNameLen);
+    {$IFDEF DebugLib}
+    OldUnitName:=UseUnitName;
+    LibDbgLog('CheckUnitAlias "'+UseUnitName+'"...');
+    {$ENDIF}
     if OnUnitAlias(OnUnitAliasData,Pointer(s),UnitNameMaxLen) then
     if OnUnitAlias(OnUnitAliasData,Pointer(s),UnitNameMaxLen) then
+      begin
       UseUnitName:=PAnsiChar(s);
       UseUnitName:=PAnsiChar(s);
+      {$IFDEF DebugLib}
+      if UseUnitName<>OldUnitName then
+        LibDbgLog('CheckUnitAlias New="'+UseUnitName+'"');
+      {$ENDIF}
+      end;
     end;
     end;
 end;
 end;
 
 
@@ -275,12 +327,18 @@ begin
   Result:=False;
   Result:=False;
   C:=ACompilerExe;
   C:=ACompilerExe;
   W:=AWorkingDir;
   W:=AWorkingDir;
+  {$IFDEF DebugLib}
+  LibDbgLog('LibraryRun Exe="'+C+'" WorkDir="'+W+'"');
+  {$ENDIF}
   CmdLine:=TStringList.Create;
   CmdLine:=TStringList.Create;
   try
   try
     PP:=CommandLine;
     PP:=CommandLine;
     While (PP^<>Nil) do
     While (PP^<>Nil) do
       begin
       begin
       CmdLine.Add(pp^);
       CmdLine.Add(pp^);
+      {$IFDEF DebugLib}
+      LibDbgLog('LibraryRun Param['+IntToStr(CmdLine.Count-1)+']="'+CmdLine[CmdLine.Count-1]+'"');
+      {$ENDIF}
       Inc(PP);
       Inc(PP);
       end;
       end;
     try
     try
@@ -290,12 +348,18 @@ begin
         begin
         begin
         LastError:=Format('Compiler exited with exit code %d',[ExitCode]);
         LastError:=Format('Compiler exited with exit code %d',[ExitCode]);
         LastErrorClass:='';
         LastErrorClass:='';
+        {$IFDEF DebugLib}
+        LibDbgLog('LibraryRun Error "'+LastError+'"');
+        {$ENDIF}
         end;
         end;
     except
     except
       On E : Exception do
       On E : Exception do
         begin
         begin
         LastError:=E.Message;
         LastError:=E.Message;
         LastErrorClass:=E.ClassName;
         LastErrorClass:=E.ClassName;
+        {$IFDEF DebugLib}
+        LibDbgLog('LibraryRun Exception '+LastErrorClass+' "'+LastError+'"');
+        {$ENDIF}
         end;
         end;
     end;
     end;
   finally
   finally