Search code examples
delphidynamic-arraysvariantdelphi-6

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;

Solution

  • 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.