From d6eb3f3a05bff9ec84e98b5a27f3609698997be1 Mon Sep 17 00:00:00 2001 From: mattias Date: Thu, 15 Oct 2020 11:20:24 +0000 Subject: [PATCH] TUTF8Process: workaround for the poNoConsole->poDetached change. Better hacks for old FPC versions without TProcessClassTemplate. Issue #35991 git-svn-id: branches/fixes_2_0@64010 - --- .../lazdebuggergdbmi/cmdlinedebugger.pp | 2 +- components/lazutils/utf8process.pp | 83 +++++++------------ 2 files changed, 33 insertions(+), 52 deletions(-) diff --git a/components/lazdebuggergdbmi/cmdlinedebugger.pp b/components/lazdebuggergdbmi/cmdlinedebugger.pp index 3b71790d71..56a068738e 100644 --- a/components/lazdebuggergdbmi/cmdlinedebugger.pp +++ b/components/lazdebuggergdbmi/cmdlinedebugger.pp @@ -335,7 +335,7 @@ begin FDbgProcess := TProcessUTF8.Create(nil); try FDbgProcess.ParseCmdLine(ExternalDebugger + ' ' + AOptions); - FDbgProcess.Options:= [poUsePipes, poNoConsole, poStdErrToOutPut, poNewProcessGroup]; + FDbgProcess.Options:= [poUsePipes, {$IF DECLARED(poDetached)}poDetached{$ELSE}poNoConsole{$ENDIF}, poStdErrToOutPut, poNewProcessGroup]; {$if defined(windows) and not defined(wince)} // under win9x and winMe should be created with console, // otherwise no break can be sent. diff --git a/components/lazutils/utf8process.pp b/components/lazutils/utf8process.pp index 2d7c44dcde..44f67bc9fa 100644 --- a/components/lazutils/utf8process.pp +++ b/components/lazutils/utf8process.pp @@ -13,21 +13,17 @@ unit UTF8Process; {$mode objfpc}{$H+} -{$IFDEF MSWINDOWS} -{$IF FPC_FULLVERSION < 30200} - {$DEFINE UseTProcessW} -{$ENDIF} -{$ENDIF} - interface uses Classes, SysUtils, Process, - {$IFDEF UseTProcessW} - pipes, - {$ENDIF} FileUtil, LazFileUtils, LazUTF8, LazUtilsStrConsts; + {$IF DEFINED(MSWINDOWS) AND NOT DECLARED(poDetached)} // we need to work around the poNoConsole->poDetached change + // more info: issue #32055, #35991; FPC r45228, https://forum.lazarus.freepascal.org/index.php/topic,49631.0 + {$DEFINE UseTProcessW} + {$ENDIF} + { TProcessUTF8 } {$IFDEF UseTProcessW} @@ -65,7 +61,11 @@ procedure Register; implementation {$IF defined(windows)} -uses Windows; +uses Windows + {$IFDEF UseTProcessW} + ,pipes + {$ENDIF} +; {$ELSEIF defined(freebsd) or defined(darwin)} uses ctypes, sysctl; {$ELSEIF defined(linux)} @@ -201,6 +201,9 @@ Const PriorityConstants : Array [TProcessPriority] of Cardinal = (HIGH_PRIORITY_CLASS,IDLE_PRIORITY_CLASS, NORMAL_PRIORITY_CLASS,REALTIME_PRIORITY_CLASS + {$if (FPC_FULLVERSION >= 30200) and not defined(WinCE)} + ,BELOW_NORMAL_PRIORITY_CLASS,ABOVE_NORMAL_PRIORITY_CLASS + {$endif} ); function WStrAsUniquePWideChar(var s: UnicodeString): PWideChar; inline; @@ -234,8 +237,15 @@ Function GetCreationFlags(P : TProcessUTF8) : Cardinal; begin Result:=CREATE_UNICODE_ENVIRONMENT; + {$IF DECLARED(poDetached)} + if poNoConsole in P.Options then + Result:=Result or CREATE_NO_WINDOW; + if poDetached in P.Options then + Result:=Result or Detached_Process; + {$ELSE} if poNoConsole in P.Options then Result:=Result or Detached_Process; + {$ENDIF} if poNewConsole in P.Options then Result:=Result or Create_new_console; if poNewProcessGroup in P.Options then @@ -376,68 +386,39 @@ begin end; end; -type - TProcessClassTemplate = class(TComponent) - private - {$if fpc_fullversion < 30101} - {%H-}FProcessOptions : TProcessOptions; - {%H-}FStartupOptions : TStartupOptions; - FProcessID : Integer; - {%H-}FTerminalProgram: String; - {$else} - {%H-}FOnRunCommandEvent: TOnRunCommandEvent; - {%H-}FProcessOptions : TProcessOptions; - FRunCommandSleepTime: Integer; - {%H-}FStartupOptions : TStartupOptions; - FProcessID : Integer; - {$ifend} - {%H-}FThreadID : Integer; - FProcessHandle : Thandle; - FThreadHandle : Thandle; - end; - { TProcessUTF8 } +type + PHandle = ^THandle; + procedure TProcessUTF8.SetProcessHandle(aProcessHandle: THandle); var - o: TProcessClassTemplate; + P: PHandle; begin - o:=TProcessClassTemplate.Create(nil); - if (@o.FProcessHandle-Pointer(o) <= TProcessUTF8.InstanceSize - SizeOf(HANDLE)) and - (PHANDLE(Pointer(Self)+(@o.FProcessHandle-Pointer(o)))^ = ProcessHandle) - then - PHANDLE(Pointer(Self)+(@o.FProcessHandle-Pointer(o)))^:=aProcessHandle; + P := @Self.ProcessHandle; + P^ := aProcessHandle; if aProcessHandle<>ProcessHandle then raise Exception.Create('TProcessUTF8.SetProcessHandle failed'); - o.Free; end; procedure TProcessUTF8.SetThreadHandle(aThreadHandle: THandle); var - o: TProcessClassTemplate; + P: PHandle; begin - o:=TProcessClassTemplate.Create(nil); - if (@o.FThreadHandle-Pointer(o) <= TProcessUTF8.InstanceSize - SizeOf(HANDLE)) and - (PHANDLE(Pointer(Self)+(@o.FThreadHandle-Pointer(o)))^ = ThreadHandle) - then - PHANDLE(Pointer(Self)+(@o.FThreadHandle-Pointer(o)))^:=aThreadHandle; + P := @Self.ThreadHandle; + P^ := aThreadHandle; if aThreadHandle<>ThreadHandle then raise Exception.Create('TProcessUTF8.SetThreadHandle failed'); - o.Free; end; procedure TProcessUTF8.SetProcessID(aProcessID: Integer); var - o: TProcessClassTemplate; + P: PInteger; begin - o:=TProcessClassTemplate.Create(nil); - if (@o.FProcessID-Pointer(o) <= TProcessUTF8.InstanceSize - SizeOf(HANDLE)) and - (PHANDLE(Pointer(Self)+(@o.FProcessID-Pointer(o)))^ = ProcessID) - then - PHANDLE(Pointer(Self)+(@o.FProcessID-Pointer(o)))^:=aProcessID; + P := @Self.ProcessID; + P^ := aProcessID; if aProcessID<>ProcessID then raise Exception.Create('TProcessUTF8.SetProcessID failed'); - o.Free; end; procedure TProcessUTF8.Execute;