tcprocfunc.pas 41 KB

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