tcprocfunc.pas 41 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349
  1. unit tcprocfunc;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils, typinfo, fpcunit, pastree, pscanner, pparser, tcbaseparser,testregistry;
  6. type
  7. { TTestProcedureFunction }
  8. TTestProcedureFunction= class(TTestParser)
  9. private
  10. FAddComment: Boolean;
  11. FFunc: TPasFunction;
  12. FHint: String;
  13. FProc: TPasProcedure;
  14. FOperator:TPasOperator;
  15. procedure AddDeclaration(const ASource: string; const AHint: String='');
  16. procedure AssertArg(ProcType: TPasProcedureType; AIndex: Integer;
  17. AName: String; AAccess: TArgumentAccess; const TypeName: String;
  18. AValue: String='');
  19. procedure AssertArrayArg(ProcType: TPasProcedureType; AIndex: Integer;
  20. AName: String; AAccess: TArgumentAccess; const ElementTypeName: String);
  21. procedure AssertFunc(const Mods: TProcedureModifiers; const TypeMods: TProcTypeModifiers; CC: TCallingConvention; ArgCount: Integer; P: TPasFunction=nil);
  22. procedure AssertProc(const Mods: TProcedureModifiers; const TypeMods: TProcTypeModifiers; CC: TCallingConvention; ArgCount: Integer; P: TPasProcedure=nil);
  23. function BaseAssertArg(ProcType: TPasProcedureType; AIndex: Integer;
  24. AName: String; AAccess: TArgumentAccess; AValue: String=''): TPasArgument;
  25. procedure CreateForwardTest;
  26. function GetFT: TPasFunctionType;
  27. function GetPT: TPasProcedureType;
  28. Procedure ParseProcedure;
  29. function ParseProcedure(const ASource: string; const AHint: String=''): TPasProcedure;
  30. Procedure ParseFunction;
  31. function ParseFunction(const ASource : String; AResult: string = ''; const AHint: String=''; CC : TCallingConvention = ccDefault): TPasProcedure;
  32. Procedure ParseOperator;
  33. protected
  34. procedure SetUp; override;
  35. procedure TearDown; override;
  36. Procedure AssertComment;
  37. Property AddComment : Boolean Read FAddComment Write FAddComment;
  38. Property Hint : String Read FHint Write FHint;
  39. Property Proc : TPasProcedure Read FProc;
  40. Property ProcType : TPasProcedureType Read GetPT;
  41. Property Func : TPasFunction Read FFunc;
  42. Property FuncType : TPasFunctionType Read GetFT;
  43. published
  44. procedure TestEmptyProcedure;
  45. procedure TestEmptyProcedureComment;
  46. Procedure TestEmptyFunction;
  47. Procedure TestEmptyFunctionComment;
  48. procedure TestEmptyProcedureDeprecated;
  49. Procedure TestEmptyFunctionDeprecated;
  50. procedure TestEmptyProcedurePlatform;
  51. Procedure TestEmptyFunctionPlatform;
  52. procedure TestEmptyProcedureExperimental;
  53. Procedure TestEmptyFunctionExperimental;
  54. procedure TestEmptyProcedureUnimplemented;
  55. Procedure TestEmptyFunctionUnimplemented;
  56. procedure TestProcedureOneArg;
  57. Procedure TestFunctionOneArg;
  58. procedure TestProcedureOneVarArg;
  59. Procedure TestFunctionOneVarArg;
  60. procedure TestProcedureOneConstArg;
  61. Procedure TestFunctionOneConstArg;
  62. procedure TestProcedureOneOutArg;
  63. Procedure TestFunctionOneOutArg;
  64. procedure TestProcedureOneConstRefArg;
  65. Procedure TestFunctionOneConstRefArg;
  66. procedure TestProcedureTwoArgs;
  67. Procedure TestFunctionTwoArgs;
  68. procedure TestProcedureTwoArgsSeparate;
  69. Procedure TestFunctionTwoArgsSeparate;
  70. procedure TestProcedureOneArgDefault;
  71. Procedure TestFunctionOneArgDefault;
  72. procedure TestProcedureOneArgDefaultSet;
  73. Procedure TestFunctionOneArgDefaultSet;
  74. procedure TestProcedureOneArgDefaultExpr;
  75. Procedure TestFunctionOneArgDefaultExpr;
  76. procedure TestProcedureTwoArgsDefault;
  77. Procedure TestFunctionTwoArgsDefault;
  78. procedure TestFunctionOneArgEnumeratedExplicit;
  79. procedure TestProcedureOneUntypedVarArg;
  80. Procedure TestFunctionOneUntypedVarArg;
  81. procedure TestProcedureTwoUntypedVarArgs;
  82. Procedure TestFunctionTwoUntypedVarArgs;
  83. procedure TestProcedureOneUntypedConstArg;
  84. Procedure TestFunctionOneUntypedConstArg;
  85. procedure TestProcedureTwoUntypedConstArgs;
  86. Procedure TestFunctionTwoUntypedConstArgs;
  87. procedure TestProcedureOpenArrayArg;
  88. Procedure TestFunctionOpenArrayArg;
  89. procedure TestProcedureTwoOpenArrayArgs;
  90. Procedure TestFunctionTwoOpenArrayArgs;
  91. procedure TestProcedureConstOpenArrayArg;
  92. Procedure TestFunctionConstOpenArrayArg;
  93. procedure TestProcedureVarOpenArrayArg;
  94. Procedure TestFunctionVarOpenArrayArg;
  95. procedure TestProcedureArrayOfConstArg;
  96. Procedure TestFunctionArrayOfConstArg;
  97. procedure TestProcedureConstArrayOfConstArg;
  98. Procedure TestFunctionConstArrayOfConstArg;
  99. Procedure TestProcedureCdecl;
  100. Procedure TestFunctionCdecl;
  101. Procedure TestProcedureCdeclDeprecated;
  102. Procedure TestFunctionCdeclDeprecated;
  103. Procedure TestProcedureSafeCall;
  104. Procedure TestFunctionSafeCall;
  105. //ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall);
  106. Procedure TestProcedurePascal;
  107. Procedure TestFunctionPascal;
  108. Procedure TestProcedureStdCall;
  109. Procedure TestFunctionStdCall;
  110. Procedure TestProcedureOldFPCCall;
  111. Procedure TestFunctionOldFPCCall;
  112. Procedure TestProcedurePublic;
  113. Procedure TestProcedurePublicIdent;
  114. Procedure TestFunctionPublic;
  115. Procedure TestProcedureCdeclPublic;
  116. Procedure TestFunctionCdeclPublic;
  117. Procedure TestProcedureOverload;
  118. Procedure TestFunctionOverload;
  119. Procedure TestProcedureVarargs;
  120. Procedure TestFunctionVarArgs;
  121. Procedure TestProcedureCDeclVarargs;
  122. Procedure TestFunctionCDeclVarArgs;
  123. Procedure TestProcedureForwardInterface;
  124. Procedure TestFunctionForwardInterface;
  125. Procedure TestProcedureForward;
  126. Procedure TestFunctionForward;
  127. Procedure TestProcedureFar;
  128. Procedure TestFunctionFar;
  129. Procedure TestProcedureCdeclForward;
  130. Procedure TestFunctionCDeclForward;
  131. Procedure TestProcedureCompilerProc;
  132. Procedure TestProcedureNoReturn;
  133. Procedure TestFunctionCompilerProc;
  134. Procedure TestProcedureCDeclCompilerProc;
  135. Procedure TestFunctionCDeclCompilerProc;
  136. Procedure TestProcedureAssembler;
  137. Procedure TestFunctionAssembler;
  138. Procedure TestProcedureCDeclAssembler;
  139. Procedure TestFunctionCDeclAssembler;
  140. Procedure TestProcedureExport;
  141. Procedure TestFunctionExport;
  142. Procedure TestProcedureCDeclExport;
  143. Procedure TestFunctionCDeclExport;
  144. Procedure TestProcedureExternal;
  145. Procedure TestFunctionExternal;
  146. Procedure TestFunctionForwardNoReturnDelphi;
  147. procedure TestFunctionForwardNoReturnNoDelphi;
  148. Procedure TestProcedureExternalLibName;
  149. Procedure TestFunctionExternalLibName;
  150. Procedure TestProcedureExternalLibNameName;
  151. Procedure TestFunctionExternalLibNameName;
  152. Procedure TestProcedureExternalName;
  153. Procedure TestFunctionExternalName;
  154. Procedure TestProcedureCdeclExternal;
  155. Procedure TestProcedureAlias;
  156. Procedure TestFunctionCdeclExternal;
  157. Procedure TestProcedureCdeclExternalLibName;
  158. Procedure TestFunctionCdeclExternalLibName;
  159. Procedure TestProcedureCdeclExternalLibNameName;
  160. Procedure TestFunctionCdeclExternalLibNameName;
  161. Procedure TestProcedureCdeclExternalName;
  162. Procedure TestFunctionCdeclExternalName;
  163. Procedure TestFunctionAlias;
  164. Procedure TestOperatorTokens;
  165. procedure TestOperatorNames;
  166. Procedure TestAssignOperatorAfterObject;
  167. Procedure TestFunctionNoResult;
  168. end;
  169. implementation
  170. procedure TTestProcedureFunction.AddDeclaration(const ASource: string;
  171. const AHint: String);
  172. Var
  173. D : String;
  174. begin
  175. Hint:=AHint;
  176. D:=ASource;
  177. If Hint<>'' then
  178. D:=D+' '+Hint;
  179. if (D[Length(D)]<>';') then
  180. D:=D+';';
  181. Add(D);
  182. end;
  183. function TTestProcedureFunction.GetPT: TPasProcedureType;
  184. begin
  185. AssertNotNull('have procedure to get type from',Proc);
  186. Result:=Proc.ProcType;
  187. end;
  188. function TTestProcedureFunction.ParseProcedure(const ASource: string;
  189. const AHint: String): TPasProcedure;
  190. begin
  191. If AddComment then
  192. begin
  193. Add('// A comment');
  194. Engine.NeedComments:=True;
  195. end;
  196. AddDeclaration('procedure A '+ASource,AHint);
  197. Self.ParseProcedure;
  198. Result:=Fproc;
  199. If AddComment then
  200. AssertComment;
  201. end;
  202. procedure TTestProcedureFunction.ParseProcedure;
  203. begin
  204. // Writeln(source.text);
  205. ParseDeclarations;
  206. AssertEquals('One variable definition',1,Declarations.Functions.Count);
  207. AssertEquals('First declaration is procedure declaration.',TPasProcedure,TObject(Declarations.Functions[0]).ClassType);
  208. FProc:=TPasProcedure(Declarations.Functions[0]);
  209. Definition:=FProc;
  210. AssertEquals('First declaration has correct name.','A',FProc.Name);
  211. if (Hint<>'') then
  212. CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'h'+Hint)));
  213. end;
  214. function TTestProcedureFunction.ParseFunction(const ASource : String;AResult: string = ''; const AHint: String = ''; CC : TCallingConvention = ccDefault): TPasProcedure;
  215. Var
  216. D :String;
  217. begin
  218. if (AResult='') then
  219. AResult:='Integer';
  220. D:='Function A '+ASource+' : '+AResult;
  221. If (cc<>ccDefault) then
  222. D:=D+'; '+cCallingConventions[cc]+';';
  223. AddDeclaration(D,AHint);
  224. Self.ParseFunction;
  225. Result:=FFunc;
  226. AssertNotNull('Have function result element',FuncType.ResultEl);
  227. AssertNotNull('Have function result type element',FuncType.ResultEl.ResultType);
  228. AssertEquals('Correct function result type name',AResult,FuncType.ResultEl.ResultType.Name);
  229. end;
  230. procedure TTestProcedureFunction.ParseOperator;
  231. begin
  232. // Writeln(source.text);
  233. ParseDeclarations;
  234. AssertEquals('One operator definition',1,Declarations.Functions.Count);
  235. AssertEquals('First declaration is function declaration.',TPasOperator,TObject(Declarations.Functions[0]).ClassType);
  236. FOperator:=TPasOperator(Declarations.Functions[0]);
  237. Definition:=FOperator;
  238. if (Hint<>'') then
  239. CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'h'+Hint)));
  240. end;
  241. procedure TTestProcedureFunction.ParseFunction;
  242. begin
  243. // Writeln(source.text);
  244. ParseDeclarations;
  245. AssertEquals('One variable definition',1,Declarations.Functions.Count);
  246. AssertEquals('First declaration is function declaration.',TPasFunction,TObject(Declarations.Functions[0]).ClassType);
  247. FFunc:=TPasFunction(Declarations.Functions[0]);
  248. Definition:=FFunc;
  249. AssertEquals('First declaration has correct name.','A',FFunc.Name);
  250. if (Hint<>'') then
  251. CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'h'+Hint)));
  252. end;
  253. procedure TTestProcedureFunction.AssertProc(const Mods: TProcedureModifiers;
  254. const TypeMods: TProcTypeModifiers; CC: TCallingConvention; ArgCount: Integer;
  255. P: TPasProcedure);
  256. begin
  257. If P=Nil then
  258. P:=Proc;
  259. AssertNotNull('No proc to assert',P);
  260. AssertEquals('Procedure modifiers',Mods,P.Modifiers);
  261. AssertEquals('Procedure type modifiers',TypeMods,P.ProcType.Modifiers);
  262. AssertEquals('Procedue calling convention',CC,P.CallingConvention);
  263. AssertEquals('No message name','',p.MessageName);
  264. AssertEquals('No message type',pmtNone,P.MessageType);
  265. AssertNotNull('Have procedure type to assert',P.ProcType);
  266. AssertEquals('Correct number of arguments',ArgCount,P.ProcType.Args.Count);
  267. AssertEquals('Not of object',False,P.ProcType.IsOfObject);
  268. AssertEquals('Not is nested',False,P.ProcType.IsNested);
  269. end;
  270. procedure TTestProcedureFunction.AssertFunc(const Mods: TProcedureModifiers;
  271. const TypeMods: TProcTypeModifiers; CC: TCallingConvention; ArgCount: Integer;
  272. P: TPasFunction);
  273. begin
  274. If P=Nil then
  275. P:=Func;
  276. AssertNotNull('No func to assert',P);
  277. AssertEquals('Procedure modifiers',Mods,P.Modifiers);
  278. AssertEquals('Procedure type modifiers',TypeMods,P.ProcType.Modifiers);
  279. AssertEquals('Procedue calling convention',CC,P.CallingConvention);
  280. AssertEquals('No message name','',p.MessageName);
  281. AssertEquals('No message type',pmtNone,P.MessageType);
  282. AssertNotNull('Have procedure type to assert',P.ProcType);
  283. AssertEquals('Correct number of arguments',ArgCount,P.ProcType.Args.Count);
  284. AssertEquals('Not of object',False,P.ProcType.IsOfObject);
  285. AssertEquals('Not is nested',False,P.ProcType.IsNested);
  286. end;
  287. function TTestProcedureFunction.BaseAssertArg(ProcType: TPasProcedureType;
  288. AIndex: Integer; AName: String; AAccess: TArgumentAccess; AValue: String
  289. ): TPasArgument;
  290. Var
  291. A : TPasArgument;
  292. N : String;
  293. begin
  294. AssertNotNull('Have proctype to test argument',ProcType);
  295. if AIndex>=Proctype.Args.Count then
  296. Fail(Format('Cannot test argument: index %d is larger than the number of arguments (%d).',[AIndex,Proctype.Args.Count]));
  297. AssertNotNull('Have argument at position '+IntToStr(AIndex),Proctype.Args[AIndex]);
  298. AssertEquals('Have argument type at position '+IntToStr(AIndex),TPasArgument,TObject(Proctype.Args[AIndex]).ClassType);
  299. N:='Argument '+IntToStr(AIndex+1)+' : ';
  300. A:=TPasArgument(Proctype.Args[AIndex]);
  301. AssertEquals(N+'Argument name',AName,A.Name);
  302. AssertEquals(N+'Argument access',AAccess,A.Access);
  303. if (AValue='') then
  304. AssertNull(N+' no default value',A.ValueExpr)
  305. else
  306. begin
  307. AssertNotNull(N+' Have default value',A.ValueExpr);
  308. AssertEquals(N+' Default value',AValue,A.Value);
  309. end;
  310. Result:=A;
  311. end;
  312. procedure TTestProcedureFunction.AssertArg(ProcType: TPasProcedureType;
  313. AIndex: Integer; AName: String; AAccess: TArgumentAccess;
  314. const TypeName: String; AValue: String);
  315. Var
  316. A : TPasArgument;
  317. N : String;
  318. begin
  319. A:=BaseAssertArg(ProcType,AIndex,ANAme,AAccess,AValue);
  320. N:='Argument '+IntToStr(AIndex+1)+' : ';
  321. if (TypeName='') then
  322. AssertNull(N+' No argument type',A.ArgType)
  323. else
  324. begin
  325. AssertNotNull(N+' Have argument type',A.ArgType);
  326. AssertEquals(N+' Correct argument type name',TypeName,A.ArgType.Name);
  327. end;
  328. end;
  329. procedure TTestProcedureFunction.AssertArrayArg(ProcType: TPasProcedureType;
  330. AIndex: Integer; AName: String; AAccess: TArgumentAccess;
  331. const ElementTypeName: String);
  332. Var
  333. A : TPasArgument;
  334. AT : TPasArrayType;
  335. N : String;
  336. begin
  337. A:=BaseAssertArg(ProcType,AIndex,ANAme,AAccess,'');
  338. N:='Argument '+IntToStr(AIndex+1)+' : ';
  339. AssertNotNull(N+' Have argument type',A.ArgType);
  340. AssertEquals(N+' is arrayType',TPasArrayType,A.ArgType.ClassType);
  341. AT:=TPasArrayType(A.ArgType);
  342. if (ElementTypeName='') then
  343. AssertNull(N+' No array element type',AT.ElType)
  344. else
  345. begin
  346. AssertNotNull(N+' Have array element type',AT.ElType);
  347. AssertEquals(N+' Correct array element type name',ElementTypeName,AT.ElType.Name);
  348. end;
  349. end;
  350. function TTestProcedureFunction.GetFT: TPasFunctionType;
  351. begin
  352. AssertNotNull('have function to get type from',Func);
  353. AssertEquals('Function type is correct type',TPasFunctionType,Func.ProcType.ClassType);
  354. Result:=Func.FuncType;
  355. end;
  356. //TProcedureMessageType
  357. procedure TTestProcedureFunction.TestEmptyProcedure;
  358. begin
  359. ParseProcedure('');
  360. AssertProc([],[],ccDefault,0);
  361. end;
  362. procedure TTestProcedureFunction.TestEmptyProcedureComment;
  363. begin
  364. AddComment:=True;
  365. TestEmptyProcedure;
  366. end;
  367. procedure TTestProcedureFunction.TestEmptyFunction;
  368. begin
  369. ParseFunction('');
  370. AssertFunc([],[],ccDefault,0);
  371. end;
  372. procedure TTestProcedureFunction.TestEmptyFunctionComment;
  373. begin
  374. AddComment:=True;
  375. TestEmptyProcedure;
  376. end;
  377. procedure TTestProcedureFunction.TestEmptyProcedureDeprecated;
  378. begin
  379. ParseProcedure('','deprecated');
  380. AssertProc([],[],ccDefault,0);
  381. end;
  382. procedure TTestProcedureFunction.TestEmptyFunctionDeprecated;
  383. begin
  384. ParseFunction('','deprecated');
  385. AssertFunc([],[],ccDefault,0);
  386. end;
  387. procedure TTestProcedureFunction.TestEmptyProcedurePlatform;
  388. begin
  389. ParseProcedure('','platform');
  390. AssertProc([],[],ccDefault,0);
  391. end;
  392. procedure TTestProcedureFunction.TestEmptyFunctionPlatform;
  393. begin
  394. ParseFunction('','platform');
  395. AssertFunc([],[],ccDefault,0);
  396. end;
  397. procedure TTestProcedureFunction.TestEmptyProcedureExperimental;
  398. begin
  399. ParseProcedure('','experimental');
  400. AssertProc([],[],ccDefault,0);
  401. end;
  402. procedure TTestProcedureFunction.TestEmptyFunctionExperimental;
  403. begin
  404. ParseFunction('','experimental');
  405. AssertFunc([],[],ccDefault,0);
  406. end;
  407. procedure TTestProcedureFunction.TestEmptyProcedureUnimplemented;
  408. begin
  409. ParseProcedure('','unimplemented');
  410. AssertProc([],[],ccDefault,0);
  411. end;
  412. procedure TTestProcedureFunction.TestEmptyFunctionUnimplemented;
  413. begin
  414. ParseFunction('','unimplemented');
  415. AssertFunc([],[],ccDefault,0);
  416. end;
  417. procedure TTestProcedureFunction.TestProcedureOneArg;
  418. begin
  419. ParseProcedure('(B : Integer)');
  420. AssertProc([],[],ccDefault,1);
  421. AssertArg(ProcType,0,'B',argDefault,'Integer','');
  422. end;
  423. procedure TTestProcedureFunction.TestFunctionOneArg;
  424. begin
  425. ParseFunction('(B : Integer)');
  426. AssertFunc([],[],ccDefault,1);
  427. AssertArg(FuncType,0,'B',argDefault,'Integer','');
  428. end;
  429. procedure TTestProcedureFunction.TestProcedureOneVarArg;
  430. begin
  431. ParseProcedure('(Var B : Integer)');
  432. AssertProc([],[],ccDefault,1);
  433. AssertArg(ProcType,0,'B',argVar,'Integer','');
  434. end;
  435. procedure TTestProcedureFunction.TestFunctionOneVarArg;
  436. begin
  437. ParseFunction('(Var B : Integer)');
  438. AssertFunc([],[],ccDefault,1);
  439. AssertArg(FuncType,0,'B',argVar,'Integer','');
  440. end;
  441. procedure TTestProcedureFunction.TestProcedureOneConstArg;
  442. begin
  443. ParseProcedure('(Const B : Integer)');
  444. AssertProc([],[],ccDefault,1);
  445. AssertArg(ProcType,0,'B',argConst,'Integer','');
  446. end;
  447. procedure TTestProcedureFunction.TestFunctionOneConstArg;
  448. begin
  449. ParseFunction('(Const B : Integer)');
  450. AssertFunc([],[],ccDefault,1);
  451. AssertArg(FuncType,0,'B',argConst,'Integer','');
  452. end;
  453. procedure TTestProcedureFunction.TestProcedureOneOutArg;
  454. begin
  455. ParseProcedure('(Out B : Integer)');
  456. AssertProc([],[],ccDefault,1);
  457. AssertArg(ProcType,0,'B',argOut,'Integer','');
  458. end;
  459. procedure TTestProcedureFunction.TestFunctionOneOutArg;
  460. begin
  461. ParseFunction('(Out B : Integer)');
  462. AssertFunc([],[],ccDefault,1);
  463. AssertArg(FuncType,0,'B',argOut,'Integer','');
  464. end;
  465. procedure TTestProcedureFunction.TestProcedureOneConstRefArg;
  466. begin
  467. ParseProcedure('(Constref B : Integer)');
  468. AssertProc([],[],ccDefault,1);
  469. AssertArg(ProcType,0,'B',argConstRef,'Integer','');
  470. end;
  471. procedure TTestProcedureFunction.TestFunctionOneConstRefArg;
  472. begin
  473. ParseFunction('(ConstRef B : Integer)');
  474. AssertFunc([],[],ccDefault,1);
  475. AssertArg(FuncType,0,'B',argConstref,'Integer','');
  476. end;
  477. procedure TTestProcedureFunction.TestProcedureTwoArgs;
  478. begin
  479. ParseProcedure('(B,C : Integer)');
  480. AssertProc([],[],ccDefault,2);
  481. AssertArg(ProcType,0,'B',argDefault,'Integer','');
  482. AssertArg(ProcType,1,'C',argDefault,'Integer','');
  483. end;
  484. procedure TTestProcedureFunction.TestFunctionTwoArgs;
  485. begin
  486. ParseFunction('(B,C : Integer)');
  487. AssertFunc([],[],ccDefault,2);
  488. AssertArg(FuncType,0,'B',argDefault,'Integer','');
  489. AssertArg(FuncType,1,'C',argDefault,'Integer','');
  490. end;
  491. procedure TTestProcedureFunction.TestProcedureTwoArgsSeparate;
  492. begin
  493. ParseProcedure('(B : Integer; C : Integer)');
  494. AssertProc([],[],ccDefault,2);
  495. AssertArg(ProcType,0,'B',argDefault,'Integer','');
  496. AssertArg(ProcType,1,'C',argDefault,'Integer','');
  497. end;
  498. procedure TTestProcedureFunction.TestFunctionTwoArgsSeparate;
  499. begin
  500. ParseFunction('(B : Integer;C : Integer)');
  501. AssertFunc([],[],ccDefault,2);
  502. AssertArg(FuncType,0,'B',argDefault,'Integer','');
  503. AssertArg(FuncType,1,'C',argDefault,'Integer','');
  504. end;
  505. procedure TTestProcedureFunction.TestProcedureOneArgDefault;
  506. begin
  507. ParseProcedure('(B : Integer = 1)');
  508. AssertProc([],[],ccDefault,1);
  509. AssertArg(ProcType,0,'B',argDefault,'Integer','1');
  510. end;
  511. procedure TTestProcedureFunction.TestFunctionOneArgDefault;
  512. begin
  513. ParseFunction('(B : Integer = 1)');
  514. AssertFunc([],[],ccDefault,1);
  515. AssertArg(FuncType,0,'B',argDefault,'Integer','1');
  516. end;
  517. procedure TTestProcedureFunction.TestFunctionOneArgEnumeratedExplicit;
  518. begin
  519. ParseFunction('(B : TSomeEnum = TSomeEnum.False)');
  520. AssertFunc([],[],ccDefault,1);
  521. AssertArg(FuncType,0,'B',argDefault,'TSomeEnum','TSomeEnum.False');
  522. end;
  523. procedure TTestProcedureFunction.TestProcedureOneArgDefaultSet;
  524. begin
  525. ParseProcedure('(B : MySet = [1,2])');
  526. AssertProc([],[],ccDefault,1);
  527. AssertArg(ProcType,0,'B',argDefault,'MySet','[1, 2]');
  528. end;
  529. procedure TTestProcedureFunction.TestFunctionOneArgDefaultSet;
  530. begin
  531. ParseFunction('(B : MySet = [1,2])');
  532. AssertFunc([],[],ccDefault,1);
  533. AssertArg(FuncType,0,'B',argDefault,'MySet','[1, 2]');
  534. end;
  535. procedure TTestProcedureFunction.TestProcedureOneArgDefaultExpr;
  536. begin
  537. ParseProcedure('(B : Integer = 1 + 2)');
  538. AssertProc([],[],ccDefault,1);
  539. AssertArg(ProcType,0,'B',argDefault,'Integer','1 + 2');
  540. end;
  541. procedure TTestProcedureFunction.TestFunctionOneArgDefaultExpr;
  542. begin
  543. ParseFunction('(B : Integer = 1 + 2)');
  544. AssertFunc([],[],ccDefault,1);
  545. AssertArg(FuncType,0,'B',argDefault,'Integer','1 + 2');
  546. end;
  547. procedure TTestProcedureFunction.TestProcedureTwoArgsDefault;
  548. begin
  549. ParseProcedure('(B : Integer = 1; C : Integer = 2)');
  550. AssertProc([],[],ccDefault,2);
  551. AssertArg(ProcType,0,'B',argDefault,'Integer','1');
  552. AssertArg(ProcType,1,'C',argDefault,'Integer','2');
  553. end;
  554. procedure TTestProcedureFunction.TestFunctionTwoArgsDefault;
  555. begin
  556. ParseFunction('(B : Integer = 1; C : Integer = 2)');
  557. AssertFunc([],[],ccDefault,2);
  558. AssertArg(FuncType,0,'B',argDefault,'Integer','1');
  559. AssertArg(FuncType,1,'C',argDefault,'Integer','2');
  560. end;
  561. procedure TTestProcedureFunction.TestProcedureOneUntypedVarArg;
  562. begin
  563. ParseProcedure('(Var B)');
  564. AssertProc([],[],ccDefault,1);
  565. AssertArg(ProcType,0,'B',argVar,'','');
  566. end;
  567. procedure TTestProcedureFunction.TestFunctionOneUntypedVarArg;
  568. begin
  569. ParseFunction('(Var B)');
  570. AssertFunc([],[],ccDefault,1);
  571. AssertArg(FuncType,0,'B',argVar,'','');
  572. end;
  573. procedure TTestProcedureFunction.TestProcedureTwoUntypedVarArgs;
  574. begin
  575. ParseProcedure('(Var B; Var C)');
  576. AssertProc([],[],ccDefault,2);
  577. AssertArg(ProcType,0,'B',argVar,'','');
  578. AssertArg(ProcType,1,'C',argVar,'','');
  579. end;
  580. procedure TTestProcedureFunction.TestFunctionTwoUntypedVarArgs;
  581. begin
  582. ParseFunction('(Var B; Var C)');
  583. AssertFunc([],[],ccDefault,2);
  584. AssertArg(FuncType,0,'B',argVar,'','');
  585. AssertArg(FuncType,1,'C',argVar,'','');
  586. end;
  587. procedure TTestProcedureFunction.TestProcedureOneUntypedConstArg;
  588. begin
  589. ParseProcedure('(Const B)');
  590. AssertProc([],[],ccDefault,1);
  591. AssertArg(ProcType,0,'B',argConst,'','');
  592. end;
  593. procedure TTestProcedureFunction.TestFunctionOneUntypedConstArg;
  594. begin
  595. ParseFunction('(Const B)');
  596. AssertFunc([],[],ccDefault,1);
  597. AssertArg(FuncType,0,'B',argConst,'','');
  598. end;
  599. procedure TTestProcedureFunction.TestProcedureTwoUntypedConstArgs;
  600. begin
  601. ParseProcedure('(Const B; Const C)');
  602. AssertProc([],[],ccDefault,2);
  603. AssertArg(ProcType,0,'B',argConst,'','');
  604. AssertArg(ProcType,1,'C',argConst,'','');
  605. end;
  606. procedure TTestProcedureFunction.TestFunctionTwoUntypedConstArgs;
  607. begin
  608. ParseFunction('(Const B; Const C)');
  609. AssertFunc([],[],ccDefault,2);
  610. AssertArg(FuncType,0,'B',argConst,'','');
  611. AssertArg(FuncType,1,'C',argConst,'','');
  612. end;
  613. procedure TTestProcedureFunction.TestProcedureOpenArrayArg;
  614. begin
  615. ParseProcedure('(B : Array of Integer)');
  616. AssertProc([],[],ccDefault,1);
  617. AssertArrayArg(ProcType,0,'B',argDefault,'Integer');
  618. end;
  619. procedure TTestProcedureFunction.TestFunctionOpenArrayArg;
  620. begin
  621. ParseFunction('(B : Array of Integer)');
  622. AssertFunc([],[],ccDefault,1);
  623. AssertArrayArg(FuncType,0,'B',argDefault,'Integer');
  624. end;
  625. procedure TTestProcedureFunction.TestProcedureTwoOpenArrayArgs;
  626. begin
  627. ParseProcedure('(B : Array of Integer;C : Array of Integer)');
  628. AssertProc([],[],ccDefault,2);
  629. AssertArrayArg(ProcType,0,'B',argDefault,'Integer');
  630. AssertArrayArg(ProcType,1,'C',argDefault,'Integer');
  631. end;
  632. procedure TTestProcedureFunction.TestFunctionTwoOpenArrayArgs;
  633. begin
  634. ParseFunction('(B : Array of Integer;C : Array of Integer)');
  635. AssertFunc([],[],ccDefault,2);
  636. AssertArrayArg(FuncType,0,'B',argDefault,'Integer');
  637. AssertArrayArg(FuncType,1,'C',argDefault,'Integer');
  638. end;
  639. procedure TTestProcedureFunction.TestProcedureConstOpenArrayArg;
  640. begin
  641. ParseProcedure('(Const B : Array of Integer)');
  642. AssertProc([],[],ccDefault,1);
  643. AssertArrayArg(ProcType,0,'B',argConst,'Integer');
  644. end;
  645. procedure TTestProcedureFunction.TestFunctionConstOpenArrayArg;
  646. begin
  647. ParseFunction('(Const B : Array of Integer)');
  648. AssertFunc([],[],ccDefault,1);
  649. AssertArrayArg(FuncType,0,'B',argConst,'Integer');
  650. end;
  651. procedure TTestProcedureFunction.TestProcedureVarOpenArrayArg;
  652. begin
  653. ParseProcedure('(Var B : Array of Integer)');
  654. AssertProc([],[],ccDefault,1);
  655. AssertArrayArg(ProcType,0,'B',argVar,'Integer');
  656. end;
  657. procedure TTestProcedureFunction.TestFunctionVarOpenArrayArg;
  658. begin
  659. ParseFunction('(Var B : Array of Integer)');
  660. AssertFunc([],[],ccDefault,1);
  661. AssertArrayArg(FuncType,0,'B',argVar,'Integer');
  662. end;
  663. procedure TTestProcedureFunction.TestProcedureArrayOfConstArg;
  664. begin
  665. ParseProcedure('(B : Array of Const)');
  666. AssertProc([],[],ccDefault,1);
  667. AssertArrayArg(ProcType,0,'B',argDefault,'');
  668. end;
  669. procedure TTestProcedureFunction.TestFunctionArrayOfConstArg;
  670. begin
  671. ParseFunction('(B : Array of Const)');
  672. AssertFunc([],[],ccDefault,1);
  673. AssertArrayArg(FuncType,0,'B',argDefault,'');
  674. end;
  675. procedure TTestProcedureFunction.TestProcedureConstArrayOfConstArg;
  676. begin
  677. ParseProcedure('(Const B : Array of Const)');
  678. AssertProc([],[],ccDefault,1);
  679. AssertArrayArg(ProcType,0,'B',argConst,'');
  680. end;
  681. procedure TTestProcedureFunction.TestFunctionConstArrayOfConstArg;
  682. begin
  683. ParseFunction('(Const B : Array of Const)');
  684. AssertFunc([],[],ccDefault,1);
  685. AssertArrayArg(FuncType,0,'B',argConst,'');
  686. end;
  687. procedure TTestProcedureFunction.TestProcedureCdecl;
  688. begin
  689. ParseProcedure('; cdecl');
  690. AssertProc([],[],ccCdecl,0);
  691. end;
  692. procedure TTestProcedureFunction.TestFunctionCdecl;
  693. begin
  694. ParseFunction('','','',ccCdecl);
  695. AssertFunc([],[],ccCdecl,0);
  696. end;
  697. procedure TTestProcedureFunction.TestProcedureCdeclDeprecated;
  698. begin
  699. ParseProcedure('; cdecl;','deprecated');
  700. AssertProc([],[],ccCdecl,0);
  701. end;
  702. procedure TTestProcedureFunction.TestFunctionCdeclDeprecated;
  703. begin
  704. ParseFunction('','','deprecated',ccCdecl);
  705. AssertFunc([],[],ccCdecl,0);
  706. end;
  707. procedure TTestProcedureFunction.TestProcedureSafeCall;
  708. begin
  709. ParseProcedure('; safecall;','');
  710. AssertProc([],[],ccSafeCall,0);
  711. end;
  712. procedure TTestProcedureFunction.TestFunctionSafeCall;
  713. begin
  714. ParseFunction('','','',ccSafecall);
  715. AssertFunc([],[],ccSafecall,0);
  716. end;
  717. procedure TTestProcedureFunction.TestProcedurePascal;
  718. begin
  719. ParseProcedure('; pascal;','');
  720. AssertProc([],[],ccPascal,0);
  721. end;
  722. procedure TTestProcedureFunction.TestFunctionPascal;
  723. begin
  724. ParseFunction('','','',ccPascal);
  725. AssertFunc([],[],ccPascal,0);
  726. end;
  727. procedure TTestProcedureFunction.TestProcedureStdCall;
  728. begin
  729. ParseProcedure('; stdcall;','');
  730. AssertProc([],[],ccstdcall,0);
  731. end;
  732. procedure TTestProcedureFunction.TestFunctionStdCall;
  733. begin
  734. ParseFunction('','','',ccStdCall);
  735. AssertFunc([],[],ccStdCall,0);
  736. end;
  737. procedure TTestProcedureFunction.TestProcedureOldFPCCall;
  738. begin
  739. ParseProcedure('; oldfpccall;','');
  740. AssertProc([],[],ccoldfpccall,0);
  741. end;
  742. procedure TTestProcedureFunction.TestFunctionOldFPCCall;
  743. begin
  744. ParseFunction('','','',ccOldFPCCall);
  745. AssertFunc([],[],ccOldFPCCall,0);
  746. end;
  747. procedure TTestProcedureFunction.TestProcedurePublic;
  748. begin
  749. ParseProcedure('; public name ''myfunc'';','');
  750. AssertProc([pmPublic],[],ccDefault,0);
  751. AssertExpression('Public name',Proc.PublicName,pekString,'''myfunc''');
  752. end;
  753. procedure TTestProcedureFunction.TestProcedurePublicIdent;
  754. begin
  755. ParseProcedure('; public name exportname;','');
  756. AssertProc([pmPublic],[],ccDefault,0);
  757. AssertExpression('Public name',Proc.PublicName,pekIdent,'exportname');
  758. end;
  759. procedure TTestProcedureFunction.TestFunctionPublic;
  760. begin
  761. AddDeclaration('function A : Integer; public name exportname');
  762. ParseFunction;
  763. AssertFunc([pmPublic],[],ccDefault,0);
  764. AssertExpression('Public name',Func.PublicName,pekIdent,'exportname');
  765. end;
  766. procedure TTestProcedureFunction.TestProcedureCdeclPublic;
  767. begin
  768. ParseProcedure('; cdecl; public name exportname;','');
  769. AssertProc([pmPublic],[],ccCDecl,0);
  770. AssertExpression('Public name',Proc.PublicName,pekIdent,'exportname');
  771. end;
  772. procedure TTestProcedureFunction.TestFunctionCdeclPublic;
  773. begin
  774. AddDeclaration('function A : Integer; cdecl; public name exportname');
  775. ParseFunction;
  776. AssertFunc([pmPublic],[],ccCDecl,0);
  777. AssertExpression('Public name',Func.PublicName,pekIdent,'exportname');
  778. end;
  779. procedure TTestProcedureFunction.TestProcedureOverload;
  780. begin
  781. ParseProcedure('; overload;','');
  782. AssertProc([pmOverload],[],ccDefault,0);
  783. end;
  784. procedure TTestProcedureFunction.TestFunctionOverload;
  785. begin
  786. AddDeclaration('function A : Integer; overload');
  787. ParseFunction;
  788. AssertFunc([pmOverload],[],ccDefault,0);
  789. end;
  790. procedure TTestProcedureFunction.TestProcedureVarargs;
  791. begin
  792. ParseProcedure('; varargs;','');
  793. AssertProc([],[ptmVarArgs],ccDefault,0);
  794. end;
  795. procedure TTestProcedureFunction.TestFunctionVarArgs;
  796. begin
  797. AddDeclaration('function A : Integer; varargs');
  798. ParseFunction;
  799. AssertFunc([],[ptmVarArgs],ccDefault,0);
  800. end;
  801. procedure TTestProcedureFunction.TestProcedureCDeclVarargs;
  802. begin
  803. ParseProcedure(';cdecl; varargs;','');
  804. AssertProc([],[ptmVarArgs],ccCDecl,0);
  805. end;
  806. procedure TTestProcedureFunction.TestFunctionCDeclVarArgs;
  807. begin
  808. AddDeclaration('function A : Integer; cdecl; varargs');
  809. ParseFunction;
  810. AssertFunc([],[ptmVarArgs],ccCdecl,0);
  811. end;
  812. procedure TTestProcedureFunction.TestProcedureForwardInterface;
  813. begin
  814. AddDeclaration('procedure A; forward;');
  815. AssertException(EParserError,@ParseProcedure);
  816. end;
  817. procedure TTestProcedureFunction.TestFunctionForwardInterface;
  818. begin
  819. AddDeclaration('function A : integer; forward;');
  820. AssertException(EParserError,@ParseFunction);
  821. end;
  822. procedure TTestProcedureFunction.TestProcedureForward;
  823. begin
  824. UseImplementation:=True;
  825. AddDeclaration('procedure A; forward;');
  826. ParseProcedure;
  827. AssertProc([pmforward],[],ccDefault,0);
  828. end;
  829. procedure TTestProcedureFunction.TestFunctionForward;
  830. begin
  831. UseImplementation:=True;
  832. AddDeclaration('function A : integer; forward;');
  833. ParseFunction;
  834. AssertFunc([pmforward],[],ccDefault,0);
  835. end;
  836. procedure TTestProcedureFunction.TestProcedureFar;
  837. begin
  838. AddDeclaration('procedure A; far;');
  839. ParseProcedure;
  840. AssertProc([pmfar],[],ccDefault,0);
  841. end;
  842. procedure TTestProcedureFunction.TestFunctionFar;
  843. begin
  844. AddDeclaration('function A : integer; far;');
  845. ParseFunction;
  846. AssertFunc([pmfar],[],ccDefault,0);
  847. end;
  848. procedure TTestProcedureFunction.TestProcedureCdeclForward;
  849. begin
  850. UseImplementation:=True;
  851. AddDeclaration('procedure A; cdecl; forward;');
  852. ParseProcedure;
  853. AssertProc([pmforward],[],ccCDecl,0);
  854. end;
  855. procedure TTestProcedureFunction.TestFunctionCDeclForward;
  856. begin
  857. UseImplementation:=True;
  858. AddDeclaration('function A : integer; cdecl; forward;');
  859. ParseFunction;
  860. AssertFunc([pmforward],[],ccCDecl,0);
  861. end;
  862. procedure TTestProcedureFunction.TestProcedureCompilerProc;
  863. begin
  864. ParseProcedure(';compilerproc;','');
  865. AssertProc([pmCompilerProc],[],ccDefault,0);
  866. end;
  867. procedure TTestProcedureFunction.TestProcedureNoReturn;
  868. begin
  869. ParseProcedure(';noreturn;','');
  870. AssertProc([pmnoreturn],[],ccDefault,0);
  871. end;
  872. procedure TTestProcedureFunction.TestFunctionCompilerProc;
  873. begin
  874. AddDeclaration('function A : Integer; compilerproc');
  875. ParseFunction;
  876. AssertFunc([pmCompilerProc],[],ccDefault,0);
  877. end;
  878. procedure TTestProcedureFunction.TestProcedureCDeclCompilerProc;
  879. begin
  880. ParseProcedure(';cdecl;compilerproc;','');
  881. AssertProc([pmCompilerProc],[],ccCDecl,0);
  882. end;
  883. procedure TTestProcedureFunction.TestFunctionCDeclCompilerProc;
  884. begin
  885. AddDeclaration('function A : Integer; cdecl; compilerproc');
  886. ParseFunction;
  887. AssertFunc([pmCompilerProc],[],ccCDecl,0);
  888. end;
  889. procedure TTestProcedureFunction.TestProcedureAssembler;
  890. begin
  891. ParseProcedure(';assembler;','');
  892. AssertProc([pmAssembler],[],ccDefault,0);
  893. end;
  894. procedure TTestProcedureFunction.TestFunctionAssembler;
  895. begin
  896. AddDeclaration('function A : Integer; assembler');
  897. ParseFunction;
  898. AssertFunc([pmAssembler],[],ccDefault,0);
  899. end;
  900. procedure TTestProcedureFunction.TestProcedureCDeclAssembler;
  901. begin
  902. ParseProcedure(';cdecl;assembler;','');
  903. AssertProc([pmAssembler],[],ccCDecl,0);
  904. end;
  905. procedure TTestProcedureFunction.TestFunctionCDeclAssembler;
  906. begin
  907. AddDeclaration('function A : Integer; cdecl; assembler');
  908. ParseFunction;
  909. AssertFunc([pmAssembler],[],ccCDecl,0);
  910. end;
  911. procedure TTestProcedureFunction.TestProcedureExport;
  912. begin
  913. ParseProcedure(';export;','');
  914. AssertProc([pmExport],[],ccDefault,0);
  915. end;
  916. procedure TTestProcedureFunction.TestFunctionExport;
  917. begin
  918. AddDeclaration('function A : Integer; export');
  919. ParseFunction;
  920. AssertFunc([pmExport],[],ccDefault,0);
  921. end;
  922. procedure TTestProcedureFunction.TestProcedureCDeclExport;
  923. begin
  924. ParseProcedure('cdecl;export;','');
  925. AssertProc([pmExport],[],ccCDecl,0);
  926. end;
  927. procedure TTestProcedureFunction.TestFunctionCDeclExport;
  928. begin
  929. AddDeclaration('function A : Integer; cdecl; export');
  930. ParseFunction;
  931. AssertFunc([pmExport],[],ccCDecl,0);
  932. end;
  933. procedure TTestProcedureFunction.TestProcedureExternal;
  934. begin
  935. ParseProcedure(';external','');
  936. AssertProc([pmExternal],[],ccDefault,0);
  937. AssertNull('No Library name expression',Proc.LibraryExpr);
  938. end;
  939. procedure TTestProcedureFunction.TestFunctionExternal;
  940. begin
  941. AddDeclaration('function A : Integer; external');
  942. ParseFunction;
  943. AssertFunc([pmExternal],[],ccDefault,0);
  944. AssertNull('No Library name expression',Func.LibraryExpr);
  945. end;
  946. procedure TTestProcedureFunction.CreateForwardTest;
  947. begin
  948. With Source do
  949. begin
  950. Add('type');
  951. Add('');
  952. Add('Entity=object');
  953. Add(' function test:Boolean;');
  954. Add('end;');
  955. Add('');
  956. Add('Function Entity.test;');
  957. Add('begin');
  958. Add('end;');
  959. Add('');
  960. Add('begin');
  961. // End is added by ParseModule
  962. end;
  963. end;
  964. procedure TTestProcedureFunction.TestFunctionForwardNoReturnDelphi;
  965. begin
  966. Source.Add('{$MODE DELPHI}');
  967. CreateForwardTest;
  968. ParseModule;
  969. end;
  970. procedure TTestProcedureFunction.TestFunctionForwardNoReturnNoDelphi;
  971. begin
  972. CreateForwardTest;
  973. AssertException('Only in delphi mode can result be omitted',EParserError,@ParseModule);
  974. end;
  975. procedure TTestProcedureFunction.TestProcedureExternalLibName;
  976. begin
  977. ParseProcedure(';external ''libname''','');
  978. AssertProc([pmExternal],[],ccDefault,0);
  979. AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
  980. end;
  981. procedure TTestProcedureFunction.TestFunctionExternalLibName;
  982. begin
  983. AddDeclaration('function A : Integer; external ''libname''');
  984. ParseFunction;
  985. AssertFunc([pmExternal],[],ccDefault,0);
  986. AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
  987. end;
  988. procedure TTestProcedureFunction.TestProcedureExternalLibNameName;
  989. begin
  990. ParseProcedure(';external ''libname'' name ''symbolname''','');
  991. AssertProc([pmExternal],[],ccDefault,0);
  992. AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
  993. AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
  994. end;
  995. procedure TTestProcedureFunction.TestFunctionExternalLibNameName;
  996. begin
  997. AddDeclaration('function A : Integer; external ''libname'' name ''symbolname''');
  998. ParseFunction;
  999. AssertFunc([pmExternal],[],ccDefault,0);
  1000. AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
  1001. AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
  1002. end;
  1003. procedure TTestProcedureFunction.TestProcedureExternalName;
  1004. begin
  1005. ParseProcedure(';external name ''symbolname''','');
  1006. AssertProc([pmExternal],[],ccDefault,0);
  1007. AssertNull('No Library name expression',Proc.LibraryExpr);
  1008. AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
  1009. end;
  1010. procedure TTestProcedureFunction.TestFunctionExternalName;
  1011. begin
  1012. AddDeclaration('function A : Integer; external name ''symbolname''');
  1013. ParseFunction;
  1014. AssertFunc([pmExternal],[],ccDefault,0);
  1015. AssertNull('No Library name expression',Func.LibraryExpr);
  1016. AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
  1017. end;
  1018. procedure TTestProcedureFunction.TestProcedureCdeclExternal;
  1019. begin
  1020. ParseProcedure('; cdecl; external','');
  1021. AssertProc([pmExternal],[],ccCdecl,0);
  1022. AssertNull('No Library name expression',Proc.LibraryExpr);
  1023. end;
  1024. procedure TTestProcedureFunction.TestFunctionCdeclExternal;
  1025. begin
  1026. AddDeclaration('function A : Integer; cdecl; external');
  1027. ParseFunction;
  1028. AssertFunc([pmExternal],[],ccCdecl,0);
  1029. AssertNull('No Library name expression',Func.LibraryExpr);
  1030. end;
  1031. procedure TTestProcedureFunction.TestProcedureCdeclExternalLibName;
  1032. begin
  1033. ParseProcedure('; cdecl; external ''libname''','');
  1034. AssertProc([pmExternal],[],ccCdecl,0);
  1035. AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
  1036. end;
  1037. procedure TTestProcedureFunction.TestFunctionCdeclExternalLibName;
  1038. begin
  1039. AddDeclaration('function A : Integer; cdecl; external ''libname''');
  1040. ParseFunction;
  1041. AssertFunc([pmExternal],[],ccCdecl,0);
  1042. AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
  1043. end;
  1044. procedure TTestProcedureFunction.TestProcedureCdeclExternalLibNameName;
  1045. begin
  1046. ParseProcedure('; cdecl; external ''libname'' name ''symbolname''','');
  1047. AssertProc([pmExternal],[],ccCdecl,0);
  1048. AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
  1049. AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
  1050. end;
  1051. procedure TTestProcedureFunction.TestFunctionCdeclExternalLibNameName;
  1052. begin
  1053. AddDeclaration('function A : Integer; cdecl; external ''libname'' name ''symbolname''');
  1054. ParseFunction;
  1055. AssertFunc([pmExternal],[],ccCdecl,0);
  1056. AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
  1057. AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
  1058. end;
  1059. procedure TTestProcedureFunction.TestProcedureCdeclExternalName;
  1060. begin
  1061. ParseProcedure('; cdecl; external name ''symbolname''','');
  1062. AssertProc([pmExternal],[],ccCdecl,0);
  1063. AssertNull('No Library name expression',Proc.LibraryExpr);
  1064. AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
  1065. end;
  1066. procedure TTestProcedureFunction.TestFunctionCdeclExternalName;
  1067. begin
  1068. AddDeclaration('function A : Integer; cdecl; external name ''symbolname''');
  1069. ParseFunction;
  1070. AssertFunc([pmExternal],[],ccCdecl,0);
  1071. AssertNull('No Library name expression',Func.LibraryExpr);
  1072. AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
  1073. end;
  1074. procedure TTestProcedureFunction.TestFunctionAlias;
  1075. begin
  1076. AddDeclaration('function A : Integer; alias: ''myalias''');
  1077. ParseFunction;
  1078. AssertFunc([],[],ccDefault,0);
  1079. AssertEquals('Alias name','''myalias''',Func.AliasName);
  1080. end;
  1081. procedure TTestProcedureFunction.TestProcedureAlias;
  1082. begin
  1083. AddDeclaration('Procedure A; Alias : ''myalias''');
  1084. ParseProcedure;
  1085. AssertProc([],[],ccDefault,0);
  1086. AssertEquals('Alias name','''myalias''',Proc.AliasName);
  1087. end;
  1088. procedure TTestProcedureFunction.TestOperatorTokens;
  1089. Var
  1090. t : TOperatorType;
  1091. s : string;
  1092. begin
  1093. For t:=otMul to High(TOperatorType) do
  1094. // No way to distinguish between logical/bitwise or/and/Xor
  1095. if not (t in [otBitwiseOr,otBitwiseAnd,otBitwiseXor]) then
  1096. begin
  1097. S:=GetEnumName(TypeInfo(TOperatorType),Ord(T));
  1098. ResetParser;
  1099. if t in UnaryOperators then
  1100. AddDeclaration(Format('operator %s (a: Integer) : te',[OperatorTokens[t]]))
  1101. else
  1102. AddDeclaration(Format('operator %s (a: Integer; b: integer) : te',[OperatorTokens[t]]));
  1103. ParseOperator;
  1104. AssertEquals(S+': Token based ',Not (T in [otInc,otDec,otEnumerator]),FOperator.TokenBased);
  1105. AssertEquals(S+': Correct operator type',T,FOperator.OperatorType);
  1106. if t in UnaryOperators then
  1107. AssertEquals(S+': Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
  1108. else
  1109. AssertEquals(S+': Correct operator name',format('%s(Integer,Integer):te',[OperatorNames[t]]),FOperator.Name);
  1110. end;
  1111. end;
  1112. procedure TTestProcedureFunction.TestOperatorNames;
  1113. Var
  1114. t : TOperatorType;
  1115. S: String;
  1116. begin
  1117. For t:=Succ(otUnknown) to High(TOperatorType) do
  1118. begin
  1119. S:=GetEnumName(TypeInfo(TOperatorType),Ord(T));
  1120. ResetParser;
  1121. if t in UnaryOperators then
  1122. AddDeclaration(Format('operator %s (a: Integer) : te',[OperatorNames[t]]))
  1123. else
  1124. AddDeclaration(Format('operator %s (a: Integer; b: integer) : te',[OperatorNames[t]]));
  1125. ParseOperator;
  1126. AssertEquals(S+': Token based',t in [otIn],FOperator.TokenBased);
  1127. AssertEquals(S+': Correct operator type',T,FOperator.OperatorType);
  1128. if t in UnaryOperators then
  1129. AssertEquals('Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
  1130. else
  1131. AssertEquals('Correct operator name',format('%s(Integer,Integer):te',[OperatorNames[t]]),FOperator.Name);
  1132. end;
  1133. end;
  1134. procedure TTestProcedureFunction.TestAssignOperatorAfterObject;
  1135. begin
  1136. Add('unit afile;');
  1137. Add('{$mode delphi}');
  1138. Add('interface');
  1139. Add('type');
  1140. Add(' TA =object');
  1141. Add(' data:integer;');
  1142. Add(' function transpose:integer;');
  1143. Add(' end;');
  1144. Add('');
  1145. Add('operator := (const v:Tvector2_single) result:Tvector2_double;');
  1146. Add('implementation');
  1147. EndSource;
  1148. Parser.Options:=[po_delphi];
  1149. ParseModule;
  1150. end;
  1151. procedure TTestProcedureFunction.TestFunctionNoResult;
  1152. begin
  1153. Add('unit afile;');
  1154. Add('{$mode delphi}');
  1155. Add('interface');
  1156. Add('function TestDelphiModeFuncs(d:double):string;');
  1157. Add('implementation');
  1158. Add('function TestDelphiModeFuncs;');
  1159. Add('begin');
  1160. Add('end;');
  1161. EndSource;
  1162. Parser.Options:=[po_delphi];
  1163. ParseModule;
  1164. end;
  1165. procedure TTestProcedureFunction.SetUp;
  1166. begin
  1167. Inherited;
  1168. end;
  1169. procedure TTestProcedureFunction.TearDown;
  1170. begin
  1171. Inherited;
  1172. end;
  1173. procedure TTestProcedureFunction.AssertComment;
  1174. begin
  1175. AssertEquals('Correct comment',' A comment'+sLineBreak,FProc.DocComment);
  1176. end;
  1177. initialization
  1178. RegisterTest(TTestProcedureFunction);
  1179. end.