pbase.pas 18 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Contains some helper routines for the parser
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit pbase;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. cutils,cclasses,
  22. tokens,globtype,
  23. symconst,symbase,symtype,symdef,symsym,symtable
  24. ;
  25. const
  26. { tokens that end a block or statement. And don't require
  27. a ; on the statement before }
  28. endtokens = [_SEMICOLON,_END,_ELSE,_UNTIL,_EXCEPT,_FINALLY];
  29. { true, if we are after an assignement }
  30. afterassignment : boolean = false;
  31. { true, if we are parsing arguments }
  32. in_args : boolean = false;
  33. { true, if we are parsing arguments allowing named parameters }
  34. named_args_allowed : boolean = false;
  35. { true, if we got an @ to get the address }
  36. got_addrn : boolean = false;
  37. { special for handling procedure vars }
  38. getprocvardef : tprocvardef = nil;
  39. var
  40. { for operators }
  41. optoken : ttoken;
  42. { true, if only routine headers should be parsed }
  43. parse_only : boolean;
  44. { true, if we found a name for a named arg }
  45. found_arg_name : boolean;
  46. { true, if we are parsing generic declaration }
  47. parse_generic : boolean;
  48. procedure identifier_not_found(const s:string);
  49. procedure identifier_not_found(const s:string;const filepos:tfileposinfo);
  50. { function tokenstring(i : ttoken):string;}
  51. { consumes token i, if the current token is unequal i }
  52. { a syntax error is written }
  53. procedure consume(i : ttoken);
  54. {Tries to consume the token i, and returns true if it was consumed:
  55. if token=i.}
  56. function try_to_consume(i:Ttoken):boolean;
  57. { consumes all tokens til atoken (for error recovering }
  58. procedure consume_all_until(atoken : ttoken);
  59. { consumes tokens while they are semicolons }
  60. procedure consume_emptystats;
  61. { reads a list of identifiers into a string list }
  62. { consume a symbol, if not found give an error and
  63. and return an errorsym }
  64. function consume_sym(var srsym:tsym;var srsymtable:TSymtable):boolean;
  65. function consume_sym_orgid(var srsym:tsym;var srsymtable:TSymtable;var s : string):boolean;
  66. type
  67. tconsume_unitsym_flag = (
  68. cuf_consume_id,
  69. cuf_allow_specialize,
  70. cuf_check_attr_suffix
  71. );
  72. tconsume_unitsym_flags = set of tconsume_unitsym_flag;
  73. function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;flags:tconsume_unitsym_flags;out is_specialize:boolean;sympattern:TSymStr):boolean;
  74. function try_consume_unitsym_no_specialize(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;flags:tconsume_unitsym_flags;sympattern:TSymStr):boolean;
  75. function try_consume_hintdirective(var symopt:tsymoptions; var deprecatedmsg:pshortstring):boolean;
  76. { just for an accurate position of the end of a procedure (PM) }
  77. var
  78. last_endtoken_filepos: tfileposinfo;
  79. implementation
  80. uses
  81. globals,scanner,verbose,fmodule;
  82. {****************************************************************************
  83. Token Parsing
  84. ****************************************************************************}
  85. procedure identifier_not_found(const s:string);
  86. begin
  87. Message1(sym_e_id_not_found,s);
  88. { show a fatal that you need -S2 or -Sd, but only
  89. if we just parsed the a token that has m_class }
  90. if not(m_class in current_settings.modeswitches) and
  91. (Upper(s)=pattern) and
  92. (m_class in tokeninfo^[idtoken].keyword) then
  93. Message(parser_f_need_objfpc_or_delphi_mode);
  94. end;
  95. procedure identifier_not_found(const s:string;const filepos:tfileposinfo);
  96. begin
  97. MessagePos1(filepos,sym_e_id_not_found,s);
  98. { show a fatal that you need -S2 or -Sd, but only
  99. if we just parsed the a token that has m_class }
  100. if not(m_class in current_settings.modeswitches) and
  101. (Upper(s)=pattern) and
  102. (m_class in tokeninfo^[idtoken].keyword) then
  103. MessagePos(filepos,parser_f_need_objfpc_or_delphi_mode);
  104. end;
  105. { consumes token i, write error if token is different }
  106. procedure consume(i : ttoken);
  107. begin
  108. if (token<>i) and (idtoken<>i) then
  109. if token=_id then
  110. Message2(scan_f_syn_expected,tokeninfo^[i].str,'identifier '+pattern)
  111. else
  112. Message2(scan_f_syn_expected,tokeninfo^[i].str,tokeninfo^[token].str)
  113. else
  114. begin
  115. if token=_END then
  116. last_endtoken_filepos:=current_tokenpos;
  117. current_scanner.readtoken(true);
  118. end;
  119. end;
  120. function try_to_consume(i:Ttoken):boolean;
  121. begin
  122. try_to_consume:=false;
  123. if (token=i) or (idtoken=i) then
  124. begin
  125. try_to_consume:=true;
  126. if token=_END then
  127. last_endtoken_filepos:=current_tokenpos;
  128. current_scanner.readtoken(true);
  129. end;
  130. end;
  131. procedure consume_all_until(atoken : ttoken);
  132. begin
  133. while (token<>atoken) and (idtoken<>atoken) do
  134. begin
  135. Consume(token);
  136. if token=_EOF then
  137. begin
  138. Consume(atoken);
  139. Message(scan_f_end_of_file);
  140. exit;
  141. end;
  142. end;
  143. end;
  144. procedure consume_emptystats;
  145. begin
  146. repeat
  147. until not try_to_consume(_SEMICOLON);
  148. end;
  149. { check if a symbol contains the hint directive, and if so gives out a hint
  150. if required.
  151. If this code is changed, it's likly that consume_sym_orgid and factor_read_id
  152. must be changed as well (FK)
  153. }
  154. function consume_sym(var srsym:tsym;var srsymtable:TSymtable):boolean;
  155. var
  156. t : ttoken;
  157. begin
  158. { first check for identifier }
  159. if token<>_ID then
  160. begin
  161. consume(_ID);
  162. srsym:=generrorsym;
  163. srsymtable:=nil;
  164. result:=false;
  165. exit;
  166. end;
  167. searchsym(pattern,srsym,srsymtable);
  168. { handle unit specification like System.Writeln }
  169. try_consume_unitsym_no_specialize(srsym,srsymtable,t,[cuf_consume_id],pattern);
  170. { if nothing found give error and return errorsym }
  171. if assigned(srsym) then
  172. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg)
  173. else
  174. begin
  175. identifier_not_found(orgpattern);
  176. srsym:=generrorsym;
  177. srsymtable:=nil;
  178. end;
  179. consume(t);
  180. result:=assigned(srsym);
  181. end;
  182. { check if a symbol contains the hint directive, and if so gives out a hint
  183. if required and returns the id with it's original casing
  184. }
  185. function consume_sym_orgid(var srsym:tsym;var srsymtable:TSymtable;var s : string):boolean;
  186. var
  187. t : ttoken;
  188. begin
  189. { first check for identifier }
  190. if token<>_ID then
  191. begin
  192. consume(_ID);
  193. srsym:=generrorsym;
  194. srsymtable:=nil;
  195. result:=false;
  196. exit;
  197. end;
  198. searchsym(pattern,srsym,srsymtable);
  199. { handle unit specification like System.Writeln }
  200. try_consume_unitsym_no_specialize(srsym,srsymtable,t,[cuf_consume_id],pattern);
  201. { if nothing found give error and return errorsym }
  202. if assigned(srsym) then
  203. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg)
  204. else
  205. begin
  206. identifier_not_found(orgpattern);
  207. srsym:=generrorsym;
  208. srsymtable:=nil;
  209. end;
  210. s:=orgpattern;
  211. consume(t);
  212. result:=assigned(srsym);
  213. end;
  214. function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;flags:tconsume_unitsym_flags;out is_specialize:boolean;sympattern:TSymStr):boolean;
  215. var
  216. hmodule: tmodule;
  217. ns:ansistring;
  218. nssym:tsym;
  219. nsitem : TCmdStrListItem;
  220. procedure consume_namespace;
  221. begin
  222. while assigned(srsym) and (srsym.typ=namespacesym) do
  223. begin
  224. { we have a namespace. the next identifier should be either a namespace or a unit }
  225. searchsym_in_module(hmodule,ns+'.'+pattern,srsym,srsymtable);
  226. if assigned(srsym) and (srsym.typ in [namespacesym,unitsym]) then
  227. begin
  228. ns:=ns+'.'+pattern;
  229. nssym:=srsym;
  230. consume(_ID);
  231. consume(_POINT);
  232. end;
  233. end;
  234. { check if there is a hidden unit with this pattern in the namespace }
  235. if not assigned(srsym) and
  236. assigned(nssym) and (nssym.typ=namespacesym) and assigned(tnamespacesym(nssym).unitsym) then
  237. srsym:=tnamespacesym(nssym).unitsym;
  238. end;
  239. begin
  240. result:=false;
  241. tokentoconsume:=_ID;
  242. is_specialize:=false;
  243. if not assigned(srsym) and (pattern<>'') and (namespacelist.count>0) then
  244. begin
  245. hmodule:=get_module(current_filepos.moduleindex);
  246. if not assigned(hmodule) then
  247. internalerror(2018050301);
  248. nsitem:=TCmdStrListItem(namespacelist.first);
  249. while assigned(nsitem) do
  250. begin
  251. ns:=upper(nsitem.str)+'.'+sympattern;
  252. if searchsym_in_module(hmodule,ns,srsym,srsymtable) and
  253. (srsym.typ in [unitsym,namespacesym]) then
  254. break;
  255. nsitem:=TCmdStrListItem(nsitem.next);
  256. end;
  257. end;
  258. if assigned(srsym) and (srsym.typ in [unitsym,namespacesym]) then
  259. begin
  260. if not(srsym.owner.symtabletype in [staticsymtable,globalsymtable]) then
  261. internalerror(2005011503);
  262. { only allow unit.symbol access if the name was
  263. found in the current module
  264. we can use iscurrentunit because generic specializations does not
  265. change current_unit variable }
  266. hmodule:=find_module_from_symtable(srsym.Owner);
  267. if not Assigned(hmodule) then
  268. internalerror(2010011201);
  269. if hmodule.unit_index=current_filepos.moduleindex then
  270. begin
  271. if cuf_consume_id in flags then
  272. consume(_ID);
  273. consume(_POINT);
  274. if srsym.typ=namespacesym then
  275. begin
  276. ns:=srsym.name;
  277. nssym:=srsym;
  278. consume_namespace;
  279. if not assigned(srsym) and (namespacelist.count>0) then
  280. begin
  281. nsitem:=TCmdStrListItem(namespacelist.first);
  282. while assigned(nsitem) do
  283. begin
  284. ns:=upper(nsitem.str)+'.'+nssym.name;
  285. if searchsym_in_module(hmodule,ns,srsym,srsymtable) and
  286. (srsym.typ in [unitsym,namespacesym]) then
  287. begin
  288. consume_namespace;
  289. break;
  290. end;
  291. nsitem:=TCmdStrListItem(nsitem.next);
  292. end;
  293. end;
  294. if assigned(srsym) and (srsym.typ<>unitsym) then
  295. internalerror(2011082601);
  296. if not assigned(srsym) then
  297. begin
  298. result:=true;
  299. srsymtable:=nil;
  300. exit;
  301. end;
  302. end;
  303. case token of
  304. _ID:
  305. begin
  306. if cuf_check_attr_suffix in flags then
  307. begin
  308. if searchsym_in_module(tunitsym(srsym).module,pattern+custom_attribute_suffix,srsym,srsymtable) then
  309. exit(true);
  310. end;
  311. { system.char? (char=widechar comes from the implicit
  312. uuchar unit -> override) }
  313. if (pattern='CHAR') and
  314. (tmodule(tunitsym(srsym).module).globalsymtable=systemunit) then
  315. begin
  316. if m_default_unicodestring in current_settings.modeswitches then
  317. searchsym_in_module(tunitsym(srsym).module,'WIDECHAR',srsym,srsymtable)
  318. else
  319. searchsym_in_module(tunitsym(srsym).module,'ANSICHAR',srsym,srsymtable)
  320. end
  321. else
  322. if (cuf_allow_specialize in flags) and (idtoken=_SPECIALIZE) then
  323. begin
  324. consume(_ID);
  325. is_specialize:=true;
  326. if token=_ID then
  327. begin
  328. if (cuf_check_attr_suffix in flags) and
  329. searchsym_in_module(tunitsym(srsym).module,pattern+custom_attribute_suffix,srsym,srsymtable) then
  330. exit(true);
  331. searchsym_in_module(tunitsym(srsym).module,pattern,srsym,srsymtable);
  332. end;
  333. end
  334. else
  335. searchsym_in_module(tunitsym(srsym).module,pattern,srsym,srsymtable);
  336. end;
  337. _STRING:
  338. begin
  339. { system.string? }
  340. if tmodule(tunitsym(srsym).module).globalsymtable=systemunit then
  341. begin
  342. if cs_refcountedstrings in current_settings.localswitches then
  343. begin
  344. if m_default_unicodestring in current_settings.modeswitches then
  345. searchsym_in_module(tunitsym(srsym).module,'UNICODESTRING',srsym,srsymtable)
  346. else
  347. searchsym_in_module(tunitsym(srsym).module,'ANSISTRING',srsym,srsymtable)
  348. end
  349. else
  350. searchsym_in_module(tunitsym(srsym).module,'SHORTSTRING',srsym,srsymtable);
  351. tokentoconsume:=_STRING;
  352. end;
  353. end
  354. else
  355. ;
  356. end;
  357. end
  358. else
  359. begin
  360. srsym:=nil;
  361. srsymtable:=nil;
  362. end;
  363. result:=true;
  364. end;
  365. end;
  366. function try_consume_unitsym_no_specialize(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;flags:tconsume_unitsym_flags;sympattern:TSymStr):boolean;
  367. var
  368. dummy: Boolean;
  369. begin
  370. exclude(flags,cuf_allow_specialize);
  371. result:=try_consume_unitsym(srsym,srsymtable,tokentoconsume,flags,dummy,sympattern);
  372. end;
  373. function try_consume_hintdirective(var symopt:tsymoptions; var deprecatedmsg:pshortstring):boolean;
  374. var
  375. last_is_deprecated:boolean;
  376. begin
  377. try_consume_hintdirective:=false;
  378. if not(m_hintdirective in current_settings.modeswitches) then
  379. exit;
  380. repeat
  381. last_is_deprecated:=false;
  382. case idtoken of
  383. _LIBRARY:
  384. begin
  385. if sp_hint_library in symopt then
  386. Message1(parser_e_dir_not_allowed,arraytokeninfo[idtoken].str)
  387. else
  388. include(symopt,sp_hint_library);
  389. try_consume_hintdirective:=true;
  390. end;
  391. _DEPRECATED:
  392. begin
  393. if sp_hint_deprecated in symopt then
  394. Message1(parser_e_dir_not_allowed,arraytokeninfo[idtoken].str)
  395. else
  396. include(symopt,sp_hint_deprecated);
  397. try_consume_hintdirective:=true;
  398. last_is_deprecated:=true;
  399. end;
  400. _EXPERIMENTAL:
  401. begin
  402. if sp_hint_experimental in symopt then
  403. Message1(parser_e_dir_not_allowed,arraytokeninfo[idtoken].str)
  404. else
  405. include(symopt,sp_hint_experimental);
  406. try_consume_hintdirective:=true;
  407. end;
  408. _PLATFORM:
  409. begin
  410. if sp_hint_platform in symopt then
  411. Message1(parser_e_dir_not_allowed,arraytokeninfo[idtoken].str)
  412. else
  413. include(symopt,sp_hint_platform);
  414. try_consume_hintdirective:=true;
  415. end;
  416. _UNIMPLEMENTED:
  417. begin
  418. if sp_hint_unimplemented in symopt then
  419. Message1(parser_e_dir_not_allowed,arraytokeninfo[idtoken].str)
  420. else
  421. include(symopt,sp_hint_unimplemented);
  422. try_consume_hintdirective:=true;
  423. end;
  424. else
  425. break;
  426. end;
  427. consume(Token);
  428. { handle deprecated message }
  429. if ((token=_CSTRING) or (token=_CCHAR)) and last_is_deprecated then
  430. begin
  431. if not assigned(deprecatedmsg) then
  432. begin
  433. if token=_CSTRING then
  434. deprecatedmsg:=stringdup(cstringpattern)
  435. else
  436. deprecatedmsg:=stringdup(pattern);
  437. end;
  438. consume(token);
  439. include(symopt,sp_has_deprecated_msg);
  440. end;
  441. until false;
  442. end;
  443. end.