* fixed variantarrays for 64 bit systems after the changes in 2.2.0 to

    turn variantarray indices into longints
  * extended tw9161 to also test storing and retrieving dynamic arrays
    in/from variant arrays

git-svn-id: trunk@12713 -

rtl/inc/compproc.inc

@@ -518,8 +518,8 @@ function fpc_variant_to_interface(const v : variant) : iinterface;compilerproc;
 function fpc_interface_to_variant(const i : iinterface) : variant;compilerproc;
 function fpc_variant_to_idispatch(const v : variant) : idispatch;compilerproc;
 function fpc_idispatch_to_variant(const i : idispatch) : variant;compilerproc;
-procedure fpc_vararray_get(var d : variant;const s : variant;indices : psizeint;len : sizeint);compilerproc;
-procedure fpc_vararray_put(var d : variant;const s : variant;indices : psizeint;len : sizeint);compilerproc;
+procedure fpc_vararray_get(var d : variant;const s : variant;indices : plongint;len : sizeint);compilerproc;
+procedure fpc_vararray_put(var d : variant;const s : variant;indices : plongint;len : sizeint);compilerproc;
 procedure fpc_dispinvoke_variant(dest : pvardata;const source : tvardata;  calldesc : pcalldesc;params : pointer);compilerproc;
 {$endif FPC_HAS_FEATURE_VARIANTS}
 

rtl/inc/variant.inc

@@ -75,13 +75,13 @@ Procedure fpc_write_text_variant(Len : Longint;var f : Text;const v : variant);
   end;
 
 
-procedure fpc_vararray_get(var d : variant;const s : variant;indices : psizeint;len : sizeint);compilerproc;
+procedure fpc_vararray_get(var d : variant;const s : variant;indices : plongint;len : sizeint);compilerproc;
   begin
     d:=variantmanager.vararrayget(s,len,indices);
   end;
 
 
-procedure fpc_vararray_put(var d : variant;const s : variant;indices : psizeint;len : sizeint);compilerproc;
+procedure fpc_vararray_put(var d : variant;const s : variant;indices : plongint;len : sizeint);compilerproc;
   begin
     variantmanager.vararrayput(d,s,len,indices);
   end;
@@ -637,7 +637,7 @@ procedure VarArrayRedim(var A: Variant; HighBound: SizeInt);
     variantmanager.vararrayredim(a,highbound);
   end;
 
-procedure VarArrayPut(var A: Variant; const Value: Variant; const Indices: array of SizeInt);
+procedure VarArrayPut(var A: Variant; const Value: Variant; const Indices: array of Longint);
   begin
     if Length(Indices)>0 then
       variantmanager.vararrayput(A, Value, Length(Indices), @Indices[0])
@@ -646,7 +646,7 @@ procedure VarArrayPut(var A: Variant; const Value: Variant; const Indices: array
   end;
 
 
-function VarArrayGet(const A: Variant; const Indices: array of SizeInt): Variant;
+function VarArrayGet(const A: Variant; const Indices: array of Longint): Variant;
   begin
     if Length(Indices)>0 then
       Result:=variantmanager.vararrayget(A, Length(Indices), @Indices[0])

rtl/inc/varianth.inc

@@ -193,9 +193,9 @@ type
         calldesc : pcalldesc;params : pointer);cdecl;
 
       vararrayredim : procedure(var a : variant;highbound : SizeInt);
-      vararrayget : function(const a : variant;indexcount : SizeInt;indices : PSizeInt) : variant;cdecl;
+      vararrayget : function(const a : variant;indexcount : SizeInt;indices : plongint) : variant;cdecl;
       vararrayput: procedure(var a : variant; const value : variant;
-        indexcount : SizeInt;indices : PSizeInt);cdecl;
+        indexcount : SizeInt;indices : plongint);cdecl;
       writevariant : function(var t : text;const v : variant;width : longint) : Pointer;
       write0Variant : function(var t : text;const v : Variant) : Pointer;
    end;
@@ -363,8 +363,8 @@ operator <=(const op1,op2 : variant) dest : boolean;{$ifdef SYSTEMINLINE}inline;
 
 { variant helpers }
 procedure VarArrayRedim(var A: Variant; HighBound: SizeInt);
-procedure VarArrayPut(var A: Variant; const Value: Variant; const Indices: array of SizeInt);
-function VarArrayGet(const A: Variant; const Indices: array of SizeInt): Variant;
+procedure VarArrayPut(var A: Variant; const Value: Variant; const Indices: array of Longint);
+function VarArrayGet(const A: Variant; const Indices: array of Longint): Variant;
 procedure VarCast(var dest : variant;const source : variant;vartype : longint);
 
 {**********************************************************************

rtl/inc/variants.pp

@@ -2542,7 +2542,7 @@ begin
 end;
 
 
-function sysvararrayget(const a : Variant;indexcount : SizeInt;indices : psizeint) : Variant;cdecl;
+function sysvararrayget(const a : Variant;indexcount : SizeInt;indices : plongint) : Variant;cdecl;
 var
   src : TVarData;
   p : pvararray;
@@ -2583,7 +2583,7 @@ begin
 end;
 
 
-procedure sysvararrayput(var a : Variant; const value : Variant;indexcount : SizeInt;indices : psizeint);cdecl;
+procedure sysvararrayput(var a : Variant; const value : Variant;indexcount : SizeInt;indices : plongint);cdecl;
 var
   Dest : TVarData;
   p : pvararray;
@@ -3390,7 +3390,7 @@ procedure DynArrayToVariant(var V: Variant; const DynArray: Pointer; TypeInfo: P
               VarClear(temp);
           end;
           dynarriter.next;
-          variantmanager.VarArrayPut(V,temp,Dims,PSizeInt(iter.Coords));
+          variantmanager.VarArrayPut(V,temp,Dims,PLongint(iter.Coords));
         until not(iter.next);
       finally
         iter.done;
@@ -3444,7 +3444,7 @@ procedure DynArrayFromVariant(var DynArray: Pointer; const V: Variant; TypeInfo:
         dynarriter.init(DynArray,TypeInfo,VarArrayDims,dynarraybounds);
         if not iter.AtEnd then
         repeat
-          temp:=variantmanager.VarArrayGet(V,VarArrayDims,PSizeInt(iter.Coords));
+          temp:=variantmanager.VarArrayGet(V,VarArrayDims,PLongint(iter.Coords));
           case dynarrvartype of
             varSmallInt:
               PSmallInt(dynarriter.data)^:=temp;

tests/webtbs/tw9161.pp

@@ -4,6 +4,7 @@ uses
 {$endif}
   variants,sysutils;
 var a:variant;
+    x,y: array of byte;
 begin
   a:=VarArrayCreate([0,2,0,2],varVariant);
   if VarArrayDimCount(a)<>2 then
@@ -14,6 +15,16 @@ begin
   a[2,1]:='asdf';
   if VarArrayGet(a,[2,1])<>'asdf' then
     halt(2);
+  setlength(x,3);
+  x[0]:=77;
+  x[1]:=88;
+  x[2]:=99;
+  a[2,2]:=x;
+  y:=VarArrayGet(a,[2,2]);
+  if (y[0]<>x[0]) or
+     (y[1]<>x[1]) or
+     (y[2]<>x[2]) then
+    halt(3);
   a:='';
   writeln('ok');
 end.