testgenericfunctions.obs

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

program testgenericfunctions;{$APPTYPE CONSOLE}uses sysutils;type tproceduregenerique
<a> =procedure(param1:a);tprocobjetgenerique<b> =procedure(x,y:b)of object;tfonctiongenerique
<t> =function:t;tmaclasse=class procedure unemethode<t>(x,y:t);procedure testmethode
;procedure testprocedure<untype>(prc:tproceduregenerique<untype>);procedure testfonction
<t>(fnct:tfonctiongenerique<t>);end;procedure proceduregeneriqueint(m:integer);begin
writeln(m);end;procedure proceduregeneriquestring(m:string);begin writeln(m);end;
function unefonctiongeneriqueint:integer;var s:string;begin result:=10;end;procedure
testtypeprocedure(arg:tmaclasse);var p:tprocobjetgenerique<string>;p2:tprocobjetgenerique
<integer>;begin p:=arg.unemethode<string>;p('Hello','World');p2:=arg.unemethode<integer
>;p2(10,20);end;procedure tmaclasse.unemethode<t>(x,y:t);begin writeln(x.tostring
,' , ',y.tostring);end;procedure tmaclasse.testmethode;var p:tprocobjetgenerique<
boolean>;begin unemethode<string>('Hello','World');unemethode('Hello','World');unemethode
<integer>(10,20);unemethode(10,20);p:=unemethode<boolean>;p(false,true);end;procedure
tmaclasse.testprocedure<untype>(prc:tproceduregenerique<untype>);var p:tproceduregenerique
<untype>;value:untype;begin prc('Hello');p:=prc;value:=default(untype);if assigned
(tobject(value))then writeln('Assign