pdecobj.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Does object types for Free Pascal
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit pdecobj;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. globtype,symtype,symdef;
  23. { parses a object declaration }
  24. function object_dec(const n : stringid;fd : tobjectdef) : tdef;
  25. implementation
  26. uses
  27. cutils,cclasses,
  28. globals,verbose,systems,tokens,
  29. symconst,symbase,symsym,
  30. node,nld,nmem,ncon,ncnv,ncal,
  31. scanner,
  32. pbase,pexpr,pdecsub,pdecvar,ptype
  33. ;
  34. const
  35. { Please leave this here, this module should NOT use
  36. these variables.
  37. Declaring it as string here results in an error when compiling (PFV) }
  38. current_procinfo = 'error';
  39. function object_dec(const n : stringid;fd : tobjectdef) : tdef;
  40. { this function parses an object or class declaration }
  41. var
  42. there_is_a_destructor : boolean;
  43. classtype : tobjectdeftype;
  44. childof : tobjectdef;
  45. aktclass : tobjectdef;
  46. function constructor_head:tprocdef;
  47. var
  48. pd : tprocdef;
  49. begin
  50. consume(_CONSTRUCTOR);
  51. { must be at same level as in implementation }
  52. parse_proc_head(aktclass,potype_constructor,pd);
  53. if not assigned(pd) then
  54. begin
  55. consume(_SEMICOLON);
  56. exit;
  57. end;
  58. if (cs_constructor_name in aktglobalswitches) and
  59. (pd.procsym.name<>'INIT') then
  60. Message(parser_e_constructorname_must_be_init);
  61. consume(_SEMICOLON);
  62. include(aktclass.objectoptions,oo_has_constructor);
  63. { Set return type, class constructors return the
  64. created instance, object constructors return boolean }
  65. if is_class(pd._class) then
  66. pd.rettype.setdef(pd._class)
  67. else
  68. pd.rettype:=booltype;
  69. constructor_head:=pd;
  70. end;
  71. procedure property_dec;
  72. var
  73. p : tpropertysym;
  74. begin
  75. { check for a class }
  76. if not((is_class_or_interface(aktclass)) or
  77. ((m_delphi in aktmodeswitches) and (is_object(aktclass)))) then
  78. Message(parser_e_syntax_error);
  79. consume(_PROPERTY);
  80. p:=read_property_dec(aktclass);
  81. consume(_SEMICOLON);
  82. if try_to_consume(_DEFAULT) then
  83. begin
  84. if oo_has_default_property in aktclass.objectoptions then
  85. message(parser_e_only_one_default_property);
  86. include(aktclass.objectoptions,oo_has_default_property);
  87. include(p.propoptions,ppo_defaultproperty);
  88. if not(ppo_hasparameters in p.propoptions) then
  89. message(parser_e_property_need_paras);
  90. consume(_SEMICOLON);
  91. end;
  92. { hint directives, these can be separated by semicolons here,
  93. that needs to be handled here with a loop (PFV) }
  94. while try_consume_hintdirective(p.symoptions) do
  95. Consume(_SEMICOLON);
  96. end;
  97. function destructor_head:tprocdef;
  98. var
  99. pd : tprocdef;
  100. begin
  101. consume(_DESTRUCTOR);
  102. parse_proc_head(aktclass,potype_destructor,pd);
  103. if not assigned(pd) then
  104. begin
  105. consume(_SEMICOLON);
  106. exit;
  107. end;
  108. if (cs_constructor_name in aktglobalswitches) and
  109. (pd.procsym.name<>'DONE') then
  110. Message(parser_e_destructorname_must_be_done);
  111. if not(pd.maxparacount=0) and
  112. (m_fpc in aktmodeswitches) then
  113. Message(parser_e_no_paras_for_destructor);
  114. consume(_SEMICOLON);
  115. include(aktclass.objectoptions,oo_has_destructor);
  116. { no return value }
  117. pd.rettype:=voidtype;
  118. destructor_head:=pd;
  119. end;
  120. var
  121. pcrd : tclassrefdef;
  122. tt : ttype;
  123. old_object_option : tsymoptions;
  124. oldparse_only : boolean;
  125. storetypecanbeforward : boolean;
  126. procedure setclassattributes;
  127. begin
  128. { publishable }
  129. if classtype in [odt_interfacecom,odt_class] then
  130. begin
  131. aktclass.objecttype:=classtype;
  132. if (cs_generate_rtti in aktlocalswitches) or
  133. (assigned(aktclass.childof) and
  134. (oo_can_have_published in aktclass.childof.objectoptions)) then
  135. begin
  136. include(aktclass.objectoptions,oo_can_have_published);
  137. { in "publishable" classes the default access type is published }
  138. current_object_option:=[sp_published];
  139. end;
  140. end;
  141. end;
  142. procedure setclassparent;
  143. begin
  144. if assigned(fd) then
  145. aktclass:=fd
  146. else
  147. aktclass:=tobjectdef.create(classtype,n,nil);
  148. { is the current class tobject? }
  149. { so you could define your own tobject }
  150. if (cs_compilesystem in aktmoduleswitches) and (classtype=odt_class) and (upper(n)='TOBJECT') then
  151. class_tobject:=aktclass
  152. else if (cs_compilesystem in aktmoduleswitches) and (classtype=odt_interfacecom) and (upper(n)='IUNKNOWN') then
  153. interface_iunknown:=aktclass
  154. else
  155. begin
  156. case classtype of
  157. odt_class:
  158. childof:=class_tobject;
  159. odt_interfacecom:
  160. childof:=interface_iunknown;
  161. end;
  162. if (oo_is_forward in childof.objectoptions) then
  163. Message1(parser_e_forward_declaration_must_be_resolved,childof.objrealname^);
  164. aktclass.set_parent(childof);
  165. end;
  166. end;
  167. procedure setinterfacemethodoptions;
  168. var
  169. i: longint;
  170. defs: TIndexArray;
  171. pd: tdef;
  172. begin
  173. include(aktclass.objectoptions,oo_has_virtual);
  174. defs:=aktclass.symtable.defindex;
  175. for i:=1 to defs.count do
  176. begin
  177. pd:=tdef(defs.search(i));
  178. if pd.deftype=procdef then
  179. begin
  180. tprocdef(pd).extnumber:=aktclass.lastvtableindex;
  181. inc(aktclass.lastvtableindex);
  182. include(tprocdef(pd).procoptions,po_virtualmethod);
  183. tprocdef(pd).forwarddef:=false;
  184. end;
  185. end;
  186. end;
  187. function readobjecttype : boolean;
  188. begin
  189. readobjecttype:=true;
  190. { distinguish classes and objects }
  191. case token of
  192. _OBJECT:
  193. begin
  194. classtype:=odt_object;
  195. consume(_OBJECT)
  196. end;
  197. _CPPCLASS:
  198. begin
  199. classtype:=odt_cppclass;
  200. consume(_CPPCLASS);
  201. end;
  202. _INTERFACE:
  203. begin
  204. { need extra check here since interface is a keyword
  205. in all pascal modes }
  206. if not(m_class in aktmodeswitches) then
  207. Message(parser_f_need_objfpc_or_delphi_mode);
  208. if aktinterfacetype=it_interfacecom then
  209. classtype:=odt_interfacecom
  210. else {it_interfacecorba}
  211. classtype:=odt_interfacecorba;
  212. consume(_INTERFACE);
  213. { forward declaration }
  214. if not(assigned(fd)) and (token=_SEMICOLON) then
  215. begin
  216. { also anonym objects aren't allow (o : object a : longint; end;) }
  217. if n='' then
  218. Message(parser_f_no_anonym_objects);
  219. aktclass:=tobjectdef.create(classtype,n,nil);
  220. if (cs_compilesystem in aktmoduleswitches) and
  221. (classtype=odt_interfacecom) and (upper(n)='IUNKNOWN') then
  222. interface_iunknown:=aktclass;
  223. include(aktclass.objectoptions,oo_is_forward);
  224. object_dec:=aktclass;
  225. typecanbeforward:=storetypecanbeforward;
  226. readobjecttype:=false;
  227. exit;
  228. end;
  229. end;
  230. _CLASS:
  231. begin
  232. classtype:=odt_class;
  233. consume(_CLASS);
  234. if not(assigned(fd)) and
  235. (token=_OF) and
  236. { Delphi only allows class of in type blocks.
  237. Note that when parsing the type of a variable declaration
  238. the blocktype is bt_type so the check for typecanbeforward
  239. is also necessary (PFV) }
  240. (((block_type=bt_type) and typecanbeforward) or
  241. not(m_delphi in aktmodeswitches)) then
  242. begin
  243. { a hack, but it's easy to handle }
  244. { class reference type }
  245. consume(_OF);
  246. single_type(tt,typecanbeforward);
  247. { accept hp1, if is a forward def or a class }
  248. if (tt.def.deftype=forwarddef) or
  249. is_class(tt.def) then
  250. begin
  251. pcrd:=tclassrefdef.create(tt);
  252. object_dec:=pcrd;
  253. end
  254. else
  255. begin
  256. object_dec:=generrortype.def;
  257. Message1(type_e_class_type_expected,generrortype.def.typename);
  258. end;
  259. typecanbeforward:=storetypecanbeforward;
  260. readobjecttype:=false;
  261. exit;
  262. end
  263. { forward class }
  264. else if not(assigned(fd)) and (token=_SEMICOLON) then
  265. begin
  266. { also anonym objects aren't allow (o : object a : longint; end;) }
  267. if n='' then
  268. Message(parser_f_no_anonym_objects);
  269. aktclass:=tobjectdef.create(odt_class,n,nil);
  270. if (cs_compilesystem in aktmoduleswitches) and (upper(n)='TOBJECT') then
  271. class_tobject:=aktclass;
  272. aktclass.objecttype:=odt_class;
  273. include(aktclass.objectoptions,oo_is_forward);
  274. { all classes must have a vmt !! at offset zero }
  275. if not(oo_has_vmt in aktclass.objectoptions) then
  276. aktclass.insertvmt;
  277. object_dec:=aktclass;
  278. typecanbeforward:=storetypecanbeforward;
  279. readobjecttype:=false;
  280. exit;
  281. end;
  282. end;
  283. else
  284. begin
  285. classtype:=odt_class; { this is error but try to recover }
  286. consume(_OBJECT);
  287. end;
  288. end;
  289. end;
  290. procedure handleimplementedinterface(implintf : tobjectdef);
  291. begin
  292. if not is_interface(implintf) then
  293. begin
  294. Message1(type_e_interface_type_expected,implintf.typename);
  295. exit;
  296. end;
  297. if aktclass.implementedinterfaces.searchintf(implintf)<>-1 then
  298. Message1(sym_e_duplicate_id,implintf.name)
  299. else
  300. begin
  301. { allocate and prepare the GUID only if the class
  302. implements some interfaces.
  303. }
  304. if aktclass.implementedinterfaces.count = 0 then
  305. aktclass.prepareguid;
  306. aktclass.implementedinterfaces.addintf(implintf);
  307. end;
  308. end;
  309. procedure readimplementedinterfaces;
  310. var
  311. tt : ttype;
  312. begin
  313. while try_to_consume(_COMMA) do
  314. begin
  315. id_type(tt,false);
  316. if (tt.def.deftype<>objectdef) then
  317. begin
  318. Message1(type_e_interface_type_expected,tt.def.typename);
  319. continue;
  320. end;
  321. handleimplementedinterface(tobjectdef(tt.def));
  322. end;
  323. end;
  324. procedure readinterfaceiid;
  325. var
  326. p : tnode;
  327. valid : boolean;
  328. begin
  329. p:=comp_expr(true);
  330. if p.nodetype=stringconstn then
  331. begin
  332. stringdispose(aktclass.iidstr);
  333. aktclass.iidstr:=stringdup(strpas(tstringconstnode(p).value_str)); { or upper? }
  334. p.free;
  335. valid:=string2guid(aktclass.iidstr^,aktclass.iidguid^);
  336. if (classtype=odt_interfacecom) and not assigned(aktclass.iidguid) and not valid then
  337. Message(parser_e_improper_guid_syntax);
  338. end
  339. else
  340. begin
  341. p.free;
  342. Message(parser_e_illegal_expression);
  343. end;
  344. end;
  345. procedure readparentclasses;
  346. var
  347. hp : tobjectdef;
  348. begin
  349. hp:=nil;
  350. { reads the parent class }
  351. if try_to_consume(_LKLAMMER) then
  352. begin
  353. id_type(tt,false);
  354. childof:=tobjectdef(tt.def);
  355. if (not assigned(childof)) or
  356. (childof.deftype<>objectdef) then
  357. begin
  358. if assigned(childof) then
  359. Message1(type_e_class_type_expected,childof.typename);
  360. childof:=nil;
  361. aktclass:=tobjectdef.create(classtype,n,nil);
  362. end
  363. else
  364. begin
  365. { a mix of class, interfaces, objects and cppclasses
  366. isn't allowed }
  367. case classtype of
  368. odt_class:
  369. if not(is_class(childof)) then
  370. begin
  371. if is_interface(childof) then
  372. begin
  373. { we insert the interface after the child
  374. is set, see below
  375. }
  376. hp:=childof;
  377. childof:=class_tobject;
  378. end
  379. else
  380. Message(parser_e_mix_of_classes_and_objects);
  381. end;
  382. odt_interfacecorba,
  383. odt_interfacecom:
  384. if not(is_interface(childof)) then
  385. Message(parser_e_mix_of_classes_and_objects);
  386. odt_cppclass:
  387. if not(is_cppclass(childof)) then
  388. Message(parser_e_mix_of_classes_and_objects);
  389. odt_object:
  390. if not(is_object(childof)) then
  391. Message(parser_e_mix_of_classes_and_objects);
  392. end;
  393. { the forward of the child must be resolved to get
  394. correct field addresses }
  395. if assigned(fd) then
  396. begin
  397. if (oo_is_forward in childof.objectoptions) then
  398. Message1(parser_e_forward_declaration_must_be_resolved,childof.objrealname^);
  399. aktclass:=fd;
  400. { we must inherit several options !!
  401. this was missing !!
  402. all is now done in set_parent
  403. including symtable datasize setting PM }
  404. fd.set_parent(childof);
  405. end
  406. else
  407. aktclass:=tobjectdef.create(classtype,n,childof);
  408. if aktclass.objecttype=odt_class then
  409. begin
  410. if assigned(hp) then
  411. handleimplementedinterface(hp);
  412. readimplementedinterfaces;
  413. end;
  414. end;
  415. consume(_RKLAMMER);
  416. end
  417. { if no parent class, then a class get tobject as parent }
  418. else if classtype in [odt_class,odt_interfacecom] then
  419. setclassparent
  420. else
  421. aktclass:=tobjectdef.create(classtype,n,nil);
  422. { read GUID }
  423. if (classtype in [odt_interfacecom,odt_interfacecorba]) and
  424. try_to_consume(_LECKKLAMMER) then
  425. begin
  426. readinterfaceiid;
  427. consume(_RECKKLAMMER);
  428. end;
  429. end;
  430. procedure chkcpp(pd:tprocdef);
  431. begin
  432. if is_cppclass(pd._class) then
  433. begin
  434. pd.proccalloption:=pocall_cppdecl;
  435. pd.setmangledname(target_info.Cprefix+pd.cplusplusmangledname);
  436. end;
  437. end;
  438. var
  439. pd : tprocdef;
  440. dummysymoptions : tsymoptions;
  441. begin
  442. old_object_option:=current_object_option;
  443. { forward is resolved }
  444. if assigned(fd) then
  445. exclude(fd.objectoptions,oo_is_forward);
  446. { objects and class types can't be declared local }
  447. if not(symtablestack.symtabletype in [globalsymtable,staticsymtable]) then
  448. Message(parser_e_no_local_objects);
  449. storetypecanbeforward:=typecanbeforward;
  450. { for tp7 don't allow forward types }
  451. if (m_tp7 in aktmodeswitches) then
  452. typecanbeforward:=false;
  453. if not(readobjecttype) then
  454. exit;
  455. { also anonym objects aren't allow (o : object a : longint; end;) }
  456. if n='' then
  457. Message(parser_f_no_anonym_objects);
  458. { read list of parent classes }
  459. readparentclasses;
  460. { default access is public }
  461. there_is_a_destructor:=false;
  462. current_object_option:=[sp_public];
  463. { set class flags and inherits published }
  464. setclassattributes;
  465. aktobjectdef:=aktclass;
  466. aktclass.symtable.next:=symtablestack;
  467. symtablestack:=aktclass.symtable;
  468. testcurobject:=1;
  469. curobjectname:=Upper(n);
  470. { short class declaration ? }
  471. if (classtype<>odt_class) or (token<>_SEMICOLON) then
  472. begin
  473. { Parse componenten }
  474. repeat
  475. case token of
  476. _ID :
  477. begin
  478. case idtoken of
  479. _PRIVATE :
  480. begin
  481. if is_interface(aktclass) then
  482. Message(parser_e_no_access_specifier_in_interfaces);
  483. consume(_PRIVATE);
  484. current_object_option:=[sp_private];
  485. include(aktclass.objectoptions,oo_has_private);
  486. end;
  487. _PROTECTED :
  488. begin
  489. if is_interface(aktclass) then
  490. Message(parser_e_no_access_specifier_in_interfaces);
  491. consume(_PROTECTED);
  492. current_object_option:=[sp_protected];
  493. include(aktclass.objectoptions,oo_has_protected);
  494. end;
  495. _PUBLIC :
  496. begin
  497. if is_interface(aktclass) then
  498. Message(parser_e_no_access_specifier_in_interfaces);
  499. consume(_PUBLIC);
  500. current_object_option:=[sp_public];
  501. end;
  502. _PUBLISHED :
  503. begin
  504. { we've to check for a pushlished section in non- }
  505. { publishable classes later, if a real declaration }
  506. { this is the way, delphi does it }
  507. if is_interface(aktclass) then
  508. Message(parser_e_no_access_specifier_in_interfaces);
  509. consume(_PUBLISHED);
  510. current_object_option:=[sp_published];
  511. end;
  512. else
  513. begin
  514. if is_interface(aktclass) then
  515. Message(parser_e_no_vars_in_interfaces);
  516. if (sp_published in current_object_option) and
  517. not(oo_can_have_published in aktclass.objectoptions) then
  518. Message(parser_e_cant_have_published);
  519. read_var_decs(false,true,false);
  520. end;
  521. end;
  522. end;
  523. _PROPERTY :
  524. begin
  525. property_dec;
  526. end;
  527. _PROCEDURE,
  528. _FUNCTION,
  529. _CLASS :
  530. begin
  531. if (sp_published in current_object_option) and
  532. not(oo_can_have_published in aktclass.objectoptions) then
  533. Message(parser_e_cant_have_published);
  534. oldparse_only:=parse_only;
  535. parse_only:=true;
  536. pd:=parse_proc_dec(aktclass);
  537. { this is for error recovery as well as forward }
  538. { interface mappings, i.e. mapping to a method }
  539. { which isn't declared yet }
  540. if assigned(pd) then
  541. begin
  542. parse_object_proc_directives(pd);
  543. handle_calling_convention(pd);
  544. { add definition to procsym }
  545. proc_add_definition(pd);
  546. { add procdef options to objectdef options }
  547. if (po_msgint in pd.procoptions) then
  548. include(aktclass.objectoptions,oo_has_msgint);
  549. if (po_msgstr in pd.procoptions) then
  550. include(aktclass.objectoptions,oo_has_msgstr);
  551. if (po_virtualmethod in pd.procoptions) then
  552. include(aktclass.objectoptions,oo_has_virtual);
  553. chkcpp(pd);
  554. end;
  555. { Support hint directives }
  556. dummysymoptions:=[];
  557. while try_consume_hintdirective(dummysymoptions) do
  558. Consume(_SEMICOLON);
  559. if assigned(pd) then
  560. pd.symoptions:=pd.symoptions+dummysymoptions;
  561. parse_only:=oldparse_only;
  562. end;
  563. _CONSTRUCTOR :
  564. begin
  565. if (sp_published in current_object_option) and
  566. not(oo_can_have_published in aktclass.objectoptions) then
  567. Message(parser_e_cant_have_published);
  568. if not(sp_public in current_object_option) and
  569. not(sp_published in current_object_option) then
  570. Message(parser_w_constructor_should_be_public);
  571. if is_interface(aktclass) then
  572. Message(parser_e_no_con_des_in_interfaces);
  573. oldparse_only:=parse_only;
  574. parse_only:=true;
  575. pd:=constructor_head;
  576. parse_object_proc_directives(pd);
  577. handle_calling_convention(pd);
  578. { add definition to procsym }
  579. proc_add_definition(pd);
  580. { add procdef options to objectdef options }
  581. if (po_virtualmethod in pd.procoptions) then
  582. include(aktclass.objectoptions,oo_has_virtual);
  583. chkcpp(pd);
  584. { Support hint directives }
  585. dummysymoptions:=[];
  586. while try_consume_hintdirective(dummysymoptions) do
  587. Consume(_SEMICOLON);
  588. if assigned(pd) then
  589. pd.symoptions:=pd.symoptions+dummysymoptions;
  590. parse_only:=oldparse_only;
  591. end;
  592. _DESTRUCTOR :
  593. begin
  594. if (sp_published in current_object_option) and
  595. not(oo_can_have_published in aktclass.objectoptions) then
  596. Message(parser_e_cant_have_published);
  597. if there_is_a_destructor then
  598. Message(parser_n_only_one_destructor);
  599. if is_interface(aktclass) then
  600. Message(parser_e_no_con_des_in_interfaces);
  601. if not(sp_public in current_object_option) then
  602. Message(parser_w_destructor_should_be_public);
  603. there_is_a_destructor:=true;
  604. oldparse_only:=parse_only;
  605. parse_only:=true;
  606. pd:=destructor_head;
  607. parse_object_proc_directives(pd);
  608. handle_calling_convention(pd);
  609. { add definition to procsym }
  610. proc_add_definition(pd);
  611. { add procdef options to objectdef options }
  612. if (po_virtualmethod in pd.procoptions) then
  613. include(aktclass.objectoptions,oo_has_virtual);
  614. chkcpp(pd);
  615. { Support hint directives }
  616. dummysymoptions:=[];
  617. while try_consume_hintdirective(dummysymoptions) do
  618. Consume(_SEMICOLON);
  619. if assigned(pd) then
  620. pd.symoptions:=pd.symoptions+dummysymoptions;
  621. parse_only:=oldparse_only;
  622. end;
  623. _END :
  624. begin
  625. consume(_END);
  626. break;
  627. end;
  628. else
  629. consume(_ID); { Give a ident expected message, like tp7 }
  630. end;
  631. until false;
  632. end;
  633. { generate vmt space if needed }
  634. if not(oo_has_vmt in aktclass.objectoptions) and
  635. (([oo_has_virtual,oo_has_constructor,oo_has_destructor]*aktclass.objectoptions<>[]) or
  636. (classtype in [odt_class])
  637. ) then
  638. aktclass.insertvmt;
  639. if is_interface(aktclass) then
  640. setinterfacemethodoptions;
  641. { reset }
  642. testcurobject:=0;
  643. curobjectname:='';
  644. typecanbeforward:=storetypecanbeforward;
  645. { restore old state }
  646. symtablestack:=symtablestack.next;
  647. aktobjectdef:=nil;
  648. current_object_option:=old_object_option;
  649. object_dec:=aktclass;
  650. end;
  651. end.
  652. {
  653. $Log$
  654. Revision 1.85 2005-02-01 08:46:13 michael
  655. * Patch from peter: fix macpas anonymous function procvar
  656. Revision 1.84 2004/12/26 20:11:39 peter
  657. * fix invalid typecast
  658. Revision 1.83 2004/11/16 20:32:40 peter
  659. * fixes for win32 mangledname
  660. Revision 1.82 2004/10/15 09:14:17 mazen
  661. - remove $IFDEF DELPHI and related code
  662. - remove $IFDEF FPCPROCVAR and related code
  663. Revision 1.81 2004/08/29 11:28:10 peter
  664. allow published for constructors
  665. Revision 1.80 2004/08/25 15:57:04 peter
  666. * allow only 1 default property
  667. Revision 1.79 2004/08/22 11:23:45 peter
  668. * support hint directives in object declarations
  669. Revision 1.78 2004/06/20 08:55:30 florian
  670. * logs truncated
  671. Revision 1.77 2004/06/16 20:07:09 florian
  672. * dwarf branch merged
  673. Revision 1.76.2.1 2004/04/28 19:55:52 peter
  674. * new warning for ordinal-pointer when size is different
  675. * fixed some cg_e_ messages to the correct section type_e_ or parser_e_
  676. Revision 1.76 2004/02/26 16:13:25 peter
  677. * fix crash when method is not declared in object declaration
  678. * fix parsing of mapped interface functions
  679. }