tcresolvegenerics.pas 62 KB

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