12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044 |
- unit tcresolvegenerics;
- {$mode objfpc}{$H+}
- interface
- uses
- Classes, SysUtils, testregistry, tcresolver, PasResolveEval, PParser,
- PScanner;
- type
- { TTestResolveGenerics }
- TTestResolveGenerics = Class(TCustomTestResolver)
- Published
- // generic types
- procedure TestGen_MissingTemplateFail;
- procedure TestGen_VarTypeWithoutSpecializeFail;
- procedure TestGen_GenTypeWithWrongParamCountFail;
- procedure TestGen_GenericNotFoundFail;
- procedure TestGen_SameNameSameParamCountFail;
- procedure TestGen_TypeAliasWithoutSpecializeFail;
- procedure TestGen_TemplNameEqTypeNameFail; // type T<T>
- // constraints
- procedure TestGen_ConstraintStringFail;
- procedure TestGen_ConstraintMultiClassFail;
- procedure TestGen_ConstraintRecordExpectedFail;
- procedure TestGen_ConstraintClassRecordFail;
- procedure TestGen_ConstraintRecordClassFail;
- procedure TestGen_ConstraintArrayFail;
- procedure TestGen_ConstraintConstructor;
- procedure TestGen_ConstraintUnit;
- // ToDo: constraint T:Unit2.specialize TGen<word>
- procedure TestGen_ConstraintSpecialize;
- procedure TestGen_ConstraintTSpecializeWithT;
- procedure TestGen_ConstraintTSpecializeAsTFail; // TBird<T; U: T<word>> and no T<>
- procedure TestGen_ConstraintTSpecializeWithTFail; // TBird<T: TAnt<T>>
- procedure TestGen_ConstraintSameNameFail; // TAnt<T:T>
- procedure TestGen_ConstraintInheritedMissingRecordFail;
- procedure TestGen_ConstraintInheritedMissingClassTypeFail;
- procedure TestGen_ConstraintMultiParam;
- procedure TestGen_ConstraintMultiParamClassMismatch;
- procedure TestGen_ConstraintClassType_DotIsAsTypeCast;
- procedure TestGen_ConstraintClassType_ForInT;
- procedure TestGen_ConstraintClassType_IsAs;
- // generic record
- procedure TestGen_RecordLocalNameDuplicateFail;
- procedure TestGen_Record;
- procedure TestGen_RecordDelphi;
- procedure TestGen_RecordNestedSpecialize_ClassRecord;
- procedure TestGen_RecordNestedSpecialize_Self;
- procedure TestGen_Record_SpecializeSelfInsideFail;
- procedure TestGen_Record_ReferGenericSelfFail;
- procedure TestGen_RecordAnoArray;
- // ToDo: unitname.specialize TBird<word>.specialize TAnt<word>
- // generic class
- procedure TestGen_Class;
- procedure TestGen_ClassDelphi;
- procedure TestGen_ClassDelphi_TypeOverload;
- procedure TestGen_ClassObjFPC;
- procedure TestGen_ClassObjFPC_OverloadFail;
- procedure TestGen_ClassObjFPC_OverloadOtherUnit;
- procedure TestGen_ClassGenAncestorWithoutParamFail;
- procedure TestGen_ClassForward;
- procedure TestGen_ClassForwardConstraints;
- procedure TestGen_ClassForwardConstraintNameMismatch;
- procedure TestGen_ClassForwardConstraintKeywordMismatch;
- procedure TestGen_ClassForwardConstraintTypeMismatch;
- procedure TestGen_ClassForward_Circle;
- procedure TestGen_Class_RedeclareInUnitImplFail;
- procedure TestGen_Class_TypeOverloadInUnitImpl;
- procedure TestGen_Class_MethodObjFPC;
- procedure TestGen_Class_MethodOverride;
- procedure TestGen_Class_MethodDelphi;
- procedure TestGen_Class_MethodDelphiTypeParamMissing;
- procedure TestGen_Class_MethodImplConstraintFail;
- procedure TestGen_Class_MethodImplTypeParamNameMismatch;
- procedure TestGen_Class_SpecializeSelfInside;
- procedure TestGen_Class_AncestorTFail;
- procedure TestGen_Class_GenAncestor;
- procedure TestGen_Class_AncestorSelfFail;
- procedure TestGen_ClassOfSpecializeFail;
- // ToDo: UnitA.impl uses UnitB.intf uses UnitA.intf, UnitB has specialize of UnitA
- procedure TestGen_Class_NestedType;
- procedure TestGen_Class_NestedRecord;
- procedure TestGen_Class_NestedClass;
- procedure TestGen_Class_Enums_NotPropagating;
- procedure TestGen_Class_Self;
- procedure TestGen_Class_MemberTypeConstructor;
- procedure TestGen_Class_AliasMemberType;
- procedure TestGen_Class_AccessGenericMemberTypeFail;
- procedure TestGen_Class_ReferenceTo;
- procedure TestGen_Class_TwoSpecsAreNotRelatedWarn;
- procedure TestGen_Class_List;
- procedure TestGen_Class_Typecast;
- // ToDo: different modeswitches at parse time and specialize time
- // generic external class
- procedure TestGen_ExtClass_Array;
- procedure TestGen_ExtClass_VarargsOfType;
- // generic interface
- procedure TestGen_ClassInterface;
- procedure TestGen_ClassInterface_Method;
- // generic array
- procedure TestGen_DynArray;
- procedure TestGen_StaticArray;
- procedure TestGen_Array_Anoynmous;
- // generic procedure type
- procedure TestGen_ProcType;
- procedure TestGen_ProcType_AnonymousFunc_Delphi;
- // pointer of generic
- procedure TestGen_PointerDirectSpecializeFail;
- // ToDo: helpers for generics
- procedure TestGen_HelperForArray;
- // ToDo: default class prop array helper: arr<b>[c]
- // generic statements
- procedure TestGen_LocalVar;
- procedure TestGen_Statements;
- procedure TestGen_InlineSpecializeExpr;
- // ToDo: a.b<c>(d)
- // ToDo: with a do b<c>
- procedure TestGen_TryExcept;
- procedure TestGen_Call;
- procedure TestGen_NestedProc;
- // ToDo: obj<b>[c]
- // generic functions
- procedure TestGenProc_Function;
- procedure TestGenProc_FunctionDelphi;
- procedure TestGenProc_OverloadDuplicate;
- procedure TestGenProc_MissingTemplatesFail;
- procedure TestGenProc_SpecializeNonGenericFail;
- procedure TestGenProc_Forward;
- procedure TestGenProc_External;
- procedure TestGenProc_UnitIntf;
- procedure TestGenProc_BackRef1Fail;
- procedure TestGenProc_BackRef2Fail;
- procedure TestGenProc_BackRef3Fail;
- procedure TestGenProc_CallSelf;
- procedure TestGenProc_CallSelfNoParams;
- procedure TestGenProc_ForwardConstraints;
- procedure TestGenProc_ForwardConstraintsRepeatFail;
- procedure TestGenProc_ForwardTempNameMismatch;
- procedure TestGenProc_ForwardOverload;
- procedure TestGenProc_NestedFail;
- procedure TestGenProc_TypeParamCntOverload;
- procedure TestGenProc_TypeParamCntOverloadNoParams;
- procedure TestGenProc_TypeParamWithDefaultParamDelphiFail;
- procedure TestGenProc_ParamSpecWithT;
- // ToDo: NestedResultAssign
- // generic function infer types
- procedure TestGenProc_Infer_NeedExplicitFail;
- procedure TestGenProc_Infer_Overload;
- procedure TestGenProc_Infer_OverloadForward;
- procedure TestGenProc_Infer_Var_Overload;
- procedure TestGenProc_Infer_Widen;
- procedure TestGenProc_Infer_DefaultValue;
- procedure TestGenProc_Infer_DefaultValueMismatch;
- procedure TestGenProc_Infer_ProcT;
- procedure TestGenProc_Infer_Mismatch;
- procedure TestGenProc_Infer_ArrayOfT;
- procedure TestGenProc_Infer_PassAsArgDelphi;
- procedure TestGenProc_Infer_PassAsArgObjFPC;
- // ToDo procedure TestGenProc_Infer_ProcType;
- // generic methods
- procedure TestGenMethod_VirtualFail;
- procedure TestGenMethod_PublishedFail;
- procedure TestGenMethod_ClassInterfaceMethodFail;
- procedure TestGenMethod_ClassConstructorFail;
- procedure TestGenMethod_TemplNameDifferFail;
- procedure TestGenMethod_ImplConstraintFail;
- procedure TestGenMethod_NestedSelf;
- procedure TestGenMethod_OverloadTypeParamCntObjFPC;
- procedure TestGenMethod_OverloadTypeParamCntDelphi;
- procedure TestGenMethod_OverloadArgs;
- procedure TestGenMethod_TypeCastParam;
- procedure TestGenMethod_TypeCastIdentDot;
- end;
- implementation
- { TTestResolveGenerics }
- procedure TTestResolveGenerics.TestGen_MissingTemplateFail;
- begin
- StartProgram(false);
- Add([
- 'type generic g< > = array of word;',
- 'begin',
- '']);
- CheckParserException('Expected "Identifier"',nParserExpectTokenError);
- end;
- procedure TTestResolveGenerics.TestGen_VarTypeWithoutSpecializeFail;
- begin
- StartProgram(false);
- Add([
- 'type generic TBird<T> = record end;',
- 'var b: TBird;',
- 'begin',
- '']);
- CheckResolverException('Generics without specialization cannot be used as a type for a variable',
- nGenericsWithoutSpecializationAsType);
- end;
- procedure TTestResolveGenerics.TestGen_GenTypeWithWrongParamCountFail;
- begin
- StartProgram(false);
- Add([
- 'type generic TBird<T> = record end;',
- 'var b: specialize TBird<word, byte>;',
- 'begin',
- '']);
- CheckResolverException('identifier not found "TBird<,>"',
- nIdentifierNotFound);
- end;
- procedure TTestResolveGenerics.TestGen_GenericNotFoundFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TBird = specialize TAnimal<word>;',
- 'begin',
- '']);
- CheckResolverException('identifier not found "TAnimal<>"',
- nIdentifierNotFound);
- end;
- procedure TTestResolveGenerics.TestGen_SameNameSameParamCountFail;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'type',
- ' TBird<S,T> = record w: T; end;',
- ' TBird<X,Y> = record f: X; end;',
- 'begin',
- '']);
- CheckResolverException('Duplicate identifier "TBird" at afile.pp(4,8)',
- nDuplicateIdentifier);
- end;
- procedure TTestResolveGenerics.TestGen_TypeAliasWithoutSpecializeFail;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'type',
- ' TBird<T> = record w: T; end;',
- ' TBirdAlias = TBird;',
- 'begin',
- '']);
- CheckResolverException('Generics without specialization cannot be used as a type for a variable',
- nGenericsWithoutSpecializationAsType);
- end;
- procedure TTestResolveGenerics.TestGen_TemplNameEqTypeNameFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' generic TBird<TBird> = record v: T; end;',
- 'var r: specialize TBird<word>;',
- 'begin',
- '']);
- CheckResolverException('Duplicate identifier "TBird" at afile.pp(4,16)',
- nDuplicateIdentifier);
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintStringFail;
- begin
- StartProgram(false);
- Add([
- 'type generic TRec<T:string> = record end;',
- 'begin',
- '']);
- CheckResolverException('"String" is not a valid constraint',
- nXIsNotAValidConstraint);
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintMultiClassFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' TBird = class end;',
- ' TBear = class end;',
- ' generic TRec<T: TBird, TBear> = record end;',
- 'begin',
- '']);
- CheckResolverException('"TBird" constraint and "TBear" constraint cannot be specified together',
- nConstraintXAndConstraintYCannotBeTogether);
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintRecordExpectedFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' generic TBird<T:record> = record v: T; end;',
- 'var r: specialize TBird<word>;',
- 'begin',
- '']);
- CheckResolverException('record type expected, but Word found',
- nXExpectedButYFound);
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintClassRecordFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TRec = record end;',
- ' generic TBird<T:class> = record v: T; end;',
- 'var r: specialize TBird<TRec>;',
- 'begin',
- '']);
- CheckResolverException('class type expected, but TRec found',
- nXExpectedButYFound);
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintRecordClassFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T:record> = record v: T; end;',
- 'var r: specialize TBird<TObject>;',
- 'begin',
- '']);
- CheckResolverException('record type expected, but TObject found',
- nXExpectedButYFound);
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintArrayFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TArr = array of word;',
- ' generic TBird<T:TArr> = record v: T; end;',
- 'begin',
- '']);
- CheckResolverException('"array of Word" is not a valid constraint',
- nXIsNotAValidConstraint);
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintConstructor;
- begin
- StartProgram(true,[supTObject]);
- Add([
- '{$mode objfpc}',
- 'type',
- ' generic TBird<T:constructor> = class',
- ' o: T;',
- ' procedure Fly;',
- ' end;',
- ' TAnt = class end;',
- 'var a: specialize TBird<TAnt>;',
- 'procedure TBird.Fly;',
- 'begin',
- ' o:=T.Create;',
- 'end;',
- 'begin',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintUnit;
- begin
- AddModuleWithIntfImplSrc('unit1.pas',
- LinesToStr([
- 'type',
- ' TBird = class b1: word; end;',
- ' generic TAnt<T> = class a1: T; end;',
- '']),
- LinesToStr([
- '']));
- StartProgram(true,[supTObject]);
- Add([
- 'uses unit1;',
- 'type',
- ' generic TCat<T: unit1.TBird> = class v: T; end;',
- ' generic TFish<T: specialize TAnt<word>> = class v: T; end;',
- ' TEagle = class(unit1.TBird);',
- ' TRedAnt = specialize TAnt<word>;',
- 'var',
- ' eagle: TEagle;',
- ' redant: TRedAnt;',
- ' cat: specialize TCat<TEagle>;',
- ' fish: specialize TFish<TRedAnt>;',
- 'begin',
- ' cat.v:=eagle;',
- ' fish.v:=redant;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintSpecialize;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TAnt<S> = class m: S; end;',
- ' generic TBird<T:specialize TAnt<word>> = class',
- ' o: T;',
- ' end;',
- ' TFireAnt = class(specialize TAnt<word>) end;',
- 'var',
- ' a: specialize TBird<TFireAnt>;',
- ' f: TFireAnt;',
- 'begin',
- ' a.o:=f;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintTSpecializeWithT;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'type',
- ' TObject = class end;',
- ' TAnt<S> = class m: S; end;',
- ' TBird<X; Y: TAnt<X>> = class',
- ' Ant: Y;',
- ' end;',
- ' TEagle<X; Y:X> = class',
- ' e: Y;',
- ' end;',
- ' TFireAnt<F> = class(TAnt<F>) end;',
- ' TAntWord = TAnt<word>;',
- ' TBirdAntWord = TBird<word, TAnt<word>>;',
- 'var',
- ' a: TAnt<word>;',
- ' b: TBird<word, TAntWord>;',
- ' c: TBird<TBirdAntWord, TAnt<TBirdAntWord>>;',
- ' f: TEagle<TAnt<boolean>, TFireAnt<boolean>>;',
- ' fb: TFireAnt<boolean>;',
- 'begin',
- ' b.Ant:=a;',
- ' f.e:=fb;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintTSpecializeAsTFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- // Note: would work if generic T<S> exists
- ' generic TBird<T; U: specialize T<word>> = record v: T; end;',
- 'begin',
- '']);
- CheckResolverException('identifier not found "T<>"',nIdentifierNotFound);
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintTSpecializeWithTFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TAnt<S> = class v: S; end;',
- ' generic TBird<T: specialize TAnt<T>> = class v: T; end;',
- ' TEagle = specialize TBird<specialize TAnt<word>>;',
- 'begin',
- '']);
- CheckResolverException('identifier not found "T"',nIdentifierNotFound);
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintSameNameFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' T = TObject;',
- ' generic TAnt<T:T> = record v: word; end;',
- 'begin',
- '']);
- CheckResolverException(sTypeCycleFound,nTypeCycleFound);
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintInheritedMissingRecordFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T: record> = class v: T; end;',
- ' generic TEagle<U> = class(specialize TBird<U>)',
- ' end;',
- 'begin',
- '']);
- CheckResolverException('Type parameter "U" is missing constraint "record"',
- nTypeParamXIsMissingConstraintY);
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintInheritedMissingClassTypeFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' TAnt = class end;',
- ' generic TBird<T: TAnt> = class v: T; end;',
- ' generic TEagle<U> = class(specialize TBird<U>)',
- ' end;',
- 'begin',
- '']);
- CheckResolverException('Type parameter "U" is not compatible with type "TAnt"',
- nTypeParamXIsNotCompatibleWithY);
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintMultiParam;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' TAnt = class end;',
- ' generic TBird<S,T: TAnt> = class',
- ' x: S;',
- ' y: T;',
- ' end;',
- ' TRedAnt = class(TAnt) end;',
- ' TEagle = specialize TBird<TRedAnt,TAnt>;',
- 'begin',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintMultiParamClassMismatch;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' TAnt = class end;',
- ' TRedAnt = class(TAnt) end;',
- ' generic TBird<S,T: TRedAnt> = class',
- ' x: S;',
- ' y: T;',
- ' end;',
- ' TEagle = specialize TBird<TRedAnt,TAnt>;',
- 'begin',
- '']);
- CheckResolverException('Incompatible types: got "TAnt" expected "TRedAnt"',
- nIncompatibleTypesGotExpected);
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintClassType_DotIsAsTypeCast;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' TAnt = class',
- ' procedure Run; external; overload;',
- ' end;',
- ' TRedAnt = class(TAnt)',
- ' procedure Run(w: word); external; overload;',
- ' end;',
- ' generic TBird<T: TRedAnt> = class',
- ' y: T;',
- ' procedure Fly;',
- ' end;',
- ' TFireAnt = class(TRedAnt);',
- ' generic TEagle<U: TRedAnt> = class(specialize TBird<U>) end;',
- ' TRedEagle = specialize TEagle<TRedAnt>;',
- 'procedure TBird.Fly;',
- 'var f: TFireAnt;',
- 'begin',
- ' y.Run;',
- ' y.Run(3);',
- ' if y is TFireAnt then',
- ' f:=y as TFireAnt;',
- ' f:=TFireAnt(y);',
- ' y:=T(f);',
- 'end;',
- 'begin',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintClassType_ForInT;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TEnumerator<TItem> = class',
- ' FCurrent: TItem;',
- ' property Current: TItem read FCurrent;',
- ' function MoveNext: boolean;',
- ' end;',
- ' generic TAnt<U> = class',
- ' function GetEnumerator: specialize TEnumerator<U>;',
- ' end;',
- ' generic TBird<S; T: specialize TAnt<S>> = class',
- ' m: T;',
- ' procedure Fly;',
- ' end;',
- 'function TEnumerator.MoveNext: boolean;',
- 'begin',
- 'end;',
- 'function TAnt.GetEnumerator: specialize TEnumerator<U>;',
- 'begin',
- 'end;',
- 'procedure TBird.Fly;',
- 'var i: S;',
- 'begin',
- ' for i in m do ;',
- 'end;',
- 'var',
- ' a: specialize TAnt<word>;',
- ' w: word;',
- ' b: specialize TBird<word,specialize TAnt<word>>;',
- 'begin',
- ' for w in a do ;',
- ' for w in b.m do ;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ConstraintClassType_IsAs;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TAnt<U> = class',
- ' v: U;',
- ' function Run: U;',
- ' end;',
- 'function TAnt.Run: U;',
- 'var a: specialize TAnt<U>;',
- 'begin',
- ' if v is TObject then ;',
- ' if v is specialize TAnt<TObject> then',
- ' specialize TAnt<TObject>(v).v:=nil;',
- ' a:=v as specialize TAnt<U>;',
- ' if (v as specialize TAnt<TObject>).v=nil then ;',
- ' if nil=(v as specialize TAnt<TObject>).v then ;',
- 'end;',
- 'begin',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_RecordLocalNameDuplicateFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' generic TBird<T> = record T: word; end;',
- 'begin',
- '']);
- CheckResolverException('Duplicate identifier "T" at afile.pp(4,18)',
- nDuplicateIdentifier);
- end;
- procedure TTestResolveGenerics.TestGen_Record;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' {#Typ}T = word;',
- ' generic TRec<{#Templ}T> = record',
- ' {=Templ}v: T;',
- ' end;',
- 'var',
- ' r: specialize TRec<word>;',
- ' {=Typ}w: T;',
- 'begin',
- ' r.v:=w;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_RecordDelphi;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'type',
- ' {#Typ}T = word;',
- ' TRec<{#Templ}T> = record',
- ' {=Templ}v: T;',
- ' end;',
- 'var',
- ' r: TRec<word>;',
- ' {=Typ}w: T;',
- 'begin',
- ' r.v:=w;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_RecordNestedSpecialize_ClassRecord;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class v: T; end;',
- ' generic TFish<T:class> = record v: T; end;',
- 'var f: specialize TFish<specialize TBird<word>>;',
- 'begin',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_RecordNestedSpecialize_Self;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' generic TBird<T> = record v: T; end;',
- 'var',
- ' a: specialize TBird<specialize TBird<word>>;',
- 'begin',
- ' a.v.v:=3;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Record_SpecializeSelfInsideFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' generic TBird<T> = record',
- ' v: specialize TBird<word>;',
- ' end;',
- 'begin',
- '']);
- CheckResolverException('type "TBird<>" is not yet completely defined',
- nTypeXIsNotYetCompletelyDefined);
- end;
- procedure TTestResolveGenerics.TestGen_Record_ReferGenericSelfFail;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'Type',
- ' TBird<T> = record',
- ' b: TBird<T>;',
- ' end;',
- 'begin',
- '']);
- CheckResolverException('type "TBird<>" is not yet completely defined',
- nTypeXIsNotYetCompletelyDefined);
- end;
- procedure TTestResolveGenerics.TestGen_RecordAnoArray;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' generic TBird<T> = record v: T; end;',
- 'var',
- ' a: specialize TBird<array of word>;',
- ' b: specialize TBird<array of word>;',
- 'begin',
- ' a:=b;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Class;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' {#Typ}T = word;',
- ' generic TBird<{#Templ}T> = class',
- ' {=Templ}v: T;',
- ' end;',
- 'var',
- ' b: specialize TBird<word>;',
- ' {=Typ}w: T;',
- 'begin',
- ' b.v:=w;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ClassDelphi;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'type',
- ' TObject = class end;',
- ' {#Typ}T = word;',
- ' TBird<{#Templ}T> = class',
- ' {=Templ}v: T;',
- ' end;',
- 'var',
- ' b: TBird<word>;',
- ' {=Typ}w: T;',
- 'begin',
- ' b.v:=w;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ClassDelphi_TypeOverload;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'type',
- ' TObject = class end;',
- ' {#a}TBird = word;',
- ' {#b}TBird<T> = class',
- ' v: T;',
- ' end;',
- ' {=b}TEagle = TBird<word>;',
- 'var',
- ' b: {@b}TBird<word>;',
- ' {=a}w: TBird;',
- 'begin',
- ' b.v:=w;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ClassObjFPC;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class',
- ' v: TBird;',
- ' end;',
- 'var',
- ' b: specialize TBird<word>;',
- 'begin',
- ' b.v:=b;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ClassObjFPC_OverloadFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' TBird = word;',
- ' generic TBird<T> = class',
- ' v: T;',
- ' end;',
- 'begin',
- '']);
- CheckResolverException('Duplicate identifier "TBird" at afile.pp(5,8)',nDuplicateIdentifier);
- end;
- procedure TTestResolveGenerics.TestGen_ClassObjFPC_OverloadOtherUnit;
- begin
- AddModuleWithIntfImplSrc('unit1.pas',
- LinesToStr([
- 'type',
- ' TBird = class b1: word; end;',
- ' generic TAnt<T> = class a1: T; end;',
- '']),
- LinesToStr([
- '']));
- AddModuleWithIntfImplSrc('unit2.pas',
- LinesToStr([
- 'type',
- ' generic TBird<T> = class b2:T; end;',
- ' TAnt = class a2:word; end;',
- '']),
- LinesToStr([
- '']));
- StartProgram(true,[supTObject]);
- Add([
- 'uses unit1, unit2;',
- 'var',
- ' b1: TBird;',
- ' b2: specialize TBird<word>;',
- ' a1: specialize TAnt<word>;',
- ' a2: TAnt;',
- 'begin',
- ' b1.b1:=1;',
- ' b2.b2:=2;',
- ' a1.a1:=3;',
- ' a2.a2:=4;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ClassGenAncestorWithoutParamFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class end;',
- ' generic TEagle<T> = class(TBird)',
- ' end;',
- 'begin',
- '']);
- CheckResolverException('Generics without specialization cannot be used as a type for a variable',
- nGenericsWithoutSpecializationAsType);
- end;
- procedure TTestResolveGenerics.TestGen_ClassForward;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' {#Typ}T = word;',
- ' generic TBird<{#Templ_Forward}T> = class;',
- ' TRec = record',
- ' b: specialize TBird<T>;',
- ' end;',
- ' generic TBird<{#Templ}T> = class',
- ' {=Templ}v: T;',
- ' r: TRec;',
- ' end;',
- 'var',
- ' s: TRec;',
- ' {=Typ}w: T;',
- 'begin',
- ' s.b.v:=w;',
- ' s.b.r:=s;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ClassForwardConstraints;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' TAnt = class end;',
- ' generic TBird<T: class; U; V: TAnt> = class;',
- ' TRec = record',
- ' b: specialize TBird<TAnt,word,TAnt>;',
- ' end;',
- ' generic TBird<T: class; U; V: TAnt> = class',
- ' i: U;',
- ' r: TRec;',
- ' end;',
- 'var',
- ' s: TRec;',
- ' w: word;',
- 'begin',
- ' s.b.i:=w;',
- ' s.b.r:=s;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ClassForwardConstraintNameMismatch;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class;',
- ' generic TBird<U> = class',
- ' i: U;',
- ' end;',
- 'begin',
- '']);
- CheckResolverException('Declaration of "U" differs from previous declaration at afile.pp(5,18)',
- nDeclOfXDiffersFromPrevAtY);
- end;
- procedure TTestResolveGenerics.TestGen_ClassForwardConstraintKeywordMismatch;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T: class, constructor> = class;',
- ' generic TBird<U: class> = class',
- ' i: U;',
- ' end;',
- 'begin',
- '']);
- CheckResolverException('Declaration of "U" differs from previous declaration at afile.pp(5,18)',
- nDeclOfXDiffersFromPrevAtY);
- end;
- procedure TTestResolveGenerics.TestGen_ClassForwardConstraintTypeMismatch;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' TAnt = class end;',
- ' TFish = class end;',
- ' generic TBird<T: TAnt> = class;',
- ' generic TBird<T: TFish> = class',
- ' i: U;',
- ' end;',
- 'begin',
- '']);
- CheckResolverException('Declaration of "T" differs from previous declaration at afile.pp(7,18)',
- nDeclOfXDiffersFromPrevAtY);
- end;
- procedure TTestResolveGenerics.TestGen_ClassForward_Circle;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TAnt<T> = class;',
- ' generic TFish<U> = class',
- ' private type AliasU = U;',
- ' var a: specialize TAnt<AliasU>;',
- ' Size: AliasU;',
- ' end;',
- ' generic TAnt<T> = class',
- ' private type AliasT = T;',
- ' var f: specialize TFish<AliasT>;',
- ' Speed: AliasT;',
- ' end;',
- 'var',
- ' WordFish: specialize TFish<word>;',
- ' BoolAnt: specialize TAnt<boolean>;',
- ' w: word;',
- ' b: boolean;',
- 'begin',
- ' WordFish.Size:=w;',
- ' WordFish.a.Speed:=w;',
- ' WordFish.a.f.Size:=w;',
- ' BoolAnt.Speed:=b;',
- ' BoolAnt.f.Size:=b;',
- ' BoolAnt.f.a.Speed:=b;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Class_RedeclareInUnitImplFail;
- begin
- StartUnit(false);
- Add([
- 'interface',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class v: T; end;',
- 'implementation',
- 'type generic TBird<T> = record v: T; end;',
- '']);
- CheckResolverException('Duplicate identifier "TBird" at afile.pp(5,16)',
- nDuplicateIdentifier);
- end;
- procedure TTestResolveGenerics.TestGen_Class_TypeOverloadInUnitImpl;
- begin
- StartUnit(false);
- Add([
- 'interface',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class v: T; end;',
- 'implementation',
- 'type generic TBird<T,U> = record x: T; y: U; end;',
- '']);
- ParseUnit;
- end;
- procedure TTestResolveGenerics.TestGen_Class_MethodObjFPC;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' {#Typ}T = word;',
- ' generic TBird<{#Templ}T> = class',
- ' function Fly(p:T): T; virtual; abstract;',
- ' function Run(p:T): T;',
- ' procedure Jump(p:T);',
- ' class procedure Go(p:T);',
- ' end;',
- 'function TBird.Run(p:T): T;',
- 'begin',
- 'end;',
- 'generic procedure TBird<T>.Jump(p:T);',
- 'begin',
- 'end;',
- 'generic class procedure TBird<T>.Go(p:T);',
- 'begin',
- 'end;',
- 'var',
- ' b: specialize TBird<word>;',
- ' {=Typ}w: T;',
- 'begin',
- ' w:=b.Fly(w);',
- ' w:=b.Run(w);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Class_MethodOverride;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class',
- ' function Fly(p:T): T; virtual; abstract;',
- ' end;',
- ' generic TEagle<S> = class(specialize TBird<S>)',
- ' function Fly(p:S): S; override;',
- ' end;',
- 'function TEagle.Fly(p:S): S;',
- 'begin',
- 'end;',
- 'var',
- ' e: specialize TEagle<word>;',
- ' w: word;',
- 'begin',
- ' w:=e.Fly(w);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Class_MethodDelphi;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'type',
- ' TObject = class end;',
- ' {#Typ}T = word;',
- ' TBird<{#Templ}T> = class',
- ' function Fly(p:T): T; virtual; abstract;',
- ' function Run(p:T): T;',
- ' end;',
- 'function TBird<T>.Run(p:T): T;',
- 'begin',
- 'end;',
- 'var',
- ' b: TBird<word>;',
- ' {=Typ}w: T;',
- 'begin',
- ' w:=b.Fly(w);',
- ' w:=b.Run(w);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Class_MethodDelphiTypeParamMissing;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'type',
- ' TObject = class end;',
- ' TBird<T> = class',
- ' function Run(p:T): T;',
- ' end;',
- 'function TBird.Run(p:T): T;',
- 'begin',
- 'end;',
- 'begin',
- '']);
- CheckResolverException('TBird<> expected, but TBird found',nXExpectedButYFound);
- end;
- procedure TTestResolveGenerics.TestGen_Class_MethodImplConstraintFail;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'type',
- ' TObject = class end;',
- ' TBird<T: record> = class',
- ' function Run(p:T): T;',
- ' end;',
- 'function TBird<T: record>.Run(p:T): T;',
- 'begin',
- 'end;',
- 'begin',
- '']);
- CheckResolverException('illegal qualifier ":" after "T"',nIllegalQualifierAfter);
- end;
- procedure TTestResolveGenerics.TestGen_Class_MethodImplTypeParamNameMismatch;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'type',
- ' TObject = class end;',
- ' TBird<T> = class',
- ' procedure DoIt;',
- ' end;',
- 'procedure TBird<S>.DoIt;',
- 'begin',
- 'end;',
- 'begin',
- '']);
- CheckResolverException('T expected, but S found',nXExpectedButYFound);
- end;
- procedure TTestResolveGenerics.TestGen_Class_SpecializeSelfInside;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class',
- ' e: T;',
- ' v: specialize TBird<boolean>;',
- ' end;',
- 'var',
- ' b: specialize TBird<word>;',
- ' w: word;',
- 'begin',
- ' b.e:=w;',
- ' if b.v.e then ;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Class_AncestorTFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' TBird = class end;',
- ' generic TFish<T: TBird> = class(T)',
- ' v: T;',
- ' end;',
- 'begin',
- '']);
- CheckResolverException('class type expected, but T found',nXExpectedButYFound);
- end;
- procedure TTestResolveGenerics.TestGen_Class_GenAncestor;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class',
- ' i: T;',
- ' end;',
- ' generic TEagle<T> = class(specialize TBird<T>)',
- ' j: T;',
- ' end;',
- 'var',
- ' e: specialize TEagle<word>;',
- 'begin',
- ' e.i:=e.j;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Class_AncestorSelfFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class(specialize TBird<word>)',
- ' e: T;',
- ' end;',
- 'var',
- ' b: specialize TBird<word>;',
- 'begin',
- '']);
- CheckResolverException('type "TBird<>" is not yet completely defined',nTypeXIsNotYetCompletelyDefined);
- end;
- procedure TTestResolveGenerics.TestGen_ClassOfSpecializeFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class',
- ' e: T;',
- ' end;',
- ' TBirdClass = class of specialize TBird<word>;',
- 'begin',
- '']);
- CheckParserException('Expected "Identifier" at token "specialize" in file afile.pp at line 8 column 25',nParserExpectTokenError);
- end;
- procedure TTestResolveGenerics.TestGen_Class_NestedType;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class',
- ' public type',
- ' TArrayEvent = reference to procedure(El: T);',
- ' public',
- ' p: TArrayEvent;',
- ' end;',
- ' TBirdWord = specialize TBird<word>;',
- 'var',
- ' b: TBirdWord;',
- 'begin',
- ' b.p:=procedure(El: word) begin end;']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Class_NestedRecord;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- '{$modeswitch advancedrecords}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class',
- ' public type TWing = record',
- ' s: T;',
- ' function GetIt: T;',
- ' end;',
- ' public',
- ' w: TWing;',
- ' end;',
- ' TBirdWord = specialize TBird<word>;',
- 'function TBird.TWing.GetIt: T;',
- 'begin',
- 'end;',
- 'var',
- ' b: TBirdWord;',
- ' i: word;',
- 'begin',
- ' b.w.s:=i;',
- ' i:=b.w.GetIt;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Class_NestedClass;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class',
- ' public type TWing = class',
- ' s: T;',
- ' function GetIt: T;',
- ' end;',
- ' public',
- ' w: TWing;',
- ' end;',
- ' TBirdWord = specialize TBird<word>;',
- 'function TBird.TWing.GetIt: T;',
- 'begin',
- 'end;',
- 'var',
- ' b: TBirdWord;',
- ' i: word;',
- 'begin',
- ' b.w.s:=3;',
- ' i:=b.w.GetIt;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Class_Enums_NotPropagating;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class',
- ' public type',
- ' TEnum = (red, blue);',
- ' const',
- ' e = blue;',
- ' end;',
- 'const',
- ' r = red;',
- 'begin']);
- CheckResolverException('identifier not found "red"',nIdentifierNotFound);
- end;
- procedure TTestResolveGenerics.TestGen_Class_Self;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class',
- ' end;',
- ' generic TAnimal<T> = class end;',
- ' generic TBird<T> = class(specialize TAnimal<T>)',
- ' function GetObj: TObject;',
- ' procedure Fly(Obj: TObject); virtual; abstract;',
- ' end;',
- ' TProc = procedure(Obj: TObject) of object;',
- ' TWordBird = specialize TBird<word>;',
- 'function TBird.GetObj: TObject;',
- 'var p: TProc;',
- 'begin',
- ' Result:=Self;',
- ' if Self.GetObj=Result then ;',
- ' Fly(Self);',
- ' p:=@Fly;',
- ' p(Self);',
- 'end;',
- 'begin']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Class_MemberTypeConstructor;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'type',
- ' TObject = class end;',
- ' TAnimal<A> = class',
- ' end;',
- ' TAnt<L> = class',
- ' constructor Create(A: TAnimal<L>);',
- ' end;',
- ' TBird<T> = class(TAnimal<T>)',
- ' type TMyAnt = TAnt<T>;',
- ' function Fly: TMyAnt;',
- ' end;',
- ' TWordBird = TBird<word>;',
- 'constructor TAnt<L>.Create(A: TAnimal<L>);',
- 'begin',
- 'end;',
- 'function TBird<T>.Fly: TMyAnt;',
- 'begin',
- ' Result:=TMyAnt.Create(Self);',
- 'end;',
- 'begin']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Class_AliasMemberType;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- '{$modeswitch externalclass}',
- 'type',
- ' TObject = class end;',
- '',
- ' generic TBird<T> = class',
- ' public type',
- ' TRun = reference to function (aValue : T) : T;',
- ' end;',
- ' TBirdWord = specialize TBird<Word>;',
- ' TBirdWordRun = TBirdWord.TRun;',
- '',
- ' generic TExt<T> = class external name ''Ext''',
- ' public type',
- ' TRun = reference to function (aValue : T) : T;',
- ' end;',
- ' TExtWord = specialize TExt<Word>;',
- ' TExtWordRun = TExtWord.TRun;',
- 'begin',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Class_AccessGenericMemberTypeFail;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- '',
- ' generic TBird<T> = class',
- ' public type',
- ' TRun = reference to function (aValue : T) : T;',
- ' end;',
- ' TBirdRun = TBird.TRun;',
- 'begin',
- '']);
- CheckResolverException('Generics without specialization cannot be used as a type for a reference',
- nGenericsWithoutSpecializationAsType);
- end;
- procedure TTestResolveGenerics.TestGen_Class_ReferenceTo;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TGJSPromise<T> = class',
- ' public type',
- ' TGJSPromiseResolver = reference to function (aValue : T) : T;',
- ' TGJSPromiseExecutor = reference to procedure (resolve,reject : TGJSPromiseResolver);',
- ' public',
- ' constructor new(Executor : TGJSPromiseExecutor);',
- ' end;',
- 'constructor TGJSPromise.new(Executor : TGJSPromiseExecutor);',
- 'begin',
- 'end;',
- '',
- 'type',
- ' TJSPromise = specialize TGJSPromise<Word>;',
- ' TJSPromiseResolver = reference to function (aValue : Word) : Word;',
- '',
- ' TURLLoader = Class(TObject)',
- ' procedure dofetch(resolve, reject: TJSPromiseResolver); virtual; abstract;',
- ' Function fetch : TJSPromise;',
- ' end;',
- 'function TURLLoader.fetch : TJSPromise;',
- 'begin',
- ' Result:=TJSPromise.New(@Dofetch);',
- 'end;',
- 'begin',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Class_TwoSpecsAreNotRelatedWarn;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'type',
- ' TObject = class end;',
- ' TBird<T> = class F: T; end;',
- ' TBirdWord = TBird<Word>;',
- ' TBirdChar = TBird<Char>;',
- 'var',
- ' w: TBirdWord;',
- ' c: TBirdChar;',
- 'begin',
- ' w:=TBirdWord(c);',
- '']);
- ParseProgram;
- CheckResolverHint(mtWarning,nClassTypesAreNotRelatedXY,'Class types "TBird<System.Char>" and "TBird<System.Word>" are not related');
- end;
- procedure TTestResolveGenerics.TestGen_Class_List;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TList<T> = class',
- ' strict private',
- ' FItems: array of T;',
- ' function GetItems(Index: longint): T;',
- ' procedure SetItems(Index: longint; Value: T);',
- ' public',
- ' procedure Alter(w: T);',
- ' property Items[Index: longint]: T read GetItems write SetItems; default;',
- ' end;',
- ' TWordList = specialize TList<word>;',
- 'function TList.GetItems(Index: longint): T;',
- 'begin',
- ' Result:=FItems[Index];',
- 'end;',
- 'procedure TList.SetItems(Index: longint; Value: T);',
- 'begin',
- ' FItems[Index]:=Value;',
- 'end;',
- 'procedure TList.Alter(w: T);',
- 'begin',
- ' SetLength(FItems,length(FItems)+1);',
- ' Insert(w,FItems,2);',
- ' Delete(FItems,2,3);',
- 'end;',
- 'var l: TWordList;',
- ' w: word;',
- 'begin',
- ' l[1]:=w;',
- ' w:=l[2];']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Class_Typecast;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'type',
- ' TObject = class end;',
- ' TList<T> = class',
- ' end;',
- ' TEagle = class;',
- ' TBird = class',
- ' FLegs: TList<TBird>;',
- ' property Legs: TList<TBird> read FLegs write FLegs;',
- ' end;',
- ' TEagle = class(TBird)',
- ' end;',
- 'var',
- ' B: TBird;',
- ' List: TList<TEagle>;',
- 'begin',
- ' List:=TList<TEagle>(B.Legs);',
- ' TList<TEagle>(B.Legs):=List;',
- '',
- '']);
- ParseProgram;
- // FPC/pas2js: Class types "TList<afile.TBird>" and "TList<afile.TEagle>" are not related
- // Delphi: no warning
- end;
- procedure TTestResolveGenerics.TestGen_ExtClass_Array;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- '{$ModeSwitch externalclass}',
- 'type',
- ' NativeInt = longint;',
- ' TJSGenArray<T> = Class external name ''Array''',
- ' private',
- ' function GetElements(Index: NativeInt): T; external name ''[]'';',
- ' procedure SetElements(Index: NativeInt; const AValue: T); external name ''[]'';',
- ' public',
- ' type TSelfType = TJSGenArray<T>;',
- ' TArrayEvent = reference to function(El: T; Arr: TSelfType): Boolean;',
- ' TArrayCallback = TArrayEvent;',
- ' public',
- ' FLength : NativeInt; external name ''length'';',
- ' constructor new; overload;',
- ' constructor new(aLength : NativeInt); overload;',
- ' class function _of() : TSelfType; varargs; external name ''of'';',
- ' function every(const aCallback: TArrayCallBack): boolean; overload;',
- ' function fill(aValue : T) : TSelfType; overload;',
- ' function fill(aValue : T; aStartIndex : NativeInt) : TSelfType; overload;',
- ' function fill(aValue : T; aStartIndex,aEndIndex : NativeInt) : TSelfType; overload;',
- ' property Length : NativeInt Read FLength Write FLength;',
- ' property Elements[Index: NativeInt]: T read GetElements write SetElements; default;',
- ' end;',
- ' TJSWordArray = TJSGenArray<word>;',
- 'var',
- ' wa: TJSWordArray;',
- ' w: word;',
- 'begin',
- ' wa:=TJSWordArray.new;',
- ' wa:=TJSWordArray.new(3);',
- ' wa:=TJSWordArray._of(4,5);',
- ' wa:=wa.fill(7);',
- ' wa:=wa.fill(7,8,9);',
- ' w:=wa.length;',
- ' wa.length:=10;',
- ' wa[11]:=w;',
- ' w:=wa[12];',
- ' wa.every(function(El: word; Arr: TJSWordArray): Boolean',
- ' begin',
- ' end',
- ' );',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ExtClass_VarargsOfType;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- '{$modeswitch externalclass}',
- 'type',
- ' TJSObject = class external name ''Object''',
- ' end;',
- ' generic TGJSSet<T> = class external name ''Set''',
- ' constructor new(aElement1: T); varargs of T; overload;',
- ' function bind(thisArg: TJSObject): T; varargs of T;',
- ' end;',
- ' TJSWordSet = specialize TGJSSet<word>;',
- 'var',
- ' s: TJSWordSet;',
- ' w: word;',
- 'begin',
- ' s:=TJSWordSet.new(3);',
- ' s:=TJSWordSet.new(3,5);',
- ' w:=s.bind(nil);',
- ' w:=s.bind(nil,6);',
- ' w:=s.bind(nil,7,8);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ClassInterface;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' {$interfaces corba}',
- ' generic ICorbaIntf<T> = interface',
- ' procedure Fly(a: T);',
- ' end;',
- ' {$interfaces com}',
- ' IUnknown = interface',
- ' end;',
- ' IInterface = IUnknown;',
- ' generic IComIntf<T> = interface',
- ' procedure Run(b: T);',
- ' end;',
- 'begin']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ClassInterface_Method;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' {$interfaces corba}',
- ' generic IBird<T> = interface',
- ' procedure Fly(a: T);',
- ' end;',
- ' TObject = class end;',
- ' generic TBird<U> = class(specialize IBird<U>)',
- ' procedure Fly(a: U);',
- ' end;',
- 'procedure TBird.Fly(a: U);',
- 'begin',
- 'end;',
- 'var b: specialize IBird<word>;',
- 'begin',
- ' b.Fly(3);']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_DynArray;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' generic TArray<T> = array of T;',
- ' TWordArray = specialize TArray<word>;',
- 'var',
- ' a: specialize TArray<word>;',
- ' b: TWordArray;',
- ' w: word;',
- 'begin',
- ' a[1]:=2;',
- ' b[2]:=a[3]+b[4];',
- ' a:=b;',
- ' b:=a;',
- ' SetLength(a,5);',
- ' SetLength(b,6);',
- ' w:=length(a)+low(a)+high(a);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_StaticArray;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' generic TBird<T> = array[T] of word;',
- ' TByteBird = specialize TBird<byte>;',
- 'var',
- ' a: specialize TBird<byte>;',
- ' b: TByteBird;',
- ' i: byte;',
- 'begin',
- ' a[1]:=2;',
- ' b[2]:=a[3]+b[4];',
- ' a:=b;',
- ' b:=a;',
- ' i:=low(a);',
- ' i:=high(a);',
- ' for i in a do ;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Array_Anoynmous;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' generic TRec<T> = record',
- ' a: array of T;',
- ' end;',
- ' TWordRec = specialize TRec<word>;',
- 'var',
- ' a: specialize TRec<word>;',
- ' b: TWordRec;',
- ' w: word;',
- 'begin',
- ' a:=b;',
- ' a.a:=b.a;',
- ' a.a[1]:=2;',
- ' b.a[2]:=a.a[3]+b.a[4];',
- ' b:=a;',
- ' SetLength(a.a,5);',
- ' SetLength(b.a,6);',
- ' w:=length(a.a)+low(a.a)+high(a.a);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ProcType;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' generic TFunc<T> = function(v: T): T;',
- ' TWordFunc = specialize TFunc<word>;',
- 'function GetIt(w: word): word;',
- 'begin',
- 'end;',
- 'var',
- ' a: specialize TFunc<word>;',
- ' b: TWordFunc;',
- ' w: word;',
- 'begin',
- ' a:=nil;',
- ' b:=nil;',
- ' a:=b;',
- ' b:=a;',
- ' w:=a(w);',
- ' w:=b(w);',
- ' a:=@GetIt;',
- ' b:=@GetIt;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_ProcType_AnonymousFunc_Delphi;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'type',
- ' TObject = class',
- ' end;',
- ' IInterface = interface',
- ' end;',
- ' Integer = longint;',
- ' IComparer<T> = interface',
- ' function Compare(const Left, Right: T): Integer; overload;',
- ' end;',
- ' TOnComparison<T> = function(const Left, Right: T): Integer of object;',
- ' TComparisonFunc<T> = reference to function(const Left, Right: T): Integer;',
- ' TComparer<T> = class(TObject, IComparer<T>)',
- ' public',
- ' function Compare(const Left, Right: T): Integer; overload;',
- ' class function Construct(const AComparison: TOnComparison<T>): IComparer<T>; overload;',
- ' class function Construct(const AComparison: TComparisonFunc<T>): IComparer<T>; overload;',
- ' end;',
- 'function TComparer<T>.Compare(const Left, Right: T): Integer; overload;',
- 'begin',
- 'end;',
- 'class function TComparer<T>.Construct(const AComparison: TOnComparison<T>): IComparer<T>;',
- 'begin',
- 'end;',
- 'class function TComparer<T>.Construct(const AComparison: TComparisonFunc<T>): IComparer<T>;',
- 'begin',
- 'end;',
- 'procedure Test;',
- 'var',
- ' aComparer : IComparer<Integer>;',
- 'begin',
- ' aComparer:=TComparer<Integer>.Construct(function (Const a,b : integer) : integer',
- ' begin',
- ' Result:=a-b;',
- ' end);',
- 'end;',
- 'begin',
- ' Test;']);
- ParseModule;
- end;
- procedure TTestResolveGenerics.TestGen_PointerDirectSpecializeFail;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' generic TRec<T> = record v: T; end;',
- ' PRec = ^specialize TRec<word>;',
- 'begin',
- '']);
- CheckParserException('Expected "Identifier or file"',nParserExpectTokenError);
- end;
- procedure TTestResolveGenerics.TestGen_HelperForArray;
- begin
- StartProgram(false);
- Add([
- '{$ModeSwitch typehelpers}',
- 'type',
- ' generic TArr<T> = array[1..2] of T;',
- ' TWordArrHelper = type helper for specialize TArr<word>',
- ' procedure Fly(w: word);',
- ' end;',
- 'procedure TWordArrHelper.Fly(w: word);',
- 'begin',
- 'end;',
- 'var',
- ' a: specialize TArr<word>;',
- 'begin',
- ' a.Fly(3);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_LocalVar;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<{#Templ}T> = class',
- ' function Fly(p:T): T;',
- ' end;',
- 'function TBird.Fly(p:T): T;',
- 'var l: T;',
- 'begin',
- ' l:=p;',
- ' p:=l;',
- ' Result:=p;',
- ' Result:=l;',
- ' l:=Result;',
- 'end;',
- 'var',
- ' b: specialize TBird<word>;',
- ' w: word;',
- 'begin',
- ' w:=b.Fly(w);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Statements;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<{#Templ}T> = class',
- ' function Fly(p:T): T;',
- ' end;',
- 'function TBird.Fly(p:T): T;',
- 'var',
- ' v1,v2,v3:T;',
- 'begin',
- ' v1:=1;',
- ' v2:=v1+v1*v1+v1 div p;',
- ' v3:=-v1;',
- ' repeat',
- ' v1:=v1+1;',
- ' until v1>=5;',
- ' while v1>=0 do',
- ' v1:=v1-v2;',
- ' for v1:=v2 to v3 do v2:=v1;',
- ' if v1<v2 then v3:=v1 else v3:=v2;',
- ' if v1<v2 then else ;',
- ' case v1 of',
- ' 1: v3:=3;',
- ' end;',
- 'end;',
- 'var',
- ' b: specialize TBird<word>;',
- 'begin',
- ' b.Fly(2);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_InlineSpecializeExpr;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class',
- ' constructor Create;',
- ' end;',
- ' generic TAnt<U> = class',
- ' constructor Create;',
- ' end;',
- 'constructor TBird.Create;',
- 'var',
- ' a: specialize TAnt<T>;',
- ' b: specialize TAnt<word>;',
- 'begin',
- ' a:=specialize TAnt<T>.create;',
- ' b:=specialize TAnt<word>.create;',
- 'end;',
- 'constructor TAnt.Create;',
- 'var',
- ' i: specialize TBird<U>;',
- ' j: specialize TBird<word>;',
- ' k: specialize TAnt<U>;',
- 'begin',
- ' i:=specialize TBird<U>.create;',
- ' j:=specialize TBird<word>.create;',
- ' k:=specialize TAnt<U>.create;',
- 'end;',
- 'var a: specialize TAnt<word>;',
- 'begin',
- ' a:=specialize TAnt<word>.create;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_TryExcept;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<{#Templ}T> = class',
- ' function Fly(p:T): T;',
- ' end;',
- ' Exception = class',
- ' end;',
- ' generic EMsg<T> = class',
- ' Msg: T;',
- ' end;',
- 'function TBird.Fly(p:T): T;',
- 'var',
- ' v1,v2,v3:T;',
- 'begin',
- ' try',
- ' finally',
- ' end;',
- ' try',
- ' v1:=v2;',
- ' finally',
- ' v2:=v1;',
- ' end;',
- ' try',
- ' except',
- ' on Exception do ;',
- ' on E: Exception do ;',
- ' on E: specialize EMsg<boolean> do E.Msg:=true;',
- ' on E: specialize EMsg<T> do E.Msg:=1;',
- ' end;',
- 'end;',
- 'var',
- ' b: specialize TBird<word>;',
- 'begin',
- ' b.Fly(2);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_Call;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class',
- ' function Fly(p:T): T;',
- ' end;',
- 'procedure Run(b: boolean); overload;',
- 'begin end;',
- 'procedure Run(w: word); overload;',
- 'begin end;',
- 'function TBird.Fly(p:T): T;',
- 'begin',
- ' Run(p);',
- ' Run(Result);',
- 'end;',
- 'var',
- ' w: specialize TBird<word>;',
- ' b: specialize TBird<boolean>;',
- 'begin',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGen_NestedProc;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- 'type',
- ' TObject = class end;',
- ' generic TBird<T> = class',
- ' function Fly(p:T): T;',
- ' end;',
- 'function TBird.Fly(p:T): T;',
- ' function Run: T;',
- ' begin',
- ' Fly:=Result;',
- ' end;',
- 'begin',
- ' Run;',
- 'end;',
- 'var',
- ' w: specialize TBird<word>;',
- ' b: specialize TBird<boolean>;',
- 'begin',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_Function;
- begin
- StartProgram(false);
- Add([
- 'generic function DoIt<T>(a: T): T;',
- 'var i: T;',
- 'begin',
- ' a:=i;',
- ' Result:=a;',
- 'end;',
- 'var w: word;',
- 'begin',
- ' w:=specialize DoIt<word>(3);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_FunctionDelphi;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'function DoIt<T>(a: T): T;',
- 'var i: T;',
- 'begin',
- ' a:=i;',
- ' Result:=a;',
- 'end;',
- 'var w: word;',
- 'begin',
- ' w:=DoIt<word>(3);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_OverloadDuplicate;
- begin
- StartProgram(false);
- Add([
- 'generic procedure Fly<T>(a: T);',
- 'begin',
- 'end;',
- 'generic procedure Fly<T>(a: T);',
- 'begin',
- 'end;',
- 'begin',
- '']);
- CheckResolverException('Duplicate identifier "Fly" at afile.pp(2,22)',nDuplicateIdentifier);
- end;
- procedure TTestResolveGenerics.TestGenProc_MissingTemplatesFail;
- begin
- StartProgram(false);
- Add([
- 'generic procedure Run;',
- 'begin',
- 'end;',
- 'begin',
- '']);
- CheckParserException('Expected "<"',nParserExpectTokenError);
- end;
- procedure TTestResolveGenerics.TestGenProc_SpecializeNonGenericFail;
- begin
- StartProgram(false);
- Add([
- 'procedure Run;',
- 'begin',
- 'end;',
- 'begin',
- ' specialize Run<word>();',
- '']);
- CheckResolverException('Run expected, but Run<> found',nXExpectedButYFound);
- end;
- procedure TTestResolveGenerics.TestGenProc_Forward;
- begin
- StartProgram(false);
- Add([
- 'generic procedure Fly<T>(a: T); forward;',
- 'procedure Run;',
- 'begin',
- ' specialize Fly<word>(3);',
- 'end;',
- 'generic procedure Fly<T>(a: T);',
- 'var i: T;',
- 'begin',
- ' i:=a;',
- 'end;',
- 'begin',
- ' specialize Fly<boolean>(true);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_External;
- begin
- StartProgram(false);
- Add([
- 'generic function Fly<T>(a: T): T; external name ''flap'';',
- 'procedure Run;',
- 'begin',
- ' specialize Fly<word>(3);',
- 'end;',
- 'begin',
- ' specialize Fly<boolean>(true);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_UnitIntf;
- begin
- AddModuleWithIntfImplSrc('unit2.pas',
- LinesToStr([
- 'generic function Fly<T>(a: T): T;',
- '']),
- LinesToStr([
- 'generic function Fly<T>(a: T): T;',
- 'var i: T;',
- 'begin',
- ' i:=a;',
- 'end;',
- '']));
- StartProgram(true);
- Add([
- 'uses unit2;',
- 'var w: word;',
- 'begin',
- ' w:=specialize Fly<word>(3);',
- ' if specialize Fly<boolean>(false) then ;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_BackRef1Fail;
- begin
- StartProgram(false);
- Add([
- 'generic function Fly<T>(a: Fly): T;',
- 'begin',
- 'end;',
- 'begin',
- '']);
- CheckResolverException('Wrong number of parameters specified for call to "function Fly<>(untyped)"',nWrongNumberOfParametersForCallTo);
- end;
- procedure TTestResolveGenerics.TestGenProc_BackRef2Fail;
- begin
- StartProgram(false);
- Add([
- 'generic function Fly<T>(a: Fly<word>): T;',
- 'begin',
- 'end;',
- 'begin',
- '']);
- CheckResolverException('Wrong number of parameters specified for call to "function Fly<>(untyped)"',nWrongNumberOfParametersForCallTo);
- end;
- procedure TTestResolveGenerics.TestGenProc_BackRef3Fail;
- begin
- StartProgram(false);
- Add([
- 'generic function Fly<T>(a: Fly<T>): T;',
- 'begin',
- 'end;',
- 'begin',
- '']);
- CheckResolverException('Wrong number of parameters specified for call to "function Fly<>(untyped)"',nWrongNumberOfParametersForCallTo);
- end;
- procedure TTestResolveGenerics.TestGenProc_CallSelf;
- begin
- StartProgram(false);
- Add([
- 'generic function Fly<T>(a: T): T;',
- ' procedure Run;',
- ' begin',
- ' specialize Fly<T>(a);',
- ' specialize Fly<word>(3);',
- ' end;',
- 'begin',
- ' specialize Fly<T>(a);',
- ' specialize Fly<boolean>(true);',
- 'end;',
- 'begin',
- ' specialize Fly<string>(''fast'');',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_CallSelfNoParams;
- begin
- StartProgram(false);
- Add([
- 'generic function Fly<T>(a: T = 0): T;',
- ' procedure Run;',
- ' begin',
- ' specialize Fly<T>;',
- ' specialize Fly<word>;',
- ' end;',
- 'begin',
- ' specialize Fly<T>;',
- ' specialize Fly<byte>;',
- 'end;',
- 'begin',
- ' specialize Fly<shortint>;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_ForwardConstraints;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' TObject = class end;',
- ' TBird = class end;',
- 'var b: TBird;',
- 'generic function Fly<T: class>(a: T): T; forward;',
- 'procedure Run;',
- 'begin',
- ' specialize Fly<TBird>(b);',
- 'end;',
- 'generic function Fly<T>(a: T): T;',
- 'begin',
- 'end;',
- 'begin',
- ' specialize Fly<TBird>(b);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_ForwardConstraintsRepeatFail;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' TObject = class end;',
- 'generic function Fly<T: class>(a: T): T; forward;',
- 'generic function Fly<T: class>(a: T): T;',
- 'begin',
- 'end;',
- 'begin',
- '']);
- CheckResolverException(sImplMustNotRepeatConstraints,nImplMustNotRepeatConstraints);
- end;
- procedure TTestResolveGenerics.TestGenProc_ForwardTempNameMismatch;
- begin
- StartProgram(false);
- Add([
- 'generic function Fly<T>(a: T): T; forward;',
- 'generic function Fly<B>(a: B): B;',
- 'begin',
- 'end;',
- 'begin',
- '']);
- CheckResolverException('Declaration of "Fly<B>" differs from previous declaration at afile.pp(2,23)',
- nDeclOfXDiffersFromPrevAtY);
- end;
- procedure TTestResolveGenerics.TestGenProc_ForwardOverload;
- begin
- StartProgram(false);
- Add([
- 'generic function {#FlyA}Fly<T>(a: T; b: boolean): T; forward; overload;',
- 'generic function {#FlyB}Fly<T>(a: T; w: word): T; forward; overload;',
- 'procedure {#FlyC}Fly; overload;',
- 'begin',
- ' specialize {@FlyA}Fly<longint>(1,true);',
- ' specialize {@FlyB}Fly<string>(''ABC'',3);',
- 'end;',
- 'generic function Fly<T>(a: T; b: boolean): T;',
- 'begin',
- 'end;',
- 'generic function Fly<T>(a: T; w: word): T;',
- 'begin',
- 'end;',
- 'begin',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_NestedFail;
- begin
- StartProgram(false);
- Add([
- 'procedure Fly;',
- ' generic procedure Run<T>(a: T);',
- ' begin',
- ' end;',
- 'begin',
- ' Run<boolean>(true);',
- 'end;',
- 'begin',
- '']);
- CheckResolverException('Type parameters not allowed on nested procedure',nTypeParamsNotAllowedOnX);
- end;
- procedure TTestResolveGenerics.TestGenProc_TypeParamCntOverload;
- begin
- StartProgram(false);
- Add([
- 'generic procedure {#A}Run<T>(a: T);',
- 'begin',
- 'end;',
- 'generic procedure {#B}Run<M,N>(a: M);',
- 'begin',
- ' specialize {@A}Run<M>(a);',
- ' specialize {@B}Run<double,char>(1.3);',
- 'end;',
- 'begin',
- ' specialize {@A}Run<word>(3);',
- ' specialize {@B}Run<word,char>(4);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_TypeParamCntOverloadNoParams;
- begin
- StartProgram(false);
- Add([
- 'generic procedure {#A}Run<T>;',
- 'begin',
- 'end;',
- 'generic procedure {#B}Run<M,N>;',
- 'begin',
- ' specialize {@A}Run<M>;',
- ' specialize {@A}Run<M>();',
- ' specialize {@B}Run<double,char>;',
- ' specialize {@B}Run<double,char>();',
- 'end;',
- 'begin',
- ' specialize {@A}Run<word>;',
- ' specialize {@A}Run<word>();',
- ' specialize {@B}Run<word,char>;',
- ' specialize {@B}Run<word,char>();',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_TypeParamWithDefaultParamDelphiFail;
- begin
- // delphi 10.3 does not allow default values for args with generic types
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'procedure {#A}Run<T>(a: T = 0); overload;',
- 'begin',
- 'end;',
- 'begin',
- '']);
- CheckResolverException(sParamOfThisTypeCannotHaveDefVal,nParamOfThisTypeCannotHaveDefVal);
- end;
- procedure TTestResolveGenerics.TestGenProc_ParamSpecWithT;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'type',
- ' TObject = class end;',
- ' TBird<T> = class v: T; end;',
- ' TAnt = class',
- ' procedure Func<T: class>(Bird: TBird<T>);',
- ' end;',
- 'procedure TAnt.Func<T>(Bird: TBird<T>);',
- 'begin',
- 'end;',
- 'var',
- ' Ant: TAnt;',
- ' Bird: TBird<TObject>;',
- ' BirdOfBird: TBird<TBird<TObject>>;',
- 'begin',
- ' Ant.Func<TObject>(Bird);',
- ' Ant.Func<TBird<TObject>>(BirdOfBird);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_Infer_NeedExplicitFail;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'function {#A}Run<S,T>(a: S): T; overload;',
- 'begin',
- 'end;',
- 'begin',
- ' {@A}Run(1);',
- '']);
- CheckResolverException('Could not infer generic type argument "T" for method "Run"',
- nCouldNotInferTypeArgXForMethodY);
- end;
- procedure TTestResolveGenerics.TestGenProc_Infer_Overload;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'procedure {#A}Run<S>(a: S; b: boolean); overload;',
- 'begin',
- 'end;',
- 'procedure {#B}Run<T>(a: T; w: word); overload;',
- 'begin',
- 'end;',
- 'procedure {#C}Run<U>(a: U; b: U); overload;',
- 'begin',
- 'end;',
- 'begin',
- ' {@A}Run(1,true);', // non generic take precedence
- ' {@B}Run(2,word(3));', // non generic take precedence
- ' {@C}Run(''foo'',''bar'');',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_Infer_OverloadForward;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'procedure {#A}Run<S>(a: S; b: boolean); forward; overload;',
- 'procedure {#B}Run<T>(a: T; w: word); forward; overload;',
- 'procedure {#C}Run<U>(a: U; b: U); forward; overload;',
- 'procedure {#A2}Run<S>(a: S; b: boolean); overload;',
- 'begin',
- ' {@A}Run(1,true);', // non generic take precedence
- ' {@B}Run(2,word(3));', // non generic take precedence
- ' {@C}Run(''foo'',''bar'');',
- 'end;',
- 'procedure {#B2}Run<T>(a: T; w: word); overload;',
- 'begin',
- 'end;',
- 'procedure {#C2}Run<U>(a: U; b: U); overload;',
- 'begin',
- 'end;',
- 'begin',
- ' {@A}Run(1,true);', // non generic take precedence
- ' {@B}Run(2,word(3));', // non generic take precedence
- ' {@C}Run(''foo'',''bar'');',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_Infer_Var_Overload;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'procedure {#A}Run<S>(var a: S; var b: boolean); overload;',
- 'begin',
- 'end;',
- 'procedure {#B}Run<T>(var a: T; var w: word); overload;',
- 'begin',
- 'end;',
- 'procedure {#C}Run<U>(var a: U; var b: U); overload;',
- 'begin',
- 'end;',
- 'var',
- ' w: word;',
- ' b: boolean;',
- ' s: string;',
- 'begin',
- ' {@A}Run(w,b);',
- ' {@B}Run(s,w);',
- ' {@C}Run(s,s);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_Infer_Widen;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'procedure {#A}Run<S>(a: S; b: S);',
- 'begin',
- 'end;',
- 'begin',
- ' {@A}Run(word(1),longint(2));',
- ' {@A}Run(int64(1),longint(2));',
- ' {@A}Run(boolean(false),wordbool(2));',
- ' {@A}Run(''a'',''foo'');',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_Infer_DefaultValue;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- '{$modeswitch implicitfunctionspecialization}',
- 'generic procedure {#A}Run<S>(a: S = 2; b: S = 10); overload;',
- 'begin',
- 'end;',
- 'begin',
- ' {@A}Run(1,2);',
- ' {@A}Run(3);',
- ' {@A}Run();',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_Infer_DefaultValueMismatch;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- '{$modeswitch implicitfunctionspecialization}',
- 'generic procedure {#A}Run<S>(a: S; b: S = 10); overload;',
- 'begin',
- 'end;',
- 'begin',
- ' {@A}Run(false,true);',
- '']);
- CheckResolverException('Incompatible types: got "Longint" expected "Boolean"',
- nIncompatibleTypesGotExpected);
- end;
- procedure TTestResolveGenerics.TestGenProc_Infer_ProcT;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'type',
- ' TProc<S> = reference to procedure(a: S);',
- ' TObject = class',
- ' procedure {#A}Run<T: class>(a: TProc<T>);',
- ' end;',
- ' TBird = class end;',
- 'procedure Tobject.Run<T>(a: TProc<T>);',
- 'begin',
- 'end;',
- 'var obj: TObject;',
- 'begin',
- ' obj.{@A}Run<TBird>(procedure(Bird: TBird) begin end);',
- //' obj.{@A}Run(procedure(Bird: TBird) begin end);', // not supported by Delphi
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_Infer_Mismatch;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'procedure Run<T>(a: T; b: T);',
- 'begin',
- 'end;',
- 'begin',
- ' Run(1,true);',
- '']);
- CheckResolverException('Inferred type "T" from different arguments mismatch for method "Run"',
- nInferredTypeXFromDiffArgsMismatchFromMethodY);
- end;
- procedure TTestResolveGenerics.TestGenProc_Infer_ArrayOfT;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'procedure Run<T>(a: array of T);',
- 'var b: T;',
- 'begin',
- ' b:=3;',
- 'end;',
- 'var Arr: array of byte;',
- 'begin',
- ' Run(Arr);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_Infer_PassAsArgDelphi;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'function Run<T>(a: T): T;',
- 'var b: T;',
- 'begin',
- ' Run(Run<word>(3));',
- ' Run(Run(4));',
- 'end;',
- 'begin',
- ' Run(Run<word>(5));',
- ' Run(Run(6));',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenProc_Infer_PassAsArgObjFPC;
- begin
- StartProgram(false);
- Add([
- '{$mode objfpc}',
- '{$ModeSwitch implicitfunctionspecialization}',
- 'generic function Run<T>(a: T): T;',
- 'var b: T;',
- 'begin',
- ' Run(specialize Run<word>(3));',
- ' Run(Run(4));',
- 'end;',
- 'begin',
- ' Run(specialize Run<word>(5));',
- ' Run(Run(6));',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenMethod_VirtualFail;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' TObject = class',
- ' generic procedure Run<T>(a: T); virtual; abstract;',
- ' end;',
- 'begin',
- '']);
- CheckResolverException('virtual, dynamic or message methods cannot have type parameters',
- nXMethodsCannotHaveTypeParams);
- end;
- procedure TTestResolveGenerics.TestGenMethod_PublishedFail;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' TObject = class',
- ' published',
- ' generic procedure Run<T>(a: T);',
- ' end;',
- 'generic procedure TObject.Run<T>(a: T);',
- 'begin',
- 'end;',
- 'begin',
- '']);
- CheckResolverException('published methods cannot have type parameters',
- nXMethodsCannotHaveTypeParams);
- end;
- procedure TTestResolveGenerics.TestGenMethod_ClassInterfaceMethodFail;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' IUnknown = interface',
- ' generic procedure Run<T>(a: T); virtual; abstract;',
- ' end;',
- 'begin',
- '']);
- CheckParserException('generic is not allowed in interface',nParserXNotAllowedInY);
- end;
- procedure TTestResolveGenerics.TestGenMethod_ClassConstructorFail;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' TObject = class',
- ' generic class constructor Run<T>(a: T);',
- ' end;',
- 'generic class constructor TObject.Run<T>(a: T);',
- 'begin end;',
- 'begin',
- '']);
- CheckParserException('Expected "Procedure" or "Function" at token "constructor" in file afile.pp at line 4 column 19',
- nParserExpectToken2Error);
- end;
- procedure TTestResolveGenerics.TestGenMethod_TemplNameDifferFail;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' TObject = class',
- ' generic procedure Run<T>(a: T);',
- ' end;',
- 'generic procedure TObject.Run<S>(a: S);',
- 'begin',
- 'end;',
- 'begin',
- '']);
- CheckResolverException('Declaration of "TObject.Run<S>" differs from previous declaration at afile.pp(4,28)',
- nDeclOfXDiffersFromPrevAtY);
- end;
- procedure TTestResolveGenerics.TestGenMethod_ImplConstraintFail;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' TObject = class',
- ' generic procedure Run<T>(a: T);',
- ' end;',
- 'generic procedure TObject.Run<T: class>(a: T);',
- 'begin',
- 'end;',
- 'begin',
- '']);
- CheckResolverException(sImplMustNotRepeatConstraints,nImplMustNotRepeatConstraints);
- end;
- procedure TTestResolveGenerics.TestGenMethod_NestedSelf;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' TObject = class',
- ' w: word;',
- ' generic function Fly<T>(a: T): T;',
- ' end;',
- 'generic function TObject.Fly<T>(a: T): T;',
- ' function Sub: T;',
- ' begin',
- ' Result:=w+a;',
- ' Result:=Self.w+a;',
- //' specialize Fly<T> :=', not supported by FPC/Delphi
- ' end;',
- 'begin',
- ' Result:=Sub;',
- ' Result:=Self.w+Sub+a;',
- 'end;',
- 'var Obj: TObject;',
- 'begin',
- ' if Obj.specialize Fly<smallint>(3)=4 then ;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenMethod_OverloadTypeParamCntObjFPC;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' TObject = class',
- ' generic procedure {#A}Run<T>(a: T);',
- ' generic procedure {#B}Run<M,N>(a: M);',
- ' end;',
- 'generic procedure TObject.Run<T>(a: T);',
- 'begin',
- 'end;',
- 'generic procedure TObject.Run<M,N>(a: M);',
- 'begin',
- ' specialize {@A}Run<M>(a);',
- ' specialize {@B}Run<double,char>(1.3);',
- 'end;',
- 'var obj: TObject;',
- 'begin',
- ' obj.specialize {@A}Run<word>(3);',
- ' obj.specialize {@B}Run<word,char>(4);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenMethod_OverloadTypeParamCntDelphi;
- begin
- StartProgram(false);
- Add([
- '{$mode delphi}',
- 'type',
- ' TObject = class',
- ' procedure {#A}Run<T>(a: T); overload;',
- ' procedure {#B}Run<M,N>(a: M); overload;',
- ' end;',
- 'procedure TObject.Run<T>(a: T);',
- 'begin',
- 'end;',
- 'procedure TObject.Run<M,N>(a: M);',
- 'begin',
- ' {@A}Run<M>(a);',
- ' {@B}Run<double,char>(1.3);',
- 'end;',
- 'var obj: TObject;',
- 'begin',
- ' obj.{@A}Run<word>(3);',
- ' obj.{@B}Run<word,char>(4);',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenMethod_OverloadArgs;
- begin
- StartProgram(false);
- Add([
- 'type',
- ' TObject = class',
- ' generic function {#A}Run<T>(a: boolean): T;',
- ' generic function {#B}Run<M>(a: word): M;',
- ' end;',
- 'generic function TObject.Run<T>(a: boolean): T;',
- 'begin',
- 'end;',
- 'generic function TObject.Run<M>(a: word): M;',
- 'begin',
- ' Result:=specialize Run<M>(a);',
- ' if specialize {@A}Run<string>(true)=''foo'' then ;',
- ' if specialize {@B}Run<byte>(3)=4 then ;',
- 'end;',
- 'var obj: TObject;',
- 'begin',
- ' if obj.specialize {@A}Run<string>(true)=''bar'' then ;',
- ' if obj.specialize {@B}Run<byte>(5)=6 then ;',
- '']);
- ParseProgram;
- end;
- procedure TTestResolveGenerics.TestGenMethod_TypeCastParam;
- begin
- StartUnit(false);
- Add([
- '{$mode delphi}',
- 'interface',
- 'type',
- ' TObject = class end;',
- ' TAnt = class end;',
- ' TArray<T> = array of T;',
- ' TBird = class',
- ' F: TArray<TObject>;',
- ' procedure Run<S>(a: TArray<S>);',
- ' end;',
- 'implementation',
- 'procedure TBird.Run<S>(a: TArray<S>);',
- 'begin',
- ' a:=TArray<S>(a);',
- ' F:=TArray<TObject>(a);',
- 'end;',
- 'var B: TBird;',
- 'initialization',
- ' B.Run<TAnt>(nil);',
- '']);
- ParseUnit;
- end;
- procedure TTestResolveGenerics.TestGenMethod_TypeCastIdentDot;
- begin
- StartUnit(false);
- Add([
- '{$mode delphi}',
- 'interface',
- 'type',
- ' TObject = class end;',
- ' TBird = class end;',
- ' TEagle = class(TBird)',
- ' procedure Run<S>(p: S);',
- ' procedure Fly;',
- ' end;',
- 'implementation',
- 'procedure TEagle.Run<S>(p: S);',
- 'begin',
- 'end;',
- 'procedure TEagle.Fly;',
- 'var Bird: TBird;',
- 'begin',
- ' TEagle(Bird).Run<word>(3);',
- 'end;',
- '']);
- ParseUnit;
- end;
- initialization
- RegisterTests([TTestResolveGenerics]);
- end.
|