Browse Source

--- Merging r20084 into '.':
U rtl/objpas/sysutils/osutilsh.inc
U rtl/objpas/sysutils/sysutils.inc
--- Merging r20102 into '.':
U rtl/objpas/strutils.pp
--- Merging r20134 into '.':
U rtl/unix/dl.pp
--- Merging r20136 into '.':
U utils/h2pas/h2pas.pas
U utils/h2pas/h2pas.y
--- Merging r20139 into '.':
U packages/fcl-image/src/fpreadpng.pp
--- Merging r20143 into '.':
U packages/imagemagick/src/imagemagick.pas
U packages/imagemagick/src/magick_wand.pas
--- Merging r20198 into '.':
U packages/winunits-base/src/activex.pp
--- Merging r20249 into '.':
U packages/fcl-base/src/rttiutils.pp
--- Merging r20273 into '.':
U packages/pasjpeg/src/jerror.pas
--- Merging r20274 into '.':
U rtl/linux/oldlinux.pp

# revisions: 20084,20102,20134,20136,20139,20143,20198,20249,20273,20274
------------------------------------------------------------------------
r20084 | marco | 2012-01-15 12:54:12 +0100 (Sun, 15 Jan 2012) | 3 lines
Changed paths:
M /trunk/rtl/objpas/sysutils/osutilsh.inc
M /trunk/rtl/objpas/sysutils/sysutils.inc

* overloaded version of raiselastoserror that allows custom errorcodes
to be raised, patch by Cytax, Mantis #21092

------------------------------------------------------------------------
------------------------------------------------------------------------
r20102 | marco | 2012-01-17 21:43:20 +0100 (Tue, 17 Jan 2012) | 2 lines
Changed paths:
M /trunk/rtl/objpas/strutils.pp

