Show preprocessor output also if compiling failed but preprocessing s…

…ucceeded. Also ISCompileScript cleanup.
ah-sabbir · Aug 29, 2020 · 15583c2 · 15583c2
1 parent faf0f4f
commit 15583c2
Show file tree

Hide file tree

Showing 4 changed files with 93 additions and 71 deletions.
diff --git a/Projects/CompForm.pas b/Projects/CompForm.pas
@@ -1378,8 +1378,9 @@ function CompilerCallbackProc(Code: Integer; var Data: TCompilerCallbackData;
           if Form.FCompileWantAbort then
             Result := iscrRequestAbort;
         end;
-      iscbNotifyIncludedFiles:
+      iscbNotifyPreproc:
         begin
+          PreprocessedScript := Data.PreprocessedScript;
           DecodeIncludedFilenames(Data.IncludedFilenames, Form.FIncludedFiles); { Also stores last write time }
           Form.SaveKnownIncludedFiles(Filename);
         end;
@@ -1578,13 +1579,6 @@ procedure TCompileForm.CompileFile(AFilename: String; const ReadFromFile: Boolea
     StatusMessage(smkStartEnd, Format(SCompilerStatusFinished, [TimeToStr(Time),
       Format('%.2u%s%.2u%s%.3u', [ElapsedSeconds div 60, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator,
         ElapsedSeconds mod 60, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}DecimalSeparator, ElapsedTime mod 1000])]));
-    FPreprocessorMemo.ReadOnly := False;
-    try
-      FPreprocessorMemo.Lines.Text := AppData.PreprocessedScript;
-      FPreprocessorMemo.ClearUndo;
-    finally
-      FPreprocessorMemo.ReadOnly := True;
-    end;
   finally
     AppData.Lines.Free;
     FCompiling := False;
@@ -1598,6 +1592,13 @@ procedure TCompileForm.CompileFile(AFilename: String; const ReadFromFile: Boolea
     UpdateEditModePanel;
     UpdateRunMenu;
     UpdateCaption;
+    FPreprocessorMemo.ReadOnly := False;
+    try
+      FPreprocessorMemo.Lines.Text := AppData.PreprocessedScript;
+      FPreprocessorMemo.ClearUndo;
+    finally
+      FPreprocessorMemo.ReadOnly := True;
+    end;
     UpdateIncludedFilesMemos;
     if AppData.DebugInfo <> nil then begin
       ParseDebugInfo(AppData.DebugInfo); { Must be called after UpdateIncludedFilesMemos }

diff --git a/Projects/CompInt.pas b/Projects/CompInt.pas
@@ -22,7 +22,7 @@ interface
   iscbNotifySuccess = 4;   { Sent when compilation succeeds }
   iscbNotifyError = 5;     { Sent when compilation fails or is aborted by the
                              application }
-  iscbNotifyIncludedFiles = 6; { Sent to notify the application of included files }
+  iscbNotifyPreproc = 6;   { Sent to notify the application of preprocessor results }
 
   { Return values for callback function }
   iscrSuccess = 0;         { Return this for compiler to continue }
@@ -74,7 +74,8 @@   TCompilerCallbackData = record
         BytesCompressedPerSecond: Cardinal); { [in] Average bytes compressed
                                                per second (new in 5.1.13) }
 
-      iscbNotifyIncludedFiles: (
+      iscbNotifyPreproc: (
+        PreprocessedScript: PChar; { [in] Preprocessed script (new in 6.1.0) }
         IncludedFilenames: PChar); { [in] Names of #included files. Each name is
                                           a null-terminated string, and the final
                                           name is followed by an additional null
@@ -85,8 +86,7 @@   TCompilerCallbackData = record
                                           or empty if output was disabled
                                           (latter new in 5.5.5) }
         DebugInfo: Pointer;        { [in] Debug info (new in 3.0.0.1) }
-        DebugInfoSize: Cardinal;   { [in] Size of debug info (new in 3.0.0.1) }
-        PreprocessedScript: PChar);{ [in] Preprocessed script (new in 6.1.0) }
+        DebugInfoSize: Cardinal);  { [in] Size of debug info (new in 3.0.0.1) }
 
       iscbNotifyError: (
         ErrorMsg: PChar;      { [in] The error message, or NULL if compilation

diff --git a/Projects/Compile.pas b/Projects/Compile.pas
@@ -9167,47 +9167,86 @@ procedure TSetupCompiler.Compile;
   end;
 end;
 
-{ Interface helper functions }
+{ Interface functions }
 
-function CheckParams(const Params: TCompileScriptParamsEx): Boolean;
-begin
-  Result := ((Params.Size = SizeOf(Params)) or
-             (Params.Size = SizeOf(TCompileScriptParams))) and
-            Assigned(Params.CallbackProc);
-end;
+function ISCompileScript(const Params: TCompileScriptParamsEx;
+  const PropagateExceptions: Boolean): Integer;
 
-procedure InitializeSetupCompiler(const SetupCompiler: TSetupCompiler;
-  const Params: TCompileScriptParamsEx);
-begin
-  SetupCompiler.AppData := Params.AppData;
-  SetupCompiler.CallbackProc := Params.CallbackProc;
-  if Assigned(Params.CompilerPath) then
-    SetupCompiler.CompilerDir := Params.CompilerPath
-  else
-    SetupCompiler.CompilerDir := PathExtractPath(GetSelfFilename);
-  SetupCompiler.SourceDir := Params.SourcePath;
-end;
+  function CheckParams(const Params: TCompileScriptParamsEx): Boolean;
+  begin
+    Result := ((Params.Size = SizeOf(Params)) or
+               (Params.Size = SizeOf(TCompileScriptParams))) and
+              Assigned(Params.CallbackProc);
+  end;
 
-function EncodeIncludedFilenames(const IncludedFilenames: TStringList): String;
-var
-  S: String;
-  I: Integer;
-begin
-  S := '';
-  for I := 0 to IncludedFilenames.Count-1 do
-   S := S + IncludedFilenames[I] + #0;
-  Result := S;
-end;
+  procedure InitializeSetupCompiler(const SetupCompiler: TSetupCompiler;
+    const Params: TCompileScriptParamsEx);
+  begin
+    SetupCompiler.AppData := Params.AppData;
+    SetupCompiler.CallbackProc := Params.CallbackProc;
+    if Assigned(Params.CompilerPath) then
+      SetupCompiler.CompilerDir := Params.CompilerPath
+    else
+      SetupCompiler.CompilerDir := PathExtractPath(GetSelfFilename);
+    SetupCompiler.SourceDir := Params.SourcePath;
+  end;
 
-{ Interface functions }
+  function EncodeIncludedFilenames(const IncludedFilenames: TStringList): String;
+  var
+    S: String;
+    I: Integer;
+  begin
+    S := '';
+    for I := 0 to IncludedFilenames.Count-1 do
+     S := S + IncludedFilenames[I] + #0;
+    Result := S;
+  end;
+
+  procedure NotifyPreproc(const SetupCompiler: TSetupCompiler);
+  var
+    Data: TCompilerCallbackData;
+    S: String;
+  begin
+    Data.PreprocessedScript := PChar(SetupCompiler.PreprocOutput);
+    S := EncodeIncludedFilenames(SetupCompiler.PreprocIncludedFilenames);
+    Data.IncludedFilenames := PChar(S);
+    Params.CallbackProc(iscbNotifyPreproc, Data, Params.AppData);
+  end;
+
+  procedure NotifySuccess(const SetupCompiler: TSetupCompiler);
+  var
+    Data: TCompilerCallbackData;
+  begin
+    Data.OutputExeFilename := PChar(SetupCompiler.ExeFilename);
+    Data.DebugInfo := SetupCompiler.DebugInfo.Memory;
+    Data.DebugInfoSize := SetupCompiler.DebugInfo.Size;
+    Data.PreprocessedScript := PChar(SetupCompiler.PreprocOutput);
+    Params.CallbackProc(iscbNotifySuccess, Data, Params.AppData);
+  end;
+
+  procedure NotifyError(const SetupCompiler: TSetupCompiler);
+  var
+    Data: TCompilerCallbackData;
+    S: String;
+  begin
+    Data.ErrorMsg := nil;
+    Data.ErrorFilename := nil;
+    Data.ErrorLine := 0;
+    if not(ExceptObject is EAbort) then begin
+      S := GetExceptMessage;
+      Data.ErrorMsg := PChar(S);
+      { use a Pointer cast instead of PChar so that we'll get a null
+        pointer if the string is empty }
+      Data.ErrorFilename := Pointer(SetupCompiler.LineFilename);
+      Data.ErrorLine := SetupCompiler.LineNumber;
+    end;
+    Params.CallbackProc(iscbNotifyError, Data, Params.AppData);
+  end;
 
-function ISCompileScript(const Params: TCompileScriptParamsEx;
-  const PropagateExceptions: Boolean): Integer;
 var
   SetupCompiler: TSetupCompiler;
   P: PChar;
   Data: TCompilerCallbackData;
-  S: String;
   P2: Integer;
 begin
   if not CheckParams(Params) then begin
@@ -9266,38 +9305,20 @@ function ISCompileScript(const Params: TCompileScriptParamsEx;
       end;
     end;
 
-    Result := isceNoError;
     try
-      SetupCompiler.Compile;
+      try
+        SetupCompiler.Compile;
+      finally
+        NotifyPreproc(SetupCompiler);
+      end;
+      Result := isceNoError;
+      NotifySuccess(SetupCompiler);
     except
       Result := isceCompileFailure;
-      S := EncodeIncludedFilenames(SetupCompiler.PreprocIncludedFilenames);
-      Data.IncludedFilenames := PChar(S);
-      Params.CallbackProc(iscbNotifyIncludedFiles, Data, Params.AppData);
-      Data.ErrorMsg := nil;
-      Data.ErrorFilename := nil;
-      Data.ErrorLine := 0;
-      if not(ExceptObject is EAbort) then begin
-        S := GetExceptMessage;
-        Data.ErrorMsg := PChar(S);
-        { use a Pointer cast instead of PChar so that we'll get a null
-          pointer if the string is empty }
-        Data.ErrorFilename := Pointer(SetupCompiler.LineFilename);
-        Data.ErrorLine := SetupCompiler.LineNumber;
-      end;
-      Params.CallbackProc(iscbNotifyError, Data, Params.AppData);
+      NotifyError(SetupCompiler);
       if PropagateExceptions then
         raise;
-      Exit;
     end;
-    S := EncodeIncludedFilenames(SetupCompiler.PreprocIncludedFilenames);
-    Data.IncludedFilenames := PChar(S);
-    Params.CallbackProc(iscbNotifyIncludedFiles, Data, Params.AppData);
-    Data.OutputExeFilename := PChar(SetupCompiler.ExeFilename);
-    Data.DebugInfo := SetupCompiler.DebugInfo.Memory;
-    Data.DebugInfoSize := SetupCompiler.DebugInfo.Size;
-    Data.PreprocessedScript := PChar(SetupCompiler.PreprocOutput);
-    Params.CallbackProc(iscbNotifySuccess, Data, Params.AppData);
   finally
     SetupCompiler.Free;
   end;

diff --git a/Projects/ISCmplr.dpr b/Projects/ISCmplr.dpr
@@ -51,7 +51,7 @@ type
     LastLineRead: String;
   end;
 
-{ Does not support iscbNotifyIncludedFiles }
+{ Does not support iscbNotifyPreproc }
 function WrapperCallbackProc(Code: Integer; var Data: TCompilerCallbackData;
   AppData: Longint): Integer;
 stdcall;