testgenericconstraints.out

来自「格式化源码的最新板」· OUT 代码 · 共 97 行

program testgenericconstraints;{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes;

type
  couleurs = (rouge, noir, vert);

  imoninterface = interface
    procedure faitqqchose;
  end;

  tclassemoninterface = class(TObject, IMonInterface)
    procedure faitqqchose;
  end;
  tenregistrement = record
  end;

  tgenericenregistrement<t> = record
    Data: t;
  end;

  tgenericclass<r:record> = class
    champ: r;
  end;

  tgenericrecord<c:class> = record
    maclasse: c;
  end;

  tgenericclass2<c:class> = class
    valeur: c;
  end;

  tgenericrecord2<c:TList> = record
    maclasse: c;
  end;

  tgenericrecord3<c:class,
constructor> = record
    maclasse: c;
  end;

  tgenericclass3<u:tgenericclass<tenregistrement>> = class
    enregistrementun: u;
  end;

  tgenericclass4<u:tgenericclass<tenregistrement>> = class
    enregistrementun:    u;
    enregistrementdeux:  tgenericrecord<TObject>;
    enregistrementtrois: tgenericrecord<tgenericclass<tenregistrement>>;
  end;

  tclasscontraintetypenu<t,u> = class
    type tclassimbriquee<s:u> = class
      valeur: s;
    end;
  end;

  procedure tclassemoninterface.faitqqchose;
  begin
    writeln('Dans la proc閐ure d''interface FaitqqChose');
  end;

var
  rec:     tgenericrecord<TObject>;
  objintf: tgenericclass2<imoninterface>;
  obj2:    tgenericclass2<TObject>;
  obj3:    tgenericclass2<string>;
  obj4:    tgenericclass2<array of integer>;
  obj5:    tgenericclass<tenregistrement>;
  obj6:    tgenericclass<integer>;
  obj7:    tgenericclass<couleurs>;
  parent:  tclasscontraintetypenu<string,integer>;
  naked:   TObject;
begin
  try
    rec.maclasse := TObject.Create;
    objintf      := tgenericclass2<imoninterface>.Create;
    objintf.valeur := tclassemoninterface.Create;
    imoninterface(objintf.valeur).faitqqchose;
    obj2   := tgenericclass2<TObject>.Create;
    obj2.valeur := nil;
    obj2.valeur := TObject.Create;
    obj3   := tgenericclass2<string>.Create;
    obj3.valeur := 'Toto';
    parent := tclasscontraintetypenu<string,integer>.Create;
    naked  :=
      tclasscontraintetypenu<string,integer>.tclassimbriquee<string>.Create;
  except
    on e: Exception do
      writeln(e.ClassName, ': ', e.message);
  end;
  readln;
end.