* updated comments (Mantis #21107)

------------------------------------------------------------------------
------------------------------------------------------------------------
r20134 | marco | 2012-01-21 12:56:40 +0100 (Sat, 21 Jan 2012) | 3 lines
Changed paths:
M /trunk/rtl/unix/dl.pp

* Add dlvsym under ifdef ELF, defined ELF for the OSes I could check
(FreeBSD, OpenBSD, Linux) Mantis #18892

------------------------------------------------------------------------
------------------------------------------------------------------------
r20136 | florian | 2012-01-21 16:17:11 +0100 (Sat, 21 Jan 2012) | 1 line
Changed paths:
M /trunk/utils/h2pas/h2pas.pas
M /trunk/utils/h2pas/h2pas.y

* prevent crash of h2pas if an unknown specifier is encountered, resolves #18664
------------------------------------------------------------------------
------------------------------------------------------------------------
r20139 | jonas | 2012-01-21 20:05:46 +0100 (Sat, 21 Jan 2012) | 3 lines
Changed paths:
M /trunk/packages/fcl-image/src/fpreadpng.pp

* don't try to assign values by indexing properties that return an
array

------------------------------------------------------------------------
------------------------------------------------------------------------
r20143 | jonas | 2012-01-21 20:51:37 +0100 (Sat, 21 Jan 2012) | 3 lines
Changed paths:
M /trunk/packages/imagemagick/src/imagemagick.pas
M /trunk/packages/imagemagick/src/magick_wand.pas

* {$PACKENUM 4} -> {$z4} so the units can also be compiled by Delphi
(patch by Alexey Voychehovich, mantis #21111)

------------------------------------------------------------------------
------------------------------------------------------------------------
r20198 | sergei | 2012-01-30 13:31:11 +0100 (Mon, 30 Jan 2012) | 1 line
Changed paths:
M /trunk/packages/winunits-base/src/activex.pp

+ Added missing SafeArray* functions, Mantis #16046
------------------------------------------------------------------------
------------------------------------------------------------------------
r20249 | marco | 2012-02-04 16:42:57 +0100 (Sat, 04 Feb 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-base/src/rttiutils.pp

* fix to store empty node also for tkastring, Mantis #21137

------------------------------------------------------------------------
------------------------------------------------------------------------
r20273 | marco | 2012-02-06 23:00:18 +0100 (Mon, 06 Feb 2012) | 2 lines
Changed paths:
M /trunk/packages/pasjpeg/src/jerror.pas

* fix for #21229, use sysutils format for error msgs, as suggested.

------------------------------------------------------------------------
------------------------------------------------------------------------
r20274 | marco | 2012-02-07 11:55:11 +0100 (Tue, 07 Feb 2012) | 3 lines
Changed paths:
M /trunk/rtl/linux/oldlinux.pp

* harmless deprecated warning, just in case.
I get warnings while compiling. Is oldfpccall still live?

------------------------------------------------------------------------

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

marco 13 years ago
parent
commit
3d7fac663d

+ 1 - 1
packages/fcl-base/src/rttiutils.pp

@@ -383,7 +383,7 @@ begin
       Exit;
     end;
     if (S <> '') or (PropInfo^.PropType^.Kind in [tkString
-      , tkLString,  tkWString, tkWChar ]) then
+      , tkLString, tkAString, tkWString, tkWChar ]) then
       WriteString(Section, GetItemName(PropInfo^.Name), Trim(S));
   end;
 end;

+ 4 - 4
packages/fcl-image/src/fpreadpng.pp

@@ -618,8 +618,8 @@ procedure TFPReaderPNG.DoDecompress;
         begin
         StartPass := 0;
         EndPass := 0;
-        CountScanlines[0] := Height;
-        ScanLineLength[0] := Width;
+        FCountScanlines[0] := Height;
+        FScanLineLength[0] := Width;
         end
       else
         begin
@@ -630,11 +630,11 @@ procedure TFPReaderPNG.DoDecompress;
           d := Height div delta[r,1];
           if (height mod delta[r,1]) > startpoints[r,1] then
             inc (d);
-          CountScanLines[r] := d;
+          FCountScanlines[r] := d;
           d := width div delta[r,0];
           if (width mod delta[r,0]) > startpoints[r,0] then
             inc (d);
-          ScanLineLength[r] := d;
+          FScanLineLength[r] := d;
           end;
         end;
       Fpltte := (ColorType = 3);

+ 1 - 1
packages/imagemagick/src/imagemagick.pas

@@ -33,7 +33,7 @@ interface
 
 uses SysUtils, ctypes;
 
-{$PACKENUM 4}
+{$z4}
 
 // Fix to compile in older FPC versions
 {$ifdef VER2_2}

+ 1 - 1
packages/imagemagick/src/magick_wand.pas

@@ -31,7 +31,7 @@ unit magick_wand;
 	{$PACKRECORDS C}
 {$ENDIF}
 
-{$PACKENUM 4}
+{$z4}
 
 interface
 

+ 1 - 1
packages/pasjpeg/src/jerror.pas

@@ -88,7 +88,7 @@ implementation
   {$DEFINE NO_FORMAT}
 {$ENDIF}
 {$IFDEF FPC}
-  {$DEFINE NO_FORMAT}
+  {.$DEFINE NO_FORMAT}
 {$ENDIF}
 
 uses

+ 45 - 0
packages/winunits-base/src/activex.pp

@@ -4196,6 +4196,51 @@ function VarUI8FromUI4(ulIn:ULONG; pi64Out:PULONG64):HResult;stdcall;external ol
 function VarUI8FromDec(var pdecIn:TDecimal; pi64Out:PULONG64):HResult;stdcall;external oleaut32dll name 'VarUI8FromDec';
 function VarUI8FromInt(intIn:cint; pi64Out:PULONG64):HResult;stdcall;external oleaut32dll name 'VarUI8FromInt';
 
+{ SafeArray API }
+
+function SafeArrayAllocDescriptor(cDims: UINT; out psaOut: PSafeArray): HResult; stdcall;
+  external oleaut32dll name 'SafeArrayAllocDescriptor';
+function SafeArrayAllocData(psa: PSafeArray): HResult; stdcall;
+  external oleaut32dll name 'SafeArrayAllocData';
+function SafeArrayCreate(vt: TVarType; cDims: UINT; rgsabound: PSafeArrayBound): PSafeArray; stdcall;
+  external oleaut32dll name 'SafeArrayCreate';
+function SafeArrayCreateVector(vt: TVarType; Lbound: Longint; cElements: ULONG): PSafeArray; stdcall;
+  external oleaut32dll name 'SafeArrayCreateVector';
+function SafeArrayCopyData(psaSource, psaTarget: PSafeArray): HResult; stdcall;
+  external oleaut32dll name 'SafeArrayCopyData';
+function SafeArrayDestroyDescriptor(psa: PSafeArray): HResult; stdcall;
+  external oleaut32dll name 'SafeArrayDestroyDescriptor';
+function SafeArrayDestroyData(psa: PSafeArray): HResult; stdcall;
+  external oleaut32dll name 'SafeArrayDestroyData';
+function SafeArrayDestroy(psa: PSafeArray): HResult; stdcall;
+  external oleaut32dll name 'SafeArrayDestroy';
+function SafeArrayRedim(psa: PSafeArray; saboundNew: PSafeArrayBound): HResult; stdcall;
+  external oleaut32dll name 'SafeArrayRedim';
+function SafeArrayGetDim(psa: PSafeArray): UINT; stdcall;
+  external oleaut32dll name 'SafeArrayGetDim';
+function SafeArrayGetElemsize(psa: PSafeArray): UINT; stdcall;
+  external oleaut32dll name 'SafeArrayGetElemsize';
+function SafeArrayGetUBound(psa: PSafeArray; nDim: UINT; out lUbound: Longint): HResult; stdcall;
+  external oleaut32dll name 'SafeArrayGetUBound';
+function SafeArrayGetLBound(psa: PSafeArray; nDim: UINT; out lLbound: Longint): HResult; stdcall;
+  external oleaut32dll name 'SafeArrayGetLBound';
+function SafeArrayLock(psa: PSafeArray): HResult; stdcall;
+  external oleaut32dll name 'SafeArrayLock';
+function SafeArrayUnlock(psa: PSafeArray): HResult; stdcall;
+  external oleaut32dll name 'SafeArrayUnlock';
+function SafeArrayAccessData(psa: PSafeArray; out pvData: Pointer): HResult; stdcall;
+  external oleaut32dll name 'SafeArrayAccessData';
+function SafeArrayUnaccessData(psa: PSafeArray): HResult; stdcall;
+  external oleaut32dll name 'SafeArrayUnaccessData';
+function SafeArrayGetElement(psa: PSafeArray; rgIndices: PLongint; out pv): HResult; stdcall;
+  external oleaut32dll name 'SafeArrayGetElement';
+function SafeArrayPutElement(psa: PSafeArray; rgIndices: PLongint; const pv): HResult; stdcall;
+  external oleaut32dll name 'SafeArrayPutElement';
+function SafeArrayCopy(psa: PSafeArray; out psaOut: PSafeArray): HResult; stdcall;
+  external oleaut32dll name 'SafeArrayCopy';
+function SafeArrayPtrOfIndex(psa: PSafeArray; rgIndices: PLongint; out pvData: Pointer): HResult; stdcall;
+  external oleaut32dll name 'SafeArrayPtrOfIndex';
+  
 implementation
 
 function Succeeded(Res: HResult) : Boolean;inline;

+ 1 - 1
rtl/linux/oldlinux.pp

@@ -12,7 +12,7 @@
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
 **********************************************************************}
