[fpc-devel] VarArray 64bit clean patch

[petr.kristan at epos.cz]

On Sat, Apr 26, 2008 at 07:28:46PM +0200, Florian Klaempfl wrote:
> petr.kristan at epos.cz schrieb:
> >Hi.
> >
> >Today I worked on VarArrays. Here is 64-bit friendly VariantArray patch.
> >Testing program is attached too. Implementation was tested on i386 and
> >AMD64 linux with valgrind.
> 
> The patch is contains more changes. Are they tested too? What's their 
> purpose?
Index: rtl/inc/variants.pp
===================================================================
--- rtl/inc/variants.pp (revision 10780)
+++ rtl/inc/variants.pp (working copy)

======== Repairs inserting varOleStr into array (symetrize calling convention SafeArrayPutElement and SafeArrayGetElement)
@@ -2618,10 +2618,7 @@
         begin
           GetVariantManager(variantmanager);
           variantmanager.varcast(tempvar,value,arrayelementtype);
-          if arrayelementtype in [varOleStr,varDispatch,varUnknown] then
-            VarResultCheck(SafeArrayPutElement(p,PVarArrayCoorArray(indices),TVarData(tempvar).vPointer))
-          else
-            VarResultCheck(SafeArrayPutElement(p,PVarArrayCoorArray(indices), at TVarData(tempvar).vPointer));
+          VarResultCheck(SafeArrayPutElement(p,PVarArrayCoorArray(indices), at TVarData(tempvar).vPointer));
         end;
     end
   else

========  Enable varInt64 and varQWord types in VarArray
@@ -3211,7 +3208,7 @@
       varSingle,varDouble,varDate,
 {$endif}
       varCurrency,varOleStr,varDispatch,varError,varBoolean,
-      varVariant,varUnknown,varShortInt,varByte,varWord,varLongWord];
+      varVariant,varUnknown,varShortInt,varByte,varWord,varLongWord,varInt64,varQWord];
   end;



======== Enables inserting variants arrays into variant -- my old patch from 21.03.
@@ -3223,7 +3220,7 @@
       Result:=true
     else
       begin
-        Result:=(aVarType and not(varByRef)) in [varEmpty,varNull,varSmallInt,varInteger,
+        Result:=(aVarType and not(varByRef) and not(varArray)) in [varEmpty,varNull,varSmallInt,varInteger,
 {$ifndef FPUNONE}
           varSingle,varDouble,varDate,
 {$endif}

Index: rtl/objpas/varutils.inc
===================================================================
--- rtl/objpas/varutils.inc (revision 10661)
+++ rtl/objpas/varutils.inc (working copy)

======== Enables varShortInt,varWord,varLongWord,varInt64,varQWord elements in VarArray
@@ -379,22 +379,17 @@
   end;
 end;

-Type
-  TVartypes = varEmpty..varByte;
-
 Const
-  Supportedpsas : set of TVarTypes =
-    [varSmallint,varInteger,
+  Supportedpsas = [varSmallint,varInteger,
 {$ifndef FPUNONE}
      varSingle,varDouble,varCurrency,varDate,
 {$endif}
-     varOleStr,varDispatch,varError,varBoolean,varVariant,varUnknown,varByte];
-  psaElementSizes : Array [varEmpty..varByte] of Byte =
-    (0,0,2,4,4,8,8,8,4,4,4,2,16,4,0,0,0,1);
-  psaElementFlags : Array [varEmpty..varByte] of Longint =
+     varOleStr,varDispatch,varError,varBoolean,varVariant,varUnknown,varShortInt,varByte,
+     varWord,varLongWord,varInt64,varQWord];
+  psaElementFlags : Array [varEmpty..varQWord] of Longint =
     (ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,
      ARR_OLESTR,ARR_DISPATCH,ARR_NONE,ARR_NONE,ARR_VARIANT,ARR_UNKNOWN,
-     ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE);
+     ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE);

 Function SafeArrayCreate(VarType, Dim: DWord; const Bounds: TVarArrayBoundArray): PVarArray;stdcall;
   var

======== Remake calculating ElementSize from static const array psaElementSizes to 64-bit friendly SizeOf function
@@ -409,7 +404,31 @@
       exit;
     Result^.DimCount:=Dim;
     Result^.Flags:=psaElementFlags[VarType];
-    Result^.ElementSize:=psaElementSizes[VarType];
+    case VarType of
+      varEmpty: Result^.ElementSize:=0;
+      varNull: Result^.ElementSize:=0;
+      varSmallInt: Result^.ElementSize:=SizeOf(SmallInt);
+      varInteger: Result^.ElementSize:=SizeOf(Integer);
+{$ifndef FPUNONE}
+      varSingle: Result^.ElementSize:=SizeOf(Single);
+      varDouble: Result^.ElementSize:=SizeOf(double);
+      varCurrency: Result^.ElementSize:=SizeOf(Currency);
+      varDate: Result^.ElementSize:=SizeOf(TDatetime);
+{$endif}
+      varOleStr: Result^.ElementSize:=SizeOf(PWideString);
+      varDispatch: Result^.ElementSize:=SizeOf(IInterface);
+      varError: Result^.ElementSize:=SizeOf(TError);
+      varBoolean: Result^.ElementSize:=SizeOf(Boolean);
+      varVariant: Result^.ElementSize:=SizeOf(TVarData);
+      varUnknown: Result^.ElementSize:=SizeOf(IUnknown);
+      varDecimal: Result^.ElementSize:=0; //???
+      varShortInt: Result^.ElementSize:=SizeOf(ShortInt);
+      varByte: Result^.ElementSize:=SizeOf(Byte);
+      varWord: Result^.ElementSize:=SizeOf(Word);
+      varLongWord: Result^.ElementSize:=SizeOf(LongWord);
+      varInt64: Result^.ElementSize:=SizeOf(Int64);
+      varQWord: Result^.ElementSize:=SizeOf(QWord);
+    end;
     Result^.LockCount := 0;
     for i:=0 to Dim-1 do
       begin

======== Enables varOleStr Get/Put into VarArray
@@ -722,7 +741,7 @@
       vatInterface:
         NoInterfaces; // Just assign...
       vatWideString:
-        NoWideStrings; // Just assign...
+        CopyAsWideString(PWideChar(Data^), PWideChar(P^));
     end;
   except
     On E : Exception do
@@ -747,7 +766,7 @@
       vatInterface:
         NoInterfaces;
       vatWideString:
-        NoWideStrings;
+        CopyAsWideString(PWideChar(P^), PWideChar(Data^));
     end;
   except
     On E : Exception do

Attached test program tries to create VariantArray of every supported type. 
Copy array and then compare inserted values.

I test this patch on 32-bit and 64-bit linux. Program vas run in valgrind without errors.

All my patches are also tested with our ported (delphi->fpc) ERP software self testing routines.
32-bit port already completes all tests without errors. Now I'am working on 64-bit port.

Petr

-- 
Ing. Petr Kristan
.
EPOS PRO s.r.o., Bozeny Nemcove 2625, 530 02 Pardubice
tel: +420 466335223    Czech Republic (Eastern Europe) 
fax: +420 466510709