tcprocfunc.pas 43 KB

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