-unit oldlinux;
+unit oldlinux deprecated 'Use Baseunix/Unix';
 
 Interface
 

+ 4 - 6
rtl/objpas/strutils.pp

@@ -748,20 +748,18 @@ end;
     Soundex Functions.
   ---------------------------------------------------------------------}
 Const
-SScore : array[1..255] of Char =
+  SScore : array[1..255] of Char =
      ('0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0', // 1..32
       '0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0', // 33..64
-      '0','1','2','3','0','1','2','i','0','2','2','4','5','5','0','1','2','6','2','3','0','1','i','2','i','2', // 64..90
-      '0','0','0','0','0','0', // 91..95
-      '0','1','2','3','0','1','2','i','0','2','2','4','5','5','0','1','2','6','2','3','0','1','i','2','i','2', // 96..122
+      '0','1','2','3','0','1','2','i','0','2','2','4','5','5','0','1','2','6','2','3','0','1','i','2','i','2', // 65..90
+      '0','0','0','0','0','0', // 91..96
+      '0','1','2','3','0','1','2','i','0','2','2','4','5','5','0','1','2','6','2','3','0','1','i','2','i','2', // 97..122
       '0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0', // 123..154
       '0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0', // 155..186
       '0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0', // 187..218
       '0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0', // 219..250
       '0','0','0','0','0'); // 251..255
 
-
-
 Function Soundex(const AText: string; ALength: TSoundexLength): string;
 
 Var

+ 2 - 1
rtl/objpas/sysutils/osutilsh.inc

@@ -19,7 +19,8 @@ Type TExecuteFlags = Set of ( ExecInheritsHandles);
 {$ifdef HAS_OSERROR}
 Function GetLastOSError : Integer;
 {$endif}
-Procedure RaiseLastOSError;
+Procedure RaiseLastOSError;overload;
+Procedure RaiseLastOSError(LastError: Integer);overload;
 Function GetEnvironmentVariable(Const EnvVar : String) : String;
 Function GetEnvironmentVariableCount : Integer;
 Function GetEnvironmentString(Index : Integer) : String;

