Re: [fpc-pascal] Tuples as variant arrays

[Sven Barth via fpc-pascal]

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
_______________________________________________
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal