diff options
author | florian <florian@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2008-11-14 20:09:49 +0000 |
---|---|---|
committer | florian <florian@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2008-11-14 20:09:49 +0000 |
commit | 418ab68c05e2854eb2ed2335577e4b9b0b5ea27f (patch) | |
tree | 041f920c7b1f5a6f8358373babc13bf0f9f0a58b | |
parent | 245cf0fff54d2a435f791080b5cf49fcbc9c42a4 (diff) | |
download | fpc-418ab68c05e2854eb2ed2335577e4b9b0b5ea27f.tar.gz |
Merged revisions 10711,11343 via svnmerge from
http://svn.freepascal.org/svn/fpc/trunk
........
r10711 | florian | 2008-04-19 11:34:00 +0200 (Sa, 19 Apr 2008) | 3 lines
+ TTypedComObject
+ skeleton for TTypedComObjectFactory
........
r11343 | florian | 2008-07-07 20:41:10 +0200 (Mo, 07 Jul 2008) | 2 lines
* empty tprocess command line results on windows now in the same exception as on unix
* some code unified
........
git-svn-id: http://svn.freepascal.org/svn/fpc/branches/fixes_2_2@12096 3ad0048d-3df7-0310-abae-a5850022a9f2
-rw-r--r-- | packages/fcl-process/Makefile | 96 | ||||
-rw-r--r-- | packages/fcl-process/Makefile.fpc | 14 | ||||
-rw-r--r-- | packages/fcl-process/src/process.pp | 14 | ||||
-rw-r--r-- | packages/fcl-process/src/unix/process.inc | 22 | ||||
-rw-r--r-- | packages/fcl-process/src/win/process.inc | 36 | ||||
-rw-r--r-- | packages/fcl-process/src/wince/process.inc | 33 | ||||
-rw-r--r-- | packages/winunits-base/src/activex.pp | 1 | ||||
-rw-r--r-- | packages/winunits-base/src/comobj.pp | 51 | ||||
-rw-r--r-- | tests/Makefile | 4 | ||||
-rw-r--r-- | tests/Makefile.fpc | 2 | ||||
-rw-r--r-- | tests/test/packages/fcl-process/tw11570.pp | 23 |
11 files changed, 242 insertions, 54 deletions
diff --git a/packages/fcl-process/Makefile b/packages/fcl-process/Makefile index ebfd828fbf..2a57e8f33a 100644 --- a/packages/fcl-process/Makefile +++ b/packages/fcl-process/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/06/15] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/11/12] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded @@ -115,6 +115,10 @@ FPC:=$(shell $(FPCPROG) -PB) endif ifneq ($(findstring Error,$(FPC)),) override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) +else +ifeq ($(strip $(wildcard $(FPC))),) +FPC:=$(firstword $(FPCPROG)) +endif endif else override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) @@ -437,11 +441,14 @@ endif ifeq ($(FULL_TARGET),i386-linux) override TARGET_RSTS+=process simpleipc endif +ifeq ($(FULL_TARGET),i386-go32v2) +override TARGET_RSTS+=process simpleipc +endif ifeq ($(FULL_TARGET),i386-win32) -override TARGET_RSTS+=simpleipc +override TARGET_RSTS+=process simpleipc endif ifeq ($(FULL_TARGET),i386-os2) -override TARGET_RSTS+=simpleipc +override TARGET_RSTS+=process simpleipc endif ifeq ($(FULL_TARGET),i386-freebsd) override TARGET_RSTS+=process simpleipc @@ -449,6 +456,9 @@ endif ifeq ($(FULL_TARGET),i386-beos) override TARGET_RSTS+=process simpleipc endif +ifeq ($(FULL_TARGET),i386-haiku) +override TARGET_RSTS+=process simpleipc +endif ifeq ($(FULL_TARGET),i386-netbsd) override TARGET_RSTS+=process simpleipc endif @@ -458,17 +468,35 @@ endif ifeq ($(FULL_TARGET),i386-qnx) override TARGET_RSTS+=process simpleipc endif +ifeq ($(FULL_TARGET),i386-netware) +override TARGET_RSTS+=process simpleipc +endif ifeq ($(FULL_TARGET),i386-openbsd) override TARGET_RSTS+=process simpleipc endif +ifeq ($(FULL_TARGET),i386-wdosx) +override TARGET_RSTS+=process simpleipc +endif ifeq ($(FULL_TARGET),i386-darwin) override TARGET_RSTS+=process simpleipc endif ifeq ($(FULL_TARGET),i386-emx) -override TARGET_RSTS+=simpleipc +override TARGET_RSTS+=process simpleipc +endif +ifeq ($(FULL_TARGET),i386-watcom) +override TARGET_RSTS+=process simpleipc +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override TARGET_RSTS+=process simpleipc endif ifeq ($(FULL_TARGET),i386-wince) -override TARGET_RSTS+=simpleipc +override TARGET_RSTS+=process simpleipc +endif +ifeq ($(FULL_TARGET),i386-embedded) +override TARGET_RSTS+=process simpleipc +endif +ifeq ($(FULL_TARGET),i386-symbian) +override TARGET_RSTS+=process simpleipc endif ifeq ($(FULL_TARGET),m68k-linux) override TARGET_RSTS+=process simpleipc @@ -479,18 +507,42 @@ endif ifeq ($(FULL_TARGET),m68k-netbsd) override TARGET_RSTS+=process simpleipc endif +ifeq ($(FULL_TARGET),m68k-amiga) +override TARGET_RSTS+=process simpleipc +endif +ifeq ($(FULL_TARGET),m68k-atari) +override TARGET_RSTS+=process simpleipc +endif ifeq ($(FULL_TARGET),m68k-openbsd) override TARGET_RSTS+=process simpleipc endif +ifeq ($(FULL_TARGET),m68k-palmos) +override TARGET_RSTS+=process simpleipc +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override TARGET_RSTS+=process simpleipc +endif ifeq ($(FULL_TARGET),powerpc-linux) override TARGET_RSTS+=process simpleipc endif ifeq ($(FULL_TARGET),powerpc-netbsd) override TARGET_RSTS+=process simpleipc endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override TARGET_RSTS+=process simpleipc +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override TARGET_RSTS+=process simpleipc +endif ifeq ($(FULL_TARGET),powerpc-darwin) override TARGET_RSTS+=process simpleipc endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override TARGET_RSTS+=process simpleipc +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override TARGET_RSTS+=process simpleipc +endif ifeq ($(FULL_TARGET),sparc-linux) override TARGET_RSTS+=process simpleipc endif @@ -500,6 +552,9 @@ endif ifeq ($(FULL_TARGET),sparc-solaris) override TARGET_RSTS+=process simpleipc endif +ifeq ($(FULL_TARGET),sparc-embedded) +override TARGET_RSTS+=process simpleipc +endif ifeq ($(FULL_TARGET),x86_64-linux) override TARGET_RSTS+=process simpleipc endif @@ -510,16 +565,34 @@ ifeq ($(FULL_TARGET),x86_64-darwin) override TARGET_RSTS+=process simpleipc endif ifeq ($(FULL_TARGET),x86_64-win64) -override TARGET_RSTS+=simpleipc +override TARGET_RSTS+=process simpleipc +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override TARGET_RSTS+=process simpleipc endif ifeq ($(FULL_TARGET),arm-linux) override TARGET_RSTS+=process simpleipc endif +ifeq ($(FULL_TARGET),arm-palmos) +override TARGET_RSTS+=process simpleipc +endif ifeq ($(FULL_TARGET),arm-darwin) override TARGET_RSTS+=process simpleipc endif ifeq ($(FULL_TARGET),arm-wince) -override TARGET_RSTS+=simpleipc +override TARGET_RSTS+=process simpleipc +endif +ifeq ($(FULL_TARGET),arm-gba) +override TARGET_RSTS+=process simpleipc +endif +ifeq ($(FULL_TARGET),arm-nds) +override TARGET_RSTS+=process simpleipc +endif +ifeq ($(FULL_TARGET),arm-embedded) +override TARGET_RSTS+=process simpleipc +endif +ifeq ($(FULL_TARGET),arm-symbian) +override TARGET_RSTS+=process simpleipc endif ifeq ($(FULL_TARGET),powerpc64-linux) override TARGET_RSTS+=process simpleipc @@ -527,9 +600,18 @@ endif ifeq ($(FULL_TARGET),powerpc64-darwin) override TARGET_RSTS+=process simpleipc endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override TARGET_RSTS+=process simpleipc +endif +ifeq ($(FULL_TARGET),avr-embedded) +override TARGET_RSTS+=process simpleipc +endif ifeq ($(FULL_TARGET),armeb-linux) override TARGET_RSTS+=process simpleipc endif +ifeq ($(FULL_TARGET),armeb-embedded) +override TARGET_RSTS+=process simpleipc +endif override INSTALL_FPCPACKAGE=y ifeq ($(FULL_TARGET),i386-linux) override COMPILER_OPTIONS+=-S2h diff --git a/packages/fcl-process/Makefile.fpc b/packages/fcl-process/Makefile.fpc index d0b8e530f3..40b532fe64 100644 --- a/packages/fcl-process/Makefile.fpc +++ b/packages/fcl-process/Makefile.fpc @@ -21,19 +21,7 @@ units_wince=simpleipc dbugmsg dbugintf units_qnx=simpleipc dbugmsg dbugintf units_os2=simpleipc dbugmsg dbugintf units_emx=simpleipc dbugmsg dbugintf -rsts_beos=process simpleipc -rsts_freebsd=process simpleipc -rsts_darwin=process simpleipc -rsts_solaris=process simpleipc -rsts_netbsd=process simpleipc -rsts_openbsd=process simpleipc -rsts_linux=process simpleipc -rsts_qnx=process simpleipc -rsts_win32=simpleipc -rsts_win64=simpleipc -rsts_wince=simpleipc -rsts_os2=simpleipc -rsts_emx=simpleipc +rsts=process simpleipc [compiler] options=-S2h diff --git a/packages/fcl-process/src/process.pp b/packages/fcl-process/src/process.pp index 6c732c9c85..ca5186de7a 100644 --- a/packages/fcl-process/src/process.pp +++ b/packages/fcl-process/src/process.pp @@ -139,6 +139,20 @@ Type implementation +{$ifdef WINDOWS} +Uses + Windows; +{$endif WINDOWS} +{$ifdef UNIX} +uses + Unix, + Baseunix; +{$endif UNIX} + +Resourcestring + SNoCommandLine = 'Cannot execute empty command-line'; + SErrNoSuchProgram = 'Executable not found: "%s"'; + {$i process.inc} Constructor TProcess.Create (AOwner : TComponent); diff --git a/packages/fcl-process/src/unix/process.inc b/packages/fcl-process/src/unix/process.inc index 5ae60d24c1..c1d269e571 100644 --- a/packages/fcl-process/src/unix/process.inc +++ b/packages/fcl-process/src/unix/process.inc @@ -1,14 +1,15 @@ { - Unix Process .inc. -} + This file is part of the Free Component Library (FCL) + Copyright (c) 1999-2008 by the Free Pascal development team -uses - Unix, - Baseunix; + See the file COPYING.FPC, included in this distribution, + for details about the copyright. -resourcestring - SErrNoSuchProgram = 'Executable not found: "%s"'; + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + **********************************************************************} Const PriorityConstants : Array [TProcessPriority] of Integer = (20,20,0,-20); @@ -17,8 +18,6 @@ Const GeometryOption : String = '-geometry'; TitleOption : String ='-title'; - - procedure TProcess.CloseProcessHandles; begin @@ -133,14 +132,11 @@ end; Function MakeCommand(P : TProcess) : PPchar; -Const - SNoCommandLine = 'Cannot execute empty command-line'; - Var Cmd : String; S : TStringList; G : String; - + begin if (P.ApplicationName='') then begin diff --git a/packages/fcl-process/src/win/process.inc b/packages/fcl-process/src/win/process.inc index 0661175958..9e9ee188a7 100644 --- a/packages/fcl-process/src/win/process.inc +++ b/packages/fcl-process/src/win/process.inc @@ -1,8 +1,15 @@ { - Win32 Process .inc. -} + This file is part of the Free Component Library (FCL) + Copyright (c) 1999-2008 by the Free Pascal development team -uses Windows; + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} Const PriorityConstants : Array [TProcessPriority] of Cardinal = @@ -150,8 +157,6 @@ end; Procedure TProcess.Execute; - - Var PName,PDir,PCommandLine : PChar; FEnv: pointer; @@ -161,16 +166,27 @@ Var FProcessInformation : TProcessInformation; FStartupInfo : STARTUPINFO; HI,HO,HE : THandle; - begin FInheritHandles:=True; PName:=Nil; PCommandLine:=Nil; PDir:=Nil; - If FApplicationName<>'' then - PName:=Pchar(FApplicationName); - If FCommandLine<>'' then - PCommandLine:=Pchar(FCommandLine); + + if (FApplicationName='') then + begin + If (FCommandLine='') then + Raise EProcess.Create(SNoCommandline); + PCommandLine:=Pchar(FCommandLine) + end + else + begin + PName:=Pchar(FApplicationName); + If (FCommandLine='') then + PCommandLine:=Pchar(FApplicationName) + else + PCommandLine:=Pchar(FCommandLine) + end; + If FCurrentDirectory<>'' then PDir:=Pchar(FCurrentDirectory); if FEnvironment.Count<>0 then diff --git a/packages/fcl-process/src/wince/process.inc b/packages/fcl-process/src/wince/process.inc index a3f358dcc2..626df7a814 100644 --- a/packages/fcl-process/src/wince/process.inc +++ b/packages/fcl-process/src/wince/process.inc @@ -1,8 +1,15 @@ { - Wince Process .inc. -} + This file is part of the Free Component Library (FCL) + Copyright (c) 1999-2008 by the Free Pascal development team -uses Windows; + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} Const PriorityConstants : Array [TProcessPriority] of Cardinal = @@ -167,10 +174,22 @@ begin PName:=Nil; PCommandLine:=Nil; PDir:=Nil; - If FApplicationName<>'' then - PName:=PWidechar(FApplicationName); - If FCommandLine<>'' then - PCommandLine:=PWidechar(FCommandLine); + + if (FApplicationName='') then + begin + If (FCommandLine='') then + Raise EProcess.Create(SNoCommandline); + PCommandLine:=PWidechar(FCommandLine) + end + else + begin + PName:=PWidechar(FApplicationName); + If (FCommandLine='') then + PCommandLine:=PWidechar(FApplicationName) + else + PCommandLine:=PWidechar(FCommandLine) + end; + If FCurrentDirectory<>'' then PDir:=PWidechar(FCurrentDirectory); if FEnvironment.Count<>0 then diff --git a/packages/winunits-base/src/activex.pp b/packages/winunits-base/src/activex.pp index 5be5f43a65..63c6d01e3f 100644 --- a/packages/winunits-base/src/activex.pp +++ b/packages/winunits-base/src/activex.pp @@ -3100,7 +3100,6 @@ TYPE function GetClassInfo(out pptti : ITypeInfo):HResult; StdCall; end; - IProvideClassInfo2 = Interface (IProvideClassInfo) ['{A6BC3AC0-DBAA-11CE-9DE3-00AA004BB851}'] function GetGUID(dwguid:DWord;out pguid:TGUID):HResult; StdCall; diff --git a/packages/winunits-base/src/comobj.pp b/packages/winunits-base/src/comobj.pp index 5630d51050..7c784114f2 100644 --- a/packages/winunits-base/src/comobj.pp +++ b/packages/winunits-base/src/comobj.pp @@ -175,6 +175,28 @@ unit comobj; property ThreadingModel: TThreadingModel read FThreadingModel; end; + { TTypedComObject } + + TTypedComObject = class(TComObject, IProvideClassInfo) + function GetClassInfo(out pptti : ITypeInfo):HResult; StdCall; + end; + + TTypedComClass = class of TTypedComObject; + + { TTypedComObjectFactory } + + TTypedComObjectFactory = class(TComObjectFactory) + private + FClassInfo: ITypeInfo; + public + constructor Create(AComServer: TComServerObject; TypedComClass: TTypedComClass; const AClassID: TGUID; + AInstancing: TClassInstancing; AThreadingModel: TThreadingModel = tmSingle); + function GetInterfaceTypeInfo(TypeFlags: Integer) : ITypeInfo; + procedure UpdateRegistry(Register: Boolean);override; + property ClassInfo : ITypeInfo read FClassInfo; + end; + + function CreateClassID : ansistring; function CreateComObject(const ClassID: TGUID) : IUnknown; @@ -1036,6 +1058,35 @@ implementation FreeMem(Arguments); end; + { TTypedComObject } + + function TTypedComObject.GetClassInfo(out pptti: ITypeInfo): HResult;stdcall; + begin + Result:=S_OK; + pptti:=TTypedComObjectFactory(factory).classinfo; + end; + + + { TTypedComObjectFactory } + + constructor TTypedComObjectFactory.Create(AComServer: TComServerObject; TypedComClass: TTypedComClass; const AClassID: TGUID; + AInstancing: TClassInstancing; AThreadingModel: TThreadingModel = tmSingle); + begin + RunError(217); + end; + + + function TTypedComObjectFactory.GetInterfaceTypeInfo(TypeFlags: Integer): ITypeInfo; + begin + RunError(217); + end; + + + procedure TTypedComObjectFactory.UpdateRegistry(Register: Boolean); + begin + RunError(217); + end; + const Initialized : boolean = false; diff --git a/tests/Makefile b/tests/Makefile index be9fdf517e..6d44a6a029 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/09/28] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/11/12] # default: allexectests MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded @@ -1446,7 +1446,7 @@ ifndef LOG export LOG:=$(TEST_OUTPUTDIR)/log endif TESTSUBDIRS=cg cg/variants cg/cdecl opt units/system units/dos units/crt units/objects units/strings units/sysutils units/math units/sharemem -TESTPACKAGESUBDIRS=cg packages/win-base packages/webtbs packages/hash packages/fcl-registry packages/zlib +TESTPACKAGESUBDIRS=cg packages/win-base packages/webtbs packages/hash packages/fcl-registry packages/zlib packages/fcl-process ifdef QUICKTEST export QUICKTEST else diff --git a/tests/Makefile.fpc b/tests/Makefile.fpc index bfce9c4a96..d982f9a820 100644 --- a/tests/Makefile.fpc +++ b/tests/Makefile.fpc @@ -123,7 +123,7 @@ endif # Subdirs available in the test subdir TESTSUBDIRS=cg cg/variants cg/cdecl opt units/system units/dos units/crt units/objects units/strings units/sysutils units/math units/sharemem -TESTPACKAGESUBDIRS=cg packages/win-base packages/webtbs packages/hash packages/fcl-registry packages/zlib +TESTPACKAGESUBDIRS=cg packages/win-base packages/webtbs packages/hash packages/fcl-registry packages/zlib packages/fcl-process ifdef QUICKTEST export QUICKTEST diff --git a/tests/test/packages/fcl-process/tw11570.pp b/tests/test/packages/fcl-process/tw11570.pp new file mode 100644 index 0000000000..16df6124da --- /dev/null +++ b/tests/test/packages/fcl-process/tw11570.pp @@ -0,0 +1,23 @@ +program Project1; + +{$mode objfpc}{$H+} + +uses + Classes, SysUtils, Process + { you can add units after this }; + +var + p: TProcess; +begin + try + p := TProcess.Create(nil); + p.Active := true; + except + on eprocess do + begin + writeln('ok'); + halt(0); + end; + end; + halt(1); +end. |