IDE: about fpc: show fpc -i and -va output

git-svn-id: trunk@28893 -

components/codetools/definetemplates.pas

@@ -694,6 +694,7 @@ type
     procedure LoadFromFile(Filename: string);
     procedure SaveToFile(Filename: string);
     function NeedsUpdate: boolean;
+    function GetFPCInfoCmdLineOptions(ExtraOptions: string): string;
     function Update(TestFilename: string; ExtraOptions: string = '';
                     const OnProgress: TDefinePoolProgress = nil): boolean;
     function FindRealCompilerInPath(aTargetCPU: string; ResolveLinks: boolean): string;
@@ -7590,6 +7591,19 @@ begin
   Result:=false;
 end;
 
+function TFPCTargetConfigCache.GetFPCInfoCmdLineOptions(ExtraOptions: string
+  ): string;
+begin
+  Result:='';
+  if CompilerOptions<>'' then
+    ExtraOptions:=CompilerOptions+' '+ExtraOptions;
+  if TargetOS<>'' then
+    ExtraOptions:='-T'+LowerCase(TargetOS)+' '+ExtraOptions;
+  if TargetCPU<>'' then
+    ExtraOptions:='-P'+LowerCase(TargetCPU)+' '+ExtraOptions;
+  Result:=Trim(ExtraOptions);
+end;
+
 procedure TFPCTargetConfigCache.IncreaseChangeStamp;
 begin
   CTIncreaseChangeStamp(FChangeStamp);
@@ -7619,14 +7633,7 @@ begin
     debugln(['TFPCTargetConfigCache.Update ',Compiler,' TargetOS=',TargetOS,' TargetCPU=',TargetCPU,' CompilerOptions=',CompilerOptions,' ExtraOptions=',ExtraOptions,' PATH=',GetEnvironmentVariableUTF8('PATH')]);
     CompilerDate:=FileAgeCached(Compiler);
     if FileExistsCached(Compiler) then begin
-
-      if CompilerOptions<>'' then
-        ExtraOptions:=CompilerOptions+' '+ExtraOptions;
-      if TargetOS<>'' then
-        ExtraOptions:='-T'+LowerCase(TargetOS)+' '+ExtraOptions;
-      if TargetCPU<>'' then
-        ExtraOptions:='-P'+LowerCase(TargetCPU)+' '+ExtraOptions;
-      ExtraOptions:=Trim(ExtraOptions);
+      ExtraOptions:=GetFPCInfoCmdLineOptions(ExtraOptions);
 
       // get real OS and CPU
       Info:=RunFPCInfo(Compiler,[fpciTargetOS,fpciTargetProcessor],ExtraOptions);

ide/idefpcinfo.lfm

@@ -8,17 +8,49 @@ object IDEFPCInfoDialog: TIDEFPCInfoDialog
   ClientWidth = 704
   OnCreate = FormCreate
   Position = poScreenCenter
-  LCLVersion = '0.9.29'
-  object Memo1: TMemo
+  LCLVersion = '0.9.31'
+  object PageControl1: TPageControl
     Left = 0
     Height = 450
     Top = 0
     Width = 704
+    ActivePage = OutputTabSheet
     Align = alClient
-    Lines.Strings = (
-      'Memo1'
-    )
-    ScrollBars = ssAutoBoth
+    TabIndex = 1
     TabOrder = 0
+    object ValuesTabSheet: TTabSheet
+      Caption = 'FPC values used by the IDE'
+      ClientHeight = 423
+      ClientWidth = 702
+      object ValuesMemo: TMemo
+        Left = 0
+        Height = 423
+        Top = 0
+        Width = 702
+        Align = alClient
+        Lines.Strings = (
+          'ValuesMemo'
+          ''
+        )
+        ScrollBars = ssAutoBoth
+        TabOrder = 0
+      end
+    end
+    object OutputTabSheet: TTabSheet
+      Caption = 'FPC output'
+      ClientHeight = 423
+      ClientWidth = 702
+      object CmdLineOutputMemo: TMemo
+        Left = 0
+        Height = 423
+        Top = 0
+        Width = 702
+        Align = alClient
+        Lines.Strings = (
+          'CmdLineOutputMemo'
+        )
+        TabOrder = 0
+      end
+    end
   end
 end

ide/idefpcinfo.pas

@@ -31,18 +31,23 @@ interface
 
 uses
   Classes, SysUtils, AVL_Tree, FileUtil, Forms, Controls, Graphics, Dialogs,
-  StdCtrls, FileProcs, DefineTemplates, CodeToolManager, BaseBuildManager,
-  Project, EnvironmentOpts, LazarusIDEStrConsts, AboutFrm;
+  StdCtrls, ComCtrls, FileProcs, DefineTemplates, CodeToolManager,
+  BaseBuildManager, Project, EnvironmentOpts, LazarusIDEStrConsts, AboutFrm;
 
 type
 
   { TIDEFPCInfoDialog }
 
   TIDEFPCInfoDialog = class(TForm)
