FpDebug: Allow to specify poNewConsole on windows

git-svn-id: trunk@59488 -

components/fpdebug/fpdbgclasses.pp

@@ -269,6 +269,9 @@ type
     property BaseAddr: TDBGPtr read FBaseAddr;
   end;
 
+  TStartInstanceFlag = (siRediretOutput, siForceNewConsole);
+  TStartInstanceFlags = set of TStartInstanceFlag;
+
   { TDbgProcess }
 
   TDbgProcess = class(TDbgInstance)
@@ -305,7 +308,7 @@ type
     // Should analyse why the debugger has stopped.
     function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; virtual; abstract;
   public
-    class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AOnLog: TOnLog; ReDirectOutput: boolean): TDbgProcess; virtual;
+    class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AOnLog: TOnLog; AFlags: TStartInstanceFlags): TDbgProcess; virtual;
     constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer; AOnLog: TOnLog); virtual;
     destructor Destroy; override;
     function  AddBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint; overload;
@@ -1086,8 +1089,9 @@ end;
 resourcestring
   sNoDebugSupport = 'Debug support is not available for this platform .';
 
-class function TDbgProcess.StartInstance(AFileName: string; AParams,
+class function TDbgProcess.StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
-  AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AOnLog: TOnLog; ReDirectOutput: boolean): TDbgProcess;
+  AWorkingDirectory, AConsoleTty: string; AOnLog: TOnLog;
+  AFlags: TStartInstanceFlags): TDbgProcess;
 begin
   if assigned(AOnLog) then
     AOnLog(sNoDebugSupport, dllError)

components/fpdebug/fpdbgcontroller.pas

@@ -129,6 +129,7 @@ type
   private
     FEnvironment: TStrings;
     FExecutableFilename: string;
+    FForceNewConsoleWin: boolean;
     FNextOnlyStopOnStartLine: boolean;
     FOnCreateProcessEvent: TOnCreateProcessEvent;
     FOnDebugInfoLoaded: TNotifyEvent;
@@ -179,6 +180,7 @@ type
     property Environment: TStrings read FEnvironment write SetEnvironment;
     property WorkingDirectory: string read FWorkingDirectory write FWorkingDirectory;
     property RedirectConsoleOutput: boolean read FRedirectConsoleOutput write FRedirectConsoleOutput;
+    property ForceNewConsoleWin: boolean read FForceNewConsoleWin write FForceNewConsoleWin; // windows only
     property ConsoleTty: string read FConsoleTty write FConsoleTty;
     // With this parameter set a 'next' will only stop if the current
     // instruction is the first instruction of a line according to the
@@ -641,6 +643,8 @@ begin
 end;
 
 function TDbgController.Run: boolean;
+var
+  Flags: TStartInstanceFlags;
 begin
   result := False;
   if assigned(FMainProcess) then
@@ -661,7 +665,10 @@ begin
     Exit;
     end;
 
-  FCurrentProcess := OSDbgClasses.DbgProcessClass.StartInstance(FExecutableFilename, Params, Environment, WorkingDirectory, FConsoleTty , @Log, RedirectConsoleOutput);
+  Flags := [];
+  if RedirectConsoleOutput then Include(Flags, siRediretOutput);
+  if ForceNewConsoleWin then Include(Flags, siForceNewConsole);
+  FCurrentProcess := OSDbgClasses.DbgProcessClass.StartInstance(FExecutableFilename, Params, Environment, WorkingDirectory, FConsoleTty , @Log, Flags);
   if assigned(FCurrentProcess) then
     begin
     FProcessMap.Add(FCurrentProcess.ProcessID, FCurrentProcess);

components/fpdebug/fpdbgdarwinclasses.pas

@@ -144,7 +144,7 @@ type
     function CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; override;
     function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
   public
-    class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AOnLog: TOnLog; ReDirectOutput: boolean): TDbgProcess; override;
+    class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AOnLog: TOnLog; AFlags: TStartInstanceFlags): TDbgProcess; override;
     constructor Create(const AName: string; const AProcessID, AThreadID: Integer; AOnLog: TOnLog); override;
     destructor Destroy; override;
 
@@ -698,7 +698,9 @@ begin
   inherited Destroy;
 end;
 
-class function TDbgDarwinProcess.StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AOnLog: TOnLog; ReDirectOutput: boolean): TDbgProcess;
+class function TDbgDarwinProcess.StartInstance(AFileName: string; AParams,
+  AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AOnLog: TOnLog;
+  AFlags: TStartInstanceFlags): TDbgProcess;
 var
   PID: TPid;
   AProcess: TProcessUTF8;
@@ -725,7 +727,7 @@ begin
     end;
 
   AMasterPtyFd:=-1;
