tcvarparser.pas 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504
  1. unit tcvarparser;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils, fpcunit, pastree, pscanner, pparser,
  6. tcbaseparser, testregistry;
  7. Type
  8. { TTestVarParser }
  9. TTestVarParser = Class(TTestParser)
  10. private
  11. FHint: string;
  12. FIsThreadVar: Boolean;
  13. FVar: TPasVariable;
  14. Protected
  15. Function ParseVar(ASource : String; Const AHint : String = '') : TPasVariable; virtual; overload;
  16. Procedure AssertVariableType(Const ATypeName : String);
  17. Procedure AssertVariableType(Const AClass : TClass);
  18. Procedure AssertParseVarError(ASource : String);
  19. Property IsThreadVar : Boolean Read FIsThreadVar Write FIsThreadVar;
  20. Property TheVar : TPasVariable Read FVar;
  21. Property Hint : string Read FHint Write FHint;
  22. procedure SetUp; override;
  23. Procedure TearDown; override;
  24. Published
  25. Procedure TestSimpleVar;
  26. Procedure TestSimpleThreadVar;
  27. Procedure TestSimpleVarAbsoluteName;
  28. Procedure TestSimpleVarHelperName;
  29. procedure TestSimpleVarHelperType;
  30. Procedure TestSimpleVarDeprecated;
  31. Procedure TestSimpleVarPlatform;
  32. Procedure TestSimpleVarInitialized;
  33. procedure TestSimpleVarInitializedDeprecated;
  34. procedure TestSimpleVarInitializedPlatform;
  35. Procedure TestSimpleVarAbsolute;
  36. Procedure TestSimpleVarAbsoluteAddress;
  37. Procedure TestSimpleVarAbsoluteDot;
  38. Procedure TestSimpleVarAbsolute2Dots;
  39. Procedure TestVarProcedure;
  40. procedure TestVarProcedureCdecl;
  41. procedure TestVarFunctionFar;
  42. Procedure TestVarFunctionINitialized;
  43. Procedure TestVarProcedureDeprecated;
  44. Procedure TestVarRecord;
  45. Procedure TestVarRecordDeprecated;
  46. Procedure TestVarRecordPlatform;
  47. Procedure TestVarArray;
  48. Procedure TestVarArrayDeprecated;
  49. Procedure TestVarDynArray;
  50. Procedure TestVarExternal;
  51. Procedure TestVarExternalLib;
  52. Procedure TestVarExternalLibName;
  53. procedure TestVarExternalNoSemiColon;
  54. procedure TestVarExternalLibNoName;
  55. Procedure TestVarCVar;
  56. Procedure TestVarCVarExternal;
  57. Procedure TestVarCVarWeakExternal;
  58. Procedure TestVarCVarExport;
  59. Procedure TestVarPublic;
  60. Procedure TestVarPublicName;
  61. Procedure TestVarDeprecatedExternalName;
  62. Procedure TestVarHintPriorToInit;
  63. Procedure TestVarAttribute;
  64. Procedure TestErrorRecovery;
  65. end;
  66. implementation
  67. uses typinfo;
  68. { TTestVarParser }
  69. function TTestVarParser.ParseVar(ASource: String; const AHint: String
  70. ): TPasVariable;
  71. Var
  72. D : String;
  73. begin
  74. Hint:=AHint;
  75. if not IsThreadVar then
  76. Add('Var')
  77. else
  78. Add('Threadvar');
  79. D:='A : '+ASource;
  80. If Hint<>'' then
  81. D:=D+' '+Hint;
  82. Add(' '+D+';');
  83. // Writeln(source.text);
  84. ParseDeclarations;
  85. AssertEquals('One variable definition',1,Declarations.Variables.Count);
  86. AssertEquals('First declaration is type definition.',TPasVariable,TObject(Declarations.Variables[0]).ClassType);
  87. Result:=TPasVariable(Declarations.Variables[0]);
  88. AssertEquals('First declaration has correct name.','A',Result.Name);
  89. FVar:=Result;
  90. Definition:=Result;
  91. if (Hint<>'') then
  92. CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'h'+Hint)));
  93. end;
  94. procedure TTestVarParser.AssertVariableType(const ATypeName: String);
  95. begin
  96. AssertVariableType(TPasUnresolvedTypeRef);
  97. AssertEquals('Correct unresolved type name',ATypeName,theVar.VarType.Name);
  98. end;
  99. procedure TTestVarParser.AssertVariableType(const AClass: TClass);
  100. begin
  101. AssertNotNull('Have variable type',theVar.VarType);
  102. AssertEquals('Correct type class',AClass,theVar.VarType.ClassType);
  103. end;
  104. procedure TTestVarParser.AssertParseVarError(ASource: String);
  105. begin
  106. try
  107. ParseVar(ASource,'');
  108. Fail('Expected parser error');
  109. except
  110. // all OK.
  111. end;
  112. end;
  113. procedure TTestVarParser.SetUp;
  114. begin
  115. inherited SetUp;
  116. FHint:='';
  117. FVar:=Nil;
  118. end;
  119. procedure TTestVarParser.TearDown;
  120. begin
  121. FVar:=Nil;
  122. inherited TearDown;
  123. end;
  124. procedure TTestVarParser.TestSimpleVar;
  125. begin
  126. ParseVar('b','');
  127. AssertVariableType('b');
  128. end;
  129. procedure TTestVarParser.TestSimpleThreadVar;
  130. begin
  131. IsThreadVar:=True;
  132. ParseVar('b','');
  133. AssertVariableType('b');
  134. end;
  135. procedure TTestVarParser.TestSimpleVarAbsoluteName;
  136. Var
  137. R : TPasVariable;
  138. begin
  139. Add('Var');
  140. Add(' Absolute : integer;');
  141. // Writeln(source.text);
  142. ParseDeclarations;
  143. AssertEquals('One variable definition',1,Declarations.Variables.Count);
  144. AssertEquals('First declaration is type definition.',TPasVariable,TObject(Declarations.Variables[0]).ClassType);
  145. R:=TPasVariable(Declarations.Variables[0]);
  146. AssertEquals('First declaration has correct name.','Absolute',R.Name);
  147. end;
  148. procedure TTestVarParser.TestSimpleVarHelperName;
  149. Var
  150. R : TPasVariable;
  151. begin
  152. Add('Var');
  153. Add(' Helper : integer;');
  154. // Writeln(source.text);
  155. ParseDeclarations;
  156. AssertEquals('One variable definition',1,Declarations.Variables.Count);
  157. AssertEquals('First declaration is type definition.',TPasVariable,TObject(Declarations.Variables[0]).ClassType);
  158. R:=TPasVariable(Declarations.Variables[0]);
  159. AssertEquals('First declaration has correct name.','Helper',R.Name);
  160. end;
  161. procedure TTestVarParser.TestSimpleVarHelperType;
  162. begin
  163. ParseVar('helper','');
  164. AssertVariableType('helper');
  165. end;
  166. procedure TTestVarParser.TestSimpleVarDeprecated;
  167. begin
  168. ParseVar('b','deprecated');
  169. AssertVariableType('b');
  170. end;
  171. procedure TTestVarParser.TestSimpleVarPlatform;
  172. begin
  173. ParseVar('b','platform');
  174. AssertVariableType('b');
  175. end;
  176. procedure TTestVarParser.TestSimpleVarInitialized;
  177. begin
  178. ParseVar('b = 123','');
  179. AssertVariableType('b');
  180. AssertNotNull(TheVar.expr);
  181. AssertExpression('Variable value',TheVar.expr,pekNumber,'123');
  182. end;
  183. procedure TTestVarParser.TestSimpleVarInitializedDeprecated;
  184. begin
  185. ParseVar('b = 123','deprecated');
  186. AssertVariableType('b');
  187. AssertNotNull(TheVar.expr);
  188. AssertExpression('Variable value',TheVar.expr,pekNumber,'123');
  189. end;
  190. procedure TTestVarParser.TestSimpleVarInitializedPlatform;
  191. begin
  192. ParseVar('b = 123','platform');
  193. AssertVariableType('b');
  194. AssertNotNull(TheVar.expr);
  195. AssertExpression('Variable value',TheVar.expr,pekNumber,'123');
  196. end;
  197. procedure TTestVarParser.TestSimpleVarAbsolute;
  198. begin
  199. ParseVar('q absolute v','');
  200. AssertVariableType('q');
  201. AssertExpression('correct absolute location',TheVar.AbsoluteExpr,pekIdent,'v');
  202. end;
  203. procedure TTestVarParser.TestSimpleVarAbsoluteAddress;
  204. begin
  205. ParseVar('q absolute $123','');
  206. AssertVariableType('q');
  207. AssertExpression('correct absolute location',TheVar.AbsoluteExpr,pekNumber,'$123');
  208. end;
  209. procedure TTestVarParser.TestSimpleVarAbsoluteDot;
  210. var
  211. B: TBinaryExpr;
  212. begin
  213. ParseVar('q absolute v.w','');
  214. AssertVariableType('q');
  215. B:=AssertExpression('binary',TheVar.AbsoluteExpr,eopSubIdent);
  216. AssertExpression('correct absolute expr v',B.Left,pekIdent,'v');
  217. AssertExpression('correct absolute expr w',B.Right,pekIdent,'w');
  218. end;
  219. procedure TTestVarParser.TestSimpleVarAbsolute2Dots;
  220. var
  221. B: TBinaryExpr;
  222. begin
  223. ParseVar('q absolute v.w.x','');
  224. AssertVariableType('q');
  225. B:=AssertExpression('binary',TheVar.AbsoluteExpr,eopSubIdent);
  226. AssertExpression('correct absolute expr x',B.Right,pekIdent,'x');
  227. B:=AssertExpression('binary',B.Left,eopSubIdent);
  228. AssertExpression('correct absolute expr w',B.Right,pekIdent,'w');
  229. AssertExpression('correct absolute expr v',B.Left,pekIdent,'v');
  230. end;
  231. procedure TTestVarParser.TestVarProcedure;
  232. begin
  233. ParseVar('procedure','');
  234. AssertVariableType(TPasProcedureType);
  235. end;
  236. procedure TTestVarParser.TestVarProcedureCdecl;
  237. begin
  238. ParseVar('procedure; cdecl;','');
  239. AssertVariableType(TPasProcedureType);
  240. end;
  241. procedure TTestVarParser.TestVarFunctionFar;
  242. begin
  243. ParseVar('function (cinfo : j_decompress_ptr) : int; far;','');
  244. AssertVariableType(TPasFunctionType);
  245. end;
  246. procedure TTestVarParser.TestVarFunctionINitialized;
  247. begin
  248. ParseVar('function (device: pointer): pointer; cdecl = nil','');
  249. AssertVariableType(TPasFunctionType);
  250. end;
  251. procedure TTestVarParser.TestVarProcedureDeprecated;
  252. begin
  253. ParseVar('procedure','deprecated');
  254. AssertVariableType(TPasProcedureType);
  255. end;
  256. procedure TTestVarParser.TestVarRecord;
  257. Var
  258. R : TPasRecordtype;
  259. begin
  260. ParseVar('record x,y : intger; end','');
  261. AssertVariableType(TPasRecordType);
  262. R:=TheVar.VarType as TPasRecordType;
  263. AssertEquals('Correct number of fields',2,R.Members.Count);
  264. end;
  265. procedure TTestVarParser.TestVarRecordDeprecated;
  266. Var
  267. R : TPasRecordtype;
  268. begin
  269. ParseVar('record x,y : integer; end','deprecated');
  270. AssertVariableType(TPasRecordType);
  271. R:=TheVar.VarType as TPasRecordType;
  272. AssertEquals('Correct number of fields',2,R.Members.Count);
  273. end;
  274. procedure TTestVarParser.TestVarRecordPlatform;
  275. Var
  276. R : TPasRecordtype;
  277. begin
  278. ParseVar('record x,y : integer; end','platform');
  279. AssertVariableType(TPasRecordType);
  280. R:=TheVar.VarType as TPasRecordType;
  281. AssertEquals('Correct number of fields',2,R.Members.Count);
  282. end;
  283. procedure TTestVarParser.TestVarArray;
  284. Var
  285. R : TPasArrayType;
  286. begin
  287. ParseVar('Array[1..20] of integer','');
  288. AssertVariableType(TPasArrayType);
  289. R:=TheVar.VarType as TPasArrayType;
  290. AssertNotNull('Correct array type name',R.ElType);
  291. AssertEquals('Correct array type name',TPasunresolvedTypeRef,R.ElType.ClassType);
  292. end;
  293. procedure TTestVarParser.TestVarArrayDeprecated;
  294. Var
  295. R : TPasArrayType;
  296. begin
  297. ParseVar('Array[1..20] of integer','Deprecated');
  298. AssertVariableType(TPasArrayType);
  299. R:=TheVar.VarType as TPasArrayType;
  300. AssertNotNull('Correct array type name',R.ElType);
  301. AssertEquals('Correct array type name',TPasunresolvedTypeRef,R.ElType.ClassType);
  302. end;
  303. procedure TTestVarParser.TestVarDynArray;
  304. Var
  305. R : TPasArrayType;
  306. begin
  307. ParseVar('Array of integer','');
  308. AssertVariableType(TPasArrayType);
  309. R:=TheVar.VarType as TPasArrayType;
  310. AssertEquals('No index','',R.IndexRange);
  311. AssertNotNull('Correct array type name',R.ElType);
  312. AssertEquals('Correct array type name',TPasunresolvedTypeRef,R.ElType.ClassType);
  313. end;
  314. procedure TTestVarParser.TestVarExternal;
  315. begin
  316. ParseVar('integer; external','');
  317. AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
  318. end;
  319. procedure TTestVarParser.TestVarExternalNoSemiColon;
  320. begin
  321. ParseVar('integer external','');
  322. AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
  323. end;
  324. procedure TTestVarParser.TestVarExternalLib;
  325. begin
  326. ParseVar('integer; external name ''mylib''','');
  327. AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
  328. AssertNull('Library name',TheVar.LibraryName);
  329. AssertNotNull('Library symbol',TheVar.ExportName);
  330. end;
  331. procedure TTestVarParser.TestVarExternalLibNoName;
  332. begin
  333. // Found in e.g.apache headers
  334. ParseVar('integer; external ''mylib''','');
  335. AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
  336. AssertNotNull('Library name',TheVar.LibraryName);
  337. end;
  338. procedure TTestVarParser.TestVarExternalLibName;
  339. begin
  340. ParseVar('integer; external ''mylib'' name ''de''','');
  341. AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
  342. AssertNotNull('Library name',TheVar.LibraryName);
  343. AssertNotNull('Library symbol',TheVar.ExportName);
  344. end;
  345. procedure TTestVarParser.TestVarCVar;
  346. begin
  347. ParseVar('integer; cvar','');
  348. AssertEquals('Variable modifiers',[vmcvar],TheVar.VarModifiers);
  349. end;
  350. procedure TTestVarParser.TestVarCVarExternal;
  351. begin
  352. ParseVar('integer; cvar;external','');
  353. AssertEquals('Variable modifiers',[vmcvar,vmexternal],TheVar.VarModifiers);
  354. end;
  355. procedure TTestVarParser.TestVarCVarWeakExternal;
  356. begin
  357. ParseVar('integer; cvar;weakexternal','');
  358. AssertEquals('Variable modifiers',[vmcvar,vmexternal],TheVar.VarModifiers);
  359. end;
  360. procedure TTestVarParser.TestVarCVarExport;
  361. begin
  362. ParseVar('integer; cvar; export','');
  363. AssertEquals('Variable modifiers',[vmCVar,vmExport],TheVar.VarModifiers);
  364. end;
  365. procedure TTestVarParser.TestVarPublic;
  366. begin
  367. ParseVar('integer; public','');
  368. AssertEquals('Variable modifiers',[vmpublic],TheVar.VarModifiers);
  369. end;
  370. procedure TTestVarParser.TestVarPublicName;
  371. begin
  372. ParseVar('integer; public name ''ce''','');
  373. AssertEquals('Variable modifiers',[vmpublic],TheVar.VarModifiers);
  374. AssertNotNull('Public export name',TheVar.ExportName);
  375. end;
  376. procedure TTestVarParser.TestVarDeprecatedExternalName;
  377. begin
  378. ParseVar('integer deprecated; external name ''me''','');
  379. CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'hdeprecated')));
  380. AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
  381. AssertNull('Library name',TheVar.LibraryName);
  382. AssertNotNull('Library symbol',TheVar.ExportName);
  383. end;
  384. procedure TTestVarParser.TestVarHintPriorToInit;
  385. Var
  386. E : TBoolConstExpr;
  387. begin
  388. ParseVar('boolean platform = false','');
  389. CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'hplatform')));
  390. AssertNotNull('Correctly initialized',Thevar.Expr);
  391. AssertEquals('Correctly initialized',TBoolConstExpr,Thevar.Expr.ClassType);
  392. E:=Thevar.Expr as TBoolConstExpr;
  393. AssertEquals('Correct initialization value',False, E.Value);
  394. end;
  395. procedure TTestVarParser.TestVarAttribute;
  396. var
  397. V : TPasVariable;
  398. begin
  399. add('{$mode delphi}');
  400. Add('Var');
  401. Add(' [xyz] A : integer;');
  402. ParseDeclarations;
  403. AssertEquals('One variable definition',1,Declarations.Variables.Count);
  404. AssertEquals('First declaration is type definition.',TPasVariable,TObject(Declarations.Variables[0]).ClassType);
  405. V:=TPasVariable(Declarations.Variables[0]);
  406. AssertEquals('First declaration has correct name.','A',V.Name);
  407. end;
  408. procedure TTestVarParser.TestErrorRecovery;
  409. begin
  410. Add('Var');
  411. Add(' a : integer;');
  412. Add(' a = integer;');
  413. Add(' a : abc integer;');
  414. // Writeln(source.text);
  415. try
  416. Parser.MaxErrorCount:=3;
  417. Parser.OnLog:=@DoParserLog;
  418. ParseDeclarations;
  419. except
  420. On E : Exception do
  421. begin
  422. AssertEquals('Correct class',E.ClassType,EParserError);
  423. end;
  424. end;
  425. AssertErrorCount(2);
  426. end;
  427. initialization
  428. RegisterTests([TTestVarParser]);
  429. end.