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.

Petr

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),@TVarData(tempvar).vPointer));
+          VarResultCheck(SafeArrayPutElement(p,PVarArrayCoorArray(indices),@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