-  if ReDirectOutput then
+  if siRediretOutput in AFlags then
     begin
     if AConsoleTty<>'' then
       AOnLog('It is of no use to provide a console-tty when the console output is being redirected.', dllInfo);

components/fpdebug/fpdbglinuxclasses.pas

@@ -264,7 +264,9 @@ type
     function CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; override;
     function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
   public
-    class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AOnLog: TOnLog; ReDirectOutput: boolean): TDbgProcess; override;
+    class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
+      AWorkingDirectory, AConsoleTty: string; AOnLog: TOnLog;
+  AFlags: TStartInstanceFlags): TDbgProcess; override;
     constructor Create(const AName: string; const AProcessID, AThreadID: Integer; AOnLog: TOnLog); override;
     destructor Destroy; override;
 
@@ -615,7 +617,7 @@ begin
 end;
 
 class function TDbgLinuxProcess.StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string;
-  AOnLog: TOnLog; ReDirectOutput: boolean): TDbgProcess;
+  AOnLog: TOnLog; AFlags: TStartInstanceFlags): TDbgProcess;
 var
   PID: TPid;
   AProcess: TProcessUTF8;
@@ -638,7 +640,7 @@ begin
   end;
 
   AMasterPtyFd:=-1;
-  if ReDirectOutput then
+  if siRediretOutput in AFlags then
     begin
     if AConsoleTty<>'' then
       AOnLog('It is of no use to provide a console-tty when the console output is being redirected.', dllInfo);

components/fpdebug/fpdbgwinclasses.pas

@@ -109,7 +109,7 @@ type
     procedure Interrupt;
     function  HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean;
 
-    class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AOnLog: TOnLog; ReDirectOutput: boolean): TDbgProcess; override;
+    class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AOnLog: TOnLog; AFlags: TStartInstanceFlags): TDbgProcess; override;
     function Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean; override;
     function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; override;
     function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
@@ -458,8 +458,9 @@ begin
   end;
 end;
 
-class function TDbgWinProcess.StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string;
+class function TDbgWinProcess.StartInstance(AFileName: string; AParams,
-  AOnLog: TOnLog; ReDirectOutput: boolean): TDbgProcess;
+  AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AOnLog: TOnLog;
+  AFlags: TStartInstanceFlags): TDbgProcess;
 var
   AProcess: TProcessUTF8;
 begin
@@ -467,6 +468,8 @@ begin
   AProcess := TProcessUTF8.Create(nil);
   try
     AProcess.Options:=[poDebugProcess, poNewProcessGroup];
+    if siForceNewConsole in AFlags then
+      AProcess.Options:=AProcess.Options+[poNewConsole];
     AProcess.Executable:=AFilename;
     AProcess.Parameters:=AParams;
     AProcess.Environment:=AnEnvironment;

components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas

@@ -61,6 +61,9 @@ type
   TFpDebugDebuggerProperties = class(TDebuggerProperties)
   private
     FConsoleTty: string;
+    {$ifdef windows}
+    FForceNewConsole: boolean;
+    {$endif windows}
     FNextOnlyStopOnStartLine: boolean;
   public
     constructor Create; override;
@@ -71,6 +74,9 @@ type
     property ConsoleTty: string read FConsoleTty write FConsoleTty;
   published
     property NextOnlyStopOnStartLine: boolean read FNextOnlyStopOnStartLine write FNextOnlyStopOnStartLine;
+    {$ifdef windows}
+    property ForceNewConsole: boolean read FForceNewConsole write FForceNewConsole;
+    {$endif windows}
   end;
 
   { TFpDebugDebugger }
@@ -417,6 +423,9 @@ begin
   if Source is TFpDebugDebuggerProperties then begin
     FNextOnlyStopOnStartLine := TFpDebugDebuggerProperties(Source).NextOnlyStopOnStartLine;
     FConsoleTty:=TFpDebugDebuggerProperties(Source).ConsoleTty;
+    {$ifdef windows}
+    FForceNewConsole:=TFpDebugDebuggerProperties(Source).FForceNewConsole;
+    {$endif windows}
   end;
 end;
 
@@ -1664,6 +1673,9 @@ begin
           CommandToList(Arguments, FDbgController.Params);
         FDbgController.WorkingDirectory:=WorkingDir;
         FDbgController.Environment:=Environment;
+        {$ifdef windows}
+        FDbgController.ForceNewConsoleWin:=TFpDebugDebuggerProperties(GetProperties).ForceNewConsole;
+        {$endif windows}
         FFpDebugThread := TFpDebugThread.Create(Self);
         RTLeventWaitFor(FFpDebugThread.DebugLoopStoppedEvent);
         RTLeventResetEvent(FFpDebugThread.DebugLoopStoppedEvent);