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: branches/fixes_2_2@12096 -

.gitattributes

@@ -7247,6 +7247,7 @@ tests/test/opt/treg3.pp svneol=native#text/plain
 tests/test/opt/treg4.pp svneol=native#text/plain
 tests/test/opt/tretopt.pp svneol=native#text/plain
 tests/test/opt/tspace.pp svneol=native#text/plain
+tests/test/packages/fcl-process/tw11570.pp svneol=native#text/plain
 tests/test/packages/fcl-registry/tregistry1.pp svneol=native#text/plain
 tests/test/packages/hash/tmdtest.pp svneol=native#text/plain
 tests/test/packages/webtbs/tw1808.pp svneol=native#text/plain

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

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

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);

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

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

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

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;

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;

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

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

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.