+ 16 - 9
rtl/objpas/sysutils/sysutils.inc

@@ -370,27 +370,34 @@ begin
 end;
 
 {$IFDEF HAS_OSERROR}
-Procedure RaiseLastOSError;
+Procedure RaiseLastOSError;overload;
+begin
+  RaiseLastOSError(GetLastOSError);
+end;
 
+Procedure RaiseLastOSError(LastError: Integer);overload;
 var
-  ECode: Cardinal;
   E : EOSError;
-
 begin
-  ECode := GetLastOSError;
-  If (ECode<>0) then
-    E:=EOSError.CreateFmt(SOSError, [ECode, SysErrorMessage(ECode)])
+  If (LastError<>0) then
+    E:=EOSError.CreateFmt(SOSError, [LastError, SysErrorMessage(LastError)])
   else
     E:=EOSError.Create(SUnkOSError);
-  E.ErrorCode:=ECode;
+  E.ErrorCode:=LastError;
   Raise E;
 end;
-{$else}
-Procedure RaiseLastOSError;
 
+{$else}
+Procedure RaiseLastOSError;overload;
 begin
   Raise Exception.Create('RaiseLastOSError not implemented on this platform.');
 end;
+
+Procedure RaiseLastOSError(LastError: Integer);overload;
+begin
+  RaiseLastOSError;
+end;
+
 {$endif}
 Procedure AssertErrorHandler (Const Msg,FN : ShortString;LineNo:longint; TheAddr : pointer);
 Var

+ 7 - 0
rtl/unix/dl.pp

@@ -27,6 +27,10 @@ const
   {$endif}
 {$endif}
 
+{$if defined(linux) or defined(freebsd) or defined(openbsd)}
+  {$define ELF} // ELF symbol versioning.
+{$endif}
+
 {$if defined(linux) and defined(cpuarm)}
 { arm-linux seems to require this }
 {$linklib c}
@@ -56,6 +60,9 @@ type
 
 function dlopen(Name : PChar; Flags : longint) : Pointer; cdecl; external libdl;
 function dlsym(Lib : Pointer; Name : Pchar) : Pointer; cdecl; external Libdl;
+{$ifdef ELF}
+function dlvsym(Lib : Pointer; Name : Pchar; Version: Pchar) : Pointer; cdecl; external Libdl;
+{$endif}
 function dlclose(Lib : Pointer) : Longint; cdecl; external libdl;
 function dlerror() : Pchar; cdecl; external libdl;
 { overloaded for compatibility with hmodule }

+ 5 - 3
utils/h2pas/h2pas.pas

@@ -1076,8 +1076,9 @@ program h2pas;
                            hp3:=hp2^.p2;
                            while assigned(hp3) do
                              begin
-                                if not assigned(hp3^.p1^.p3) or
-                                   (hp3^.p1^.p3^.typ <> t_size_specifier) then
+                                if assigned(hp3^.p1) and
+                                   (not assigned(hp3^.p1^.p3) or
+                                   (hp3^.p1^.p3^.typ <> t_size_specifier)) then
                                   begin
                                      if is_sized then
                                        begin
@@ -1097,7 +1098,8 @@ program h2pas;
                                      popshift;
                                   end;
                                 { size specifier  or default value ? }
-                                if assigned(hp3^.p1^.p3) then
+                                if assigned(hp3^.p1) and
+                                   assigned(hp3^.p1^.p3) then
                                   begin
                                      { we could use mask to implement this }
                                      { because we need to respect the positions }

+ 5 - 3
utils/h2pas/h2pas.y

@@ -1072,8 +1072,9 @@ program h2pas;
                            hp3:=hp2^.p2;
                            while assigned(hp3) do
                              begin
-                                if not assigned(hp3^.p1^.p3) or
-                                   (hp3^.p1^.p3^.typ <> t_size_specifier) then
+                                if assigned(hp3^.p1) and
+                                   (not assigned(hp3^.p1^.p3) or
+                                   (hp3^.p1^.p3^.typ <> t_size_specifier)) then
                                   begin
                                      if is_sized then
                                        begin
@@ -1093,7 +1094,8 @@ program h2pas;
                                      popshift;
                                   end;
                                 { size specifier  or default value ? }
-                                if assigned(hp3^.p1^.p3) then
+                                if assigned(hp3^.p1) and
+                                   assigned(hp3^.p1^.p3) then
                                   begin
                                      { we could use mask to implement this }
                                      { because we need to respect the positions }