pdecobj.pas 54 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Does object types for Free Pascal
  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 pdecobj;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. cclasses,
  22. globtype,symconst,symtype,symdef;
  23. { parses a object declaration }
  24. function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
  25. function class_constructor_head:tprocdef;
  26. function class_destructor_head:tprocdef;
  27. function constructor_head:tprocdef;
  28. function destructor_head:tprocdef;
  29. procedure struct_property_dec(is_classproperty:boolean);
  30. implementation
  31. uses
  32. sysutils,cutils,
  33. globals,verbose,systems,tokens,
  34. symbase,symsym,symtable,
  35. node,nld,nmem,ncon,ncnv,ncal,
  36. fmodule,scanner,
  37. pbase,pexpr,pdecsub,pdecvar,ptype,pdecl,ppu
  38. ;
  39. const
  40. { Please leave this here, this module should NOT use
  41. these variables.
  42. Declaring it as string here results in an error when compiling (PFV) }
  43. current_procinfo = 'error';
  44. var
  45. current_objectdef : tobjectdef absolute current_structdef;
  46. function class_constructor_head:tprocdef;
  47. var
  48. pd : tprocdef;
  49. begin
  50. result:=nil;
  51. consume(_CONSTRUCTOR);
  52. { must be at same level as in implementation }
  53. parse_proc_head(current_structdef,potype_class_constructor,pd);
  54. if not assigned(pd) then
  55. begin
  56. consume(_SEMICOLON);
  57. exit;
  58. end;
  59. pd.calcparas;
  60. if (pd.maxparacount>0) then
  61. Message(parser_e_no_paras_for_class_constructor);
  62. consume(_SEMICOLON);
  63. include(current_structdef.objectoptions,oo_has_class_constructor);
  64. current_module.flags:=current_module.flags or uf_classinits;
  65. { no return value }
  66. pd.returndef:=voidtype;
  67. result:=pd;
  68. end;
  69. function constructor_head:tprocdef;
  70. var
  71. pd : tprocdef;
  72. begin
  73. result:=nil;
  74. consume(_CONSTRUCTOR);
  75. { must be at same level as in implementation }
  76. parse_proc_head(current_structdef,potype_constructor,pd);
  77. if not assigned(pd) then
  78. begin
  79. consume(_SEMICOLON);
  80. exit;
  81. end;
  82. if (cs_constructor_name in current_settings.globalswitches) and
  83. (pd.procsym.name<>'INIT') then
  84. Message(parser_e_constructorname_must_be_init);
  85. consume(_SEMICOLON);
  86. include(current_structdef.objectoptions,oo_has_constructor);
  87. { Set return type, class and record constructors return the
  88. created instance, object constructors return boolean }
  89. if is_class(pd.struct) or
  90. is_record(pd.struct) or
  91. is_javaclass(pd.struct) then
  92. pd.returndef:=pd.struct
  93. else
  94. {$ifdef CPU64bitaddr}
  95. pd.returndef:=bool64type;
  96. {$else CPU64bitaddr}
  97. pd.returndef:=bool32type;
  98. {$endif CPU64bitaddr}
  99. result:=pd;
  100. end;
  101. procedure struct_property_dec(is_classproperty:boolean);
  102. var
  103. p : tpropertysym;
  104. begin
  105. { check for a class, record or helper }
  106. if not((is_class_or_interface_or_dispinterface(current_structdef) or is_record(current_structdef) or is_objectpascal_helper(current_structdef)) or
  107. (not(m_tp7 in current_settings.modeswitches) and (is_object(current_structdef)))) then
  108. Message(parser_e_syntax_error);
  109. consume(_PROPERTY);
  110. p:=read_property_dec(is_classproperty,current_structdef);
  111. consume(_SEMICOLON);
  112. if try_to_consume(_DEFAULT) then
  113. begin
  114. if oo_has_default_property in current_structdef.objectoptions then
  115. message(parser_e_only_one_default_property);
  116. include(current_structdef.objectoptions,oo_has_default_property);
  117. include(p.propoptions,ppo_defaultproperty);
  118. if not(ppo_hasparameters in p.propoptions) then
  119. message(parser_e_property_need_paras);
  120. if (token=_COLON) then
  121. begin
  122. Message(parser_e_field_not_allowed_here);
  123. consume_all_until(_SEMICOLON);
  124. end;
  125. consume(_SEMICOLON);
  126. end;
  127. { parse possible enumerator modifier }
  128. if try_to_consume(_ENUMERATOR) then
  129. begin
  130. if (token = _ID) then
  131. begin
  132. if pattern='CURRENT' then
  133. begin
  134. if oo_has_enumerator_current in current_structdef.objectoptions then
  135. message(parser_e_only_one_enumerator_current);
  136. if not p.propaccesslist[palt_read].empty then
  137. begin
  138. include(current_structdef.objectoptions,oo_has_enumerator_current);
  139. include(p.propoptions,ppo_enumerator_current);
  140. end
  141. else
  142. Message(parser_e_enumerator_current_is_not_valid) // property has no reader
  143. end
  144. else
  145. Message1(parser_e_invalid_enumerator_identifier, pattern);
  146. consume(token);
  147. end
  148. else
  149. Message(parser_e_enumerator_identifier_required);
  150. consume(_SEMICOLON);
  151. end;
  152. { hint directives, these can be separated by semicolons here,
  153. that needs to be handled here with a loop (PFV) }
  154. while try_consume_hintdirective(p.symoptions,p.deprecatedmsg) do
  155. Consume(_SEMICOLON);
  156. end;
  157. function class_destructor_head:tprocdef;
  158. var
  159. pd : tprocdef;
  160. begin
  161. result:=nil;
  162. consume(_DESTRUCTOR);
  163. parse_proc_head(current_structdef,potype_class_destructor,pd);
  164. if not assigned(pd) then
  165. begin
  166. consume(_SEMICOLON);
  167. exit;
  168. end;
  169. pd.calcparas;
  170. if (pd.maxparacount>0) then
  171. Message(parser_e_no_paras_for_class_destructor);
  172. consume(_SEMICOLON);
  173. include(current_structdef.objectoptions,oo_has_class_destructor);
  174. current_module.flags:=current_module.flags or uf_classinits;
  175. { no return value }
  176. pd.returndef:=voidtype;
  177. result:=pd;
  178. end;
  179. function destructor_head:tprocdef;
  180. var
  181. pd : tprocdef;
  182. begin
  183. result:=nil;
  184. consume(_DESTRUCTOR);
  185. parse_proc_head(current_structdef,potype_destructor,pd);
  186. if not assigned(pd) then
  187. begin
  188. consume(_SEMICOLON);
  189. exit;
  190. end;
  191. if (cs_constructor_name in current_settings.globalswitches) and
  192. (pd.procsym.name<>'DONE') then
  193. Message(parser_e_destructorname_must_be_done);
  194. pd.calcparas;
  195. if not(pd.maxparacount=0) and
  196. (m_fpc in current_settings.modeswitches) then
  197. Message(parser_e_no_paras_for_destructor);
  198. consume(_SEMICOLON);
  199. include(current_structdef.objectoptions,oo_has_destructor);
  200. { no return value }
  201. pd.returndef:=voidtype;
  202. result:=pd;
  203. end;
  204. procedure setinterfacemethodoptions;
  205. var
  206. i : longint;
  207. def : tdef;
  208. begin
  209. include(current_structdef.objectoptions,oo_has_virtual);
  210. for i:=0 to current_structdef.symtable.DefList.count-1 do
  211. begin
  212. def:=tdef(current_structdef.symtable.DefList[i]);
  213. if assigned(def) and
  214. (def.typ=procdef) then
  215. begin
  216. include(tprocdef(def).procoptions,po_virtualmethod);
  217. tprocdef(def).forwarddef:=false;
  218. end;
  219. end;
  220. end;
  221. procedure setobjcclassmethodoptions;
  222. var
  223. i : longint;
  224. def : tdef;
  225. begin
  226. for i:=0 to current_structdef.symtable.DefList.count-1 do
  227. begin
  228. def:=tdef(current_structdef.symtable.DefList[i]);
  229. if assigned(def) and
  230. (def.typ=procdef) then
  231. begin
  232. include(tprocdef(def).procoptions,po_virtualmethod);
  233. end;
  234. end;
  235. end;
  236. procedure handleImplementedInterface(intfdef : tobjectdef);
  237. begin
  238. if not is_interface(intfdef) then
  239. begin
  240. Message1(type_e_interface_type_expected,intfdef.typename);
  241. exit;
  242. end;
  243. if current_objectdef.find_implemented_interface(intfdef)<>nil then
  244. Message1(sym_e_duplicate_id,intfdef.objname^)
  245. else
  246. begin
  247. { allocate and prepare the GUID only if the class
  248. implements some interfaces. }
  249. if current_objectdef.ImplementedInterfaces.count = 0 then
  250. current_objectdef.prepareguid;
  251. current_objectdef.ImplementedInterfaces.Add(TImplementedInterface.Create(intfdef));
  252. end;
  253. end;
  254. procedure handleImplementedProtocolOrJavaIntf(intfdef : tobjectdef);
  255. begin
  256. intfdef:=find_real_class_definition(intfdef,false);
  257. case current_objectdef.objecttype of
  258. odt_objcclass,
  259. odt_objccategory,
  260. odt_objcprotocol:
  261. if not is_objcprotocol(intfdef) then
  262. begin
  263. Message1(type_e_protocol_type_expected,intfdef.typename);
  264. exit;
  265. end;
  266. odt_javaclass,
  267. odt_interfacejava:
  268. if not is_javainterface(intfdef) then
  269. begin
  270. Message1(type_e_interface_type_expected,intfdef.typename);
  271. exit
  272. end;
  273. else
  274. internalerror(2011010807);
  275. end;
  276. if ([oo_is_forward,oo_is_formal] * intfdef.objectoptions <> []) then
  277. begin
  278. Message1(parser_e_forward_intf_declaration_must_be_resolved,intfdef.objrealname^);
  279. exit;
  280. end;
  281. if current_objectdef.find_implemented_interface(intfdef)<>nil then
  282. Message1(sym_e_duplicate_id,intfdef.objname^)
  283. else
  284. begin
  285. current_objectdef.ImplementedInterfaces.Add(TImplementedInterface.Create(intfdef));
  286. end;
  287. end;
  288. procedure readImplementedInterfacesAndProtocols(intf: boolean);
  289. var
  290. hdef : tdef;
  291. begin
  292. while try_to_consume(_COMMA) do
  293. begin
  294. { use single_type instead of id_type for specialize support }
  295. single_type(hdef,[stoAllowSpecialization,stoParseClassParent]);
  296. if (hdef.typ<>objectdef) then
  297. begin
  298. if intf then
  299. Message1(type_e_interface_type_expected,hdef.typename)
  300. else
  301. Message1(type_e_protocol_type_expected,hdef.typename);
  302. continue;
  303. end;
  304. if intf then
  305. handleImplementedInterface(tobjectdef(hdef))
  306. else
  307. handleImplementedProtocolOrJavaIntf(tobjectdef(hdef));
  308. end;
  309. end;
  310. procedure readinterfaceiid;
  311. var
  312. p : tnode;
  313. valid : boolean;
  314. begin
  315. p:=comp_expr(true,false);
  316. if p.nodetype=stringconstn then
  317. begin
  318. stringdispose(current_objectdef.iidstr);
  319. current_objectdef.iidstr:=stringdup(strpas(tstringconstnode(p).value_str));
  320. valid:=string2guid(current_objectdef.iidstr^,current_objectdef.iidguid^);
  321. if (current_objectdef.objecttype in [odt_interfacecom,odt_dispinterface]) and
  322. not valid then
  323. Message(parser_e_improper_guid_syntax);
  324. include(current_structdef.objectoptions,oo_has_valid_guid);
  325. end
  326. else
  327. Message(parser_e_illegal_expression);
  328. p.free;
  329. end;
  330. procedure get_cpp_or_java_class_external_status(od: tobjectdef);
  331. var
  332. hs: string;
  333. begin
  334. { C++ classes can be external -> all methods inside are external
  335. (defined at the class level instead of per method, so that you cannot
  336. define some methods as external and some not)
  337. }
  338. if try_to_consume(_EXTERNAL) then
  339. begin
  340. if token in [_CSTRING,_CWSTRING,_CCHAR,_CWCHAR] then
  341. begin
  342. { Always add library prefix and suffix to create an uniform name }
  343. hs:=get_stringconst;
  344. if ExtractFileExt(hs)='' then
  345. hs:=ChangeFileExt(hs,target_info.sharedlibext);
  346. if Copy(hs,1,length(target_info.sharedlibprefix))<>target_info.sharedlibprefix then
  347. hs:=target_info.sharedlibprefix+hs;
  348. { the JVM expects java/lang/Object rather than java.lang.Object }
  349. if target_info.system=system_jvm_java32 then
  350. Replace(hs,'.','/');
  351. od.import_lib:=stringdup(hs);
  352. end;
  353. include(od.objectoptions, oo_is_external);
  354. { check if we shall use another name for the class }
  355. if try_to_consume(_NAME) then
  356. od.objextname:=stringdup(get_stringconst)
  357. else
  358. od.objextname:=stringdup(od.objrealname^);
  359. include(od.objectoptions,oo_is_external);
  360. end
  361. else
  362. od.objextname:=stringdup(od.objrealname^);
  363. { ToDo: read the namespace of the class (influences the mangled name)}
  364. end;
  365. procedure get_objc_class_or_protocol_external_status(od: tobjectdef);
  366. begin
  367. { Objective-C classes can be external -> all messages inside are
  368. external (defined at the class level instead of per method, so
  369. that you cannot define some methods as external and some not)
  370. }
  371. if try_to_consume(_EXTERNAL) then
  372. begin
  373. if try_to_consume(_NAME) then
  374. od.objextname:=stringdup(get_stringconst)
  375. else
  376. { the external name doesn't matter for formally declared
  377. classes, and allowing to specify one would mean that we would
  378. have to check it for consistency with the actual definition
  379. later on }
  380. od.objextname:=stringdup(od.objrealname^);
  381. include(od.objectoptions,oo_is_external);
  382. end
  383. else
  384. od.objextname:=stringdup(od.objrealname^);
  385. end;
  386. procedure parse_object_options;
  387. begin
  388. case current_objectdef.objecttype of
  389. odt_object,odt_class:
  390. begin
  391. while true do
  392. begin
  393. if try_to_consume(_ABSTRACT) then
  394. include(current_structdef.objectoptions,oo_is_abstract)
  395. else
  396. if try_to_consume(_SEALED) then
  397. include(current_structdef.objectoptions,oo_is_sealed)
  398. else
  399. break;
  400. end;
  401. if [oo_is_abstract, oo_is_sealed] * current_structdef.objectoptions = [oo_is_abstract, oo_is_sealed] then
  402. Message(parser_e_abstract_and_sealed_conflict);
  403. end;
  404. odt_cppclass,
  405. odt_javaclass,
  406. odt_interfacejava:
  407. get_cpp_or_java_class_external_status(current_objectdef);
  408. odt_objcclass,odt_objcprotocol,odt_objccategory:
  409. get_objc_class_or_protocol_external_status(current_objectdef);
  410. odt_helper: ; // nothing
  411. end;
  412. end;
  413. procedure parse_parent_classes;
  414. var
  415. intfchildof,
  416. childof : tobjectdef;
  417. hdef : tdef;
  418. hasparentdefined : boolean;
  419. begin
  420. childof:=nil;
  421. intfchildof:=nil;
  422. hasparentdefined:=false;
  423. { reads the parent class }
  424. if (token=_LKLAMMER) or
  425. is_objccategory(current_structdef) then
  426. begin
  427. consume(_LKLAMMER);
  428. { use single_type instead of id_type for specialize support }
  429. single_type(hdef,[stoAllowSpecialization, stoParseClassParent]);
  430. if (not assigned(hdef)) or
  431. (hdef.typ<>objectdef) then
  432. begin
  433. if assigned(hdef) then
  434. Message1(type_e_class_type_expected,hdef.typename)
  435. else if is_objccategory(current_structdef) then
  436. { a category must specify the class to extend }
  437. Message(type_e_objcclass_type_expected);
  438. end
  439. else
  440. begin
  441. childof:=tobjectdef(hdef);
  442. { a mix of class, interfaces, objects and cppclasses
  443. isn't allowed }
  444. case current_objectdef.objecttype of
  445. odt_class,
  446. odt_javaclass:
  447. if (childof.objecttype<>current_objectdef.objecttype) then
  448. begin
  449. if (is_interface(childof) and
  450. is_class(current_objectdef)) or
  451. (is_javainterface(childof) and
  452. is_javaclass(current_objectdef)) then
  453. begin
  454. { we insert the interface after the child
  455. is set, see below
  456. }
  457. intfchildof:=childof;
  458. childof:=class_tobject;
  459. end
  460. else
  461. Message(parser_e_mix_of_classes_and_objects);
  462. end
  463. else
  464. if oo_is_sealed in childof.objectoptions then
  465. Message1(parser_e_sealed_descendant,childof.typename)
  466. else
  467. childof:=find_real_class_definition(childof,true);
  468. odt_interfacecorba,
  469. odt_interfacecom:
  470. begin
  471. if not(is_interface(childof)) then
  472. Message(parser_e_mix_of_classes_and_objects);
  473. current_objectdef.objecttype:=childof.objecttype;
  474. end;
  475. odt_cppclass:
  476. if not(is_cppclass(childof)) then
  477. Message(parser_e_mix_of_classes_and_objects);
  478. odt_objcclass:
  479. if not(is_objcclass(childof) or
  480. is_objccategory(childof)) then
  481. begin
  482. if is_objcprotocol(childof) then
  483. begin
  484. if not(oo_is_classhelper in current_structdef.objectoptions) then
  485. begin
  486. intfchildof:=childof;
  487. childof:=nil;
  488. CGMessage(parser_h_no_objc_parent);
  489. end
  490. else
  491. { a category must specify the class to extend }
  492. CGMessage(type_e_objcclass_type_expected);
  493. end
  494. else
  495. Message(parser_e_mix_of_classes_and_objects);
  496. end
  497. else
  498. childof:=find_real_class_definition(childof,true);
  499. odt_objcprotocol:
  500. begin
  501. if not(is_objcprotocol(childof)) then
  502. Message(parser_e_mix_of_classes_and_objects);
  503. intfchildof:=childof;
  504. childof:=nil;
  505. end;
  506. odt_interfacejava:
  507. begin
  508. if not(is_javainterface(childof)) then
  509. Message(parser_e_mix_of_classes_and_objects);
  510. intfchildof:=find_real_class_definition(childof,true);
  511. childof:=nil;
  512. end;
  513. odt_object:
  514. if not(is_object(childof)) then
  515. Message(parser_e_mix_of_classes_and_objects)
  516. else
  517. if oo_is_sealed in childof.objectoptions then
  518. Message1(parser_e_sealed_descendant,childof.typename);
  519. odt_dispinterface:
  520. Message(parser_e_dispinterface_cant_have_parent);
  521. odt_helper:
  522. if not is_objectpascal_helper(childof) then
  523. begin
  524. Message(type_e_helper_type_expected);
  525. childof:=nil;
  526. end;
  527. end;
  528. end;
  529. hasparentdefined:=true;
  530. end;
  531. { if no parent class, then a class get tobject as parent }
  532. if not assigned(childof) then
  533. begin
  534. case current_objectdef.objecttype of
  535. odt_class:
  536. if current_objectdef<>class_tobject then
  537. childof:=class_tobject;
  538. odt_interfacecom:
  539. if current_objectdef<>interface_iunknown then
  540. childof:=interface_iunknown;
  541. odt_dispinterface:
  542. childof:=interface_idispatch;
  543. odt_objcclass:
  544. CGMessage(parser_h_no_objc_parent);
  545. odt_javaclass:
  546. if current_objectdef<>java_jlobject then
  547. childof:=java_jlobject;
  548. end;
  549. end;
  550. if assigned(childof) then
  551. begin
  552. { Forbid not completly defined objects to be used as parents. This will
  553. also prevent circular loops of classes, because we set the forward flag
  554. at the start of the new definition and will reset it below after the
  555. parent has been set }
  556. if (oo_is_forward in childof.objectoptions) then
  557. Message1(parser_e_forward_declaration_must_be_resolved,childof.objrealname^)
  558. else if not(oo_is_formal in childof.objectoptions) then
  559. current_objectdef.set_parent(childof)
  560. else
  561. Message1(sym_e_formal_class_not_resolved,childof.objrealname^);
  562. end;
  563. { remove forward flag, is resolved }
  564. exclude(current_structdef.objectoptions,oo_is_forward);
  565. if hasparentdefined then
  566. begin
  567. if current_objectdef.objecttype in [odt_class,odt_objcclass,odt_objcprotocol,odt_javaclass,odt_interfacejava] then
  568. begin
  569. if assigned(intfchildof) then
  570. if current_objectdef.objecttype=odt_class then
  571. handleImplementedInterface(intfchildof)
  572. else
  573. handleImplementedProtocolOrJavaIntf(intfchildof);
  574. readImplementedInterfacesAndProtocols(current_objectdef.objecttype=odt_class);
  575. end;
  576. consume(_RKLAMMER);
  577. end;
  578. end;
  579. procedure parse_extended_type(helpertype:thelpertype);
  580. var
  581. hdef: tdef;
  582. begin
  583. if not is_objectpascal_helper(current_structdef) then
  584. Internalerror(2011021103);
  585. if helpertype=ht_none then
  586. Internalerror(2011021001);
  587. consume(_FOR);
  588. single_type(hdef,[stoParseClassParent]);
  589. if (not assigned(hdef)) or
  590. not (hdef.typ in [objectdef,recorddef]) then
  591. begin
  592. if helpertype=ht_class then
  593. Message1(type_e_class_type_expected,hdef.typename)
  594. else
  595. if helpertype=ht_record then
  596. Message1(type_e_record_type_expected,hdef.typename);
  597. end
  598. else
  599. begin
  600. case helpertype of
  601. ht_class:
  602. begin
  603. if not is_class(hdef) then
  604. Message1(type_e_class_type_expected,hdef.typename);
  605. { a class helper must extend the same class or a subclass
  606. of the class extended by the parent class helper }
  607. if assigned(current_objectdef.childof) then
  608. begin
  609. if not is_class(current_objectdef.childof.extendeddef) then
  610. Internalerror(2011021101);
  611. if not hdef.is_related(current_objectdef.childof.extendeddef) then
  612. Message1(type_e_class_helper_must_extend_subclass,current_objectdef.childof.extendeddef.typename);
  613. end;
  614. end;
  615. ht_record:
  616. begin
  617. if not is_record(hdef) then
  618. Message1(type_e_record_type_expected,hdef.typename);
  619. { a record helper must extend the same record as the
  620. parent helper }
  621. if assigned(current_objectdef.childof) then
  622. begin
  623. if not is_record(current_objectdef.childof.extendeddef) then
  624. Internalerror(2011021102);
  625. if hdef<>current_objectdef.childof.extendeddef then
  626. Message1(type_e_record_helper_must_extend_same_record,current_objectdef.childof.extendeddef.typename);
  627. end;
  628. end;
  629. end;
  630. current_objectdef.extendeddef:=tabstractrecorddef(hdef);
  631. end;
  632. end;
  633. procedure parse_guid;
  634. begin
  635. { read GUID }
  636. if (current_objectdef.objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface]) and
  637. try_to_consume(_LECKKLAMMER) then
  638. begin
  639. readinterfaceiid;
  640. consume(_RECKKLAMMER);
  641. end
  642. else if (current_objectdef.objecttype=odt_dispinterface) then
  643. message(parser_e_dispinterface_needs_a_guid);
  644. end;
  645. procedure parse_object_members;
  646. procedure chkobjc(pd: tprocdef);
  647. begin
  648. if is_objc_class_or_protocol(pd.struct) then
  649. begin
  650. include(pd.procoptions,po_objc);
  651. end;
  652. end;
  653. procedure chkjava(pd: tprocdef);
  654. begin
  655. if is_java_class_or_interface(pd.struct) then
  656. begin
  657. include(pd.procoptions,po_java);
  658. { In java, all methods are either regular virtual methods,
  659. or static class methods }
  660. if [po_staticmethod,po_classmethod]*pd.procoptions=[po_classmethod] then
  661. messagepos(pd.fileinfo,type_e_java_class_method_not_static);
  662. end;
  663. end;
  664. procedure chkcpp(pd:tprocdef);
  665. begin
  666. { nothing currently }
  667. end;
  668. procedure maybe_parse_hint_directives(pd:tprocdef);
  669. var
  670. dummysymoptions : tsymoptions;
  671. deprecatedmsg : pshortstring;
  672. begin
  673. dummysymoptions:=[];
  674. deprecatedmsg:=nil;
  675. while try_consume_hintdirective(dummysymoptions,deprecatedmsg) do
  676. Consume(_SEMICOLON);
  677. if assigned(pd) then
  678. begin
  679. pd.symoptions:=pd.symoptions+dummysymoptions;
  680. pd.deprecatedmsg:=deprecatedmsg;
  681. end
  682. else
  683. stringdispose(deprecatedmsg);
  684. end;
  685. var
  686. pd : tprocdef;
  687. has_destructor,
  688. oldparse_only: boolean;
  689. object_member_blocktype : tblock_type;
  690. fields_allowed, is_classdef, classfields: boolean;
  691. vdoptions: tvar_dec_options;
  692. begin
  693. { empty class declaration ? }
  694. if (current_objectdef.objecttype in [odt_class,odt_objcclass,odt_javaclass]) and
  695. (token=_SEMICOLON) then
  696. exit;
  697. { in "publishable" classes the default access type is published }
  698. if (oo_can_have_published in current_structdef.objectoptions) then
  699. current_structdef.symtable.currentvisibility:=vis_published
  700. else
  701. current_structdef.symtable.currentvisibility:=vis_public;
  702. has_destructor:=false;
  703. fields_allowed:=true;
  704. is_classdef:=false;
  705. classfields:=false;
  706. object_member_blocktype:=bt_general;
  707. repeat
  708. case token of
  709. _TYPE :
  710. begin
  711. if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper,odt_javaclass]) then
  712. Message(parser_e_type_var_const_only_in_records_and_classes);
  713. consume(_TYPE);
  714. object_member_blocktype:=bt_type;
  715. end;
  716. _VAR :
  717. begin
  718. if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper,odt_javaclass]) then
  719. Message(parser_e_type_var_const_only_in_records_and_classes);
  720. consume(_VAR);
  721. fields_allowed:=true;
  722. object_member_blocktype:=bt_general;
  723. classfields:=is_classdef;
  724. is_classdef:=false;
  725. end;
  726. _CONST:
  727. begin
  728. if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper,odt_javaclass]) then
  729. Message(parser_e_type_var_const_only_in_records_and_classes);
  730. consume(_CONST);
  731. object_member_blocktype:=bt_const;
  732. end;
  733. _ID :
  734. begin
  735. if is_objcprotocol(current_structdef) and
  736. ((idtoken=_REQUIRED) or
  737. (idtoken=_OPTIONAL)) then
  738. begin
  739. current_structdef.symtable.currentlyoptional:=(idtoken=_OPTIONAL);
  740. consume(idtoken)
  741. end
  742. else case idtoken of
  743. _PRIVATE :
  744. begin
  745. if is_interface(current_structdef) or
  746. is_objc_protocol_or_category(current_structdef) or
  747. is_javainterface(current_structdef) then
  748. Message(parser_e_no_access_specifier_in_interfaces);
  749. consume(_PRIVATE);
  750. current_structdef.symtable.currentvisibility:=vis_private;
  751. include(current_structdef.objectoptions,oo_has_private);
  752. fields_allowed:=true;
  753. is_classdef:=false;
  754. classfields:=false;
  755. object_member_blocktype:=bt_general;
  756. end;
  757. _PROTECTED :
  758. begin
  759. if is_interface(current_structdef) or
  760. is_objc_protocol_or_category(current_structdef) or
  761. is_javainterface(current_structdef) then
  762. Message(parser_e_no_access_specifier_in_interfaces);
  763. consume(_PROTECTED);
  764. current_structdef.symtable.currentvisibility:=vis_protected;
  765. include(current_structdef.objectoptions,oo_has_protected);
  766. fields_allowed:=true;
  767. is_classdef:=false;
  768. classfields:=false;
  769. object_member_blocktype:=bt_general;
  770. end;
  771. _PUBLIC :
  772. begin
  773. if is_interface(current_structdef) or
  774. is_objc_protocol_or_category(current_structdef) or
  775. is_javainterface(current_structdef) then
  776. Message(parser_e_no_access_specifier_in_interfaces);
  777. consume(_PUBLIC);
  778. current_structdef.symtable.currentvisibility:=vis_public;
  779. fields_allowed:=true;
  780. is_classdef:=false;
  781. classfields:=false;
  782. object_member_blocktype:=bt_general;
  783. end;
  784. _PUBLISHED :
  785. begin
  786. { we've to check for a pushlished section in non- }
  787. { publishable classes later, if a real declaration }
  788. { this is the way, delphi does it }
  789. if is_interface(current_structdef) then
  790. Message(parser_e_no_access_specifier_in_interfaces);
  791. { Objective-C and Java classes do not support "published",
  792. as basically everything is published. }
  793. if is_objc_class_or_protocol(current_structdef) or
  794. is_java_class_or_interface(current_structdef) then
  795. Message(parser_e_no_objc_published);
  796. consume(_PUBLISHED);
  797. current_structdef.symtable.currentvisibility:=vis_published;
  798. fields_allowed:=true;
  799. is_classdef:=false;
  800. classfields:=false;
  801. object_member_blocktype:=bt_general;
  802. end;
  803. _STRICT :
  804. begin
  805. if is_interface(current_structdef) or
  806. is_objc_protocol_or_category(current_structdef) or
  807. is_javainterface(current_structdef) then
  808. Message(parser_e_no_access_specifier_in_interfaces);
  809. consume(_STRICT);
  810. if token=_ID then
  811. begin
  812. case idtoken of
  813. _PRIVATE:
  814. begin
  815. consume(_PRIVATE);
  816. current_structdef.symtable.currentvisibility:=vis_strictprivate;
  817. include(current_structdef.objectoptions,oo_has_strictprivate);
  818. end;
  819. _PROTECTED:
  820. begin
  821. consume(_PROTECTED);
  822. current_structdef.symtable.currentvisibility:=vis_strictprotected;
  823. include(current_structdef.objectoptions,oo_has_strictprotected);
  824. end;
  825. else
  826. message(parser_e_protected_or_private_expected);
  827. end;
  828. end
  829. else
  830. message(parser_e_protected_or_private_expected);
  831. fields_allowed:=true;
  832. is_classdef:=false;
  833. classfields:=false;
  834. object_member_blocktype:=bt_general;
  835. end
  836. else
  837. begin
  838. if object_member_blocktype=bt_general then
  839. begin
  840. if is_interface(current_structdef) or
  841. is_objc_protocol_or_category(current_structdef) or
  842. is_objectpascal_helper(current_structdef) or
  843. is_javainterface(current_structdef) then
  844. Message(parser_e_no_vars_in_interfaces);
  845. if (current_structdef.symtable.currentvisibility=vis_published) and
  846. not(oo_can_have_published in current_structdef.objectoptions) then
  847. Message(parser_e_cant_have_published);
  848. if (not fields_allowed) then
  849. Message(parser_e_field_not_allowed_here);
  850. vdoptions:=[vd_object];
  851. if classfields then
  852. include(vdoptions,vd_class);
  853. read_record_fields(vdoptions);
  854. end
  855. else if object_member_blocktype=bt_type then
  856. types_dec(true)
  857. else if object_member_blocktype=bt_const then
  858. consts_dec(true)
  859. else
  860. internalerror(201001110);
  861. end;
  862. end;
  863. end;
  864. _PROPERTY :
  865. begin
  866. struct_property_dec(is_classdef);
  867. fields_allowed:=false;
  868. is_classdef:=false;
  869. end;
  870. _CLASS:
  871. begin
  872. is_classdef:=false;
  873. { read class method/field/property }
  874. consume(_CLASS);
  875. { class modifier is only allowed for procedures, functions, }
  876. { constructors, destructors, fields and properties }
  877. if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR,_CONSTRUCTOR,_DESTRUCTOR]) then
  878. Message(parser_e_procedure_or_function_expected);
  879. if is_interface(current_structdef) or
  880. is_javainterface(current_structdef) then
  881. Message(parser_e_no_static_method_in_interfaces)
  882. else
  883. { class methods are also allowed for Objective-C protocols }
  884. is_classdef:=true;
  885. end;
  886. _PROCEDURE,
  887. _FUNCTION:
  888. begin
  889. if (current_structdef.symtable.currentvisibility=vis_published) and
  890. not(oo_can_have_published in current_structdef.objectoptions) then
  891. Message(parser_e_cant_have_published);
  892. oldparse_only:=parse_only;
  893. parse_only:=true;
  894. pd:=parse_proc_dec(is_classdef,current_structdef);
  895. { this is for error recovery as well as forward }
  896. { interface mappings, i.e. mapping to a method }
  897. { which isn't declared yet }
  898. if assigned(pd) then
  899. begin
  900. parse_object_proc_directives(pd);
  901. { check if dispid is set }
  902. if is_dispinterface(pd.struct) and not (po_dispid in pd.procoptions) then
  903. begin
  904. pd.dispid:=tobjectdef(pd.struct).get_next_dispid;
  905. include(pd.procoptions, po_dispid);
  906. end;
  907. { all Macintosh Object Pascal methods are virtual. }
  908. { this can't be a class method, because macpas mode }
  909. { has no m_class }
  910. if (m_mac in current_settings.modeswitches) then
  911. include(pd.procoptions,po_virtualmethod);
  912. { for record helpers only static class methods are allowed }
  913. if is_objectpascal_helper(current_structdef) and
  914. is_record(current_objectdef.extendeddef) and
  915. is_classdef and not (po_staticmethod in pd.procoptions) then
  916. MessagePos(pd.fileinfo, parser_e_class_methods_only_static_in_records);
  917. handle_calling_convention(pd);
  918. { add definition to procsym }
  919. proc_add_definition(pd);
  920. { add procdef options to objectdef options }
  921. if (po_msgint in pd.procoptions) then
  922. include(current_structdef.objectoptions,oo_has_msgint);
  923. if (po_msgstr in pd.procoptions) then
  924. include(current_structdef.objectoptions,oo_has_msgstr);
  925. if (po_virtualmethod in pd.procoptions) then
  926. include(current_structdef.objectoptions,oo_has_virtual);
  927. chkcpp(pd);
  928. chkobjc(pd);
  929. chkjava(pd);
  930. end;
  931. maybe_parse_hint_directives(pd);
  932. parse_only:=oldparse_only;
  933. fields_allowed:=false;
  934. is_classdef:=false;
  935. end;
  936. _CONSTRUCTOR :
  937. begin
  938. if (current_structdef.symtable.currentvisibility=vis_published) and
  939. not(oo_can_have_published in current_structdef.objectoptions) then
  940. Message(parser_e_cant_have_published);
  941. if not is_classdef and not(current_structdef.symtable.currentvisibility in [vis_public,vis_published]) then
  942. Message(parser_w_constructor_should_be_public);
  943. if is_interface(current_structdef) then
  944. Message(parser_e_no_con_des_in_interfaces);
  945. { Objective-C does not know the concept of a constructor }
  946. if is_objc_class_or_protocol(current_structdef) then
  947. Message(parser_e_objc_no_constructor_destructor);
  948. if is_objectpascal_helper(current_structdef) then
  949. if is_classdef then
  950. { class constructors are not allowed in class helpers }
  951. Message(parser_e_no_class_constructor_in_helpers)
  952. else
  953. if is_record(current_objectdef.extendeddef) then
  954. { as long as constructors aren't allowed in records they
  955. aren't allowed in helpers either }
  956. Message(parser_e_no_constructor_in_records);
  957. { only 1 class constructor is allowed }
  958. if is_classdef and (oo_has_class_constructor in current_structdef.objectoptions) then
  959. Message1(parser_e_only_one_class_constructor_allowed, current_structdef.objrealname^);
  960. oldparse_only:=parse_only;
  961. parse_only:=true;
  962. if is_classdef then
  963. pd:=class_constructor_head
  964. else
  965. pd:=constructor_head;
  966. parse_object_proc_directives(pd);
  967. handle_calling_convention(pd);
  968. { add definition to procsym }
  969. proc_add_definition(pd);
  970. { add procdef options to objectdef options }
  971. if (po_virtualmethod in pd.procoptions) then
  972. include(current_structdef.objectoptions,oo_has_virtual);
  973. chkcpp(pd);
  974. maybe_parse_hint_directives(pd);
  975. parse_only:=oldparse_only;
  976. fields_allowed:=false;
  977. is_classdef:=false;
  978. end;
  979. _DESTRUCTOR :
  980. begin
  981. if (current_structdef.symtable.currentvisibility=vis_published) and
  982. not(oo_can_have_published in current_structdef.objectoptions) then
  983. Message(parser_e_cant_have_published);
  984. if not is_classdef then
  985. if has_destructor then
  986. Message(parser_n_only_one_destructor)
  987. else
  988. has_destructor:=true;
  989. if is_interface(current_structdef) then
  990. Message(parser_e_no_con_des_in_interfaces);
  991. { (class) destructors are not allowed in class helpers }
  992. if is_objectpascal_helper(current_structdef) then
  993. Message(parser_e_no_destructor_in_records);
  994. if not is_classdef and (current_structdef.symtable.currentvisibility<>vis_public) then
  995. Message(parser_w_destructor_should_be_public);
  996. { Objective-C does not know the concept of a destructor }
  997. if is_objc_class_or_protocol(current_structdef) then
  998. Message(parser_e_objc_no_constructor_destructor);
  999. { only 1 class destructor is allowed }
  1000. if is_classdef and (oo_has_class_destructor in current_structdef.objectoptions) then
  1001. Message1(parser_e_only_one_class_destructor_allowed, current_structdef.objrealname^);
  1002. oldparse_only:=parse_only;
  1003. parse_only:=true;
  1004. if is_classdef then
  1005. pd:=class_destructor_head
  1006. else
  1007. pd:=destructor_head;
  1008. parse_object_proc_directives(pd);
  1009. handle_calling_convention(pd);
  1010. { add definition to procsym }
  1011. proc_add_definition(pd);
  1012. { add procdef options to objectdef options }
  1013. if (po_virtualmethod in pd.procoptions) then
  1014. include(current_structdef.objectoptions,oo_has_virtual);
  1015. chkcpp(pd);
  1016. maybe_parse_hint_directives(pd);
  1017. parse_only:=oldparse_only;
  1018. fields_allowed:=false;
  1019. is_classdef:=false;
  1020. end;
  1021. _END :
  1022. begin
  1023. consume(_END);
  1024. break;
  1025. end;
  1026. else
  1027. consume(_ID); { Give a ident expected message, like tp7 }
  1028. end;
  1029. until false;
  1030. end;
  1031. function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
  1032. var
  1033. old_current_structdef: tabstractrecorddef;
  1034. old_current_genericdef,
  1035. old_current_specializedef: tstoreddef;
  1036. old_parse_generic: boolean;
  1037. list: TFPObjectList;
  1038. s: String;
  1039. st: TSymtable;
  1040. begin
  1041. old_current_structdef:=current_structdef;
  1042. old_current_genericdef:=current_genericdef;
  1043. old_current_specializedef:=current_specializedef;
  1044. old_parse_generic:=parse_generic;
  1045. current_structdef:=nil;
  1046. current_genericdef:=nil;
  1047. current_specializedef:=nil;
  1048. { objects and class types can't be declared local }
  1049. if not(symtablestack.top.symtabletype in [globalsymtable,staticsymtable,objectsymtable,recordsymtable]) and
  1050. not assigned(genericlist) then
  1051. Message(parser_e_no_local_objects);
  1052. { reuse forward objectdef? }
  1053. if assigned(fd) then
  1054. begin
  1055. if fd.objecttype<>objecttype then
  1056. begin
  1057. Message(parser_e_forward_mismatch);
  1058. { recover }
  1059. current_structdef:=tobjectdef.create(current_objectdef.objecttype,n,nil);
  1060. include(current_structdef.objectoptions,oo_is_forward);
  1061. end
  1062. else
  1063. current_structdef:=fd
  1064. end
  1065. else
  1066. begin
  1067. { anonym objects aren't allow (o : object a : longint; end;) }
  1068. if n='' then
  1069. Message(parser_f_no_anonym_objects);
  1070. { create new class }
  1071. current_structdef:=tobjectdef.create(objecttype,n,nil);
  1072. { include always the forward flag, it'll be removed after the parent class have been
  1073. added. This is to prevent circular childof loops }
  1074. include(current_structdef.objectoptions,oo_is_forward);
  1075. if (cs_compilesystem in current_settings.moduleswitches) then
  1076. begin
  1077. case current_objectdef.objecttype of
  1078. odt_interfacecom :
  1079. if (current_structdef.objname^='IUNKNOWN') then
  1080. interface_iunknown:=current_objectdef
  1081. else
  1082. if (current_structdef.objname^='IDISPATCH') then
  1083. interface_idispatch:=current_objectdef;
  1084. odt_class :
  1085. if (current_structdef.objname^='TOBJECT') then
  1086. class_tobject:=current_objectdef;
  1087. odt_javaclass:
  1088. begin
  1089. if (current_objectdef.objname^='TOBJECT') then
  1090. java_jlobject:=current_objectdef;
  1091. if (current_objectdef.objname^='TJLTHROWABLE') then
  1092. java_jlthrowable:=current_objectdef;
  1093. end;
  1094. end;
  1095. end;
  1096. if (current_module.modulename^='OBJCBASE') then
  1097. begin
  1098. case current_objectdef.objecttype of
  1099. odt_objcclass:
  1100. if (current_objectdef.objname^='Protocol') then
  1101. objc_protocoltype:=current_objectdef;
  1102. end;
  1103. end;
  1104. end;
  1105. { usage of specialized type inside its generic template }
  1106. if assigned(genericdef) then
  1107. current_specializedef:=current_structdef
  1108. { reject declaration of generic class inside generic class }
  1109. else if assigned(genericlist) then
  1110. current_genericdef:=current_structdef;
  1111. { set published flag in $M+ mode, it can also be inherited and will
  1112. be added when the parent class set with tobjectdef.set_parent (PFV) }
  1113. if (cs_generate_rtti in current_settings.localswitches) and
  1114. (current_objectdef.objecttype in [odt_interfacecom,odt_class,odt_helper]) then
  1115. include(current_structdef.objectoptions,oo_can_have_published);
  1116. { Objective-C/Java objectdefs can be "formal definitions", in which case
  1117. the syntax is "type tc = objcclass external;" -> we have to parse
  1118. its object options (external) already here, to make sure that such
  1119. definitions are recognised as formal defs }
  1120. if objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory,odt_javaclass,odt_interfacejava] then
  1121. parse_object_options;
  1122. { forward def? }
  1123. if not assigned(fd) and
  1124. (token=_SEMICOLON) then
  1125. begin
  1126. { add to the list of definitions to check that the forward
  1127. is resolved. this is required for delphi mode }
  1128. current_module.checkforwarddefs.add(current_structdef);
  1129. end
  1130. else
  1131. begin
  1132. { change objccategories into objcclass helpers }
  1133. if (objecttype=odt_objccategory) then
  1134. begin
  1135. current_objectdef.objecttype:=odt_objcclass;
  1136. include(current_structdef.objectoptions,oo_is_classhelper);
  1137. end;
  1138. { include the class helper flag for Object Pascal helpers }
  1139. if (objecttype=odt_helper) then
  1140. include(current_objectdef.objectoptions,oo_is_classhelper);
  1141. { parse list of options (abstract / sealed) }
  1142. if not(objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory,odt_javaclass,odt_interfacejava]) then
  1143. parse_object_options;
  1144. symtablestack.push(current_structdef.symtable);
  1145. insert_generic_parameter_types(current_structdef,genericdef,genericlist);
  1146. parse_generic:=(df_generic in current_structdef.defoptions);
  1147. { parse list of parent classes }
  1148. { for record helpers in mode Delphi this is not allowed }
  1149. if not (is_objectpascal_helper(current_objectdef) and
  1150. (m_delphi in current_settings.modeswitches) and
  1151. (helpertype=ht_record)) then
  1152. parse_parent_classes
  1153. else
  1154. { remove forward flag, is resolved (this is normally done inside
  1155. parse_parent_classes) }
  1156. exclude(current_structdef.objectoptions,oo_is_forward);
  1157. { parse extended type for helpers }
  1158. if is_objectpascal_helper(current_structdef) then
  1159. parse_extended_type(helpertype);
  1160. { parse optional GUID for interfaces }
  1161. parse_guid;
  1162. { parse and insert object members }
  1163. parse_object_members;
  1164. symtablestack.pop(current_structdef.symtable);
  1165. end;
  1166. { generate vmt space if needed }
  1167. if not(oo_has_vmt in current_structdef.objectoptions) and
  1168. not(oo_is_forward in current_structdef.objectoptions) and
  1169. (
  1170. ([oo_has_virtual,oo_has_constructor,oo_has_destructor]*current_structdef.objectoptions<>[]) or
  1171. (current_objectdef.objecttype in [odt_class])
  1172. ) then
  1173. current_objectdef.insertvmt;
  1174. { for implemented classes with a vmt check if there is a constructor }
  1175. if (oo_has_vmt in current_structdef.objectoptions) and
  1176. not(oo_is_forward in current_structdef.objectoptions) and
  1177. not(oo_has_constructor in current_structdef.objectoptions) and
  1178. not is_objc_class_or_protocol(current_structdef) and
  1179. not is_java_class_or_interface(current_structdef) then
  1180. Message1(parser_w_virtual_without_constructor,current_structdef.objrealname^);
  1181. if is_interface(current_structdef) or
  1182. is_objcprotocol(current_structdef) or
  1183. is_javainterface(current_structdef) then
  1184. setinterfacemethodoptions
  1185. else if is_objcclass(current_structdef) then
  1186. setobjcclassmethodoptions;
  1187. { if this helper is defined in the implementation section of the unit
  1188. or inside the main project file, the extendeddefs list of the current
  1189. module must be updated (it will be removed when poping the symtable) }
  1190. if is_objectpascal_helper(current_structdef) then
  1191. begin
  1192. { the topmost symtable must be a static symtable }
  1193. st:=current_structdef.owner;
  1194. while st.symtabletype in [objectsymtable,recordsymtable] do
  1195. st:=st.defowner.owner;
  1196. if st.symtabletype=staticsymtable then
  1197. begin
  1198. s:=make_mangledname('',current_objectdef.extendeddef.symtable,'');
  1199. list:=TFPObjectList(current_module.extendeddefs.Find(s));
  1200. if not assigned(list) then
  1201. begin
  1202. list:=TFPObjectList.Create(false);
  1203. current_module.extendeddefs.Add(s, list);
  1204. end;
  1205. list.add(current_structdef);
  1206. end;
  1207. end;
  1208. tabstractrecordsymtable(current_objectdef.symtable).addalignmentpadding;
  1209. { return defined objectdef }
  1210. result:=current_objectdef;
  1211. { restore old state }
  1212. current_structdef:=old_current_structdef;
  1213. current_genericdef:=old_current_genericdef;
  1214. current_specializedef:=old_current_specializedef;
  1215. parse_generic:=old_parse_generic;
  1216. end;
  1217. end.