-    Memo1: TMemo;
+    CmdLineOutputMemo: TMemo;
+    ValuesMemo: TMemo;
+    PageControl1: TPageControl;
+    ValuesTabSheet: TTabSheet;
+    OutputTabSheet: TTabSheet;
     procedure FormCreate(Sender: TObject);
   private
-    procedure UpdateMemo;
+    procedure UpdateValuesMemo;
+    procedure UpdateCmdLinePage;
     procedure GatherIDEVersion(sl: TStrings);
     procedure GatherEnvironmentVars(sl: TStrings);
     procedure GatherGlobalOptions(sl: TStrings);
@@ -76,10 +81,12 @@ procedure TIDEFPCInfoDialog.FormCreate(Sender: TObject);
 begin
   Caption:=lisInformationAboutUsedFPC;
 
-  UpdateMemo;
+  UpdateValuesMemo;
+  UpdateCmdLinePage;
+  PageControl1.PageIndex:=0;
 end;
 
-procedure TIDEFPCInfoDialog.UpdateMemo;
+procedure TIDEFPCInfoDialog.UpdateValuesMemo;
 var
   sl: TStringList;
   TargetOS: String;
@@ -104,12 +111,87 @@ begin
       CompilerFilename,TargetOS,TargetCPU,'',FPCSrcDir,true);
     GatherFPCExecutable(UnitSetCache,sl);
 
-    Memo1.Lines.Assign(sl);
+    ValuesMemo.Lines.Assign(sl);
   finally
     sl.Free;
   end;
 end;
 
+procedure TIDEFPCInfoDialog.UpdateCmdLinePage;
+var
+  TargetOS: String;
+  TargetCPU: String;
+  CompilerFilename: String;
+  CompilerOptions: String;
+  Cfg: TFPCTargetConfigCache;
+  Params: String;
+  ExtraOptions: String;
+  sl, List: TStringList;
+  TestFilename: String;
+  Filename: String;
+  WorkDir: String;
+  fs: TFileStream;
+begin
+  TargetOS:=BuildBoss.GetTargetOS(true);
+  TargetCPU:=BuildBoss.GetTargetCPU(true);
+  CompilerFilename:=EnvironmentOptions.GetCompilerFilename;
+  CompilerOptions:='';
+  Cfg:=CodeToolBoss.FPCDefinesCache.ConfigCaches.Find(
+                      CompilerFilename,CompilerOptions,TargetOS,TargetCPU,true);
+  sl:=TStringList.Create;
+  List:=nil;
+  try
+    // fpc -i
+    sl.Add('The IDE asks the compiler with the following command for the real OS/CPU:');
+    ExtraOptions:=Cfg.GetFPCInfoCmdLineOptions('');
+    Params:=Trim('-iTOTP '+ExtraOptions);
+    WorkDir:=GetCurrentDirUTF8;
+    sl.Add(CompilerFilename+' '+Params);
+    sl.Add('Working directory: '+WorkDir);
+    List:=RunTool(CompilerFilename,Params);
+    if (List=nil) or (List.Count<1) then begin
+      sl.Add('Error: unable to run compiler.');
+    end else begin
+      sl.Add('Output:');
+      sl.AddStrings(List);
+    end;
+    List.Free;
+    sl.Add('');
+
+    // fpc -va
+    TestFilename:=CodeToolBoss.FPCDefinesCache.TestFilename;
+    Filename:=ExtractFileName(TestFilename);
+    WorkDir:=ExtractFilePath(TestFilename);
+    sl.Add('The IDE asks the compiler with the following command for paths and macros:');
+    ExtraOptions:='';
+    Params:=Trim('-va '+ExtraOptions)+' '+Filename;
+    sl.Add(CompilerFilename+' '+Params);
+    sl.Add('Working directory: '+WorkDir);
+    // create empty file
+    try
+      fs:=TFileStream.Create(UTF8ToSys(TestFilename),fmCreate);
+      fs.Free;
+    except
+      sl.Add('Error: unable to create test file '+TestFilename);
+      exit;
+    end;
+    List:=RunTool(CompilerFilename,Params,WorkDir);
+    if (List=nil) or (List.Count<1) then begin
+      sl.Add('Error: unable to run compiler.');
+    end else begin
+      sl.Add('Output:');
+      sl.AddStrings(List);
+      sl.Add('');
+      sl.Add('Note: The '+Filename+' is empty, so compilation fails. This is what we want.');
+    end;
+
+  finally
+    CmdLineOutputMemo.Lines.Assign(sl);
+    List.free;
+    sl.Free;
+  end;
+end;
+
 procedure TIDEFPCInfoDialog.GatherIDEVersion(sl: TStrings);
 const
   LazarusVersionStr= {$I version.inc};