12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349 |
- unit tcprocfunc;
- {$mode objfpc}{$H+}
- interface
- uses
- Classes, SysUtils, typinfo, fpcunit, pastree, pscanner, pparser, tcbaseparser,testregistry;
- type
- { TTestProcedureFunction }
- TTestProcedureFunction= class(TTestParser)
- private
- FAddComment: Boolean;
- FFunc: TPasFunction;
- FHint: String;
- FProc: TPasProcedure;
- FOperator:TPasOperator;
- procedure AddDeclaration(const ASource: string; const AHint: String='');
- procedure AssertArg(ProcType: TPasProcedureType; AIndex: Integer;
- AName: String; AAccess: TArgumentAccess; const TypeName: String;
- AValue: String='');
- procedure AssertArrayArg(ProcType: TPasProcedureType; AIndex: Integer;
- AName: String; AAccess: TArgumentAccess; const ElementTypeName: String);
- procedure AssertFunc(const Mods: TProcedureModifiers; const TypeMods: TProcTypeModifiers; CC: TCallingConvention; ArgCount: Integer; P: TPasFunction=nil);
- procedure AssertProc(const Mods: TProcedureModifiers; const TypeMods: TProcTypeModifiers; CC: TCallingConvention; ArgCount: Integer; P: TPasProcedure=nil);
- function BaseAssertArg(ProcType: TPasProcedureType; AIndex: Integer;
- AName: String; AAccess: TArgumentAccess; AValue: String=''): TPasArgument;
- procedure CreateForwardTest;
- function GetFT: TPasFunctionType;
- function GetPT: TPasProcedureType;
- Procedure ParseProcedure;
- function ParseProcedure(const ASource: string; const AHint: String=''): TPasProcedure;
- Procedure ParseFunction;
- function ParseFunction(const ASource : String; AResult: string = ''; const AHint: String=''; CC : TCallingConvention = ccDefault): TPasProcedure;
- Procedure ParseOperator;
- protected
- procedure SetUp; override;
- procedure TearDown; override;
- Procedure AssertComment;
- Property AddComment : Boolean Read FAddComment Write FAddComment;
- Property Hint : String Read FHint Write FHint;
- Property Proc : TPasProcedure Read FProc;
- Property ProcType : TPasProcedureType Read GetPT;
- Property Func : TPasFunction Read FFunc;
- Property FuncType : TPasFunctionType Read GetFT;
- published
- procedure TestEmptyProcedure;
- procedure TestEmptyProcedureComment;
- Procedure TestEmptyFunction;
- Procedure TestEmptyFunctionComment;
- procedure TestEmptyProcedureDeprecated;
- Procedure TestEmptyFunctionDeprecated;
- procedure TestEmptyProcedurePlatform;
- Procedure TestEmptyFunctionPlatform;
- procedure TestEmptyProcedureExperimental;
- Procedure TestEmptyFunctionExperimental;
- procedure TestEmptyProcedureUnimplemented;
- Procedure TestEmptyFunctionUnimplemented;
- procedure TestProcedureOneArg;
- Procedure TestFunctionOneArg;
- procedure TestProcedureOneVarArg;
- Procedure TestFunctionOneVarArg;
- procedure TestProcedureOneConstArg;
- Procedure TestFunctionOneConstArg;
- procedure TestProcedureOneOutArg;
- Procedure TestFunctionOneOutArg;
- procedure TestProcedureOneConstRefArg;
- Procedure TestFunctionOneConstRefArg;
- procedure TestProcedureTwoArgs;
- Procedure TestFunctionTwoArgs;
- procedure TestProcedureTwoArgsSeparate;
- Procedure TestFunctionTwoArgsSeparate;
- procedure TestProcedureOneArgDefault;
- Procedure TestFunctionOneArgDefault;
- procedure TestProcedureOneArgDefaultSet;
- Procedure TestFunctionOneArgDefaultSet;
- procedure TestProcedureOneArgDefaultExpr;
- Procedure TestFunctionOneArgDefaultExpr;
- procedure TestProcedureTwoArgsDefault;
- Procedure TestFunctionTwoArgsDefault;
- procedure TestFunctionOneArgEnumeratedExplicit;
- procedure TestProcedureOneUntypedVarArg;
- Procedure TestFunctionOneUntypedVarArg;
- procedure TestProcedureTwoUntypedVarArgs;
- Procedure TestFunctionTwoUntypedVarArgs;
- procedure TestProcedureOneUntypedConstArg;
- Procedure TestFunctionOneUntypedConstArg;
- procedure TestProcedureTwoUntypedConstArgs;
- Procedure TestFunctionTwoUntypedConstArgs;
- procedure TestProcedureOpenArrayArg;
- Procedure TestFunctionOpenArrayArg;
- procedure TestProcedureTwoOpenArrayArgs;
- Procedure TestFunctionTwoOpenArrayArgs;
- procedure TestProcedureConstOpenArrayArg;
- Procedure TestFunctionConstOpenArrayArg;
- procedure TestProcedureVarOpenArrayArg;
- Procedure TestFunctionVarOpenArrayArg;
- procedure TestProcedureArrayOfConstArg;
- Procedure TestFunctionArrayOfConstArg;
- procedure TestProcedureConstArrayOfConstArg;
- Procedure TestFunctionConstArrayOfConstArg;
- Procedure TestProcedureCdecl;
- Procedure TestFunctionCdecl;
- Procedure TestProcedureCdeclDeprecated;
- Procedure TestFunctionCdeclDeprecated;
- Procedure TestProcedureSafeCall;
- Procedure TestFunctionSafeCall;
- //ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall);
- Procedure TestProcedurePascal;
- Procedure TestFunctionPascal;
- Procedure TestProcedureStdCall;
- Procedure TestFunctionStdCall;
- Procedure TestProcedureOldFPCCall;
- Procedure TestFunctionOldFPCCall;
- Procedure TestProcedurePublic;
- Procedure TestProcedurePublicIdent;
- Procedure TestFunctionPublic;
- Procedure TestProcedureCdeclPublic;
- Procedure TestFunctionCdeclPublic;
- Procedure TestProcedureOverload;
- Procedure TestFunctionOverload;
- Procedure TestProcedureVarargs;
- Procedure TestFunctionVarArgs;
- Procedure TestProcedureCDeclVarargs;
- Procedure TestFunctionCDeclVarArgs;
- Procedure TestProcedureForwardInterface;
- Procedure TestFunctionForwardInterface;
- Procedure TestProcedureForward;
- Procedure TestFunctionForward;
- Procedure TestProcedureFar;
- Procedure TestFunctionFar;
- Procedure TestProcedureCdeclForward;
- Procedure TestFunctionCDeclForward;
- Procedure TestProcedureCompilerProc;
- Procedure TestProcedureNoReturn;
- Procedure TestFunctionCompilerProc;
- Procedure TestProcedureCDeclCompilerProc;
- Procedure TestFunctionCDeclCompilerProc;
- Procedure TestProcedureAssembler;
- Procedure TestFunctionAssembler;
- Procedure TestProcedureCDeclAssembler;
- Procedure TestFunctionCDeclAssembler;
- Procedure TestProcedureExport;
- Procedure TestFunctionExport;
- Procedure TestProcedureCDeclExport;
- Procedure TestFunctionCDeclExport;
- Procedure TestProcedureExternal;
- Procedure TestFunctionExternal;
- Procedure TestFunctionForwardNoReturnDelphi;
- procedure TestFunctionForwardNoReturnNoDelphi;
- Procedure TestProcedureExternalLibName;
- Procedure TestFunctionExternalLibName;
- Procedure TestProcedureExternalLibNameName;
- Procedure TestFunctionExternalLibNameName;
- Procedure TestProcedureExternalName;
- Procedure TestFunctionExternalName;
- Procedure TestProcedureCdeclExternal;
- Procedure TestProcedureAlias;
- Procedure TestFunctionCdeclExternal;
- Procedure TestProcedureCdeclExternalLibName;
- Procedure TestFunctionCdeclExternalLibName;
- Procedure TestProcedureCdeclExternalLibNameName;
- Procedure TestFunctionCdeclExternalLibNameName;
- Procedure TestProcedureCdeclExternalName;
- Procedure TestFunctionCdeclExternalName;
- Procedure TestFunctionAlias;
- Procedure TestOperatorTokens;
- procedure TestOperatorNames;
- Procedure TestAssignOperatorAfterObject;
- Procedure TestFunctionNoResult;
- end;
- implementation
- procedure TTestProcedureFunction.AddDeclaration(const ASource: string;
- const AHint: String);
- Var
- D : String;
- begin
- Hint:=AHint;
- D:=ASource;
- If Hint<>'' then
- D:=D+' '+Hint;
- if (D[Length(D)]<>';') then
- D:=D+';';
- Add(D);
- end;
- function TTestProcedureFunction.GetPT: TPasProcedureType;
- begin
- AssertNotNull('have procedure to get type from',Proc);
- Result:=Proc.ProcType;
- end;
- function TTestProcedureFunction.ParseProcedure(const ASource: string;
- const AHint: String): TPasProcedure;
- begin
- If AddComment then
- begin
- Add('// A comment');
- Engine.NeedComments:=True;
- end;
- AddDeclaration('procedure A '+ASource,AHint);
- Self.ParseProcedure;
- Result:=Fproc;
- If AddComment then
- AssertComment;
- end;
- procedure TTestProcedureFunction.ParseProcedure;
- begin
- // Writeln(source.text);
- ParseDeclarations;
- AssertEquals('One variable definition',1,Declarations.Functions.Count);
- AssertEquals('First declaration is procedure declaration.',TPasProcedure,TObject(Declarations.Functions[0]).ClassType);
- FProc:=TPasProcedure(Declarations.Functions[0]);
- Definition:=FProc;
- AssertEquals('First declaration has correct name.','A',FProc.Name);
- if (Hint<>'') then
- CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'h'+Hint)));
- end;
- function TTestProcedureFunction.ParseFunction(const ASource : String;AResult: string = ''; const AHint: String = ''; CC : TCallingConvention = ccDefault): TPasProcedure;
- Var
- D :String;
- begin
- if (AResult='') then
- AResult:='Integer';
- D:='Function A '+ASource+' : '+AResult;
- If (cc<>ccDefault) then
- D:=D+'; '+cCallingConventions[cc]+';';
- AddDeclaration(D,AHint);
- Self.ParseFunction;
- Result:=FFunc;
- AssertNotNull('Have function result element',FuncType.ResultEl);
- AssertNotNull('Have function result type element',FuncType.ResultEl.ResultType);
- AssertEquals('Correct function result type name',AResult,FuncType.ResultEl.ResultType.Name);
- end;
- procedure TTestProcedureFunction.ParseOperator;
- begin
- // Writeln(source.text);
- ParseDeclarations;
- AssertEquals('One operator definition',1,Declarations.Functions.Count);
- AssertEquals('First declaration is function declaration.',TPasOperator,TObject(Declarations.Functions[0]).ClassType);
- FOperator:=TPasOperator(Declarations.Functions[0]);
- Definition:=FOperator;
- if (Hint<>'') then
- CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'h'+Hint)));
- end;
- procedure TTestProcedureFunction.ParseFunction;
- begin
- // Writeln(source.text);
- ParseDeclarations;
- AssertEquals('One variable definition',1,Declarations.Functions.Count);
- AssertEquals('First declaration is function declaration.',TPasFunction,TObject(Declarations.Functions[0]).ClassType);
- FFunc:=TPasFunction(Declarations.Functions[0]);
- Definition:=FFunc;
- AssertEquals('First declaration has correct name.','A',FFunc.Name);
- if (Hint<>'') then
- CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'h'+Hint)));
- end;
- procedure TTestProcedureFunction.AssertProc(const Mods: TProcedureModifiers;
- const TypeMods: TProcTypeModifiers; CC: TCallingConvention; ArgCount: Integer;
- P: TPasProcedure);
- begin
- If P=Nil then
- P:=Proc;
- AssertNotNull('No proc to assert',P);
- AssertEquals('Procedure modifiers',Mods,P.Modifiers);
- AssertEquals('Procedure type modifiers',TypeMods,P.ProcType.Modifiers);
- AssertEquals('Procedue calling convention',CC,P.CallingConvention);
- AssertEquals('No message name','',p.MessageName);
- AssertEquals('No message type',pmtNone,P.MessageType);
- AssertNotNull('Have procedure type to assert',P.ProcType);
- AssertEquals('Correct number of arguments',ArgCount,P.ProcType.Args.Count);
- AssertEquals('Not of object',False,P.ProcType.IsOfObject);
- AssertEquals('Not is nested',False,P.ProcType.IsNested);
- end;
- procedure TTestProcedureFunction.AssertFunc(const Mods: TProcedureModifiers;
- const TypeMods: TProcTypeModifiers; CC: TCallingConvention; ArgCount: Integer;
- P: TPasFunction);
- begin
- If P=Nil then
- P:=Func;
- AssertNotNull('No func to assert',P);
- AssertEquals('Procedure modifiers',Mods,P.Modifiers);
- AssertEquals('Procedure type modifiers',TypeMods,P.ProcType.Modifiers);
- AssertEquals('Procedue calling convention',CC,P.CallingConvention);
- AssertEquals('No message name','',p.MessageName);
- AssertEquals('No message type',pmtNone,P.MessageType);
- AssertNotNull('Have procedure type to assert',P.ProcType);
- AssertEquals('Correct number of arguments',ArgCount,P.ProcType.Args.Count);
- AssertEquals('Not of object',False,P.ProcType.IsOfObject);
- AssertEquals('Not is nested',False,P.ProcType.IsNested);
- end;
- function TTestProcedureFunction.BaseAssertArg(ProcType: TPasProcedureType;
- AIndex: Integer; AName: String; AAccess: TArgumentAccess; AValue: String
- ): TPasArgument;
- Var
- A : TPasArgument;
- N : String;
- begin
- AssertNotNull('Have proctype to test argument',ProcType);
- if AIndex>=Proctype.Args.Count then
- Fail(Format('Cannot test argument: index %d is larger than the number of arguments (%d).',[AIndex,Proctype.Args.Count]));
- AssertNotNull('Have argument at position '+IntToStr(AIndex),Proctype.Args[AIndex]);
- AssertEquals('Have argument type at position '+IntToStr(AIndex),TPasArgument,TObject(Proctype.Args[AIndex]).ClassType);
- N:='Argument '+IntToStr(AIndex+1)+' : ';
- A:=TPasArgument(Proctype.Args[AIndex]);
- AssertEquals(N+'Argument name',AName,A.Name);
- AssertEquals(N+'Argument access',AAccess,A.Access);
- if (AValue='') then
- AssertNull(N+' no default value',A.ValueExpr)
- else
- begin
- AssertNotNull(N+' Have default value',A.ValueExpr);
- AssertEquals(N+' Default value',AValue,A.Value);
- end;
- Result:=A;
- end;
- procedure TTestProcedureFunction.AssertArg(ProcType: TPasProcedureType;
- AIndex: Integer; AName: String; AAccess: TArgumentAccess;
- const TypeName: String; AValue: String);
- Var
- A : TPasArgument;
- N : String;
- begin
- A:=BaseAssertArg(ProcType,AIndex,ANAme,AAccess,AValue);
- N:='Argument '+IntToStr(AIndex+1)+' : ';
- if (TypeName='') then
- AssertNull(N+' No argument type',A.ArgType)
- else
- begin
- AssertNotNull(N+' Have argument type',A.ArgType);
- AssertEquals(N+' Correct argument type name',TypeName,A.ArgType.Name);
- end;
- end;
- procedure TTestProcedureFunction.AssertArrayArg(ProcType: TPasProcedureType;
- AIndex: Integer; AName: String; AAccess: TArgumentAccess;
- const ElementTypeName: String);
- Var
- A : TPasArgument;
- AT : TPasArrayType;
- N : String;
- begin
- A:=BaseAssertArg(ProcType,AIndex,ANAme,AAccess,'');
- N:='Argument '+IntToStr(AIndex+1)+' : ';
- AssertNotNull(N+' Have argument type',A.ArgType);
- AssertEquals(N+' is arrayType',TPasArrayType,A.ArgType.ClassType);
- AT:=TPasArrayType(A.ArgType);
- if (ElementTypeName='') then
- AssertNull(N+' No array element type',AT.ElType)
- else
- begin
- AssertNotNull(N+' Have array element type',AT.ElType);
- AssertEquals(N+' Correct array element type name',ElementTypeName,AT.ElType.Name);
- end;
- end;
- function TTestProcedureFunction.GetFT: TPasFunctionType;
- begin
- AssertNotNull('have function to get type from',Func);
- AssertEquals('Function type is correct type',TPasFunctionType,Func.ProcType.ClassType);
- Result:=Func.FuncType;
- end;
- //TProcedureMessageType
- procedure TTestProcedureFunction.TestEmptyProcedure;
- begin
- ParseProcedure('');
- AssertProc([],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestEmptyProcedureComment;
- begin
- AddComment:=True;
- TestEmptyProcedure;
- end;
- procedure TTestProcedureFunction.TestEmptyFunction;
- begin
- ParseFunction('');
- AssertFunc([],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestEmptyFunctionComment;
- begin
- AddComment:=True;
- TestEmptyProcedure;
- end;
- procedure TTestProcedureFunction.TestEmptyProcedureDeprecated;
- begin
- ParseProcedure('','deprecated');
- AssertProc([],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestEmptyFunctionDeprecated;
- begin
- ParseFunction('','deprecated');
- AssertFunc([],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestEmptyProcedurePlatform;
- begin
- ParseProcedure('','platform');
- AssertProc([],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestEmptyFunctionPlatform;
- begin
- ParseFunction('','platform');
- AssertFunc([],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestEmptyProcedureExperimental;
- begin
- ParseProcedure('','experimental');
- AssertProc([],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestEmptyFunctionExperimental;
- begin
- ParseFunction('','experimental');
- AssertFunc([],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestEmptyProcedureUnimplemented;
- begin
- ParseProcedure('','unimplemented');
- AssertProc([],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestEmptyFunctionUnimplemented;
- begin
- ParseFunction('','unimplemented');
- AssertFunc([],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestProcedureOneArg;
- begin
- ParseProcedure('(B : Integer)');
- AssertProc([],[],ccDefault,1);
- AssertArg(ProcType,0,'B',argDefault,'Integer','');
- end;
- procedure TTestProcedureFunction.TestFunctionOneArg;
- begin
- ParseFunction('(B : Integer)');
- AssertFunc([],[],ccDefault,1);
- AssertArg(FuncType,0,'B',argDefault,'Integer','');
- end;
- procedure TTestProcedureFunction.TestProcedureOneVarArg;
- begin
- ParseProcedure('(Var B : Integer)');
- AssertProc([],[],ccDefault,1);
- AssertArg(ProcType,0,'B',argVar,'Integer','');
- end;
- procedure TTestProcedureFunction.TestFunctionOneVarArg;
- begin
- ParseFunction('(Var B : Integer)');
- AssertFunc([],[],ccDefault,1);
- AssertArg(FuncType,0,'B',argVar,'Integer','');
- end;
- procedure TTestProcedureFunction.TestProcedureOneConstArg;
- begin
- ParseProcedure('(Const B : Integer)');
- AssertProc([],[],ccDefault,1);
- AssertArg(ProcType,0,'B',argConst,'Integer','');
- end;
- procedure TTestProcedureFunction.TestFunctionOneConstArg;
- begin
- ParseFunction('(Const B : Integer)');
- AssertFunc([],[],ccDefault,1);
- AssertArg(FuncType,0,'B',argConst,'Integer','');
- end;
- procedure TTestProcedureFunction.TestProcedureOneOutArg;
- begin
- ParseProcedure('(Out B : Integer)');
- AssertProc([],[],ccDefault,1);
- AssertArg(ProcType,0,'B',argOut,'Integer','');
- end;
- procedure TTestProcedureFunction.TestFunctionOneOutArg;
- begin
- ParseFunction('(Out B : Integer)');
- AssertFunc([],[],ccDefault,1);
- AssertArg(FuncType,0,'B',argOut,'Integer','');
- end;
- procedure TTestProcedureFunction.TestProcedureOneConstRefArg;
- begin
- ParseProcedure('(Constref B : Integer)');
- AssertProc([],[],ccDefault,1);
- AssertArg(ProcType,0,'B',argConstRef,'Integer','');
- end;
- procedure TTestProcedureFunction.TestFunctionOneConstRefArg;
- begin
- ParseFunction('(ConstRef B : Integer)');
- AssertFunc([],[],ccDefault,1);
- AssertArg(FuncType,0,'B',argConstref,'Integer','');
- end;
- procedure TTestProcedureFunction.TestProcedureTwoArgs;
- begin
- ParseProcedure('(B,C : Integer)');
- AssertProc([],[],ccDefault,2);
- AssertArg(ProcType,0,'B',argDefault,'Integer','');
- AssertArg(ProcType,1,'C',argDefault,'Integer','');
- end;
- procedure TTestProcedureFunction.TestFunctionTwoArgs;
- begin
- ParseFunction('(B,C : Integer)');
- AssertFunc([],[],ccDefault,2);
- AssertArg(FuncType,0,'B',argDefault,'Integer','');
- AssertArg(FuncType,1,'C',argDefault,'Integer','');
- end;
- procedure TTestProcedureFunction.TestProcedureTwoArgsSeparate;
- begin
- ParseProcedure('(B : Integer; C : Integer)');
- AssertProc([],[],ccDefault,2);
- AssertArg(ProcType,0,'B',argDefault,'Integer','');
- AssertArg(ProcType,1,'C',argDefault,'Integer','');
- end;
- procedure TTestProcedureFunction.TestFunctionTwoArgsSeparate;
- begin
- ParseFunction('(B : Integer;C : Integer)');
- AssertFunc([],[],ccDefault,2);
- AssertArg(FuncType,0,'B',argDefault,'Integer','');
- AssertArg(FuncType,1,'C',argDefault,'Integer','');
- end;
- procedure TTestProcedureFunction.TestProcedureOneArgDefault;
- begin
- ParseProcedure('(B : Integer = 1)');
- AssertProc([],[],ccDefault,1);
- AssertArg(ProcType,0,'B',argDefault,'Integer','1');
- end;
- procedure TTestProcedureFunction.TestFunctionOneArgDefault;
- begin
- ParseFunction('(B : Integer = 1)');
- AssertFunc([],[],ccDefault,1);
- AssertArg(FuncType,0,'B',argDefault,'Integer','1');
- end;
- procedure TTestProcedureFunction.TestFunctionOneArgEnumeratedExplicit;
- begin
- ParseFunction('(B : TSomeEnum = TSomeEnum.False)');
- AssertFunc([],[],ccDefault,1);
- AssertArg(FuncType,0,'B',argDefault,'TSomeEnum','TSomeEnum.False');
- end;
- procedure TTestProcedureFunction.TestProcedureOneArgDefaultSet;
- begin
- ParseProcedure('(B : MySet = [1,2])');
- AssertProc([],[],ccDefault,1);
- AssertArg(ProcType,0,'B',argDefault,'MySet','[1, 2]');
- end;
- procedure TTestProcedureFunction.TestFunctionOneArgDefaultSet;
- begin
- ParseFunction('(B : MySet = [1,2])');
- AssertFunc([],[],ccDefault,1);
- AssertArg(FuncType,0,'B',argDefault,'MySet','[1, 2]');
- end;
- procedure TTestProcedureFunction.TestProcedureOneArgDefaultExpr;
- begin
- ParseProcedure('(B : Integer = 1 + 2)');
- AssertProc([],[],ccDefault,1);
- AssertArg(ProcType,0,'B',argDefault,'Integer','1 + 2');
- end;
- procedure TTestProcedureFunction.TestFunctionOneArgDefaultExpr;
- begin
- ParseFunction('(B : Integer = 1 + 2)');
- AssertFunc([],[],ccDefault,1);
- AssertArg(FuncType,0,'B',argDefault,'Integer','1 + 2');
- end;
- procedure TTestProcedureFunction.TestProcedureTwoArgsDefault;
- begin
- ParseProcedure('(B : Integer = 1; C : Integer = 2)');
- AssertProc([],[],ccDefault,2);
- AssertArg(ProcType,0,'B',argDefault,'Integer','1');
- AssertArg(ProcType,1,'C',argDefault,'Integer','2');
- end;
- procedure TTestProcedureFunction.TestFunctionTwoArgsDefault;
- begin
- ParseFunction('(B : Integer = 1; C : Integer = 2)');
- AssertFunc([],[],ccDefault,2);
- AssertArg(FuncType,0,'B',argDefault,'Integer','1');
- AssertArg(FuncType,1,'C',argDefault,'Integer','2');
- end;
- procedure TTestProcedureFunction.TestProcedureOneUntypedVarArg;
- begin
- ParseProcedure('(Var B)');
- AssertProc([],[],ccDefault,1);
- AssertArg(ProcType,0,'B',argVar,'','');
- end;
- procedure TTestProcedureFunction.TestFunctionOneUntypedVarArg;
- begin
- ParseFunction('(Var B)');
- AssertFunc([],[],ccDefault,1);
- AssertArg(FuncType,0,'B',argVar,'','');
- end;
- procedure TTestProcedureFunction.TestProcedureTwoUntypedVarArgs;
- begin
- ParseProcedure('(Var B; Var C)');
- AssertProc([],[],ccDefault,2);
- AssertArg(ProcType,0,'B',argVar,'','');
- AssertArg(ProcType,1,'C',argVar,'','');
- end;
- procedure TTestProcedureFunction.TestFunctionTwoUntypedVarArgs;
- begin
- ParseFunction('(Var B; Var C)');
- AssertFunc([],[],ccDefault,2);
- AssertArg(FuncType,0,'B',argVar,'','');
- AssertArg(FuncType,1,'C',argVar,'','');
- end;
- procedure TTestProcedureFunction.TestProcedureOneUntypedConstArg;
- begin
- ParseProcedure('(Const B)');
- AssertProc([],[],ccDefault,1);
- AssertArg(ProcType,0,'B',argConst,'','');
- end;
- procedure TTestProcedureFunction.TestFunctionOneUntypedConstArg;
- begin
- ParseFunction('(Const B)');
- AssertFunc([],[],ccDefault,1);
- AssertArg(FuncType,0,'B',argConst,'','');
- end;
- procedure TTestProcedureFunction.TestProcedureTwoUntypedConstArgs;
- begin
- ParseProcedure('(Const B; Const C)');
- AssertProc([],[],ccDefault,2);
- AssertArg(ProcType,0,'B',argConst,'','');
- AssertArg(ProcType,1,'C',argConst,'','');
- end;
- procedure TTestProcedureFunction.TestFunctionTwoUntypedConstArgs;
- begin
- ParseFunction('(Const B; Const C)');
- AssertFunc([],[],ccDefault,2);
- AssertArg(FuncType,0,'B',argConst,'','');
- AssertArg(FuncType,1,'C',argConst,'','');
- end;
- procedure TTestProcedureFunction.TestProcedureOpenArrayArg;
- begin
- ParseProcedure('(B : Array of Integer)');
- AssertProc([],[],ccDefault,1);
- AssertArrayArg(ProcType,0,'B',argDefault,'Integer');
- end;
- procedure TTestProcedureFunction.TestFunctionOpenArrayArg;
- begin
- ParseFunction('(B : Array of Integer)');
- AssertFunc([],[],ccDefault,1);
- AssertArrayArg(FuncType,0,'B',argDefault,'Integer');
- end;
- procedure TTestProcedureFunction.TestProcedureTwoOpenArrayArgs;
- begin
- ParseProcedure('(B : Array of Integer;C : Array of Integer)');
- AssertProc([],[],ccDefault,2);
- AssertArrayArg(ProcType,0,'B',argDefault,'Integer');
- AssertArrayArg(ProcType,1,'C',argDefault,'Integer');
- end;
- procedure TTestProcedureFunction.TestFunctionTwoOpenArrayArgs;
- begin
- ParseFunction('(B : Array of Integer;C : Array of Integer)');
- AssertFunc([],[],ccDefault,2);
- AssertArrayArg(FuncType,0,'B',argDefault,'Integer');
- AssertArrayArg(FuncType,1,'C',argDefault,'Integer');
- end;
- procedure TTestProcedureFunction.TestProcedureConstOpenArrayArg;
- begin
- ParseProcedure('(Const B : Array of Integer)');
- AssertProc([],[],ccDefault,1);
- AssertArrayArg(ProcType,0,'B',argConst,'Integer');
- end;
- procedure TTestProcedureFunction.TestFunctionConstOpenArrayArg;
- begin
- ParseFunction('(Const B : Array of Integer)');
- AssertFunc([],[],ccDefault,1);
- AssertArrayArg(FuncType,0,'B',argConst,'Integer');
- end;
- procedure TTestProcedureFunction.TestProcedureVarOpenArrayArg;
- begin
- ParseProcedure('(Var B : Array of Integer)');
- AssertProc([],[],ccDefault,1);
- AssertArrayArg(ProcType,0,'B',argVar,'Integer');
- end;
- procedure TTestProcedureFunction.TestFunctionVarOpenArrayArg;
- begin
- ParseFunction('(Var B : Array of Integer)');
- AssertFunc([],[],ccDefault,1);
- AssertArrayArg(FuncType,0,'B',argVar,'Integer');
- end;
- procedure TTestProcedureFunction.TestProcedureArrayOfConstArg;
- begin
- ParseProcedure('(B : Array of Const)');
- AssertProc([],[],ccDefault,1);
- AssertArrayArg(ProcType,0,'B',argDefault,'');
- end;
- procedure TTestProcedureFunction.TestFunctionArrayOfConstArg;
- begin
- ParseFunction('(B : Array of Const)');
- AssertFunc([],[],ccDefault,1);
- AssertArrayArg(FuncType,0,'B',argDefault,'');
- end;
- procedure TTestProcedureFunction.TestProcedureConstArrayOfConstArg;
- begin
- ParseProcedure('(Const B : Array of Const)');
- AssertProc([],[],ccDefault,1);
- AssertArrayArg(ProcType,0,'B',argConst,'');
- end;
- procedure TTestProcedureFunction.TestFunctionConstArrayOfConstArg;
- begin
- ParseFunction('(Const B : Array of Const)');
- AssertFunc([],[],ccDefault,1);
- AssertArrayArg(FuncType,0,'B',argConst,'');
- end;
- procedure TTestProcedureFunction.TestProcedureCdecl;
- begin
- ParseProcedure('; cdecl');
- AssertProc([],[],ccCdecl,0);
- end;
- procedure TTestProcedureFunction.TestFunctionCdecl;
- begin
- ParseFunction('','','',ccCdecl);
- AssertFunc([],[],ccCdecl,0);
- end;
- procedure TTestProcedureFunction.TestProcedureCdeclDeprecated;
- begin
- ParseProcedure('; cdecl;','deprecated');
- AssertProc([],[],ccCdecl,0);
- end;
- procedure TTestProcedureFunction.TestFunctionCdeclDeprecated;
- begin
- ParseFunction('','','deprecated',ccCdecl);
- AssertFunc([],[],ccCdecl,0);
- end;
- procedure TTestProcedureFunction.TestProcedureSafeCall;
- begin
- ParseProcedure('; safecall;','');
- AssertProc([],[],ccSafeCall,0);
- end;
- procedure TTestProcedureFunction.TestFunctionSafeCall;
- begin
- ParseFunction('','','',ccSafecall);
- AssertFunc([],[],ccSafecall,0);
- end;
- procedure TTestProcedureFunction.TestProcedurePascal;
- begin
- ParseProcedure('; pascal;','');
- AssertProc([],[],ccPascal,0);
- end;
- procedure TTestProcedureFunction.TestFunctionPascal;
- begin
- ParseFunction('','','',ccPascal);
- AssertFunc([],[],ccPascal,0);
- end;
- procedure TTestProcedureFunction.TestProcedureStdCall;
- begin
- ParseProcedure('; stdcall;','');
- AssertProc([],[],ccstdcall,0);
- end;
- procedure TTestProcedureFunction.TestFunctionStdCall;
- begin
- ParseFunction('','','',ccStdCall);
- AssertFunc([],[],ccStdCall,0);
- end;
- procedure TTestProcedureFunction.TestProcedureOldFPCCall;
- begin
- ParseProcedure('; oldfpccall;','');
- AssertProc([],[],ccoldfpccall,0);
- end;
- procedure TTestProcedureFunction.TestFunctionOldFPCCall;
- begin
- ParseFunction('','','',ccOldFPCCall);
- AssertFunc([],[],ccOldFPCCall,0);
- end;
- procedure TTestProcedureFunction.TestProcedurePublic;
- begin
- ParseProcedure('; public name ''myfunc'';','');
- AssertProc([pmPublic],[],ccDefault,0);
- AssertExpression('Public name',Proc.PublicName,pekString,'''myfunc''');
- end;
- procedure TTestProcedureFunction.TestProcedurePublicIdent;
- begin
- ParseProcedure('; public name exportname;','');
- AssertProc([pmPublic],[],ccDefault,0);
- AssertExpression('Public name',Proc.PublicName,pekIdent,'exportname');
- end;
- procedure TTestProcedureFunction.TestFunctionPublic;
- begin
- AddDeclaration('function A : Integer; public name exportname');
- ParseFunction;
- AssertFunc([pmPublic],[],ccDefault,0);
- AssertExpression('Public name',Func.PublicName,pekIdent,'exportname');
- end;
- procedure TTestProcedureFunction.TestProcedureCdeclPublic;
- begin
- ParseProcedure('; cdecl; public name exportname;','');
- AssertProc([pmPublic],[],ccCDecl,0);
- AssertExpression('Public name',Proc.PublicName,pekIdent,'exportname');
- end;
- procedure TTestProcedureFunction.TestFunctionCdeclPublic;
- begin
- AddDeclaration('function A : Integer; cdecl; public name exportname');
- ParseFunction;
- AssertFunc([pmPublic],[],ccCDecl,0);
- AssertExpression('Public name',Func.PublicName,pekIdent,'exportname');
- end;
- procedure TTestProcedureFunction.TestProcedureOverload;
- begin
- ParseProcedure('; overload;','');
- AssertProc([pmOverload],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestFunctionOverload;
- begin
- AddDeclaration('function A : Integer; overload');
- ParseFunction;
- AssertFunc([pmOverload],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestProcedureVarargs;
- begin
- ParseProcedure('; varargs;','');
- AssertProc([],[ptmVarArgs],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestFunctionVarArgs;
- begin
- AddDeclaration('function A : Integer; varargs');
- ParseFunction;
- AssertFunc([],[ptmVarArgs],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestProcedureCDeclVarargs;
- begin
- ParseProcedure(';cdecl; varargs;','');
- AssertProc([],[ptmVarArgs],ccCDecl,0);
- end;
- procedure TTestProcedureFunction.TestFunctionCDeclVarArgs;
- begin
- AddDeclaration('function A : Integer; cdecl; varargs');
- ParseFunction;
- AssertFunc([],[ptmVarArgs],ccCdecl,0);
- end;
- procedure TTestProcedureFunction.TestProcedureForwardInterface;
- begin
- AddDeclaration('procedure A; forward;');
- AssertException(EParserError,@ParseProcedure);
- end;
- procedure TTestProcedureFunction.TestFunctionForwardInterface;
- begin
- AddDeclaration('function A : integer; forward;');
- AssertException(EParserError,@ParseFunction);
- end;
- procedure TTestProcedureFunction.TestProcedureForward;
- begin
- UseImplementation:=True;
- AddDeclaration('procedure A; forward;');
- ParseProcedure;
- AssertProc([pmforward],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestFunctionForward;
- begin
- UseImplementation:=True;
- AddDeclaration('function A : integer; forward;');
- ParseFunction;
- AssertFunc([pmforward],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestProcedureFar;
- begin
- AddDeclaration('procedure A; far;');
- ParseProcedure;
- AssertProc([pmfar],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestFunctionFar;
- begin
- AddDeclaration('function A : integer; far;');
- ParseFunction;
- AssertFunc([pmfar],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestProcedureCdeclForward;
- begin
- UseImplementation:=True;
- AddDeclaration('procedure A; cdecl; forward;');
- ParseProcedure;
- AssertProc([pmforward],[],ccCDecl,0);
- end;
- procedure TTestProcedureFunction.TestFunctionCDeclForward;
- begin
- UseImplementation:=True;
- AddDeclaration('function A : integer; cdecl; forward;');
- ParseFunction;
- AssertFunc([pmforward],[],ccCDecl,0);
- end;
- procedure TTestProcedureFunction.TestProcedureCompilerProc;
- begin
- ParseProcedure(';compilerproc;','');
- AssertProc([pmCompilerProc],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestProcedureNoReturn;
- begin
- ParseProcedure(';noreturn;','');
- AssertProc([pmnoreturn],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestFunctionCompilerProc;
- begin
- AddDeclaration('function A : Integer; compilerproc');
- ParseFunction;
- AssertFunc([pmCompilerProc],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestProcedureCDeclCompilerProc;
- begin
- ParseProcedure(';cdecl;compilerproc;','');
- AssertProc([pmCompilerProc],[],ccCDecl,0);
- end;
- procedure TTestProcedureFunction.TestFunctionCDeclCompilerProc;
- begin
- AddDeclaration('function A : Integer; cdecl; compilerproc');
- ParseFunction;
- AssertFunc([pmCompilerProc],[],ccCDecl,0);
- end;
- procedure TTestProcedureFunction.TestProcedureAssembler;
- begin
- ParseProcedure(';assembler;','');
- AssertProc([pmAssembler],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestFunctionAssembler;
- begin
- AddDeclaration('function A : Integer; assembler');
- ParseFunction;
- AssertFunc([pmAssembler],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestProcedureCDeclAssembler;
- begin
- ParseProcedure(';cdecl;assembler;','');
- AssertProc([pmAssembler],[],ccCDecl,0);
- end;
- procedure TTestProcedureFunction.TestFunctionCDeclAssembler;
- begin
- AddDeclaration('function A : Integer; cdecl; assembler');
- ParseFunction;
- AssertFunc([pmAssembler],[],ccCDecl,0);
- end;
- procedure TTestProcedureFunction.TestProcedureExport;
- begin
- ParseProcedure(';export;','');
- AssertProc([pmExport],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestFunctionExport;
- begin
- AddDeclaration('function A : Integer; export');
- ParseFunction;
- AssertFunc([pmExport],[],ccDefault,0);
- end;
- procedure TTestProcedureFunction.TestProcedureCDeclExport;
- begin
- ParseProcedure('cdecl;export;','');
- AssertProc([pmExport],[],ccCDecl,0);
- end;
- procedure TTestProcedureFunction.TestFunctionCDeclExport;
- begin
- AddDeclaration('function A : Integer; cdecl; export');
- ParseFunction;
- AssertFunc([pmExport],[],ccCDecl,0);
- end;
- procedure TTestProcedureFunction.TestProcedureExternal;
- begin
- ParseProcedure(';external','');
- AssertProc([pmExternal],[],ccDefault,0);
- AssertNull('No Library name expression',Proc.LibraryExpr);
- end;
- procedure TTestProcedureFunction.TestFunctionExternal;
- begin
- AddDeclaration('function A : Integer; external');
- ParseFunction;
- AssertFunc([pmExternal],[],ccDefault,0);
- AssertNull('No Library name expression',Func.LibraryExpr);
- end;
- procedure TTestProcedureFunction.CreateForwardTest;
- begin
- With Source do
- begin
- Add('type');
- Add('');
- Add('Entity=object');
- Add(' function test:Boolean;');
- Add('end;');
- Add('');
- Add('Function Entity.test;');
- Add('begin');
- Add('end;');
- Add('');
- Add('begin');
- // End is added by ParseModule
- end;
- end;
- procedure TTestProcedureFunction.TestFunctionForwardNoReturnDelphi;
- begin
- Source.Add('{$MODE DELPHI}');
- CreateForwardTest;
- ParseModule;
- end;
- procedure TTestProcedureFunction.TestFunctionForwardNoReturnNoDelphi;
- begin
- CreateForwardTest;
- AssertException('Only in delphi mode can result be omitted',EParserError,@ParseModule);
- end;
- procedure TTestProcedureFunction.TestProcedureExternalLibName;
- begin
- ParseProcedure(';external ''libname''','');
- AssertProc([pmExternal],[],ccDefault,0);
- AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
- end;
- procedure TTestProcedureFunction.TestFunctionExternalLibName;
- begin
- AddDeclaration('function A : Integer; external ''libname''');
- ParseFunction;
- AssertFunc([pmExternal],[],ccDefault,0);
- AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
- end;
- procedure TTestProcedureFunction.TestProcedureExternalLibNameName;
- begin
- ParseProcedure(';external ''libname'' name ''symbolname''','');
- AssertProc([pmExternal],[],ccDefault,0);
- AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
- AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
- end;
- procedure TTestProcedureFunction.TestFunctionExternalLibNameName;
- begin
- AddDeclaration('function A : Integer; external ''libname'' name ''symbolname''');
- ParseFunction;
- AssertFunc([pmExternal],[],ccDefault,0);
- AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
- AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
- end;
- procedure TTestProcedureFunction.TestProcedureExternalName;
- begin
- ParseProcedure(';external name ''symbolname''','');
- AssertProc([pmExternal],[],ccDefault,0);
- AssertNull('No Library name expression',Proc.LibraryExpr);
- AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
- end;
- procedure TTestProcedureFunction.TestFunctionExternalName;
- begin
- AddDeclaration('function A : Integer; external name ''symbolname''');
- ParseFunction;
- AssertFunc([pmExternal],[],ccDefault,0);
- AssertNull('No Library name expression',Func.LibraryExpr);
- AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
- end;
- procedure TTestProcedureFunction.TestProcedureCdeclExternal;
- begin
- ParseProcedure('; cdecl; external','');
- AssertProc([pmExternal],[],ccCdecl,0);
- AssertNull('No Library name expression',Proc.LibraryExpr);
- end;
- procedure TTestProcedureFunction.TestFunctionCdeclExternal;
- begin
- AddDeclaration('function A : Integer; cdecl; external');
- ParseFunction;
- AssertFunc([pmExternal],[],ccCdecl,0);
- AssertNull('No Library name expression',Func.LibraryExpr);
- end;
- procedure TTestProcedureFunction.TestProcedureCdeclExternalLibName;
- begin
- ParseProcedure('; cdecl; external ''libname''','');
- AssertProc([pmExternal],[],ccCdecl,0);
- AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
- end;
- procedure TTestProcedureFunction.TestFunctionCdeclExternalLibName;
- begin
- AddDeclaration('function A : Integer; cdecl; external ''libname''');
- ParseFunction;
- AssertFunc([pmExternal],[],ccCdecl,0);
- AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
- end;
- procedure TTestProcedureFunction.TestProcedureCdeclExternalLibNameName;
- begin
- ParseProcedure('; cdecl; external ''libname'' name ''symbolname''','');
- AssertProc([pmExternal],[],ccCdecl,0);
- AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
- AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
- end;
- procedure TTestProcedureFunction.TestFunctionCdeclExternalLibNameName;
- begin
- AddDeclaration('function A : Integer; cdecl; external ''libname'' name ''symbolname''');
- ParseFunction;
- AssertFunc([pmExternal],[],ccCdecl,0);
- AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
- AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
- end;
- procedure TTestProcedureFunction.TestProcedureCdeclExternalName;
- begin
- ParseProcedure('; cdecl; external name ''symbolname''','');
- AssertProc([pmExternal],[],ccCdecl,0);
- AssertNull('No Library name expression',Proc.LibraryExpr);
- AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
- end;
- procedure TTestProcedureFunction.TestFunctionCdeclExternalName;
- begin
- AddDeclaration('function A : Integer; cdecl; external name ''symbolname''');
- ParseFunction;
- AssertFunc([pmExternal],[],ccCdecl,0);
- AssertNull('No Library name expression',Func.LibraryExpr);
- AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
- end;
- procedure TTestProcedureFunction.TestFunctionAlias;
- begin
- AddDeclaration('function A : Integer; alias: ''myalias''');
- ParseFunction;
- AssertFunc([],[],ccDefault,0);
- AssertEquals('Alias name','''myalias''',Func.AliasName);
- end;
- procedure TTestProcedureFunction.TestProcedureAlias;
- begin
- AddDeclaration('Procedure A; Alias : ''myalias''');
- ParseProcedure;
- AssertProc([],[],ccDefault,0);
- AssertEquals('Alias name','''myalias''',Proc.AliasName);
- end;
- procedure TTestProcedureFunction.TestOperatorTokens;
- Var
- t : TOperatorType;
- s : string;
- begin
- For t:=otMul to High(TOperatorType) do
- // No way to distinguish between logical/bitwise or/and/Xor
- if not (t in [otBitwiseOr,otBitwiseAnd,otBitwiseXor]) then
- begin
- S:=GetEnumName(TypeInfo(TOperatorType),Ord(T));
- ResetParser;
- if t in UnaryOperators then
- AddDeclaration(Format('operator %s (a: Integer) : te',[OperatorTokens[t]]))
- else
- AddDeclaration(Format('operator %s (a: Integer; b: integer) : te',[OperatorTokens[t]]));
- ParseOperator;
- AssertEquals(S+': Token based ',Not (T in [otInc,otDec,otEnumerator]),FOperator.TokenBased);
- AssertEquals(S+': Correct operator type',T,FOperator.OperatorType);
- if t in UnaryOperators then
- AssertEquals(S+': Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
- else
- AssertEquals(S+': Correct operator name',format('%s(Integer,Integer):te',[OperatorNames[t]]),FOperator.Name);
- end;
- end;
- procedure TTestProcedureFunction.TestOperatorNames;
- Var
- t : TOperatorType;
- S: String;
- begin
- For t:=Succ(otUnknown) to High(TOperatorType) do
- begin
- S:=GetEnumName(TypeInfo(TOperatorType),Ord(T));
- ResetParser;
- if t in UnaryOperators then
- AddDeclaration(Format('operator %s (a: Integer) : te',[OperatorNames[t]]))
- else
- AddDeclaration(Format('operator %s (a: Integer; b: integer) : te',[OperatorNames[t]]));
- ParseOperator;
- AssertEquals(S+': Token based',t in [otIn],FOperator.TokenBased);
- AssertEquals(S+': Correct operator type',T,FOperator.OperatorType);
- if t in UnaryOperators then
- AssertEquals('Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
- else
- AssertEquals('Correct operator name',format('%s(Integer,Integer):te',[OperatorNames[t]]),FOperator.Name);
- end;
- end;
- procedure TTestProcedureFunction.TestAssignOperatorAfterObject;
- begin
- Add('unit afile;');
- Add('{$mode delphi}');
- Add('interface');
- Add('type');
- Add(' TA =object');
- Add(' data:integer;');
- Add(' function transpose:integer;');
- Add(' end;');
- Add('');
- Add('operator := (const v:Tvector2_single) result:Tvector2_double;');
- Add('implementation');
- EndSource;
- Parser.Options:=[po_delphi];
- ParseModule;
- end;
- procedure TTestProcedureFunction.TestFunctionNoResult;
- begin
- Add('unit afile;');
- Add('{$mode delphi}');
- Add('interface');
- Add('function TestDelphiModeFuncs(d:double):string;');
- Add('implementation');
- Add('function TestDelphiModeFuncs;');
- Add('begin');
- Add('end;');
- EndSource;
- Parser.Options:=[po_delphi];
- ParseModule;
- end;
- procedure TTestProcedureFunction.SetUp;
- begin
- Inherited;
- end;
- procedure TTestProcedureFunction.TearDown;
- begin
- Inherited;
- end;
- procedure TTestProcedureFunction.AssertComment;
- begin
- AssertEquals('Correct comment',' A comment'+sLineBreak,FProc.DocComment);
- end;
- initialization
- RegisterTest(TTestProcedureFunction);
- end.
|