tcprocfunc.pas 45 KB

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