Browse Source

--- Merging r21295 into '.':
U rtl/darwin/termiosproc.inc
--- Merging r21625 into '.':
U packages/fcl-process/src/unix/process.inc
--- Merging r21652 into '.':
U packages/winunits-base/src/eventsink.pp
--- Merging r21681 into '.':
U ide/fputils.pas
U ide/fpredir.pas

# revisions: 21295,21625,21652,21681
r21295 | jonas | 2012-05-14 20:12:30 +0200 (Mon, 14 May 2012) | 4 lines
Changed paths:
M /trunk/rtl/darwin/termiosproc.inc

* use libc functions instead of (wrong) translations of C code for most
functions (except for TCGetPGrp, which behaves differently in Pascal
compared to the C version -- although that may be a bug in itself)
(mantis #21665)
r21625 | marco | 2012-06-16 17:59:40 +0200 (Sat, 16 Jun 2012) | 3 lines
Changed paths:
M /trunk/packages/fcl-process/src/unix/process.inc

* workaround rangecheck error, Mantis #22055. Possibly temporarily while
deciding what to do with that report.
r21652 | marco | 2012-06-19 10:55:40 +0200 (Tue, 19 Jun 2012) | 4 lines
Changed paths:
M /trunk/packages/winunits-base/src/eventsink.pp

* fix from mantis #22156 to wholly implement iunknown or not.
TAbstractEventSink no longer descends from Tinterfacedobject.
Patch by Ludo
r21681 | pierre | 2012-06-22 21:03:13 +0200 (Fri, 22 Jun 2012) | 1 line
Changed paths:
M /trunk/ide/fpredir.pas
M /trunk/ide/fputils.pas

* Avoid ShortString limitations for LocateExeFile in PATH environment variable is very long

git-svn-id: branches/fixes_2_6@22311 -

marco 13 years ago
parent
commit
27e693188b

+ 7 - 4
ide/fpredir.pas

@@ -79,6 +79,7 @@ const
 Implementation
 
 Uses
+  sysutils,
 {$ifdef go32v2}
   go32,
 {$endif go32v2}
@@ -280,7 +281,8 @@ end;
 
 function LocateExeFile(var FileName:string): boolean;
 var
-  dir,s,d,n,e : string;
+  S : AnsiString;
+  dir,d,n,e : string;
   i : longint;
 begin
   LocateExeFile:=False;
@@ -299,7 +301,7 @@ begin
       Exit;
     end;
 
-  S:=GetEnv('PATH');
+  S:=sysutils.GetEnvironmentVariable('PATH');
   While Length(S)>0 do
     begin
       i:=1;
@@ -637,7 +639,8 @@ end;
 
 function LocateExeFile(var FileName:string): boolean;
 var
-  dir,s,d,n,e : string;
+  S : AnsiString;
+  dir,d,n,e : string;
   i : longint;
 begin
   LocateExeFile:=False;
@@ -656,7 +659,7 @@ begin
       Exit;
     end;
 
-  S:=GetEnv('PATH');
+  S:=sysutils.GetEnvironmentVariable('PATH');
   While Length(S)>0 do
     begin
       i:=1;

+ 7 - 4
ide/fputils.pas

@@ -16,11 +16,13 @@ unit FPUtils;
 
 interface
 
-uses Objects;
+uses
+  Sysutils,
+  Objects;
 
 const
   dirsep = System.DirectorySeparator;
-  
+
 {$ifdef Unix}
   listsep = [';',':'];
   exeext = '';
@@ -419,7 +421,8 @@ end;
 
 function LocateExeFile(var FileName:string): boolean;
 var
-  dir,s : string;
+  dir : string;
+  s : ansistring;
   i : longint;
 begin
   LocateExeFile:=False;
@@ -429,7 +432,7 @@ begin
       Exit;
     end;
 
-  S:=GetEnv('PATH');
+  S:=sysutils.GetEnvironmentVariable('PATH');
   While Length(S)>0 do
     begin
       i:=1;

+ 1 - 1
packages/fcl-process/src/unix/process.inc

@@ -52,7 +52,7 @@ begin
       // else pass errorvalue unmodified like shell does, bug #22055
      end
    else
-    FexitCode:=-1; // was 0, better testable for abnormal exit.
+    FexitCode:=cardinal(-1); // was 0, better testable for abnormal exit.
 end;
 
 Type

+ 20 - 1
packages/winunits-base/src/eventsink.pp

@@ -41,7 +41,9 @@ type
   const IID: TGUID; LocaleID: Integer; Flags: Word;
   Params: TDispParams; VarResult, ExcepInfo, ArgErr: Pointer) of object;
 
