Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Why does assigning a NIL array to a Variant cause a non-empty array to be returned in Delphi 6?

Consider the code below which compiles and runs without error in Delphi 6. When I recover the dynamic string array, instead of seeing an empty array in sa, I see an array with a length of 1 with a single element containing an empty string. Why is this and how can I safely assign a NIL dynamic array to a Variant and recover it properly? Here's the code:

TDynamicStringArray = array of string;

var
    V: Variant;
    sa: TDynamicStringArray;
begin
    sa := nil;

    V := sa;

    sa := V;

    OutputDebugString('sa has a single element now with an empty string in it when I expect it to be empty.');
end;
like image 999
Robert Oschler Avatar asked Oct 11 '12 01:10

Robert Oschler


1 Answers

There are two bugs here.

First of all in Variants.DynArrayVariantBounds. When the dynamic array is nil this erroneously returns a low/high bounds pair of (0, 0). It should return (0, -1). This bug is fixed in the latest versions of Delphi. That causes V := sa to return a variant array with a single, empty, element.

The second bug affects the other direction, sa := V. This bug is still present in the latest versions of Delphi. This bug is in Variants.DynArrayFromVariant. There is a repeat/until loop which walks over the input variant array and populates the output dynamic array. When the input variant array is empty, it should not enter that repeat/until loop. However, the code erroneously does so and attempts to read an element of the variant array with VarArrayGet. Since the array is empty, that provokes a runtime error. I have reported this: QC#109445.

Here is a very simply bit of code that fixes the bugs. Note that I have only consider the case where the arrays are one dimensional. If you need to support higher dimensional arrays then you can extend this approach to do so.

program Project1;

{$APPTYPE CONSOLE}

uses
  Variants;

var
  OriginalVarFromDynArray: procedure(var V: Variant; const DynArray: Pointer; TypeInfo: Pointer);
  OriginalVarToDynArray: procedure(var DynArray: Pointer; const V: Variant; TypeInfo: Pointer);

function DynArrayVarType(typeInfo: PDynArrayTypeInfo): Integer;
const
  tkDynArray  = 17;
begin
  Result := varNull;
  if (typeInfo<>nil) and (typeInfo.Kind=tkDynArray) then
  begin
    Inc(PChar(typeInfo), Length(typeInfo.name));
    Result := typeInfo.varType;
    if Result=$48 then
      Result := varString;
  end;
  if (Result<=varNull) or (Result=$000E) or (Result=$000F) or ((Result>varInt64) and not (Result=varString)) then
    VarCastError;
end;

procedure VarFromDynArray(var V: Variant; const DynArray: Pointer; TypeInfo: Pointer);
var
  VarType, DynDim: Integer;
begin
  DynDim := DynarrayDim(PDynArrayTypeInfo(TypeInfo));
  if DynDim=1 then
  begin
    //only attempt to deal with 1 dimensional arrays
    if DynArray=nil then begin
      VarClear(V);
      VarType := DynArrayVarType(PDynArrayTypeInfo(TypeInfo));
      if VarType = varString then
        VarType := varOleStr;
      V := VarArrayCreate([0, -1], VarType);
      exit;
    end;
  end;
  OriginalVarFromDynArray(V, DynArray, TypeInfo);
end;

procedure VarToDynArray(var DynArray: Pointer; const V: Variant; TypeInfo: Pointer);
var
  DimCount: Integer;
  Len: Integer;
begin
  DimCount:= VarArrayDimCount(V);
  if DimCount=1 then
  begin
    //only attempt to deal with 1 dimensional arrays
    Len := VarArrayHighBound(V, 1) - VarArrayLowBound(V, 1) + 1;
    if Len=0 then begin
      DynArraySetLength(DynArray, PDynArrayTypeInfo(TypeInfo), 1, @Len);
      exit;
    end;
  end;
  OriginalVarToDynArray(DynArray, V, TypeInfo);
end;

procedure FixVariants;
var
  VarMgr: TVariantManager;
begin
  GetVariantManager(VarMgr);
  OriginalVarFromDynArray := VarMgr.VarFromDynArray;
  VarMgr.VarFromDynArray := VarFromDynArray;
  OriginalVarToDynArray := VarMgr.VarToDynArray;
  VarMgr.VarToDynArray := VarToDynArray;
  SetVariantManager(VarMgr);
end;

type
  TDynamicStringArray = array of string;

var
  V: Variant;
  sa: TDynamicStringArray;
begin
  FixVariants;

  sa := nil;
  V := sa;
  sa := V;

  Writeln(Length(sa));
  Readln;
end.
like image 90
David Heffernan Avatar answered Nov 19 '22 13:11

David Heffernan