tcresolvegenerics.pas 60 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602
  1. unit tcresolvegenerics;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils, testregistry, tcresolver, PasResolveEval, PParser;
  6. type
  7. { TTestResolveGenerics }
  8. TTestResolveGenerics = Class(TCustomTestResolver)
  9. Published
  10. // generic types
  11. procedure TestGen_MissingTemplateFail;
  12. procedure TestGen_VarTypeWithoutSpecializeFail;
  13. procedure TestGen_GenTypeWithWrongParamCountFail;
  14. procedure TestGen_GenericNotFoundFail;
  15. procedure TestGen_SameNameSameParamCountFail;
  16. procedure TestGen_TypeAliasWithoutSpecializeFail;
  17. // constraints
  18. procedure TestGen_ConstraintStringFail;
  19. procedure TestGen_ConstraintMultiClassFail;
  20. procedure TestGen_ConstraintRecordExpectedFail;
  21. procedure TestGen_ConstraintClassRecordFail;
  22. procedure TestGen_ConstraintRecordClassFail;
  23. procedure TestGen_ConstraintArrayFail;
  24. procedure TestGen_ConstraintConstructor;
  25. // ToDo: constraint T:Unit2.TBird
  26. // ToDo: constraint T:Unit2.TGen<word>
  27. procedure TestGen_ConstraintSpecialize;
  28. procedure TestGen_ConstraintTSpecializeWithT;
  29. procedure TestGen_ConstraintTSpecializeAsTFail;
  30. procedure TestGen_TemplNameEqTypeNameFail;
  31. procedure TestGen_ConstraintInheritedMissingRecordFail;
  32. procedure TestGen_ConstraintInheritedMissingClassTypeFail;
  33. procedure TestGen_ConstraintMultiParam;
  34. procedure TestGen_ConstraintMultiParamClassMismatch;
  35. procedure TestGen_ConstraintClassType_DotIsAsTypeCast;
  36. procedure TestGen_ConstraintClassType_ForInT;
  37. procedure TestGen_ConstraintClassType_IsAs;
  38. // ToDo: A<T:T> fail
  39. // ToDo: A<T:B<T>> fail
  40. // generic record
  41. procedure TestGen_RecordLocalNameDuplicateFail;
  42. procedure TestGen_Record;
  43. procedure TestGen_RecordDelphi;
  44. procedure TestGen_RecordNestedSpecialized;
  45. procedure TestGen_Record_SpecializeSelfInsideFail;
  46. procedure TestGen_RecordAnoArray;
  47. // ToDo: unitname.specialize TBird<word>.specialize
  48. procedure TestGen_RecordNestedSpecialize;
  49. // generic class
  50. procedure TestGen_Class;
  51. procedure TestGen_ClassDelphi;
  52. procedure TestGen_ClassDelphi_TypeOverload;
  53. procedure TestGen_ClassObjFPC;
  54. procedure TestGen_ClassObjFPC_OverloadFail;
  55. procedure TestGen_ClassObjFPC_OverloadOtherUnit;
  56. procedure TestGen_ClassForward;
  57. procedure TestGen_ClassForwardConstraints;
  58. procedure TestGen_ClassForwardConstraintNameMismatch;
  59. procedure TestGen_ClassForwardConstraintKeywordMismatch;
  60. procedure TestGen_ClassForwardConstraintTypeMismatch;
  61. procedure TestGen_ClassForward_Circle;
  62. procedure TestGen_Class_RedeclareInUnitImplFail;
  63. procedure TestGen_Class_TypeOverloadInUnitImpl;
  64. procedure TestGen_Class_MethodObjFPC;
  65. procedure TestGen_Class_MethodOverride;
  66. procedure TestGen_Class_MethodDelphi;
  67. procedure TestGen_Class_MethodDelphiTypeParamMissing;
  68. procedure TestGen_Class_MethodImplConstraintFail;
  69. procedure TestGen_Class_MethodImplTypeParamNameMismatch;
  70. procedure TestGen_Class_SpecializeSelfInside;
  71. procedure TestGen_Class_GenAncestor;
  72. procedure TestGen_Class_AncestorSelfFail;
  73. procedure TestGen_ClassOfSpecializeFail;
  74. // ToDo: UnitA.impl uses UnitB.intf uses UnitA.intf, UnitB has specialize of UnitA
  75. procedure TestGen_Class_NestedType;
  76. procedure TestGen_Class_NestedRecord;
  77. procedure TestGen_Class_NestedClass;
  78. procedure TestGen_Class_Enums_NotPropagating;
  79. procedure TestGen_Class_Self;
  80. procedure TestGen_Class_MemberTypeConstructor;
  81. procedure TestGen_Class_List;
  82. // ToDo: different modeswitches at parse time and specialize time
  83. // generic external class
  84. procedure TestGen_ExtClass_Array;
  85. // generic interface
  86. procedure TestGen_ClassInterface;
  87. procedure TestGen_ClassInterface_Method;
  88. // generic array
  89. procedure TestGen_DynArray;
  90. procedure TestGen_StaticArray;
  91. procedure TestGen_Array_Anoynmous;
  92. // generic procedure type
  93. procedure TestGen_ProcType;
  94. // pointer of generic
  95. procedure TestGen_PointerDirectSpecializeFail;
  96. // ToDo: helpers for generics
  97. procedure TestGen_HelperForArray;
  98. // ToDo: default class prop array helper: arr<b>[c]
  99. // generic statements
  100. procedure TestGen_LocalVar;
  101. procedure TestGen_Statements;
  102. procedure TestGen_InlineSpecializeExpr;
  103. // ToDo: a.b<c>(d)
  104. // ToDo: with a do b<c>
  105. procedure TestGen_TryExcept;
  106. procedure TestGen_Call;
  107. procedure TestGen_NestedProc;
  108. // ToDo: obj<b>[c]
  109. // generic functions
  110. procedure TestGenProc_Function;
  111. procedure TestGenProc_FunctionDelphi;
  112. procedure TestGenProc_OverloadDuplicate;
  113. procedure TestGenProc_MissingTemplatesFail;
  114. procedure TestGenProc_Forward;
  115. procedure TestGenProc_External;
  116. procedure TestGenProc_UnitIntf;
  117. procedure TestGenProc_BackRef1Fail;
  118. procedure TestGenProc_BackRef2Fail;
  119. procedure TestGenProc_BackRef3Fail;
  120. procedure TestGenProc_CallSelf;
  121. procedure TestGenProc_CallSelfNoParams;
  122. procedure TestGenProc_ForwardConstraints;
  123. procedure TestGenProc_ForwardConstraintsRepeatFail;
  124. procedure TestGenProc_ForwardTempNameMismatch;
  125. procedure TestGenProc_ForwardOverload;
  126. procedure TestGenProc_NestedFail;
  127. procedure TestGenProc_TypeParamCntOverload;
  128. procedure TestGenProc_TypeParamCntOverloadNoParams;
  129. procedure TestGenProc_TypeParamWithDefaultParamDelphiFail;
  130. // ToDo: NestedResultAssign
  131. // generic function infer types
  132. procedure TestGenProc_Infer_NeedExplicitFail;
  133. procedure TestGenProc_Infer_Overload;
  134. procedure TestGenProc_Infer_OverloadForward;
  135. procedure TestGenProc_Infer_Var_Overload;
  136. procedure TestGenProc_Infer_Widen;
  137. procedure TestGenProc_Infer_DefaultValue;
  138. procedure TestGenProc_Infer_DefaultValueMismatch;
  139. procedure TestGenProc_Infer_ProcT;
  140. procedure TestGenProc_Infer_Mismatch;
  141. procedure TestGenProc_Infer_ArrayOfT;
  142. procedure TestGenProc_Infer_PassAsArgDelphi;
  143. procedure TestGenProc_Infer_PassAsArgObjFPC;
  144. // ToDo procedure TestGenProc_Infer_ProcType;
  145. // generic methods
  146. procedure TestGenMethod_VirtualFail;
  147. procedure TestGenMethod_PublishedFail;
  148. procedure TestGenMethod_ClassInterfaceMethodFail;
  149. procedure TestGenMethod_ClassConstructorFail;
  150. procedure TestGenMethod_TemplNameDifferFail;
  151. procedure TestGenMethod_ImplConstraintFail;
  152. procedure TestGenMethod_NestedSelf;
  153. procedure TestGenMethod_OverloadTypeParamCnt;
  154. procedure TestGenMethod_OverloadArgs;
  155. end;
  156. implementation
  157. { TTestResolveGenerics }
  158. procedure TTestResolveGenerics.TestGen_MissingTemplateFail;
  159. begin
  160. StartProgram(false);
  161. Add([
  162. 'type generic g< > = array of word;',
  163. 'begin',
  164. '']);
  165. CheckParserException('Expected "Identifier"',nParserExpectTokenError);
  166. end;
  167. procedure TTestResolveGenerics.TestGen_VarTypeWithoutSpecializeFail;
  168. begin
  169. StartProgram(false);
  170. Add([
  171. 'type generic TBird<T> = record end;',
  172. 'var b: TBird;',
  173. 'begin',
  174. '']);
  175. CheckResolverException('Generics without specialization cannot be used as a type for a variable',
  176. nGenericsWithoutSpecializationAsType);
  177. end;
  178. procedure TTestResolveGenerics.TestGen_GenTypeWithWrongParamCountFail;
  179. begin
  180. StartProgram(false);
  181. Add([
  182. 'type generic TBird<T> = record end;',
  183. 'var b: specialize TBird<word, byte>;',
  184. 'begin',
  185. '']);
  186. CheckResolverException('identifier not found "TBird<,>"',
  187. nIdentifierNotFound);
  188. end;
  189. procedure TTestResolveGenerics.TestGen_GenericNotFoundFail;
  190. begin
  191. StartProgram(false);
  192. Add([
  193. '{$mode objfpc}',
  194. 'type',
  195. ' TBird = specialize TAnimal<word>;',
  196. 'begin',
  197. '']);
  198. CheckResolverException('identifier not found "TAnimal<>"',
  199. nIdentifierNotFound);
  200. end;
  201. procedure TTestResolveGenerics.TestGen_SameNameSameParamCountFail;
  202. begin
  203. StartProgram(false);
  204. Add([
  205. '{$mode delphi}',
  206. 'type',
  207. ' TBird<S,T> = record w: T; end;',
  208. ' TBird<X,Y> = record f: X; end;',
  209. 'begin',
  210. '']);
  211. CheckResolverException('Duplicate identifier "TBird" at afile.pp(4,8)',
  212. nDuplicateIdentifier);
  213. end;
  214. procedure TTestResolveGenerics.TestGen_TypeAliasWithoutSpecializeFail;
  215. begin
  216. StartProgram(false);
  217. Add([
  218. '{$mode delphi}',
  219. 'type',
  220. ' TBird<T> = record w: T; end;',
  221. ' TBirdAlias = TBird;',
  222. 'begin',
  223. '']);
  224. CheckResolverException('type expected, but TBird<> found',
  225. nXExpectedButYFound);
  226. end;
  227. procedure TTestResolveGenerics.TestGen_ConstraintStringFail;
  228. begin
  229. StartProgram(false);
  230. Add([
  231. 'type generic TRec<T:string> = record end;',
  232. 'begin',
  233. '']);
  234. CheckResolverException('"String" is not a valid constraint',
  235. nXIsNotAValidConstraint);
  236. end;
  237. procedure TTestResolveGenerics.TestGen_ConstraintMultiClassFail;
  238. begin
  239. StartProgram(false);
  240. Add([
  241. '{$mode objfpc}',
  242. 'type',
  243. ' TObject = class end;',
  244. ' TBird = class end;',
  245. ' TBear = class end;',
  246. ' generic TRec<T: TBird, TBear> = record end;',
  247. 'begin',
  248. '']);
  249. CheckResolverException('"TBird" constraint and "TBear" constraint cannot be specified together',
  250. nConstraintXAndConstraintYCannotBeTogether);
  251. end;
  252. procedure TTestResolveGenerics.TestGen_ConstraintRecordExpectedFail;
  253. begin
  254. StartProgram(false);
  255. Add([
  256. '{$mode objfpc}',
  257. 'type',
  258. ' generic TBird<T:record> = record v: T; end;',
  259. 'var r: specialize TBird<word>;',
  260. 'begin',
  261. '']);
  262. CheckResolverException('record type expected, but Word found',
  263. nXExpectedButYFound);
  264. end;
  265. procedure TTestResolveGenerics.TestGen_ConstraintClassRecordFail;
  266. begin
  267. StartProgram(false);
  268. Add([
  269. '{$mode objfpc}',
  270. 'type',
  271. ' TRec = record end;',
  272. ' generic TBird<T:class> = record v: T; end;',
  273. 'var r: specialize TBird<TRec>;',
  274. 'begin',
  275. '']);
  276. CheckResolverException('class type expected, but TRec found',
  277. nXExpectedButYFound);
  278. end;
  279. procedure TTestResolveGenerics.TestGen_ConstraintRecordClassFail;
  280. begin
  281. StartProgram(false);
  282. Add([
  283. '{$mode objfpc}',
  284. 'type',
  285. ' TObject = class end;',
  286. ' generic TBird<T:record> = record v: T; end;',
  287. 'var r: specialize TBird<TObject>;',
  288. 'begin',
  289. '']);
  290. CheckResolverException('record type expected, but TObject found',
  291. nXExpectedButYFound);
  292. end;
  293. procedure TTestResolveGenerics.TestGen_ConstraintArrayFail;
  294. begin
  295. StartProgram(false);
  296. Add([
  297. '{$mode objfpc}',
  298. 'type',
  299. ' TArr = array of word;',
  300. ' generic TBird<T:TArr> = record v: T; end;',
  301. 'begin',
  302. '']);
  303. CheckResolverException('"array of Word" is not a valid constraint',
  304. nXIsNotAValidConstraint);
  305. end;
  306. procedure TTestResolveGenerics.TestGen_ConstraintConstructor;
  307. begin
  308. StartProgram(true,[supTObject]);
  309. Add([
  310. '{$mode objfpc}',
  311. 'type',
  312. ' generic TBird<T:constructor> = class',
  313. ' o: T;',
  314. ' procedure Fly;',
  315. ' end;',
  316. ' TAnt = class end;',
  317. 'var a: specialize TBird<TAnt>;',
  318. 'procedure TBird.Fly;',
  319. 'begin',
  320. ' o:=T.Create;',
  321. 'end;',
  322. 'begin',
  323. '']);
  324. ParseProgram;
  325. end;
  326. procedure TTestResolveGenerics.TestGen_ConstraintSpecialize;
  327. begin
  328. StartProgram(false);
  329. Add([
  330. '{$mode objfpc}',
  331. 'type',
  332. ' TObject = class end;',
  333. ' generic TAnt<S> = class m: S; end;',
  334. ' generic TBird<T:specialize TAnt<word>> = class',
  335. ' o: T;',
  336. ' end;',
  337. ' TFireAnt = class(specialize TAnt<word>) end;',
  338. 'var',
  339. ' a: specialize TBird<TFireAnt>;',
  340. ' f: TFireAnt;',
  341. 'begin',
  342. ' a.o:=f;',
  343. '']);
  344. ParseProgram;
  345. end;
  346. procedure TTestResolveGenerics.TestGen_ConstraintTSpecializeWithT;
  347. begin
  348. StartProgram(false);
  349. Add([
  350. '{$mode delphi}',
  351. 'type',
  352. ' TObject = class end;',
  353. ' TAnt<S> = class m: S; end;',
  354. ' TBird<X; Y: TAnt<X>> = class',
  355. ' Ant: Y;',
  356. ' end;',
  357. ' TEagle<X; Y:X> = class',
  358. ' e: Y;',
  359. ' end;',
  360. ' TFireAnt<F> = class(TAnt<F>) end;',
  361. ' TAntWord = TAnt<word>;',
  362. ' TBirdAntWord = TBird<word, TAnt<word>>;',
  363. 'var',
  364. ' a: TAnt<word>;',
  365. ' b: TBird<word, TAntWord>;',
  366. ' c: TBird<TBirdAntWord, TAnt<TBirdAntWord>>;',
  367. ' f: TEagle<TAnt<boolean>, TFireAnt<boolean>>;',
  368. ' fb: TFireAnt<boolean>;',
  369. 'begin',
  370. ' b.Ant:=a;',
  371. ' f.e:=fb;',
  372. '']);
  373. ParseProgram;
  374. end;
  375. procedure TTestResolveGenerics.TestGen_ConstraintTSpecializeAsTFail;
  376. begin
  377. StartProgram(false);
  378. Add([
  379. '{$mode objfpc}',
  380. 'type',
  381. ' generic TAnt<S> = record v: S; end;',
  382. ' generic TBird<T; U: specialize T<word>> = record v: T; end;',
  383. 'begin',
  384. '']);
  385. CheckResolverException('identifier not found "T<>"',nIdentifierNotFound);
  386. end;
  387. procedure TTestResolveGenerics.TestGen_TemplNameEqTypeNameFail;
  388. begin
  389. StartProgram(false);
  390. Add([
  391. '{$mode objfpc}',
  392. 'type',
  393. ' generic TBird<TBird> = record v: T; end;',
  394. 'var r: specialize TBird<word>;',
  395. 'begin',
  396. '']);
  397. CheckResolverException('Duplicate identifier "TBird" at afile.pp(4,16)',
  398. nDuplicateIdentifier);
  399. end;
  400. procedure TTestResolveGenerics.TestGen_ConstraintInheritedMissingRecordFail;
  401. begin
  402. StartProgram(false);
  403. Add([
  404. '{$mode objfpc}',
  405. 'type',
  406. ' TObject = class end;',
  407. ' generic TBird<T: record> = class v: T; end;',
  408. ' generic TEagle<U> = class(specialize TBird<U>)',
  409. ' end;',
  410. 'begin',
  411. '']);
  412. CheckResolverException('Type parameter "U" is missing constraint "record"',
  413. nTypeParamXIsMissingConstraintY);
  414. end;
  415. procedure TTestResolveGenerics.TestGen_ConstraintInheritedMissingClassTypeFail;
  416. begin
  417. StartProgram(false);
  418. Add([
  419. '{$mode objfpc}',
  420. 'type',
  421. ' TObject = class end;',
  422. ' TAnt = class end;',
  423. ' generic TBird<T: TAnt> = class v: T; end;',
  424. ' generic TEagle<U> = class(specialize TBird<U>)',
  425. ' end;',
  426. 'begin',
  427. '']);
  428. CheckResolverException('Type parameter "U" is not compatible with type "TAnt"',
  429. nTypeParamXIsNotCompatibleWithY);
  430. end;
  431. procedure TTestResolveGenerics.TestGen_ConstraintMultiParam;
  432. begin
  433. StartProgram(false);
  434. Add([
  435. '{$mode objfpc}',
  436. 'type',
  437. ' TObject = class end;',
  438. ' TAnt = class end;',
  439. ' generic TBird<S,T: TAnt> = class',
  440. ' x: S;',
  441. ' y: T;',
  442. ' end;',
  443. ' TRedAnt = class(TAnt) end;',
  444. ' TEagle = specialize TBird<TRedAnt,TAnt>;',
  445. 'begin',
  446. '']);
  447. ParseProgram;
  448. end;
  449. procedure TTestResolveGenerics.TestGen_ConstraintMultiParamClassMismatch;
  450. begin
  451. StartProgram(false);
  452. Add([
  453. '{$mode objfpc}',
  454. 'type',
  455. ' TObject = class end;',
  456. ' TAnt = class end;',
  457. ' TRedAnt = class(TAnt) end;',
  458. ' generic TBird<S,T: TRedAnt> = class',
  459. ' x: S;',
  460. ' y: T;',
  461. ' end;',
  462. ' TEagle = specialize TBird<TRedAnt,TAnt>;',
  463. 'begin',
  464. '']);
  465. CheckResolverException('Incompatible types: got "TAnt" expected "TRedAnt"',
  466. nIncompatibleTypesGotExpected);
  467. end;
  468. procedure TTestResolveGenerics.TestGen_ConstraintClassType_DotIsAsTypeCast;
  469. begin
  470. StartProgram(false);
  471. Add([
  472. '{$mode objfpc}',
  473. 'type',
  474. ' TObject = class end;',
  475. ' TAnt = class',
  476. ' procedure Run; external; overload;',
  477. ' end;',
  478. ' TRedAnt = class(TAnt)',
  479. ' procedure Run(w: word); external; overload;',
  480. ' end;',
  481. ' generic TBird<T: TRedAnt> = class',
  482. ' y: T;',
  483. ' procedure Fly;',
  484. ' end;',
  485. ' TFireAnt = class(TRedAnt);',
  486. ' generic TEagle<U: TRedAnt> = class(specialize TBird<U>) end;',
  487. ' TRedEagle = specialize TEagle<TRedAnt>;',
  488. 'procedure TBird.Fly;',
  489. 'var f: TFireAnt;',
  490. 'begin',
  491. ' y.Run;',
  492. ' y.Run(3);',
  493. ' if y is TFireAnt then',
  494. ' f:=y as TFireAnt;',
  495. ' f:=TFireAnt(y);',
  496. ' y:=T(f);',
  497. 'end;',
  498. 'begin',
  499. '']);
  500. ParseProgram;
  501. end;
  502. procedure TTestResolveGenerics.TestGen_ConstraintClassType_ForInT;
  503. begin
  504. StartProgram(false);
  505. Add([
  506. '{$mode objfpc}',
  507. 'type',
  508. ' TObject = class end;',
  509. ' generic TEnumerator<TItem> = class',
  510. ' FCurrent: TItem;',
  511. ' property Current: TItem read FCurrent;',
  512. ' function MoveNext: boolean;',
  513. ' end;',
  514. ' generic TAnt<U> = class',
  515. ' function GetEnumerator: specialize TEnumerator<U>;',
  516. ' end;',
  517. ' generic TBird<S; T: specialize TAnt<S>> = class',
  518. ' m: T;',
  519. ' procedure Fly;',
  520. ' end;',
  521. 'function TEnumerator.MoveNext: boolean;',
  522. 'begin',
  523. 'end;',
  524. 'function TAnt.GetEnumerator: specialize TEnumerator<U>;',
  525. 'begin',
  526. 'end;',
  527. 'procedure TBird.Fly;',
  528. 'var i: S;',
  529. 'begin',
  530. ' for i in m do ;',
  531. 'end;',
  532. 'var',
  533. ' a: specialize TAnt<word>;',
  534. ' w: word;',
  535. ' b: specialize TBird<word,specialize TAnt<word>>;',
  536. 'begin',
  537. ' for w in a do ;',
  538. ' for w in b.m do ;',
  539. '']);
  540. ParseProgram;
  541. end;
  542. procedure TTestResolveGenerics.TestGen_ConstraintClassType_IsAs;
  543. begin
  544. StartProgram(false);
  545. Add([
  546. '{$mode objfpc}',
  547. 'type',
  548. ' TObject = class end;',
  549. ' generic TAnt<U> = class',
  550. ' v: U;',
  551. ' function Run: U;',
  552. ' end;',
  553. 'function TAnt.Run: U;',
  554. 'var a: specialize TAnt<U>;',
  555. 'begin',
  556. ' if v is TObject then ;',
  557. ' if v is specialize TAnt<TObject> then',
  558. ' specialize TAnt<TObject>(v).v:=nil;',
  559. ' a:=v as specialize TAnt<U>;',
  560. ' if (v as specialize TAnt<TObject>).v=nil then ;',
  561. ' if nil=(v as specialize TAnt<TObject>).v then ;',
  562. 'end;',
  563. 'begin',
  564. '']);
  565. ParseProgram;
  566. end;
  567. procedure TTestResolveGenerics.TestGen_RecordLocalNameDuplicateFail;
  568. begin
  569. StartProgram(false);
  570. Add([
  571. '{$mode objfpc}',
  572. 'type',
  573. ' generic TBird<T> = record T: word; end;',
  574. 'begin',
  575. '']);
  576. CheckResolverException('Duplicate identifier "T" at afile.pp(4,18)',
  577. nDuplicateIdentifier);
  578. end;
  579. procedure TTestResolveGenerics.TestGen_Record;
  580. begin
  581. StartProgram(false);
  582. Add([
  583. '{$mode objfpc}',
  584. 'type',
  585. ' {#Typ}T = word;',
  586. ' generic TRec<{#Templ}T> = record',
  587. ' {=Templ}v: T;',
  588. ' end;',
  589. 'var',
  590. ' r: specialize TRec<word>;',
  591. ' {=Typ}w: T;',
  592. 'begin',
  593. ' r.v:=w;',
  594. '']);
  595. ParseProgram;
  596. end;
  597. procedure TTestResolveGenerics.TestGen_RecordDelphi;
  598. begin
  599. StartProgram(false);
  600. Add([
  601. '{$mode delphi}',
  602. 'type',
  603. ' {#Typ}T = word;',
  604. ' TRec<{#Templ}T> = record',
  605. ' {=Templ}v: T;',
  606. ' end;',
  607. 'var',
  608. ' r: TRec<word>;',
  609. ' {=Typ}w: T;',
  610. 'begin',
  611. ' r.v:=w;',
  612. '']);
  613. ParseProgram;
  614. end;
  615. procedure TTestResolveGenerics.TestGen_RecordNestedSpecialized;
  616. begin
  617. StartProgram(false);
  618. Add([
  619. '{$mode objfpc}',
  620. 'type',
  621. ' TObject = class end;',
  622. ' generic TBird<T> = class v: T; end;',
  623. ' generic TFish<T:class> = record v: T; end;',
  624. 'var f: specialize TFish<specialize TBird<word>>;',
  625. 'begin',
  626. '']);
  627. ParseProgram;
  628. end;
  629. procedure TTestResolveGenerics.TestGen_Record_SpecializeSelfInsideFail;
  630. begin
  631. StartProgram(false);
  632. Add([
  633. '{$mode objfpc}',
  634. 'type',
  635. ' generic TBird<T> = record',
  636. ' v: specialize TBird<word>;',
  637. ' end;',
  638. 'begin',
  639. '']);
  640. CheckResolverException('type "TBird<>" is not yet completely defined',
  641. nTypeXIsNotYetCompletelyDefined);
  642. end;
  643. procedure TTestResolveGenerics.TestGen_RecordAnoArray;
  644. begin
  645. StartProgram(false);
  646. Add([
  647. '{$mode objfpc}',
  648. 'type',
  649. ' generic TBird<T> = record v: T; end;',
  650. 'var',
  651. ' a: specialize TBird<array of word>;',
  652. ' b: specialize TBird<array of word>;',
  653. 'begin',
  654. ' a:=b;',
  655. '']);
  656. ParseProgram;
  657. end;
  658. procedure TTestResolveGenerics.TestGen_RecordNestedSpecialize;
  659. begin
  660. StartProgram(false);
  661. Add([
  662. '{$mode objfpc}',
  663. 'type',
  664. ' generic TBird<T> = record v: T; end;',
  665. 'var',
  666. ' a: specialize TBird<specialize TBird<word>>;',
  667. 'begin',
  668. ' a.v.v:=3;',
  669. '']);
  670. ParseProgram;
  671. end;
  672. procedure TTestResolveGenerics.TestGen_Class;
  673. begin
  674. StartProgram(false);
  675. Add([
  676. '{$mode objfpc}',
  677. 'type',
  678. ' TObject = class end;',
  679. ' {#Typ}T = word;',
  680. ' generic TBird<{#Templ}T> = class',
  681. ' {=Templ}v: T;',
  682. ' end;',
  683. 'var',
  684. ' b: specialize TBird<word>;',
  685. ' {=Typ}w: T;',
  686. 'begin',
  687. ' b.v:=w;',
  688. '']);
  689. ParseProgram;
  690. end;
  691. procedure TTestResolveGenerics.TestGen_ClassDelphi;
  692. begin
  693. StartProgram(false);
  694. Add([
  695. '{$mode delphi}',
  696. 'type',
  697. ' TObject = class end;',
  698. ' {#Typ}T = word;',
  699. ' TBird<{#Templ}T> = class',
  700. ' {=Templ}v: T;',
  701. ' end;',
  702. 'var',
  703. ' b: TBird<word>;',
  704. ' {=Typ}w: T;',
  705. 'begin',
  706. ' b.v:=w;',
  707. '']);
  708. ParseProgram;
  709. end;
  710. procedure TTestResolveGenerics.TestGen_ClassDelphi_TypeOverload;
  711. begin
  712. StartProgram(false);
  713. Add([
  714. '{$mode delphi}',
  715. 'type',
  716. ' TObject = class end;',
  717. ' {#a}TBird = word;',
  718. ' {#b}TBird<T> = class',
  719. ' v: T;',
  720. ' end;',
  721. ' {=b}TEagle = TBird<word>;',
  722. 'var',
  723. ' b: {@b}TBird<word>;',
  724. ' {=a}w: TBird;',
  725. 'begin',
  726. ' b.v:=w;',
  727. '']);
  728. ParseProgram;
  729. end;
  730. procedure TTestResolveGenerics.TestGen_ClassObjFPC;
  731. begin
  732. StartProgram(false);
  733. Add([
  734. '{$mode objfpc}',
  735. 'type',
  736. ' TObject = class end;',
  737. ' generic TBird<T> = class',
  738. ' v: TBird;',
  739. ' end;',
  740. 'var',
  741. ' b: specialize TBird<word>;',
  742. 'begin',
  743. ' b.v:=b;',
  744. '']);
  745. ParseProgram;
  746. end;
  747. procedure TTestResolveGenerics.TestGen_ClassObjFPC_OverloadFail;
  748. begin
  749. StartProgram(false);
  750. Add([
  751. '{$mode objfpc}',
  752. 'type',
  753. ' TObject = class end;',
  754. ' TBird = word;',
  755. ' generic TBird<T> = class',
  756. ' v: T;',
  757. ' end;',
  758. 'begin',
  759. '']);
  760. CheckResolverException('Duplicate identifier "TBird" at afile.pp(5,8)',nDuplicateIdentifier);
  761. end;
  762. procedure TTestResolveGenerics.TestGen_ClassObjFPC_OverloadOtherUnit;
  763. begin
  764. AddModuleWithIntfImplSrc('unit1.pas',
  765. LinesToStr([
  766. 'type',
  767. ' TBird = class b1: word; end;',
  768. ' generic TAnt<T> = class a1: T; end;',
  769. '']),
  770. LinesToStr([
  771. '']));
  772. AddModuleWithIntfImplSrc('unit2.pas',
  773. LinesToStr([
  774. 'type',
  775. ' generic TBird<T> = class b2:T; end;',
  776. ' TAnt = class a2:word; end;',
  777. '']),
  778. LinesToStr([
  779. '']));
  780. StartProgram(true,[supTObject]);
  781. Add([
  782. 'uses unit1, unit2;',
  783. 'var',
  784. ' b1: TBird;',
  785. ' b2: specialize TBird<word>;',
  786. ' a1: specialize TAnt<word>;',
  787. ' a2: TAnt;',
  788. 'begin',
  789. ' b1.b1:=1;',
  790. ' b2.b2:=2;',
  791. ' a1.a1:=3;',
  792. ' a2.a2:=4;',
  793. '']);
  794. ParseProgram;
  795. end;
  796. procedure TTestResolveGenerics.TestGen_ClassForward;
  797. begin
  798. StartProgram(false);
  799. Add([
  800. '{$mode objfpc}',
  801. 'type',
  802. ' TObject = class end;',
  803. ' {#Typ}T = word;',
  804. ' generic TBird<{#Templ_Forward}T> = class;',
  805. ' TRec = record',
  806. ' b: specialize TBird<T>;',
  807. ' end;',
  808. ' generic TBird<{#Templ}T> = class',
  809. ' {=Templ}v: T;',
  810. ' r: TRec;',
  811. ' end;',
  812. 'var',
  813. ' s: TRec;',
  814. ' {=Typ}w: T;',
  815. 'begin',
  816. ' s.b.v:=w;',
  817. ' s.b.r:=s;',
  818. '']);
  819. ParseProgram;
  820. end;
  821. procedure TTestResolveGenerics.TestGen_ClassForwardConstraints;
  822. begin
  823. StartProgram(false);
  824. Add([
  825. '{$mode objfpc}',
  826. 'type',
  827. ' TObject = class end;',
  828. ' TAnt = class end;',
  829. ' generic TBird<T: class; U; V: TAnt> = class;',
  830. ' TRec = record',
  831. ' b: specialize TBird<TAnt,word,TAnt>;',
  832. ' end;',
  833. ' generic TBird<T: class; U; V: TAnt> = class',
  834. ' i: U;',
  835. ' r: TRec;',
  836. ' end;',
  837. 'var',
  838. ' s: TRec;',
  839. ' w: word;',
  840. 'begin',
  841. ' s.b.i:=w;',
  842. ' s.b.r:=s;',
  843. '']);
  844. ParseProgram;
  845. end;
  846. procedure TTestResolveGenerics.TestGen_ClassForwardConstraintNameMismatch;
  847. begin
  848. StartProgram(false);
  849. Add([
  850. '{$mode objfpc}',
  851. 'type',
  852. ' TObject = class end;',
  853. ' generic TBird<T> = class;',
  854. ' generic TBird<U> = class',
  855. ' i: U;',
  856. ' end;',
  857. 'begin',
  858. '']);
  859. CheckResolverException('Declaration of "U" differs from previous declaration at afile.pp(5,18)',
  860. nDeclOfXDiffersFromPrevAtY);
  861. end;
  862. procedure TTestResolveGenerics.TestGen_ClassForwardConstraintKeywordMismatch;
  863. begin
  864. StartProgram(false);
  865. Add([
  866. '{$mode objfpc}',
  867. 'type',
  868. ' TObject = class end;',
  869. ' generic TBird<T: class, constructor> = class;',
  870. ' generic TBird<U: class> = class',
  871. ' i: U;',
  872. ' end;',
  873. 'begin',
  874. '']);
  875. CheckResolverException('Declaration of "U" differs from previous declaration at afile.pp(5,18)',
  876. nDeclOfXDiffersFromPrevAtY);
  877. end;
  878. procedure TTestResolveGenerics.TestGen_ClassForwardConstraintTypeMismatch;
  879. begin
  880. StartProgram(false);
  881. Add([
  882. '{$mode objfpc}',
  883. 'type',
  884. ' TObject = class end;',
  885. ' TAnt = class end;',
  886. ' TFish = class end;',
  887. ' generic TBird<T: TAnt> = class;',
  888. ' generic TBird<T: TFish> = class',
  889. ' i: U;',
  890. ' end;',
  891. 'begin',
  892. '']);
  893. CheckResolverException('Declaration of "T" differs from previous declaration at afile.pp(7,18)',
  894. nDeclOfXDiffersFromPrevAtY);
  895. end;
  896. procedure TTestResolveGenerics.TestGen_ClassForward_Circle;
  897. begin
  898. StartProgram(false);
  899. Add([
  900. '{$mode objfpc}',
  901. 'type',
  902. ' TObject = class end;',
  903. ' generic TAnt<T> = class;',
  904. ' generic TFish<U> = class',
  905. ' private type AliasU = U;',
  906. ' var a: specialize TAnt<AliasU>;',
  907. ' Size: AliasU;',
  908. ' end;',
  909. ' generic TAnt<T> = class',
  910. ' private type AliasT = T;',
  911. ' var f: specialize TFish<AliasT>;',
  912. ' Speed: AliasT;',
  913. ' end;',
  914. 'var',
  915. ' WordFish: specialize TFish<word>;',
  916. ' BoolAnt: specialize TAnt<boolean>;',
  917. ' w: word;',
  918. ' b: boolean;',
  919. 'begin',
  920. ' WordFish.Size:=w;',
  921. ' WordFish.a.Speed:=w;',
  922. ' WordFish.a.f.Size:=w;',
  923. ' BoolAnt.Speed:=b;',
  924. ' BoolAnt.f.Size:=b;',
  925. ' BoolAnt.f.a.Speed:=b;',
  926. '']);
  927. ParseProgram;
  928. end;
  929. procedure TTestResolveGenerics.TestGen_Class_RedeclareInUnitImplFail;
  930. begin
  931. StartUnit(false);
  932. Add([
  933. 'interface',
  934. 'type',
  935. ' TObject = class end;',
  936. ' generic TBird<T> = class v: T; end;',
  937. 'implementation',
  938. 'type generic TBird<T> = record v: T; end;',
  939. '']);
  940. CheckResolverException('Duplicate identifier "TBird" at afile.pp(5,16)',
  941. nDuplicateIdentifier);
  942. end;
  943. procedure TTestResolveGenerics.TestGen_Class_TypeOverloadInUnitImpl;
  944. begin
  945. StartUnit(false);
  946. Add([
  947. 'interface',
  948. 'type',
  949. ' TObject = class end;',
  950. ' generic TBird<T> = class v: T; end;',
  951. 'implementation',
  952. 'type generic TBird<T,U> = record x: T; y: U; end;',
  953. '']);
  954. ParseUnit;
  955. end;
  956. procedure TTestResolveGenerics.TestGen_Class_MethodObjFPC;
  957. begin
  958. StartProgram(false);
  959. Add([
  960. '{$mode objfpc}',
  961. 'type',
  962. ' TObject = class end;',
  963. ' {#Typ}T = word;',
  964. ' generic TBird<{#Templ}T> = class',
  965. ' function Fly(p:T): T; virtual; abstract;',
  966. ' function Run(p:T): T;',
  967. ' procedure Jump(p:T);',
  968. ' class procedure Go(p:T);',
  969. ' end;',
  970. 'function TBird.Run(p:T): T;',
  971. 'begin',
  972. 'end;',
  973. 'generic procedure TBird<T>.Jump(p:T);',
  974. 'begin',
  975. 'end;',
  976. 'generic class procedure TBird<T>.Go(p:T);',
  977. 'begin',
  978. 'end;',
  979. 'var',
  980. ' b: specialize TBird<word>;',
  981. ' {=Typ}w: T;',
  982. 'begin',
  983. ' w:=b.Fly(w);',
  984. ' w:=b.Run(w);',
  985. '']);
  986. ParseProgram;
  987. end;
  988. procedure TTestResolveGenerics.TestGen_Class_MethodOverride;
  989. begin
  990. StartProgram(false);
  991. Add([
  992. '{$mode objfpc}',
  993. 'type',
  994. ' TObject = class end;',
  995. ' generic TBird<T> = class',
  996. ' function Fly(p:T): T; virtual; abstract;',
  997. ' end;',
  998. ' generic TEagle<S> = class(specialize TBird<S>)',
  999. ' function Fly(p:S): S; override;',
  1000. ' end;',
  1001. 'function TEagle.Fly(p:S): S;',
  1002. 'begin',
  1003. 'end;',
  1004. 'var',
  1005. ' e: specialize TEagle<word>;',
  1006. ' w: word;',
  1007. 'begin',
  1008. ' w:=e.Fly(w);',
  1009. '']);
  1010. ParseProgram;
  1011. end;
  1012. procedure TTestResolveGenerics.TestGen_Class_MethodDelphi;
  1013. begin
  1014. StartProgram(false);
  1015. Add([
  1016. '{$mode delphi}',
  1017. 'type',
  1018. ' TObject = class end;',
  1019. ' {#Typ}T = word;',
  1020. ' TBird<{#Templ}T> = class',
  1021. ' function Fly(p:T): T; virtual; abstract;',
  1022. ' function Run(p:T): T;',
  1023. ' end;',
  1024. 'function TBird<T>.Run(p:T): T;',
  1025. 'begin',
  1026. 'end;',
  1027. 'var',
  1028. ' b: TBird<word>;',
  1029. ' {=Typ}w: T;',
  1030. 'begin',
  1031. ' w:=b.Fly(w);',
  1032. ' w:=b.Run(w);',
  1033. '']);
  1034. ParseProgram;
  1035. end;
  1036. procedure TTestResolveGenerics.TestGen_Class_MethodDelphiTypeParamMissing;
  1037. begin
  1038. StartProgram(false);
  1039. Add([
  1040. '{$mode delphi}',
  1041. 'type',
  1042. ' TObject = class end;',
  1043. ' TBird<T> = class',
  1044. ' function Run(p:T): T;',
  1045. ' end;',
  1046. 'function TBird.Run(p:T): T;',
  1047. 'begin',
  1048. 'end;',
  1049. 'begin',
  1050. '']);
  1051. CheckResolverException('TBird<> expected, but TBird found',nXExpectedButYFound);
  1052. end;
  1053. procedure TTestResolveGenerics.TestGen_Class_MethodImplConstraintFail;
  1054. begin
  1055. StartProgram(false);
  1056. Add([
  1057. '{$mode delphi}',
  1058. 'type',
  1059. ' TObject = class end;',
  1060. ' TBird<T: record> = class',
  1061. ' function Run(p:T): T;',
  1062. ' end;',
  1063. 'function TBird<T: record>.Run(p:T): T;',
  1064. 'begin',
  1065. 'end;',
  1066. 'begin',
  1067. '']);
  1068. CheckResolverException('illegal qualifier ":" after "T"',nIllegalQualifierAfter);
  1069. end;
  1070. procedure TTestResolveGenerics.TestGen_Class_MethodImplTypeParamNameMismatch;
  1071. begin
  1072. StartProgram(false);
  1073. Add([
  1074. '{$mode delphi}',
  1075. 'type',
  1076. ' TObject = class end;',
  1077. ' TBird<T> = class',
  1078. ' procedure DoIt;',
  1079. ' end;',
  1080. 'procedure TBird<S>.DoIt;',
  1081. 'begin',
  1082. 'end;',
  1083. 'begin',
  1084. '']);
  1085. CheckResolverException('T expected, but S found',nXExpectedButYFound);
  1086. end;
  1087. procedure TTestResolveGenerics.TestGen_Class_SpecializeSelfInside;
  1088. begin
  1089. StartProgram(false);
  1090. Add([
  1091. '{$mode objfpc}',
  1092. 'type',
  1093. ' TObject = class end;',
  1094. ' generic TBird<T> = class',
  1095. ' e: T;',
  1096. ' v: specialize TBird<boolean>;',
  1097. ' end;',
  1098. 'var',
  1099. ' b: specialize TBird<word>;',
  1100. ' w: word;',
  1101. 'begin',
  1102. ' b.e:=w;',
  1103. ' if b.v.e then ;',
  1104. '']);
  1105. ParseProgram;
  1106. end;
  1107. procedure TTestResolveGenerics.TestGen_Class_GenAncestor;
  1108. begin
  1109. StartProgram(false);
  1110. Add([
  1111. '{$mode objfpc}',
  1112. 'type',
  1113. ' TObject = class end;',
  1114. ' generic TBird<T> = class',
  1115. ' i: T;',
  1116. ' end;',
  1117. ' generic TEagle<T> = class(specialize TBird<T>)',
  1118. ' j: T;',
  1119. ' end;',
  1120. 'var',
  1121. ' e: specialize TEagle<word>;',
  1122. 'begin',
  1123. ' e.i:=e.j;',
  1124. '']);
  1125. ParseProgram;
  1126. end;
  1127. procedure TTestResolveGenerics.TestGen_Class_AncestorSelfFail;
  1128. begin
  1129. StartProgram(false);
  1130. Add([
  1131. '{$mode objfpc}',
  1132. 'type',
  1133. ' TObject = class end;',
  1134. ' generic TBird<T> = class(specialize TBird<word>)',
  1135. ' e: T;',
  1136. ' end;',
  1137. 'var',
  1138. ' b: specialize TBird<word>;',
  1139. 'begin',
  1140. '']);
  1141. CheckResolverException('type "TBird<>" is not yet completely defined',nTypeXIsNotYetCompletelyDefined);
  1142. end;
  1143. procedure TTestResolveGenerics.TestGen_ClassOfSpecializeFail;
  1144. begin
  1145. StartProgram(false);
  1146. Add([
  1147. '{$mode objfpc}',
  1148. 'type',
  1149. ' TObject = class end;',
  1150. ' generic TBird<T> = class',
  1151. ' e: T;',
  1152. ' end;',
  1153. ' TBirdClass = class of specialize TBird<word>;',
  1154. 'begin',
  1155. '']);
  1156. CheckParserException('Expected "Identifier" at token "specialize" in file afile.pp at line 8 column 25',nParserExpectTokenError);
  1157. end;
  1158. procedure TTestResolveGenerics.TestGen_Class_NestedType;
  1159. begin
  1160. StartProgram(false);
  1161. Add([
  1162. '{$mode objfpc}',
  1163. 'type',
  1164. ' TObject = class end;',
  1165. ' generic TBird<T> = class',
  1166. ' public type',
  1167. ' TArrayEvent = reference to procedure(El: T);',
  1168. ' public',
  1169. ' p: TArrayEvent;',
  1170. ' end;',
  1171. ' TBirdWord = specialize TBird<word>;',
  1172. 'var',
  1173. ' b: TBirdWord;',
  1174. 'begin',
  1175. ' b.p:=procedure(El: word) begin end;']);
  1176. ParseProgram;
  1177. end;
  1178. procedure TTestResolveGenerics.TestGen_Class_NestedRecord;
  1179. begin
  1180. StartProgram(false);
  1181. Add([
  1182. '{$mode objfpc}',
  1183. '{$modeswitch advancedrecords}',
  1184. 'type',
  1185. ' TObject = class end;',
  1186. ' generic TBird<T> = class',
  1187. ' public type TWing = record',
  1188. ' s: T;',
  1189. ' function GetIt: T;',
  1190. ' end;',
  1191. ' public',
  1192. ' w: TWing;',
  1193. ' end;',
  1194. ' TBirdWord = specialize TBird<word>;',
  1195. 'function TBird.TWing.GetIt: T;',
  1196. 'begin',
  1197. 'end;',
  1198. 'var',
  1199. ' b: TBirdWord;',
  1200. ' i: word;',
  1201. 'begin',
  1202. ' b.w.s:=i;',
  1203. ' i:=b.w.GetIt;',
  1204. '']);
  1205. ParseProgram;
  1206. end;
  1207. procedure TTestResolveGenerics.TestGen_Class_NestedClass;
  1208. begin
  1209. StartProgram(false);
  1210. Add([
  1211. '{$mode objfpc}',
  1212. 'type',
  1213. ' TObject = class end;',
  1214. ' generic TBird<T> = class',
  1215. ' public type TWing = class',
  1216. ' s: T;',
  1217. ' function GetIt: T;',
  1218. ' end;',
  1219. ' public',
  1220. ' w: TWing;',
  1221. ' end;',
  1222. ' TBirdWord = specialize TBird<word>;',
  1223. 'function TBird.TWing.GetIt: T;',
  1224. 'begin',
  1225. 'end;',
  1226. 'var',
  1227. ' b: TBirdWord;',
  1228. ' i: word;',
  1229. 'begin',
  1230. ' b.w.s:=3;',
  1231. ' i:=b.w.GetIt;',
  1232. '']);
  1233. ParseProgram;
  1234. end;
  1235. procedure TTestResolveGenerics.TestGen_Class_Enums_NotPropagating;
  1236. begin
  1237. StartProgram(false);
  1238. Add([
  1239. '{$mode objfpc}',
  1240. 'type',
  1241. ' TObject = class end;',
  1242. ' generic TBird<T> = class',
  1243. ' public type',
  1244. ' TEnum = (red, blue);',
  1245. ' const',
  1246. ' e = blue;',
  1247. ' end;',
  1248. 'const',
  1249. ' r = red;',
  1250. 'begin']);
  1251. CheckResolverException('identifier not found "red"',nIdentifierNotFound);
  1252. end;
  1253. procedure TTestResolveGenerics.TestGen_Class_Self;
  1254. begin
  1255. StartProgram(false);
  1256. Add([
  1257. '{$mode objfpc}',
  1258. 'type',
  1259. ' TObject = class',
  1260. ' end;',
  1261. ' generic TAnimal<T> = class end;',
  1262. ' generic TBird<T> = class(specialize TAnimal<T>)',
  1263. ' function GetObj: TObject;',
  1264. ' procedure Fly(Obj: TObject); virtual; abstract;',
  1265. ' end;',
  1266. ' TProc = procedure(Obj: TObject) of object;',
  1267. ' TWordBird = specialize TBird<word>;',
  1268. 'function TBird.GetObj: TObject;',
  1269. 'var p: TProc;',
  1270. 'begin',
  1271. ' Result:=Self;',
  1272. ' if Self.GetObj=Result then ;',
  1273. ' Fly(Self);',
  1274. ' p:=@Fly;',
  1275. ' p(Self);',
  1276. 'end;',
  1277. 'begin']);
  1278. ParseProgram;
  1279. end;
  1280. procedure TTestResolveGenerics.TestGen_Class_MemberTypeConstructor;
  1281. begin
  1282. StartProgram(false);
  1283. Add([
  1284. '{$mode delphi}',
  1285. 'type',
  1286. ' TObject = class end;',
  1287. ' TAnimal<A> = class',
  1288. ' end;',
  1289. ' TAnt<L> = class',
  1290. ' constructor Create(A: TAnimal<L>);',
  1291. ' end;',
  1292. ' TBird<T> = class(TAnimal<T>)',
  1293. ' type TMyAnt = TAnt<T>;',
  1294. ' function Fly: TMyAnt;',
  1295. ' end;',
  1296. ' TWordBird = TBird<word>;',
  1297. 'constructor TAnt<L>.Create(A: TAnimal<L>);',
  1298. 'begin',
  1299. 'end;',
  1300. 'function TBird<T>.Fly: TMyAnt;',
  1301. 'begin',
  1302. ' Result:=TMyAnt.Create(Self);',
  1303. 'end;',
  1304. 'begin']);
  1305. ParseProgram;
  1306. end;
  1307. procedure TTestResolveGenerics.TestGen_Class_List;
  1308. begin
  1309. StartProgram(false);
  1310. Add([
  1311. '{$mode objfpc}',
  1312. 'type',
  1313. ' TObject = class end;',
  1314. ' generic TList<T> = class',
  1315. ' strict private',
  1316. ' FItems: array of T;',
  1317. ' function GetItems(Index: longint): T;',
  1318. ' procedure SetItems(Index: longint; Value: T);',
  1319. ' public',
  1320. ' procedure Alter(w: T);',
  1321. ' property Items[Index: longint]: T read GetItems write SetItems; default;',
  1322. ' end;',
  1323. ' TWordList = specialize TList<word>;',
  1324. 'function TList.GetItems(Index: longint): T;',
  1325. 'begin',
  1326. ' Result:=FItems[Index];',
  1327. 'end;',
  1328. 'procedure TList.SetItems(Index: longint; Value: T);',
  1329. 'begin',
  1330. ' FItems[Index]:=Value;',
  1331. 'end;',
  1332. 'procedure TList.Alter(w: T);',
  1333. 'begin',
  1334. ' SetLength(FItems,length(FItems)+1);',
  1335. ' Insert(w,FItems,2);',
  1336. ' Delete(FItems,2,3);',
  1337. 'end;',
  1338. 'var l: TWordList;',
  1339. ' w: word;',
  1340. 'begin',
  1341. ' l[1]:=w;',
  1342. ' w:=l[2];']);
  1343. ParseProgram;
  1344. end;
  1345. procedure TTestResolveGenerics.TestGen_ExtClass_Array;
  1346. begin
  1347. StartProgram(false);
  1348. Add([
  1349. '{$mode delphi}',
  1350. '{$ModeSwitch externalclass}',
  1351. 'type',
  1352. ' NativeInt = longint;',
  1353. ' TJSGenArray<T> = Class external name ''Array''',
  1354. ' private',
  1355. ' function GetElements(Index: NativeInt): T; external name ''[]'';',
  1356. ' procedure SetElements(Index: NativeInt; const AValue: T); external name ''[]'';',
  1357. ' public',
  1358. ' type TSelfType = TJSGenArray<T>;',
  1359. ' TArrayEvent = reference to function(El: T; Arr: TSelfType): Boolean;',
  1360. ' TArrayCallback = TArrayEvent;',
  1361. ' public',
  1362. ' FLength : NativeInt; external name ''length'';',
  1363. ' constructor new; overload;',
  1364. ' constructor new(aLength : NativeInt); overload;',
  1365. ' class function _of() : TSelfType; varargs; external name ''of'';',
  1366. ' function every(const aCallback: TArrayCallBack): boolean; overload;',
  1367. ' function fill(aValue : T) : TSelfType; overload;',
  1368. ' function fill(aValue : T; aStartIndex : NativeInt) : TSelfType; overload;',
  1369. ' function fill(aValue : T; aStartIndex,aEndIndex : NativeInt) : TSelfType; overload;',
  1370. ' property Length : NativeInt Read FLength Write FLength;',
  1371. ' property Elements[Index: NativeInt]: T read GetElements write SetElements; default;',
  1372. ' end;',
  1373. ' TJSWordArray = TJSGenArray<word>;',
  1374. 'var',
  1375. ' wa: TJSWordArray;',
  1376. ' w: word;',
  1377. 'begin',
  1378. ' wa:=TJSWordArray.new;',
  1379. ' wa:=TJSWordArray.new(3);',
  1380. ' wa:=TJSWordArray._of(4,5);',
  1381. ' wa:=wa.fill(7);',
  1382. ' wa:=wa.fill(7,8,9);',
  1383. ' w:=wa.length;',
  1384. ' wa.length:=10;',
  1385. ' wa[11]:=w;',
  1386. ' w:=wa[12];',
  1387. ' wa.every(function(El: word; Arr: TJSWordArray): Boolean',
  1388. ' begin',
  1389. ' end',
  1390. ' );',
  1391. '']);
  1392. ParseProgram;
  1393. end;
  1394. procedure TTestResolveGenerics.TestGen_ClassInterface;
  1395. begin
  1396. StartProgram(false);
  1397. Add([
  1398. 'type',
  1399. ' {$interfaces corba}',
  1400. ' generic ICorbaIntf<T> = interface',
  1401. ' procedure Fly(a: T);',
  1402. ' end;',
  1403. ' {$interfaces com}',
  1404. ' IUnknown = interface',
  1405. ' end;',
  1406. ' IInterface = IUnknown;',
  1407. ' generic IComIntf<T> = interface',
  1408. ' procedure Run(b: T);',
  1409. ' end;',
  1410. 'begin']);
  1411. ParseProgram;
  1412. end;
  1413. procedure TTestResolveGenerics.TestGen_ClassInterface_Method;
  1414. begin
  1415. StartProgram(false);
  1416. Add([
  1417. 'type',
  1418. ' {$interfaces corba}',
  1419. ' generic IBird<T> = interface',
  1420. ' procedure Fly(a: T);',
  1421. ' end;',
  1422. ' TObject = class end;',
  1423. ' generic TBird<U> = class(specialize IBird<U>)',
  1424. ' procedure Fly(a: U);',
  1425. ' end;',
  1426. 'procedure TBird.Fly(a: U);',
  1427. 'begin',
  1428. 'end;',
  1429. 'var b: specialize IBird<word>;',
  1430. 'begin',
  1431. ' b.Fly(3);']);
  1432. ParseProgram;
  1433. end;
  1434. procedure TTestResolveGenerics.TestGen_DynArray;
  1435. begin
  1436. StartProgram(false);
  1437. Add([
  1438. 'type',
  1439. ' generic TArray<T> = array of T;',
  1440. ' TWordArray = specialize TArray<word>;',
  1441. 'var',
  1442. ' a: specialize TArray<word>;',
  1443. ' b: TWordArray;',
  1444. ' w: word;',
  1445. 'begin',
  1446. ' a[1]:=2;',
  1447. ' b[2]:=a[3]+b[4];',
  1448. ' a:=b;',
  1449. ' b:=a;',
  1450. ' SetLength(a,5);',
  1451. ' SetLength(b,6);',
  1452. ' w:=length(a)+low(a)+high(a);',
  1453. '']);
  1454. ParseProgram;
  1455. end;
  1456. procedure TTestResolveGenerics.TestGen_StaticArray;
  1457. begin
  1458. StartProgram(false);
  1459. Add([
  1460. 'type',
  1461. ' generic TBird<T> = array[T] of word;',
  1462. ' TByteBird = specialize TBird<byte>;',
  1463. 'var',
  1464. ' a: specialize TBird<byte>;',
  1465. ' b: TByteBird;',
  1466. ' i: byte;',
  1467. 'begin',
  1468. ' a[1]:=2;',
  1469. ' b[2]:=a[3]+b[4];',
  1470. ' a:=b;',
  1471. ' b:=a;',
  1472. ' i:=low(a);',
  1473. ' i:=high(a);',
  1474. ' for i in a do ;',
  1475. '']);
  1476. ParseProgram;
  1477. end;
  1478. procedure TTestResolveGenerics.TestGen_Array_Anoynmous;
  1479. begin
  1480. StartProgram(false);
  1481. Add([
  1482. 'type',
  1483. ' generic TRec<T> = record',
  1484. ' a: array of T;',
  1485. ' end;',
  1486. ' TWordRec = specialize TRec<word>;',
  1487. 'var',
  1488. ' a: specialize TRec<word>;',
  1489. ' b: TWordRec;',
  1490. ' w: word;',
  1491. 'begin',
  1492. ' a:=b;',
  1493. ' a.a:=b.a;',
  1494. ' a.a[1]:=2;',
  1495. ' b.a[2]:=a.a[3]+b.a[4];',
  1496. ' b:=a;',
  1497. ' SetLength(a.a,5);',
  1498. ' SetLength(b.a,6);',
  1499. ' w:=length(a.a)+low(a.a)+high(a.a);',
  1500. '']);
  1501. ParseProgram;
  1502. end;
  1503. procedure TTestResolveGenerics.TestGen_ProcType;
  1504. begin
  1505. StartProgram(false);
  1506. Add([
  1507. 'type',
  1508. ' generic TFunc<T> = function(v: T): T;',
  1509. ' TWordFunc = specialize TFunc<word>;',
  1510. 'function GetIt(w: word): word;',
  1511. 'begin',
  1512. 'end;',
  1513. 'var',
  1514. ' a: specialize TFunc<word>;',
  1515. ' b: TWordFunc;',
  1516. ' w: word;',
  1517. 'begin',
  1518. ' a:=nil;',
  1519. ' b:=nil;',
  1520. ' a:=b;',
  1521. ' b:=a;',
  1522. ' w:=a(w);',
  1523. ' w:=b(w);',
  1524. ' a:=@GetIt;',
  1525. ' b:=@GetIt;',
  1526. '']);
  1527. ParseProgram;
  1528. end;
  1529. procedure TTestResolveGenerics.TestGen_PointerDirectSpecializeFail;
  1530. begin
  1531. StartProgram(false);
  1532. Add([
  1533. 'type',
  1534. ' generic TRec<T> = record v: T; end;',
  1535. ' PRec = ^specialize TRec<word>;',
  1536. 'begin',
  1537. '']);
  1538. CheckParserException('Expected "Identifier" at token "specialize" in file afile.pp at line 4 column 11',nParserExpectTokenError);
  1539. end;
  1540. procedure TTestResolveGenerics.TestGen_HelperForArray;
  1541. begin
  1542. StartProgram(false);
  1543. Add([
  1544. '{$ModeSwitch typehelpers}',
  1545. 'type',
  1546. ' generic TArr<T> = array[1..2] of T;',
  1547. ' TWordArrHelper = type helper for specialize TArr<word>',
  1548. ' procedure Fly(w: word);',
  1549. ' end;',
  1550. 'procedure TWordArrHelper.Fly(w: word);',
  1551. 'begin',
  1552. 'end;',
  1553. 'var',
  1554. ' a: specialize TArr<word>;',
  1555. 'begin',
  1556. ' a.Fly(3);',
  1557. '']);
  1558. ParseProgram;
  1559. end;
  1560. procedure TTestResolveGenerics.TestGen_LocalVar;
  1561. begin
  1562. StartProgram(false);
  1563. Add([
  1564. '{$mode objfpc}',
  1565. 'type',
  1566. ' TObject = class end;',
  1567. ' generic TBird<{#Templ}T> = class',
  1568. ' function Fly(p:T): T;',
  1569. ' end;',
  1570. 'function TBird.Fly(p:T): T;',
  1571. 'var l: T;',
  1572. 'begin',
  1573. ' l:=p;',
  1574. ' p:=l;',
  1575. ' Result:=p;',
  1576. ' Result:=l;',
  1577. ' l:=Result;',
  1578. 'end;',
  1579. 'var',
  1580. ' b: specialize TBird<word>;',
  1581. ' w: word;',
  1582. 'begin',
  1583. ' w:=b.Fly(w);',
  1584. '']);
  1585. ParseProgram;
  1586. end;
  1587. procedure TTestResolveGenerics.TestGen_Statements;
  1588. begin
  1589. StartProgram(false);
  1590. Add([
  1591. '{$mode objfpc}',
  1592. 'type',
  1593. ' TObject = class end;',
  1594. ' generic TBird<{#Templ}T> = class',
  1595. ' function Fly(p:T): T;',
  1596. ' end;',
  1597. 'function TBird.Fly(p:T): T;',
  1598. 'var',
  1599. ' v1,v2,v3:T;',
  1600. 'begin',
  1601. ' v1:=1;',
  1602. ' v2:=v1+v1*v1+v1 div p;',
  1603. ' v3:=-v1;',
  1604. ' repeat',
  1605. ' v1:=v1+1;',
  1606. ' until v1>=5;',
  1607. ' while v1>=0 do',
  1608. ' v1:=v1-v2;',
  1609. ' for v1:=v2 to v3 do v2:=v1;',
  1610. ' if v1<v2 then v3:=v1 else v3:=v2;',
  1611. ' if v1<v2 then else ;',
  1612. ' case v1 of',
  1613. ' 1: v3:=3;',
  1614. ' end;',
  1615. 'end;',
  1616. 'var',
  1617. ' b: specialize TBird<word>;',
  1618. 'begin',
  1619. ' b.Fly(2);',
  1620. '']);
  1621. ParseProgram;
  1622. end;
  1623. procedure TTestResolveGenerics.TestGen_InlineSpecializeExpr;
  1624. begin
  1625. StartProgram(false);
  1626. Add([
  1627. '{$mode objfpc}',
  1628. 'type',
  1629. ' TObject = class end;',
  1630. ' generic TBird<T> = class',
  1631. ' constructor Create;',
  1632. ' end;',
  1633. ' generic TAnt<U> = class',
  1634. ' constructor Create;',
  1635. ' end;',
  1636. 'constructor TBird.Create;',
  1637. 'var',
  1638. ' a: specialize TAnt<T>;',
  1639. ' b: specialize TAnt<word>;',
  1640. 'begin',
  1641. ' a:=specialize TAnt<T>.create;',
  1642. ' b:=specialize TAnt<word>.create;',
  1643. 'end;',
  1644. 'constructor TAnt.Create;',
  1645. 'var',
  1646. ' i: specialize TBird<U>;',
  1647. ' j: specialize TBird<word>;',
  1648. ' k: specialize TAnt<U>;',
  1649. 'begin',
  1650. ' i:=specialize TBird<U>.create;',
  1651. ' j:=specialize TBird<word>.create;',
  1652. ' k:=specialize TAnt<U>.create;',
  1653. 'end;',
  1654. 'var a: specialize TAnt<word>;',
  1655. 'begin',
  1656. ' a:=specialize TAnt<word>.create;',
  1657. '']);
  1658. ParseProgram;
  1659. end;
  1660. procedure TTestResolveGenerics.TestGen_TryExcept;
  1661. begin
  1662. StartProgram(false);
  1663. Add([
  1664. '{$mode objfpc}',
  1665. 'type',
  1666. ' TObject = class end;',
  1667. ' generic TBird<{#Templ}T> = class',
  1668. ' function Fly(p:T): T;',
  1669. ' end;',
  1670. ' Exception = class',
  1671. ' end;',
  1672. ' generic EMsg<T> = class',
  1673. ' Msg: T;',
  1674. ' end;',
  1675. 'function TBird.Fly(p:T): T;',
  1676. 'var',
  1677. ' v1,v2,v3:T;',
  1678. 'begin',
  1679. ' try',
  1680. ' finally',
  1681. ' end;',
  1682. ' try',
  1683. ' v1:=v2;',
  1684. ' finally',
  1685. ' v2:=v1;',
  1686. ' end;',
  1687. ' try',
  1688. ' except',
  1689. ' on Exception do ;',
  1690. ' on E: Exception do ;',
  1691. ' on E: specialize EMsg<boolean> do E.Msg:=true;',
  1692. ' on E: specialize EMsg<T> do E.Msg:=1;',
  1693. ' end;',
  1694. 'end;',
  1695. 'var',
  1696. ' b: specialize TBird<word>;',
  1697. 'begin',
  1698. ' b.Fly(2);',
  1699. '']);
  1700. ParseProgram;
  1701. end;
  1702. procedure TTestResolveGenerics.TestGen_Call;
  1703. begin
  1704. StartProgram(false);
  1705. Add([
  1706. '{$mode objfpc}',
  1707. 'type',
  1708. ' TObject = class end;',
  1709. ' generic TBird<T> = class',
  1710. ' function Fly(p:T): T;',
  1711. ' end;',
  1712. 'procedure Run(b: boolean); overload;',
  1713. 'begin end;',
  1714. 'procedure Run(w: word); overload;',
  1715. 'begin end;',
  1716. 'function TBird.Fly(p:T): T;',
  1717. 'begin',
  1718. ' Run(p);',
  1719. ' Run(Result);',
  1720. 'end;',
  1721. 'var',
  1722. ' w: specialize TBird<word>;',
  1723. ' b: specialize TBird<boolean>;',
  1724. 'begin',
  1725. '']);
  1726. ParseProgram;
  1727. end;
  1728. procedure TTestResolveGenerics.TestGen_NestedProc;
  1729. begin
  1730. StartProgram(false);
  1731. Add([
  1732. '{$mode objfpc}',
  1733. 'type',
  1734. ' TObject = class end;',
  1735. ' generic TBird<T> = class',
  1736. ' function Fly(p:T): T;',
  1737. ' end;',
  1738. 'function TBird.Fly(p:T): T;',
  1739. ' function Run: T;',
  1740. ' begin',
  1741. ' Fly:=Result;',
  1742. ' end;',
  1743. 'begin',
  1744. ' Run;',
  1745. 'end;',
  1746. 'var',
  1747. ' w: specialize TBird<word>;',
  1748. ' b: specialize TBird<boolean>;',
  1749. 'begin',
  1750. '']);
  1751. ParseProgram;
  1752. end;
  1753. procedure TTestResolveGenerics.TestGenProc_Function;
  1754. begin
  1755. StartProgram(false);
  1756. Add([
  1757. 'generic function DoIt<T>(a: T): T;',
  1758. 'var i: T;',
  1759. 'begin',
  1760. ' a:=i;',
  1761. ' Result:=a;',
  1762. 'end;',
  1763. 'var w: word;',
  1764. 'begin',
  1765. ' w:=specialize DoIt<word>(3);',
  1766. '']);
  1767. ParseProgram;
  1768. end;
  1769. procedure TTestResolveGenerics.TestGenProc_FunctionDelphi;
  1770. begin
  1771. StartProgram(false);
  1772. Add([
  1773. '{$mode delphi}',
  1774. 'function DoIt<T>(a: T): T;',
  1775. 'var i: T;',
  1776. 'begin',
  1777. ' a:=i;',
  1778. ' Result:=a;',
  1779. 'end;',
  1780. 'var w: word;',
  1781. 'begin',
  1782. ' w:=DoIt<word>(3);',
  1783. '']);
  1784. ParseProgram;
  1785. end;
  1786. procedure TTestResolveGenerics.TestGenProc_OverloadDuplicate;
  1787. begin
  1788. StartProgram(false);
  1789. Add([
  1790. 'generic procedure Fly<T>(a: T);',
  1791. 'begin',
  1792. 'end;',
  1793. 'generic procedure Fly<T>(a: T);',
  1794. 'begin',
  1795. 'end;',
  1796. 'begin',
  1797. '']);
  1798. CheckResolverException('Duplicate identifier "Fly" at afile.pp(2,22)',nDuplicateIdentifier);
  1799. end;
  1800. procedure TTestResolveGenerics.TestGenProc_MissingTemplatesFail;
  1801. begin
  1802. StartProgram(false);
  1803. Add([
  1804. 'generic procedure Run;',
  1805. 'begin',
  1806. 'end;',
  1807. 'begin',
  1808. '']);
  1809. CheckParserException('Expected "<"',nParserExpectTokenError);
  1810. end;
  1811. procedure TTestResolveGenerics.TestGenProc_Forward;
  1812. begin
  1813. StartProgram(false);
  1814. Add([
  1815. 'generic procedure Fly<T>(a: T); forward;',
  1816. 'procedure Run;',
  1817. 'begin',
  1818. ' specialize Fly<word>(3);',
  1819. 'end;',
  1820. 'generic procedure Fly<T>(a: T);',
  1821. 'var i: T;',
  1822. 'begin',
  1823. ' i:=a;',
  1824. 'end;',
  1825. 'begin',
  1826. ' specialize Fly<boolean>(true);',
  1827. '']);
  1828. ParseProgram;
  1829. end;
  1830. procedure TTestResolveGenerics.TestGenProc_External;
  1831. begin
  1832. StartProgram(false);
  1833. Add([
  1834. 'generic function Fly<T>(a: T): T; external name ''flap'';',
  1835. 'procedure Run;',
  1836. 'begin',
  1837. ' specialize Fly<word>(3);',
  1838. 'end;',
  1839. 'begin',
  1840. ' specialize Fly<boolean>(true);',
  1841. '']);
  1842. ParseProgram;
  1843. end;
  1844. procedure TTestResolveGenerics.TestGenProc_UnitIntf;
  1845. begin
  1846. AddModuleWithIntfImplSrc('unit2.pas',
  1847. LinesToStr([
  1848. 'generic function Fly<T>(a: T): T;',
  1849. '']),
  1850. LinesToStr([
  1851. 'generic function Fly<T>(a: T): T;',
  1852. 'var i: T;',
  1853. 'begin',
  1854. ' i:=a;',
  1855. 'end;',
  1856. '']));
  1857. StartProgram(true);
  1858. Add([
  1859. 'uses unit2;',
  1860. 'var w: word;',
  1861. 'begin',
  1862. ' w:=specialize Fly<word>(3);',
  1863. ' if specialize Fly<boolean>(false) then ;',
  1864. '']);
  1865. ParseProgram;
  1866. end;
  1867. procedure TTestResolveGenerics.TestGenProc_BackRef1Fail;
  1868. begin
  1869. StartProgram(false);
  1870. Add([
  1871. 'generic function Fly<T>(a: Fly): T;',
  1872. 'begin',
  1873. 'end;',
  1874. 'begin',
  1875. '']);
  1876. CheckResolverException('Wrong number of parameters specified for call to "function Fly<>(untyped)"',nWrongNumberOfParametersForCallTo);
  1877. end;
  1878. procedure TTestResolveGenerics.TestGenProc_BackRef2Fail;
  1879. begin
  1880. StartProgram(false);
  1881. Add([
  1882. 'generic function Fly<T>(a: Fly<word>): T;',
  1883. 'begin',
  1884. 'end;',
  1885. 'begin',
  1886. '']);
  1887. CheckResolverException('Wrong number of parameters specified for call to "function Fly<>(untyped)"',nWrongNumberOfParametersForCallTo);
  1888. end;
  1889. procedure TTestResolveGenerics.TestGenProc_BackRef3Fail;
  1890. begin
  1891. StartProgram(false);
  1892. Add([
  1893. 'generic function Fly<T>(a: Fly<T>): T;',
  1894. 'begin',
  1895. 'end;',
  1896. 'begin',
  1897. '']);
  1898. CheckResolverException('Wrong number of parameters specified for call to "function Fly<>(untyped)"',nWrongNumberOfParametersForCallTo);
  1899. end;
  1900. procedure TTestResolveGenerics.TestGenProc_CallSelf;
  1901. begin
  1902. StartProgram(false);
  1903. Add([
  1904. 'generic function Fly<T>(a: T): T;',
  1905. ' procedure Run;',
  1906. ' begin',
  1907. ' specialize Fly<T>(a);',
  1908. ' specialize Fly<word>(3);',
  1909. ' end;',
  1910. 'begin',
  1911. ' specialize Fly<T>(a);',
  1912. ' specialize Fly<boolean>(true);',
  1913. 'end;',
  1914. 'begin',
  1915. ' specialize Fly<string>(''fast'');',
  1916. '']);
  1917. ParseProgram;
  1918. end;
  1919. procedure TTestResolveGenerics.TestGenProc_CallSelfNoParams;
  1920. begin
  1921. StartProgram(false);
  1922. Add([
  1923. 'generic function Fly<T>(a: T = 0): T;',
  1924. ' procedure Run;',
  1925. ' begin',
  1926. ' specialize Fly<T>;',
  1927. ' specialize Fly<word>;',
  1928. ' end;',
  1929. 'begin',
  1930. ' specialize Fly<T>;',
  1931. ' specialize Fly<byte>;',
  1932. 'end;',
  1933. 'begin',
  1934. ' specialize Fly<shortint>;',
  1935. '']);
  1936. ParseProgram;
  1937. end;
  1938. procedure TTestResolveGenerics.TestGenProc_ForwardConstraints;
  1939. begin
  1940. StartProgram(false);
  1941. Add([
  1942. 'type',
  1943. ' TObject = class end;',
  1944. ' TBird = class end;',
  1945. 'var b: TBird;',
  1946. 'generic function Fly<T: class>(a: T): T; forward;',
  1947. 'procedure Run;',
  1948. 'begin',
  1949. ' specialize Fly<TBird>(b);',
  1950. 'end;',
  1951. 'generic function Fly<T>(a: T): T;',
  1952. 'begin',
  1953. 'end;',
  1954. 'begin',
  1955. ' specialize Fly<TBird>(b);',
  1956. '']);
  1957. ParseProgram;
  1958. end;
  1959. procedure TTestResolveGenerics.TestGenProc_ForwardConstraintsRepeatFail;
  1960. begin
  1961. StartProgram(false);
  1962. Add([
  1963. 'type',
  1964. ' TObject = class end;',
  1965. 'generic function Fly<T: class>(a: T): T; forward;',
  1966. 'generic function Fly<T: class>(a: T): T;',
  1967. 'begin',
  1968. 'end;',
  1969. 'begin',
  1970. '']);
  1971. CheckResolverException(sImplMustNotRepeatConstraints,nImplMustNotRepeatConstraints);
  1972. end;
  1973. procedure TTestResolveGenerics.TestGenProc_ForwardTempNameMismatch;
  1974. begin
  1975. StartProgram(false);
  1976. Add([
  1977. 'generic function Fly<T>(a: T): T; forward;',
  1978. 'generic function Fly<B>(a: B): B;',
  1979. 'begin',
  1980. 'end;',
  1981. 'begin',
  1982. '']);
  1983. CheckResolverException('Declaration of "Fly<B>" differs from previous declaration at afile.pp(2,23)',
  1984. nDeclOfXDiffersFromPrevAtY);
  1985. end;
  1986. procedure TTestResolveGenerics.TestGenProc_ForwardOverload;
  1987. begin
  1988. StartProgram(false);
  1989. Add([
  1990. 'generic function {#FlyA}Fly<T>(a: T; b: boolean): T; forward; overload;',
  1991. 'generic function {#FlyB}Fly<T>(a: T; w: word): T; forward; overload;',
  1992. 'procedure {#FlyC}Fly; overload;',
  1993. 'begin',
  1994. ' specialize {@FlyA}Fly<longint>(1,true);',
  1995. ' specialize {@FlyB}Fly<string>(''ABC'',3);',
  1996. 'end;',
  1997. 'generic function Fly<T>(a: T; b: boolean): T;',
  1998. 'begin',
  1999. 'end;',
  2000. 'generic function Fly<T>(a: T; w: word): T;',
  2001. 'begin',
  2002. 'end;',
  2003. 'begin',
  2004. '']);
  2005. ParseProgram;
  2006. end;
  2007. procedure TTestResolveGenerics.TestGenProc_NestedFail;
  2008. begin
  2009. StartProgram(false);
  2010. Add([
  2011. 'procedure Fly;',
  2012. ' generic procedure Run<T>(a: T);',
  2013. ' begin',
  2014. ' end;',
  2015. 'begin',
  2016. ' Run<boolean>(true);',
  2017. 'end;',
  2018. 'begin',
  2019. '']);
  2020. CheckResolverException('Type parameters not allowed on nested procedure',nTypeParamsNotAllowedOnX);
  2021. end;
  2022. procedure TTestResolveGenerics.TestGenProc_TypeParamCntOverload;
  2023. begin
  2024. StartProgram(false);
  2025. Add([
  2026. 'generic procedure {#A}Run<T>(a: T);',
  2027. 'begin',
  2028. 'end;',
  2029. 'generic procedure {#B}Run<M,N>(a: M);',
  2030. 'begin',
  2031. ' specialize {@A}Run<M>(a);',
  2032. ' specialize {@B}Run<double,char>(1.3);',
  2033. 'end;',
  2034. 'begin',
  2035. ' specialize {@A}Run<word>(3);',
  2036. ' specialize {@B}Run<word,char>(4);',
  2037. '']);
  2038. ParseProgram;
  2039. end;
  2040. procedure TTestResolveGenerics.TestGenProc_TypeParamCntOverloadNoParams;
  2041. begin
  2042. StartProgram(false);
  2043. Add([
  2044. 'generic procedure {#A}Run<T>;',
  2045. 'begin',
  2046. 'end;',
  2047. 'generic procedure {#B}Run<M,N>;',
  2048. 'begin',
  2049. ' specialize {@A}Run<M>;',
  2050. ' specialize {@A}Run<M>();',
  2051. ' specialize {@B}Run<double,char>;',
  2052. ' specialize {@B}Run<double,char>();',
  2053. 'end;',
  2054. 'begin',
  2055. ' specialize {@A}Run<word>;',
  2056. ' specialize {@A}Run<word>();',
  2057. ' specialize {@B}Run<word,char>;',
  2058. ' specialize {@B}Run<word,char>();',
  2059. '']);
  2060. ParseProgram;
  2061. end;
  2062. procedure TTestResolveGenerics.TestGenProc_TypeParamWithDefaultParamDelphiFail;
  2063. begin
  2064. // delphi 10.3 does not allow default values for args with generic types
  2065. StartProgram(false);
  2066. Add([
  2067. '{$mode delphi}',
  2068. 'procedure {#A}Run<T>(a: T = 0); overload;',
  2069. 'begin',
  2070. 'end;',
  2071. 'begin',
  2072. '']);
  2073. CheckResolverException(sParamOfThisTypeCannotHaveDefVal,nParamOfThisTypeCannotHaveDefVal);
  2074. end;
  2075. procedure TTestResolveGenerics.TestGenProc_Infer_NeedExplicitFail;
  2076. begin
  2077. StartProgram(false);
  2078. Add([
  2079. '{$mode delphi}',
  2080. 'function {#A}Run<S,T>(a: S): T; overload;',
  2081. 'begin',
  2082. 'end;',
  2083. 'begin',
  2084. ' {@A}Run(1);',
  2085. '']);
  2086. CheckResolverException('Could not infer generic type argument "T" for method "Run"',
  2087. nCouldNotInferTypeArgXForMethodY);
  2088. end;
  2089. procedure TTestResolveGenerics.TestGenProc_Infer_Overload;
  2090. begin
  2091. StartProgram(false);
  2092. Add([
  2093. '{$mode delphi}',
  2094. 'procedure {#A}Run<S>(a: S; b: boolean); overload;',
  2095. 'begin',
  2096. 'end;',
  2097. 'procedure {#B}Run<T>(a: T; w: word); overload;',
  2098. 'begin',
  2099. 'end;',
  2100. 'procedure {#C}Run<U>(a: U; b: U); overload;',
  2101. 'begin',
  2102. 'end;',
  2103. 'begin',
  2104. ' {@A}Run(1,true);', // non generic take precedence
  2105. ' {@B}Run(2,word(3));', // non generic take precedence
  2106. ' {@C}Run(''foo'',''bar'');',
  2107. '']);
  2108. ParseProgram;
  2109. end;
  2110. procedure TTestResolveGenerics.TestGenProc_Infer_OverloadForward;
  2111. begin
  2112. StartProgram(false);
  2113. Add([
  2114. '{$mode delphi}',
  2115. 'procedure {#A}Run<S>(a: S; b: boolean); forward; overload;',
  2116. 'procedure {#B}Run<T>(a: T; w: word); forward; overload;',
  2117. 'procedure {#C}Run<U>(a: U; b: U); forward; overload;',
  2118. 'procedure {#A2}Run<S>(a: S; b: boolean); overload;',
  2119. 'begin',
  2120. ' {@A}Run(1,true);', // non generic take precedence
  2121. ' {@B}Run(2,word(3));', // non generic take precedence
  2122. ' {@C}Run(''foo'',''bar'');',
  2123. 'end;',
  2124. 'procedure {#B2}Run<T>(a: T; w: word); overload;',
  2125. 'begin',
  2126. 'end;',
  2127. 'procedure {#C2}Run<U>(a: U; b: U); overload;',
  2128. 'begin',
  2129. 'end;',
  2130. 'begin',
  2131. ' {@A}Run(1,true);', // non generic take precedence
  2132. ' {@B}Run(2,word(3));', // non generic take precedence
  2133. ' {@C}Run(''foo'',''bar'');',
  2134. '']);
  2135. ParseProgram;
  2136. end;
  2137. procedure TTestResolveGenerics.TestGenProc_Infer_Var_Overload;
  2138. begin
  2139. StartProgram(false);
  2140. Add([
  2141. '{$mode delphi}',
  2142. 'procedure {#A}Run<S>(var a: S; var b: boolean); overload;',
  2143. 'begin',
  2144. 'end;',
  2145. 'procedure {#B}Run<T>(var a: T; var w: word); overload;',
  2146. 'begin',
  2147. 'end;',
  2148. 'procedure {#C}Run<U>(var a: U; var b: U); overload;',
  2149. 'begin',
  2150. 'end;',
  2151. 'var',
  2152. ' w: word;',
  2153. ' b: boolean;',
  2154. ' s: string;',
  2155. 'begin',
  2156. ' {@A}Run(w,b);',
  2157. ' {@B}Run(s,w);',
  2158. ' {@C}Run(s,s);',
  2159. '']);
  2160. ParseProgram;
  2161. end;
  2162. procedure TTestResolveGenerics.TestGenProc_Infer_Widen;
  2163. begin
  2164. StartProgram(false);
  2165. Add([
  2166. '{$mode delphi}',
  2167. 'procedure {#A}Run<S>(a: S; b: S);',
  2168. 'begin',
  2169. 'end;',
  2170. 'begin',
  2171. ' {@A}Run(word(1),longint(2));',
  2172. ' {@A}Run(int64(1),longint(2));',
  2173. ' {@A}Run(boolean(false),wordbool(2));',
  2174. ' {@A}Run(''a'',''foo'');',
  2175. '']);
  2176. ParseProgram;
  2177. end;
  2178. procedure TTestResolveGenerics.TestGenProc_Infer_DefaultValue;
  2179. begin
  2180. StartProgram(false);
  2181. Add([
  2182. '{$mode objfpc}',
  2183. '{$modeswitch implicitfunctionspecialization}',
  2184. 'generic procedure {#A}Run<S>(a: S = 2; b: S = 10); overload;',
  2185. 'begin',
  2186. 'end;',
  2187. 'begin',
  2188. ' {@A}Run(1,2);',
  2189. ' {@A}Run(3);',
  2190. ' {@A}Run();',
  2191. '']);
  2192. ParseProgram;
  2193. end;
  2194. procedure TTestResolveGenerics.TestGenProc_Infer_DefaultValueMismatch;
  2195. begin
  2196. StartProgram(false);
  2197. Add([
  2198. '{$mode objfpc}',
  2199. '{$modeswitch implicitfunctionspecialization}',
  2200. 'generic procedure {#A}Run<S>(a: S; b: S = 10); overload;',
  2201. 'begin',
  2202. 'end;',
  2203. 'begin',
  2204. ' {@A}Run(false,true);',
  2205. '']);
  2206. CheckResolverException('Incompatible types: got "Longint" expected "Boolean"',
  2207. nIncompatibleTypesGotExpected);
  2208. end;
  2209. procedure TTestResolveGenerics.TestGenProc_Infer_ProcT;
  2210. begin
  2211. StartProgram(false);
  2212. Add([
  2213. '{$mode delphi}',
  2214. 'type',
  2215. ' TProc<S> = reference to procedure(a: S);',
  2216. ' TObject = class',
  2217. ' procedure {#A}Run<T: class>(a: TProc<T>);',
  2218. ' end;',
  2219. ' TBird = class end;',
  2220. 'procedure Tobject.Run<T>(a: TProc<T>);',
  2221. 'begin',
  2222. 'end;',
  2223. 'var obj: TObject;',
  2224. 'begin',
  2225. ' obj.{@A}Run<TBird>(procedure(Bird: TBird) begin end);',
  2226. //' obj.{@A}Run(procedure(Bird: TBird) begin end);', // not supported by Delphi
  2227. '']);
  2228. ParseProgram;
  2229. end;
  2230. procedure TTestResolveGenerics.TestGenProc_Infer_Mismatch;
  2231. begin
  2232. StartProgram(false);
  2233. Add([
  2234. '{$mode delphi}',
  2235. 'procedure Run<T>(a: T; b: T);',
  2236. 'begin',
  2237. 'end;',
  2238. 'begin',
  2239. ' Run(1,true);',
  2240. '']);
  2241. CheckResolverException('Inferred type "T" from different arguments mismatch for method "Run"',
  2242. nInferredTypeXFromDiffArgsMismatchFromMethodY);
  2243. end;
  2244. procedure TTestResolveGenerics.TestGenProc_Infer_ArrayOfT;
  2245. begin
  2246. StartProgram(false);
  2247. Add([
  2248. '{$mode delphi}',
  2249. 'procedure Run<T>(a: array of T);',
  2250. 'var b: T;',
  2251. 'begin',
  2252. ' b:=3;',
  2253. 'end;',
  2254. 'var Arr: array of byte;',
  2255. 'begin',
  2256. ' Run(Arr);',
  2257. '']);
  2258. ParseProgram;
  2259. end;
  2260. procedure TTestResolveGenerics.TestGenProc_Infer_PassAsArgDelphi;
  2261. begin
  2262. StartProgram(false);
  2263. Add([
  2264. '{$mode delphi}',
  2265. 'function Run<T>(a: T): T;',
  2266. 'var b: T;',
  2267. 'begin',
  2268. ' Run(Run<word>(3));',
  2269. ' Run(Run(4));',
  2270. 'end;',
  2271. 'begin',
  2272. ' Run(Run<word>(5));',
  2273. ' Run(Run(6));',
  2274. '']);
  2275. ParseProgram;
  2276. end;
  2277. procedure TTestResolveGenerics.TestGenProc_Infer_PassAsArgObjFPC;
  2278. begin
  2279. StartProgram(false);
  2280. Add([
  2281. '{$mode objfpc}',
  2282. '{$ModeSwitch implicitfunctionspecialization}',
  2283. 'generic function Run<T>(a: T): T;',
  2284. 'var b: T;',
  2285. 'begin',
  2286. ' Run(specialize Run<word>(3));',
  2287. ' Run(Run(4));',
  2288. 'end;',
  2289. 'begin',
  2290. ' Run(specialize Run<word>(5));',
  2291. ' Run(Run(6));',
  2292. '']);
  2293. ParseProgram;
  2294. end;
  2295. procedure TTestResolveGenerics.TestGenMethod_VirtualFail;
  2296. begin
  2297. StartProgram(false);
  2298. Add([
  2299. 'type',
  2300. ' TObject = class',
  2301. ' generic procedure Run<T>(a: T); virtual; abstract;',
  2302. ' end;',
  2303. 'begin',
  2304. '']);
  2305. CheckResolverException('virtual, dynamic or message methods cannot have type parameters',
  2306. nXMethodsCannotHaveTypeParams);
  2307. end;
  2308. procedure TTestResolveGenerics.TestGenMethod_PublishedFail;
  2309. begin
  2310. StartProgram(false);
  2311. Add([
  2312. 'type',
  2313. ' TObject = class',
  2314. ' published',
  2315. ' generic procedure Run<T>(a: T);',
  2316. ' end;',
  2317. 'generic procedure TObject.Run<T>(a: T);',
  2318. 'begin',
  2319. 'end;',
  2320. 'begin',
  2321. '']);
  2322. CheckResolverException('published methods cannot have type parameters',
  2323. nXMethodsCannotHaveTypeParams);
  2324. end;
  2325. procedure TTestResolveGenerics.TestGenMethod_ClassInterfaceMethodFail;
  2326. begin
  2327. StartProgram(false);
  2328. Add([
  2329. 'type',
  2330. ' IUnknown = interface',
  2331. ' generic procedure Run<T>(a: T); virtual; abstract;',
  2332. ' end;',
  2333. 'begin',
  2334. '']);
  2335. CheckParserException('generic is not allowed in interface',nParserXNotAllowedInY);
  2336. end;
  2337. procedure TTestResolveGenerics.TestGenMethod_ClassConstructorFail;
  2338. begin
  2339. StartProgram(false);
  2340. Add([
  2341. 'type',
  2342. ' TObject = class',
  2343. ' generic class constructor Run<T>(a: T);',
  2344. ' end;',
  2345. 'generic class constructor TObject.Run<T>(a: T);',
  2346. 'begin end;',
  2347. 'begin',
  2348. '']);
  2349. CheckParserException('Expected "Procedure" or "Function" at token "constructor" in file afile.pp at line 4 column 19',
  2350. nParserExpectToken2Error);
  2351. end;
  2352. procedure TTestResolveGenerics.TestGenMethod_TemplNameDifferFail;
  2353. begin
  2354. StartProgram(false);
  2355. Add([
  2356. 'type',
  2357. ' TObject = class',
  2358. ' generic procedure Run<T>(a: T);',
  2359. ' end;',
  2360. 'generic procedure TObject.Run<S>(a: S);',
  2361. 'begin',
  2362. 'end;',
  2363. 'begin',
  2364. '']);
  2365. CheckResolverException('Declaration of "TObject.Run<S>" differs from previous declaration at afile.pp(4,28)',
  2366. nDeclOfXDiffersFromPrevAtY);
  2367. end;
  2368. procedure TTestResolveGenerics.TestGenMethod_ImplConstraintFail;
  2369. begin
  2370. StartProgram(false);
  2371. Add([
  2372. 'type',
  2373. ' TObject = class',
  2374. ' generic procedure Run<T>(a: T);',
  2375. ' end;',
  2376. 'generic procedure TObject.Run<T: class>(a: T);',
  2377. 'begin',
  2378. 'end;',
  2379. 'begin',
  2380. '']);
  2381. CheckResolverException(sImplMustNotRepeatConstraints,nImplMustNotRepeatConstraints);
  2382. end;
  2383. procedure TTestResolveGenerics.TestGenMethod_NestedSelf;
  2384. begin
  2385. StartProgram(false);
  2386. Add([
  2387. 'type',
  2388. ' TObject = class',
  2389. ' w: word;',
  2390. ' generic function Fly<T>(a: T): T;',
  2391. ' end;',
  2392. 'generic function TObject.Fly<T>(a: T): T;',
  2393. ' function Sub: T;',
  2394. ' begin',
  2395. ' Result:=w+a;',
  2396. ' Result:=Self.w+a;',
  2397. //' specialize Fly<T> :=', not supported by FPC/Delphi
  2398. ' end;',
  2399. 'begin',
  2400. ' Result:=Sub;',
  2401. ' Result:=Self.w+Sub+a;',
  2402. 'end;',
  2403. 'var Obj: TObject;',
  2404. 'begin',
  2405. ' if Obj.specialize Fly<smallint>(3)=4 then ;',
  2406. '']);
  2407. ParseProgram;
  2408. end;
  2409. procedure TTestResolveGenerics.TestGenMethod_OverloadTypeParamCnt;
  2410. begin
  2411. StartProgram(false);
  2412. Add([
  2413. 'type',
  2414. ' TObject = class',
  2415. ' generic procedure {#A}Run<T>(a: T);',
  2416. ' generic procedure {#B}Run<M,N>(a: M);',
  2417. ' end;',
  2418. 'generic procedure TObject.Run<T>(a: T);',
  2419. 'begin',
  2420. 'end;',
  2421. 'generic procedure TObject.Run<M,N>(a: M);',
  2422. 'begin',
  2423. ' specialize {@A}Run<M>(a);',
  2424. ' specialize {@B}Run<double,char>(1.3);',
  2425. 'end;',
  2426. 'var obj: TObject;',
  2427. 'begin',
  2428. ' obj.specialize {@A}Run<word>(3);',
  2429. ' obj.specialize {@B}Run<word,char>(4);',
  2430. '']);
  2431. ParseProgram;
  2432. end;
  2433. procedure TTestResolveGenerics.TestGenMethod_OverloadArgs;
  2434. begin
  2435. StartProgram(false);
  2436. Add([
  2437. 'type',
  2438. ' TObject = class',
  2439. ' generic function {#A}Run<T>(a: boolean): T;',
  2440. ' generic function {#B}Run<M>(a: word): M;',
  2441. ' end;',
  2442. 'generic function TObject.Run<T>(a: boolean): T;',
  2443. 'begin',
  2444. 'end;',
  2445. 'generic function TObject.Run<M>(a: word): M;',
  2446. 'begin',
  2447. ' Result:=specialize Run<M>(a);',
  2448. ' if specialize {@A}Run<string>(true)=''foo'' then ;',
  2449. ' if specialize {@B}Run<byte>(3)=4 then ;',
  2450. 'end;',
  2451. 'var obj: TObject;',
  2452. 'begin',
  2453. ' if obj.specialize {@A}Run<string>(true)=''bar'' then ;',
  2454. ' if obj.specialize {@B}Run<byte>(5)=6 then ;',
  2455. '']);
  2456. ParseProgram;
  2457. end;
  2458. initialization
  2459. RegisterTests([TTestResolveGenerics]);
  2460. end.