- TAbstractEventSink = class(TInterfacedObject, IDispatch)
+ { TAbstractEventSink }
+
+ TAbstractEventSink = class(TObject, IDispatch,IUnknown) // see mantis #22156
  private
   FDispatch: IDispatch;
   FDispIntfIID: TGUID;
@@ -49,7 +51,10 @@ type
   FOwner: TComponent;
  protected
   { IUnknown }
+  frefcount : longint;
   function QueryInterface(constref IID: TGUID; out Obj): HRESULT; stdcall;
+  function _AddRef : longint;stdcall;
+  function _Release : longint;stdcall;
   { IDispatch }
   function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;
   function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT; stdcall;
@@ -166,6 +171,20 @@ begin
   Result := S_OK;
 end;
 
+function TAbstractEventSink._AddRef: longint; stdcall;
+begin
+ frefcount:=frefcount+1;
+  _addref:=frefcount;
+end;
+
+function TAbstractEventSink._Release: longint; stdcall;
+begin
+ frefcount:=frefcount-1;
+ _Release:=frefcount;
+ if frefcount=0 then
+   self.destroy;
+end;
+
 procedure TAbstractEventSink.Connect(AnAppDispatch: IDispatch;
  const AnAppDispIntfIID: TGUID);
 begin

+ 21 - 9
rtl/darwin/termiosproc.inc

@@ -77,41 +77,53 @@ end;
 //Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal); cdecl; external 'c' name 'cfsetospeed';
 //Procedure CFMakeRaw(var tios:TermIOS); cdecl; external 'c' name 'cfmakeraw';
 
+function real_tcsendbreak(fd,duration: cint): cint; cdecl; external name 'tcsendbreak';
+
 Function TCSendBreak(fd,duration:cint):cint;{$ifdef VER2_0}inline;{$endif}
 begin
-  TCSendBreak:=fpIOCtl(fd,TIOCSBRK,nil);
+  TCSendBreak:=real_tcsendbreak(fd,duration);
 end;
 
 
+function real_tcsetpgrp(fd: cint; pgrp: pid_t): cint; cdecl; external name 'tcsetpgrp';
+
 Function TCSetPGrp(fd,id:cint):cint;{$ifdef VER2_0}inline;{$endif}
 begin
-  TCSetPGrp:=fpIOCtl(fd,TIOCSPGRP,pointer(ptrint(id)));
+  TCSetPGrp:=real_tcsetpgrp(fd,id);;
 end;
 
 
 Function TCGetPGrp(fd:cint;var id:cint):cint;{$ifdef VER2_0}inline;{$endif}
+var
+  pid: pid_t;
 begin
-  TCGetPGrp:=fpIOCtl(fd,TIOCGPGRP,@id);
+  if isatty(fd)=0 then
+    exit(-1);
+  TCGetPGrp:=fpIOCtl(fd,TIOCGPGRP,@pid);
+  if TCGetPGrp>=0 then
+    id:=pid;
 end;
 
+function real_tcdrain(fd: cint): cint; cdecl; external name 'tcdrain';
+
 Function TCDrain(fd:cint):cint;{$ifdef VER2_0}inline;{$endif}
 begin
   TCDrain:=fpIOCtl(fd,TIOCDRAIN,nil); {Should set timeout to 1 first?}
 end;
 
 
+function real_tcflow(fd,act:cint): cint; cdecl; external name 'tcflow';
+
 Function TCFlow(fd,act:cint):cint; {$ifdef VER2_0}inline;{$endif}
 begin
-    case act OF
-     TCOOFF :  TCFlow:=fpIoctl(fd,TIOCSTOP,nil);
-     TCOOn  :  TCFlow:=fpIOctl(Fd,TIOCStart,nil);
-     TCIOFF :  {N/I}
-    end;
+  TCFlow:=real_tcflow(fd,act);
 end;
 
+function real_tcflush(fd,qsel: cint): cint; cdecl; external name 'tcflush';
+
 Function TCFlush(fd,qsel:cint):cint;  {$ifdef VER2_0}inline;{$endif}
 begin
-  TCFlush:=fpIOCtl(fd,TIOCFLUSH,pointer(ptrint(qsel)));
+  TCFlush:=real_tcflush(fd,qsel);
 end;
 
 Function IsATTY (Handle:cint):cint;