* fix for Mantis #31029, based on the patch provided by Silvio Clécio: PArrayOfByte is not necessary and in fact the purpose of TArrayOfByte is a different one from reference counting (namely to ensure correct passing of the parameter), so renamed accordingly (plus a comment); similar change in SetDynArrayProp. Also Get-/SetPropValue in Variants unit has been adjusted to make use of Get-/SetDynArrayProp.

+ added adjusted test

git-svn-id: trunk@35025 -

.gitattributes

@@ -15283,6 +15283,7 @@ tests/webtbs/tw30948.pp svneol=native#text/plain
 tests/webtbs/tw30978.pp svneol=native#text/pascal
 tests/webtbs/tw30978a.pp svneol=native#text/pascal
 tests/webtbs/tw3101.pp svneol=native#text/plain
+tests/webtbs/tw31029.pp svneol=native#text/pascal
 tests/webtbs/tw3104.pp svneol=native#text/plain
 tests/webtbs/tw3109.pp svneol=native#text/plain
 tests/webtbs/tw3111.pp svneol=native#text/plain

packages/rtl-objpas/src/inc/variants.pp

@@ -4536,6 +4536,8 @@ begin
       Result := GetInt64Prop(Instance, PropInfo);
     tkQWord:
       Result := QWord(GetInt64Prop(Instance, PropInfo));
+    tkDynArray:
+      DynArrayToVariant(Result,GetDynArrayProp(Instance, PropInfo), PropInfo^.PropType);
     else
       raise EPropertyConvertError.CreateFmt('Invalid Property Type: %s',[PropInfo^.PropType^.Name]);
   end;
@@ -4550,6 +4552,7 @@ var
  Qw: QWord;
  S: String;
  B: Boolean;
+ dynarr: Pointer;
 
 begin
    TypeData := GetTypeData(PropInfo^.PropType);
@@ -4638,7 +4641,13 @@ begin
          if (Qw<TypeData^.MinQWordValue) or (Qw>TypeData^.MaxQWordValue) then
            raise ERangeError.Create(SRangeError);
          SetInt64Prop(Instance, PropInfo,Qw);
-       end
+       end;
+     tkDynArray:
+       begin
+         dynarr:=Nil;
+         DynArrayFromVariant(dynarr, Value, PropInfo^.PropType);
+         SetDynArrayProp(Instance, PropInfo, dynarr);
+       end;
    else
      raise EPropertyConvertError.CreateFmt('SetPropValue: Invalid Property Type %s',
                                     [PropInfo^.PropType^.Name]);

rtl/objpas/typinfo.pp

@@ -491,6 +491,11 @@ function GetRawInterfaceProp(Instance: TObject; PropInfo: PPropInfo): Pointer;
 procedure SetRawInterfaceProp(Instance: TObject; const PropName: string; const Value: Pointer);
 procedure SetRawInterfaceProp(Instance: TObject; PropInfo: PPropInfo; const Value: Pointer);
 
+function GetDynArrayProp(Instance: TObject; const PropName: string): Pointer;
+function GetDynArrayProp(Instance: TObject; PropInfo: PPropInfo): Pointer;
+procedure SetDynArrayProp(Instance: TObject; const PropName: string; const Value: Pointer);
+procedure SetDynArrayProp(Instance: TObject; PropInfo: PPropInfo; const Value: Pointer);
+
 // Auxiliary routines, which may be useful
 Function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
 Function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
@@ -1506,6 +1511,83 @@ begin
   end;
 end;
 
