tcprocfunc.pas 41 KB

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