[fpc-pascal] Tuples as variant arrays

[Sven Barth]

Am 26.06.2021 um 00:12 schrieb Ryan Joseph via fpc-pascal:
> Is it possible something like this could work? Seems like it should but I get an error (got MyRecord expected variant).
>
> ====================================
>
> {$mode objfpc}
>
> program unit_name;
>
> type
>    TTuple = array of variant;
>
> type
>    MyRecord = record
>    end;
>
> var
>    t: TTuple;
>    r: MyRecord;
>    i: variant;
> begin
>    t := [1,'string', r];
>    for i in t do
>      begin
>        writeln(i);
>      end;
> end.

Variants by themselves can not handle records, because they can't carry 
type information. However by using TCustomVariantType one can come 
rather close though one still needs to some things manually:

=== code begin ===

program tvarrec;

{$mode objfpc}{$H+}
{$modeswitch advancedrecords}

uses
   Variants;

type
   generic TRecVariantType<T: record> = class(TCustomVariantType)
   private type
     PT = ^T;
   public
     procedure Copy(var Dest: TVarData; const Source: TVarData;
       const Indirect: Boolean); override;
     procedure Clear(var V: TVarData); override;
     function ToVariant(const aArg: T): Variant;
     function FromVariant(const aArg: Variant): T;
   end;

{ TRecVariantType }

procedure TRecVariantType.Copy(var Dest: TVarData; const Source: TVarData;
   const Indirect: Boolean);
begin
   New(PT(Dest.vrecord));
   PT(Dest.vrecord)^ := PT(Source.vrecord)^;
end;

procedure TRecVariantType.Clear(var V: TVarData);
begin
   Dispose(PT(V.vrecord));
   V.vtype:=varEmpty;
   V.vrecord:=Nil;
end;

function TRecVariantType.ToVariant(const aArg: T): Variant;
begin
   TVarData(Result).vtype := VarType;
   New(PT(TVarData(Result).vrecord));
   PT(TVarData(Result).vrecord)^ := aArg;
end;

function TRecVariantType.FromVariant(const aArg: Variant): T;
begin
   if TVarData(aArg).VType <> VarType then
     EVariantTypeCastError.Create('Not a suitable record');
   Result := PT(TVarData(aArg).vrecord)^;
end;

type
   TMyRec = record
     f: LongInt;
     s: String;
     class operator := (const aOther: TMyRec): Variant;
     class operator := (const aOther: Variant): TMyRec;
   end;

   TMyRecVarType = specialize TRecVariantType<TMyRec>;

var
   myrectype: TMyRecVarType;

{ TMyRec }

class operator TMyRec.:=(const aOther: TMyRec): Variant;
begin
   Result := myrectype.ToVariant(aOther);
end;

class operator TMyRec.:=(const aOther: Variant): TMyRec;
begin
   Result := myrectype.FromVariant(aOther);
end;

var
   v: Variant;
   varr: array of Variant;
   m, m2, m3: TMyRec;
   i: LongInt;
begin
   myrectype := TMyRecVarType.Create;
   try
     m.f := 42;
     m.s := 'Hello World';

     v := m;

     m2 := v;

     Writeln(m2.f, ' ', m2.s);

     varr := [1, 'Foobar', m];

     for i := Low(varr) to High(varr) do
       try
         m3 := varr[i];
         Writeln('Entry ', i, ': ', m3.f, ' ', m3.s);
       except
         Writeln('Entry ', i, ': failed to cast');
       end;
   finally
     myrectype.Free;
   end;
end.

=== code end ===

This code is merely a proof of concept and might be further improved.

Regards,
Sven