+{ ---------------------------------------------------------------------
+  Dynamic array properties
+  ---------------------------------------------------------------------}
+
+function GetDynArrayProp(Instance: TObject; const PropName: string): Pointer;
+begin
+  Result:=GetDynArrayProp(Instance,FindPropInfo(Instance,PropName));
+end;
+
+function GetDynArrayProp(Instance: TObject; PropInfo: PPropInfo): Pointer;
+type
+  { we need a dynamic array as that type is usually passed differently from
+    a plain pointer }
+  TDynArray=array of Byte;
+  TGetDynArrayProc=function:TDynArray of object;
+  TGetDynArrayProcIndex=function(index:longint):TDynArray of object;
+var
+  AMethod : TMethod;
+begin
+  Result:=nil;
+  if PropInfo^.PropType^.Kind<>tkDynArray then
+    Exit;
+  case (PropInfo^.PropProcs) and 3 of
+    ptField:
+      Result:=PPointer(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^;
+    ptStatic,
+    ptVirtual:
+      begin
+        if (PropInfo^.PropProcs and 3)=ptStatic then
+          AMethod.Code:=PropInfo^.GetProc
+        else
+          AMethod.Code:=PCodePointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.GetProc))^;
+        AMethod.Data:=Instance;
+        if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+          Result:=Pointer(TGetDynArrayProcIndex(AMethod)(PropInfo^.Index))
+        else
+          Result:=Pointer(TGetDynArrayProc(AMethod)());
+      end;
+  end;
+end;
+
+procedure SetDynArrayProp(Instance: TObject; const PropName: string; const Value: Pointer);
+begin
+  SetDynArrayProp(Instance,FindPropInfo(Instance,PropName),Value);
+end;
+
+procedure SetDynArrayProp(Instance: TObject; PropInfo: PPropInfo; const Value: Pointer);
+type
+  { we need a dynamic array as that type is usually passed differently from
+    a plain pointer }
+  TDynArray=array of Byte;
+  TSetDynArrayProcIndex=procedure(index:longint;const i:TDynArray) of object;
+  TSetDynArrayProc=procedure(i:TDynArray) of object;
+var
+  AMethod: TMethod;
+begin
+  if PropInfo^.PropType^.Kind<>tkDynArray then
+    Exit;
+  case (PropInfo^.PropProcs shr 2) and 3 of
+    ptField:
+      CopyArray(PPointer(Pointer(Instance)+PtrUInt(PropInfo^.SetProc)), @Value, PropInfo^.PropType, 1);
+    ptStatic,
+    ptVirtual:
+      begin
+        if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
+          AMethod.Code:=PropInfo^.SetProc
+        else
+          AMethod.Code:=PCodePointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.SetProc))^;
+        AMethod.Data:=Instance;
+        if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+          TSetDynArrayProcIndex(AMethod)(PropInfo^.Index,TDynArray(Value))
+        else
+          TSetDynArrayProc(AMethod)(TDynArray(Value));
+      end;
+  end;
+end;
+
 { ---------------------------------------------------------------------
   String properties
   ---------------------------------------------------------------------}

tests/webtbs/tw31029.pp

@@ -0,0 +1,177 @@
+program tw31029;
+
+{$ifdef fpc}
+{$mode objfpc}{$H+}
+{$endif}
+
+uses
+  TypInfo,
+  variants;
+
+type
+  TBytes = array of Byte;
+
+  {$M+}
+  TMyObject = class
+  private
+    FDynArr1: TBytes;
+    FDynArr2: TBytes;
+    FDynArr3: TBytes;
+    FDynArr4: TBytes;
+    function GetDynArr2: TBytes;
+    function GetDynArr3(AIndex: Integer): TBytes;
+    procedure SetDynArr2(AValue: TBytes);
+    procedure SetDynArr3(AIndex: Integer; AValue: TBytes);
+  protected
+    procedure CheckIndex(AIndex: Integer); inline;
+    function GetDynArr4: TBytes; virtual;
+    procedure SetDynArr4(AValue: TBytes); virtual;
+  published
+    property DynArr1: TBytes read FDynArr1 write FDynArr1;
+    property DynArr2: TBytes read GetDynArr2 write SetDynArr2;
+    property DynArr3: TBytes index 1 read GetDynArr3 write SetDynArr3;
+    property DynArr4: TBytes read GetDynArr4 write SetDynArr4;
+  end;
+  {$M-}
+
+  function TMyObject.GetDynArr2: TBytes;
+  begin
+    Result := FDynArr2;
+  end;
+
+  procedure TMyObject.SetDynArr2(AValue: TBytes);
+  begin
+    FDynArr2 := AValue;
+  end;
+
+  function TMyObject.GetDynArr3(AIndex: Integer): TBytes;
+  begin
+    Result := FDynArr3;
+    CheckIndex(AIndex);
+  end;
+
+  procedure TMyObject.SetDynArr3(AIndex: Integer; AValue: TBytes);
+  begin
+    FDynArr3 := AValue;
+    CheckIndex(AIndex);
+  end;
+
+  function TMyObject.GetDynArr4: TBytes;
+  begin
+    Result := FDynArr4;
+  end;
+
+  procedure TMyObject.SetDynArr4(AValue: TBytes);
+  begin
+    FDynArr4 := AValue;
+  end;
+
+  procedure TMyObject.CheckIndex(AIndex: Integer);
+  begin
+    if AIndex <> 1 then begin
+      Writeln('Invalid property index: ', AIndex);
+      Halt(1);
+    end;
+  end;
+
+  procedure CheckArr(const A1, A2: TBytes; const AMsg: string; ACode: LongInt); inline;
+  begin
+    //Writeln(HexStr(Pointer(A1)), ' ', HexStr(Pointer(A2)));
+    if A1 <> A2 then begin
+      Writeln(AMsg);
+      Halt(ACode);
+    end;
+  end;
+
+  procedure CheckArrContents(const A1, A2: TBytes; const AMsg: string; ACode: LongInt);
+  var
+    valid: Boolean;
+    i: LongInt;
+  begin
+    valid := True;
+    if Length(A1) <> Length(A2) then
+      valid := False;
+    if valid then begin
+      for i := Low(A1) to High(A1) do begin
+        if A1[i] <> A2[i] then begin
+          valid := False;
+          Break;
+        end;
+      end;
+    end;
+    if not valid then begin
+      Writeln(AMsg);
+      Halt(ACode);
+    end;
+  end;
+
+var
+  VMyObject: TMyObject;
+  VDynArr1, VDynArr2, VDynArr3, VDynArr4: TBytes;
+  V: Variant;
+begin
+  VMyObject := TMyObject.Create;
+  try
+    { direct use of SetDynArrayProp }
+
+    VMyObject.DynArr1 := nil;
+    VDynArr1 := TBytes.Create(65, 66, 64);
+    SetDynArrayProp(VMyObject, 'DynArr1', Pointer(VDynArr1));
+    CheckArr(VMyObject.DynArr1, VDynArr1,
+      'SetDynArrayProp: VMyObject.DynArr1 <> VDynArr1', 2);
+    VMyObject.DynArr1 := TBytes.Create(65, 66, 64);
+    VDynArr1 := GetDynArrayProp(VMyObject, 'DynArr1');
+    CheckArr(VMyObject.DynArr1, VDynArr1,
+      'GetDynArrayProp: VMyObject.DynArr1 <> VDynArr1', 3);
+
+    VMyObject.DynArr2 := nil;
+    VDynArr2 := TBytes.Create(65, 66, 64);
+    SetDynArrayProp(VMyObject, 'DynArr2', Pointer(VDynArr2));
+    CheckArr(VMyObject.DynArr2, VDynArr2,
+      'SetDynArrayProp: VMyObject.DynArr2 <> VDynArr2', 4);
+    VMyObject.DynArr2 := TBytes.Create(65, 66, 64);
+    VDynArr2 := GetDynArrayProp(VMyObject, 'DynArr2');
+    CheckArr(VMyObject.DynArr2, VDynArr2,
+      'GetDynArrayProp: VMyObject.DynArr2 <> VDynArr2', 5);
+
+    VMyObject.DynArr3 := nil;
+    VDynArr3 := TBytes.Create(65, 66, 64);
+    SetDynArrayProp(VMyObject, 'DynArr3', Pointer(VDynArr3));
+    CheckArr(VMyObject.DynArr3, VDynArr3,
+      'SetDynArrayProp: VMyObject.DynArr3 <> VDynArr3', 6);
+    VMyObject.DynArr3 := TBytes.Create(65, 66, 64);
+    VDynArr3 := GetDynArrayProp(VMyObject, 'DynArr3');
+    CheckArr(VMyObject.DynArr3, VDynArr3,
+      'GetDynArrayProp: VMyObject.DynArr3 <> VDynArr3', 7);
+
+    VMyObject.DynArr4 := nil;
+    VDynArr4 := TBytes.Create(65, 66, 64);
+    SetDynArrayProp(VMyObject, 'DynArr4', Pointer(VDynArr4));
+    CheckArr(VMyObject.DynArr4, VDynArr4,
+      'SetDynArrayProp: VMyObject.DynArr4 <> VDynArr4', 8);
+    VMyObject.DynArr4 := TBytes.Create(65, 66, 64);
+    VDynArr4 := GetDynArrayProp(VMyObject, 'DynArr4');
+    CheckArr(VMyObject.DynArr4, VDynArr4,
+      'GetDynArrayProp: VMyObject.DynArr4 <> VDynArr4', 9);
+
+    { indirect use through a variant (a single test should be enough) }
+    VMyObject.DynArr1 := nil;
+    VDynArr1 := TBytes.Create(65, 66, 64);
+    V := Null;
+    DynArrayToVariant(V, Pointer(VDynArr1), TypeInfo(VDynArr1));
+    SetPropValue(VMyObject, 'DynArr1', V);
+    CheckArrContents(VMyObject.DynArr1, VDynArr1,
+      'SetPropValue: VMyObject.DynArr1 <> VDynArr1', 10);
+    VMyObject.DynArr1 := TBytes.Create(65, 66, 64);
+    V := GetPropValue(VMyObject, 'DynArr1');
+    VDynArr1 := nil;
+    DynArrayFromVariant(Pointer(VDynArr1), V, TypeInfo(VDynArr1));
+    CheckArrContents(VMyObject.DynArr1, VDynArr1,
+      'GetPropValue: VMyObject.DynArr1 <> VDynArr1', 10);
+
+    WriteLn('All tests OK');
+  finally
+    VMyObject.Free;
+  end;
+end.
+