htypechk.pas 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852
  1. {
  2. $Id$
  3. Copyright (c) 1996-98 by Florian Klaempfl
  4. This unit exports some help routines for the type checking
  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 htypechk;
  19. interface
  20. uses
  21. tree,symtable;
  22. const
  23. { firstcallparan without varspez we don't count the ref }
  24. count_ref : boolean = true;
  25. get_para_resulttype : boolean = false;
  26. allow_array_constructor : boolean = false;
  27. { Conversion }
  28. function isconvertable(def_from,def_to : pdef;
  29. var doconv : tconverttype;fromtreetype : ttreetyp;
  30. explicit : boolean) : byte;
  31. { Register Allocation }
  32. procedure make_not_regable(p : ptree);
  33. procedure left_right_max(p : ptree);
  34. procedure calcregisters(p : ptree;r32,fpu,mmx : word);
  35. { subroutine handling }
  36. procedure test_protected_sym(sym : psym);
  37. procedure test_protected(p : ptree);
  38. function valid_for_formal_var(p : ptree) : boolean;
  39. function valid_for_formal_const(p : ptree) : boolean;
  40. function is_procsym_load(p:Ptree):boolean;
  41. function is_procsym_call(p:Ptree):boolean;
  42. function assignment_overloaded(from_def,to_def : pdef) : pprocdef;
  43. procedure test_local_to_procvar(from_def:pprocvardef;to_def:pdef);
  44. implementation
  45. uses
  46. globtype,systems,tokens,
  47. cobjects,verbose,globals,
  48. symconst,
  49. types,
  50. hcodegen;
  51. {****************************************************************************
  52. Convert
  53. ****************************************************************************}
  54. { Returns:
  55. 0 - Not convertable
  56. 1 - Convertable
  57. 2 - Convertable, but not first choice }
  58. function isconvertable(def_from,def_to : pdef;
  59. var doconv : tconverttype;fromtreetype : ttreetyp;
  60. explicit : boolean) : byte;
  61. { Tbasetype: uauto,uvoid,uchar,
  62. u8bit,u16bit,u32bit,
  63. s8bit,s16bit,s32,
  64. bool8bit,bool16bit,bool32bit,
  65. u64bit,s64bitint }
  66. type
  67. tbasedef=(bvoid,bchar,bint,bbool);
  68. const
  69. basedeftbl:array[tbasetype] of tbasedef =
  70. (bvoid,bvoid,bchar,
  71. bint,bint,bint,
  72. bint,bint,bint,
  73. bbool,bbool,bbool,bint,bint);
  74. basedefconverts : array[tbasedef,tbasedef] of tconverttype =
  75. ((tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible),
  76. (tc_not_possible,tc_equal,tc_not_possible,tc_not_possible),
  77. (tc_not_possible,tc_not_possible,tc_int_2_int,tc_int_2_bool),
  78. (tc_not_possible,tc_not_possible,tc_bool_2_int,tc_bool_2_bool));
  79. var
  80. b : byte;
  81. hd1,hd2 : pdef;
  82. hct : tconverttype;
  83. begin
  84. { safety check }
  85. if not(assigned(def_from) and assigned(def_to)) then
  86. begin
  87. isconvertable:=0;
  88. exit;
  89. end;
  90. { tp7 procvar def support, in tp7 a procvar is always called, if the
  91. procvar is passed explicit a addrn would be there }
  92. if (m_tp_procvar in aktmodeswitches) and
  93. (def_from^.deftype=procvardef) and
  94. (fromtreetype=loadn) then
  95. begin
  96. def_from:=pprocvardef(def_from)^.retdef;
  97. end;
  98. { we walk the wanted (def_to) types and check then the def_from
  99. types if there is a conversion possible }
  100. b:=0;
  101. case def_to^.deftype of
  102. orddef :
  103. begin
  104. case def_from^.deftype of
  105. orddef :
  106. begin
  107. doconv:=basedefconverts[basedeftbl[porddef(def_from)^.typ],basedeftbl[porddef(def_to)^.typ]];
  108. b:=1;
  109. if (doconv=tc_not_possible) or
  110. ((doconv=tc_int_2_bool) and
  111. (not explicit) and
  112. (not is_boolean(def_from))) or
  113. ((doconv=tc_bool_2_int) and
  114. (not explicit) and
  115. (not is_boolean(def_to))) then
  116. b:=0;
  117. end;
  118. enumdef :
  119. begin
  120. { needed for char(enum) }
  121. if explicit then
  122. begin
  123. doconv:=tc_int_2_int;
  124. b:=1;
  125. end;
  126. end;
  127. end;
  128. end;
  129. stringdef :
  130. begin
  131. case def_from^.deftype of
  132. stringdef :
  133. begin
  134. doconv:=tc_string_2_string;
  135. b:=1;
  136. end;
  137. orddef :
  138. begin
  139. { char to string}
  140. if is_char(def_from) then
  141. begin
  142. doconv:=tc_char_2_string;
  143. b:=1;
  144. end;
  145. end;
  146. arraydef :
  147. begin
  148. { array of char to string, the length check is done by the firstpass of this node }
  149. if is_chararray(def_from) then
  150. begin
  151. doconv:=tc_chararray_2_string;
  152. if (not(cs_ansistrings in aktlocalswitches) and
  153. is_shortstring(def_to)) or
  154. ((cs_ansistrings in aktlocalswitches) and
  155. is_ansistring(def_to)) then
  156. b:=1
  157. else
  158. b:=2;
  159. end;
  160. end;
  161. pointerdef :
  162. begin
  163. { pchar can be assigned to short/ansistrings }
  164. if is_pchar(def_from) and not(m_tp in aktmodeswitches) then
  165. begin
  166. doconv:=tc_pchar_2_string;
  167. b:=1;
  168. end;
  169. end;
  170. end;
  171. end;
  172. floatdef :
  173. begin
  174. case def_from^.deftype of
  175. orddef :
  176. begin { ordinal to real }
  177. if is_integer(def_from) then
  178. begin
  179. if pfloatdef(def_to)^.typ=f32bit then
  180. doconv:=tc_int_2_fix
  181. else
  182. doconv:=tc_int_2_real;
  183. b:=1;
  184. end;
  185. end;
  186. floatdef :
  187. begin { 2 float types ? }
  188. if pfloatdef(def_from)^.typ=pfloatdef(def_to)^.typ then
  189. doconv:=tc_equal
  190. else
  191. begin
  192. if pfloatdef(def_from)^.typ=f32bit then
  193. doconv:=tc_fix_2_real
  194. else
  195. if pfloatdef(def_to)^.typ=f32bit then
  196. doconv:=tc_real_2_fix
  197. else
  198. doconv:=tc_real_2_real;
  199. end;
  200. b:=1;
  201. end;
  202. end;
  203. end;
  204. enumdef :
  205. begin
  206. if (def_from^.deftype=enumdef) then
  207. begin
  208. if assigned(penumdef(def_from)^.basedef) then
  209. hd1:=penumdef(def_from)^.basedef
  210. else
  211. hd1:=def_from;
  212. if assigned(penumdef(def_to)^.basedef) then
  213. hd2:=penumdef(def_to)^.basedef
  214. else
  215. hd2:=def_to;
  216. if (hd1=hd2) then
  217. b:=1;
  218. end;
  219. end;
  220. arraydef :
  221. begin
  222. { open array is also compatible with a single element of its base type }
  223. if is_open_array(def_to) and
  224. is_equal(parraydef(def_to)^.definition,def_from) then
  225. begin
  226. doconv:=tc_equal;
  227. b:=1;
  228. end
  229. else
  230. begin
  231. case def_from^.deftype of
  232. arraydef :
  233. begin
  234. { array constructor -> open array }
  235. if is_open_array(def_to) and
  236. is_array_constructor(def_from) then
  237. begin
  238. if is_equal(parraydef(def_to)^.definition,parraydef(def_from)^.definition) then
  239. begin
  240. doconv:=tc_equal;
  241. b:=1;
  242. end
  243. else
  244. if isconvertable(parraydef(def_to)^.definition,
  245. parraydef(def_from)^.definition,hct,nothingn,false)<>0 then
  246. begin
  247. doconv:=hct;
  248. b:=2;
  249. end;
  250. end;
  251. end;
  252. pointerdef :
  253. begin
  254. if is_zero_based_array(def_to) and
  255. is_equal(ppointerdef(def_from)^.definition,parraydef(def_to)^.definition) then
  256. begin
  257. doconv:=tc_pointer_2_array;
  258. b:=1;
  259. end;
  260. end;
  261. stringdef :
  262. begin
  263. { string to array of char}
  264. if (not(is_special_array(def_to)) or is_open_array(def_to)) and
  265. is_equal(parraydef(def_to)^.definition,cchardef) then
  266. begin
  267. doconv:=tc_string_2_chararray;
  268. b:=1;
  269. end;
  270. end;
  271. end;
  272. end;
  273. end;
  274. pointerdef :
  275. begin
  276. case def_from^.deftype of
  277. stringdef :
  278. begin
  279. { string constant to zero terminated string constant }
  280. if (fromtreetype=stringconstn) and
  281. is_pchar(def_to) then
  282. begin
  283. doconv:=tc_cstring_2_pchar;
  284. b:=1;
  285. end;
  286. end;
  287. orddef :
  288. begin
  289. { char constant to zero terminated string constant }
  290. if (fromtreetype=ordconstn) and is_equal(def_from,cchardef) and
  291. is_pchar(def_to) then
  292. begin
  293. doconv:=tc_cchar_2_pchar;
  294. b:=1;
  295. end;
  296. end;
  297. arraydef :
  298. begin
  299. { chararray to pointer }
  300. if is_zero_based_array(def_from) and
  301. is_equal(parraydef(def_from)^.definition,ppointerdef(def_to)^.definition) then
  302. begin
  303. doconv:=tc_array_2_pointer;
  304. b:=1;
  305. end;
  306. end;
  307. pointerdef :
  308. begin
  309. { child class pointer can be assigned to anchestor pointers }
  310. if (
  311. (ppointerdef(def_from)^.definition^.deftype=objectdef) and
  312. (ppointerdef(def_to)^.definition^.deftype=objectdef) and
  313. pobjectdef(ppointerdef(def_from)^.definition)^.is_related(
  314. pobjectdef(ppointerdef(def_to)^.definition))
  315. ) or
  316. { all pointers can be assigned to void-pointer }
  317. is_equal(ppointerdef(def_to)^.definition,voiddef) or
  318. { in my opnion, is this not clean pascal }
  319. { well, but it's handy to use, it isn't ? (FK) }
  320. is_equal(ppointerdef(def_from)^.definition,voiddef) then
  321. begin
  322. doconv:=tc_equal;
  323. b:=1;
  324. end;
  325. end;
  326. procvardef :
  327. begin
  328. { procedure variable can be assigned to an void pointer }
  329. { Not anymore. Use the @ operator now.}
  330. if not(m_tp_procvar in aktmodeswitches) and
  331. (ppointerdef(def_to)^.definition^.deftype=orddef) and
  332. (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
  333. begin
  334. doconv:=tc_equal;
  335. b:=1;
  336. end;
  337. end;
  338. classrefdef,
  339. objectdef :
  340. begin
  341. { class types and class reference type
  342. can be assigned to void pointers }
  343. if (
  344. ((def_from^.deftype=objectdef) and pobjectdef(def_from)^.is_class) or
  345. (def_from^.deftype=classrefdef)
  346. ) and
  347. (ppointerdef(def_to)^.definition^.deftype=orddef) and
  348. (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
  349. begin
  350. doconv:=tc_equal;
  351. b:=1;
  352. end;
  353. end;
  354. end;
  355. end;
  356. setdef :
  357. begin
  358. { automatic arrayconstructor -> set conversion }
  359. if is_array_constructor(def_from) then
  360. begin
  361. doconv:=tc_arrayconstructor_2_set;
  362. b:=1;
  363. end;
  364. end;
  365. procvardef :
  366. begin
  367. { proc -> procvar }
  368. if (def_from^.deftype=procdef) then
  369. begin
  370. doconv:=tc_proc_2_procvar;
  371. if proc_to_procvar_equal(pprocdef(def_from),pprocvardef(def_to)) then
  372. b:=1;
  373. end
  374. else
  375. { for example delphi allows the assignement from pointers }
  376. { to procedure variables }
  377. if (m_pointer_2_procedure in aktmodeswitches) and
  378. (def_from^.deftype=pointerdef) and
  379. (ppointerdef(def_from)^.definition^.deftype=orddef) and
  380. (porddef(ppointerdef(def_from)^.definition)^.typ=uvoid) then
  381. begin
  382. doconv:=tc_equal;
  383. b:=1;
  384. end
  385. else
  386. { nil is compatible with procvars }
  387. if (fromtreetype=niln) then
  388. begin
  389. doconv:=tc_equal;
  390. b:=1;
  391. end;
  392. end;
  393. objectdef :
  394. begin
  395. { object pascal objects }
  396. if (def_from^.deftype=objectdef) {and
  397. pobjectdef(def_from)^.isclass and pobjectdef(def_to)^.isclass }then
  398. begin
  399. doconv:=tc_equal;
  400. if pobjectdef(def_from)^.is_related(pobjectdef(def_to)) then
  401. b:=1;
  402. end
  403. else
  404. { nil is compatible with class instances }
  405. if (fromtreetype=niln) and (pobjectdef(def_to)^.is_class) then
  406. begin
  407. doconv:=tc_equal;
  408. b:=1;
  409. end;
  410. end;
  411. classrefdef :
  412. begin
  413. { class reference types }
  414. if (def_from^.deftype=classrefdef) then
  415. begin
  416. doconv:=tc_equal;
  417. if pobjectdef(pclassrefdef(def_from)^.definition)^.is_related(
  418. pobjectdef(pclassrefdef(def_to)^.definition)) then
  419. b:=1;
  420. end
  421. else
  422. { nil is compatible with class references }
  423. if (fromtreetype=niln) then
  424. begin
  425. doconv:=tc_equal;
  426. b:=1;
  427. end;
  428. end;
  429. filedef :
  430. begin
  431. { typed files are all equal to the abstract file type
  432. name TYPEDFILE in system.pp in is_equal in types.pas
  433. the problem is that it sholud be also compatible to FILE
  434. but this would leed to a problem for ASSIGN RESET and REWRITE
  435. when trying to find the good overloaded function !!
  436. so all file function are doubled in system.pp
  437. this is not very beautiful !!}
  438. if (def_from^.deftype=filedef) and
  439. (
  440. (
  441. (pfiledef(def_from)^.filetype = ft_typed) and
  442. (pfiledef(def_to)^.filetype = ft_typed) and
  443. (
  444. (pfiledef(def_from)^.typed_as = pdef(voiddef)) or
  445. (pfiledef(def_to)^.typed_as = pdef(voiddef))
  446. )
  447. ) or
  448. (
  449. (
  450. (pfiledef(def_from)^.filetype = ft_untyped) and
  451. (pfiledef(def_to)^.filetype = ft_typed)
  452. ) or
  453. (
  454. (pfiledef(def_from)^.filetype = ft_typed) and
  455. (pfiledef(def_to)^.filetype = ft_untyped)
  456. )
  457. )
  458. ) then
  459. begin
  460. doconv:=tc_equal;
  461. b:=1;
  462. end
  463. end;
  464. else
  465. begin
  466. { assignment overwritten ?? }
  467. if assignment_overloaded(def_from,def_to)<>nil then
  468. b:=2;
  469. end;
  470. end;
  471. isconvertable:=b;
  472. end;
  473. {****************************************************************************
  474. Register Calculation
  475. ****************************************************************************}
  476. { marks an lvalue as "unregable" }
  477. procedure make_not_regable(p : ptree);
  478. begin
  479. case p^.treetype of
  480. typeconvn :
  481. make_not_regable(p^.left);
  482. loadn :
  483. if p^.symtableentry^.typ=varsym then
  484. pvarsym(p^.symtableentry)^.varoptions:=pvarsym(p^.symtableentry)^.varoptions-[vo_regable,vo_fpuregable];
  485. end;
  486. end;
  487. procedure left_right_max(p : ptree);
  488. begin
  489. if assigned(p^.left) then
  490. begin
  491. if assigned(p^.right) then
  492. begin
  493. p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
  494. p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
  495. {$ifdef SUPPORT_MMX}
  496. p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
  497. {$endif SUPPORT_MMX}
  498. end
  499. else
  500. begin
  501. p^.registers32:=p^.left^.registers32;
  502. p^.registersfpu:=p^.left^.registersfpu;
  503. {$ifdef SUPPORT_MMX}
  504. p^.registersmmx:=p^.left^.registersmmx;
  505. {$endif SUPPORT_MMX}
  506. end;
  507. end;
  508. end;
  509. { calculates the needed registers for a binary operator }
  510. procedure calcregisters(p : ptree;r32,fpu,mmx : word);
  511. begin
  512. left_right_max(p);
  513. { Only when the difference between the left and right registers < the
  514. wanted registers allocate the amount of registers }
  515. if assigned(p^.left) then
  516. begin
  517. if assigned(p^.right) then
  518. begin
  519. if (abs(p^.left^.registers32-p^.right^.registers32)<r32) then
  520. inc(p^.registers32,r32);
  521. if (abs(p^.left^.registersfpu-p^.right^.registersfpu)<fpu) then
  522. inc(p^.registersfpu,fpu);
  523. {$ifdef SUPPORT_MMX}
  524. if (abs(p^.left^.registersmmx-p^.right^.registersmmx)<mmx) then
  525. inc(p^.registersmmx,mmx);
  526. {$endif SUPPORT_MMX}
  527. end
  528. else
  529. begin
  530. if (p^.left^.registers32<r32) then
  531. inc(p^.registers32,r32);
  532. if (p^.left^.registersfpu<fpu) then
  533. inc(p^.registersfpu,fpu);
  534. {$ifdef SUPPORT_MMX}
  535. if (p^.left^.registersmmx<mmx) then
  536. inc(p^.registersmmx,mmx);
  537. {$endif SUPPORT_MMX}
  538. end;
  539. end;
  540. { error CGMessage, if more than 8 floating point }
  541. { registers are needed }
  542. if p^.registersfpu>8 then
  543. CGMessage(cg_e_too_complex_expr);
  544. end;
  545. {****************************************************************************
  546. Subroutine Handling
  547. ****************************************************************************}
  548. { protected field handling
  549. protected field can not appear in
  550. var parameters of function !!
  551. this can only be done after we have determined the
  552. overloaded function
  553. this is the reason why it is not in the parser, PM }
  554. procedure test_protected_sym(sym : psym);
  555. begin
  556. if (sp_protected in sym^.symoptions) and
  557. ((sym^.owner^.symtabletype=unitsymtable) or
  558. ((sym^.owner^.symtabletype=objectsymtable) and
  559. (pobjectdef(sym^.owner^.defowner)^.owner^.symtabletype=unitsymtable))
  560. ) then
  561. CGMessage(parser_e_cant_access_protected_member);
  562. end;
  563. procedure test_protected(p : ptree);
  564. begin
  565. case p^.treetype of
  566. loadn : test_protected_sym(p^.symtableentry);
  567. typeconvn : test_protected(p^.left);
  568. derefn : test_protected(p^.left);
  569. subscriptn : begin
  570. { test_protected(p^.left);
  571. Is a field of a protected var
  572. also protected ??? PM }
  573. test_protected_sym(p^.vs);
  574. end;
  575. end;
  576. end;
  577. function valid_for_formal_var(p : ptree) : boolean;
  578. var
  579. v : boolean;
  580. begin
  581. case p^.treetype of
  582. loadn : v:=(p^.symtableentry^.typ in [typedconstsym,varsym]);
  583. typeconvn : v:=valid_for_formal_var(p^.left);
  584. typen : v:=false;
  585. derefn,subscriptn,vecn,
  586. funcretn,selfn : v:=true;
  587. { procvars are callnodes first }
  588. calln : v:=assigned(p^.right) and not assigned(p^.left);
  589. { should this depend on mode ? }
  590. addrn : v:=true;
  591. { no other node accepted (PM) }
  592. else v:=false;
  593. end;
  594. valid_for_formal_var:=v;
  595. end;
  596. function valid_for_formal_const(p : ptree) : boolean;
  597. var
  598. v : boolean;
  599. begin
  600. { p must have been firstpass'd before }
  601. { accept about anything but not a statement ! }
  602. v:=true;
  603. if (p^.treetype in [calln,statementn]) then
  604. { if not assigned(p^.resulttype) or (p^.resulttype=pdef(voiddef)) then }
  605. v:=false;
  606. valid_for_formal_const:=v;
  607. end;
  608. function is_procsym_load(p:Ptree):boolean;
  609. begin
  610. is_procsym_load:=((p^.treetype=loadn) and (p^.symtableentry^.typ=procsym)) or
  611. ((p^.treetype=addrn) and (p^.left^.treetype=loadn)
  612. and (p^.left^.symtableentry^.typ=procsym)) ;
  613. end;
  614. { change a proc call to a procload for assignment to a procvar }
  615. { this can only happen for proc/function without arguments }
  616. function is_procsym_call(p:Ptree):boolean;
  617. begin
  618. is_procsym_call:=(p^.treetype=calln) and (p^.left=nil) and
  619. (((p^.symtableprocentry^.typ=procsym) and (p^.right=nil)) or
  620. ((p^.right<>nil) and (p^.right^.symtableprocentry^.typ=varsym)));
  621. end;
  622. function assignment_overloaded(from_def,to_def : pdef) : pprocdef;
  623. var
  624. passproc : pprocdef;
  625. convtyp : tconverttype;
  626. begin
  627. assignment_overloaded:=nil;
  628. if assigned(overloaded_operators[_assignment]) then
  629. passproc:=overloaded_operators[_assignment]^.definition
  630. else
  631. exit;
  632. while passproc<>nil do
  633. begin
  634. if is_equal(passproc^.retdef,to_def) and
  635. (is_equal(passproc^.para1^.data,from_def) or
  636. (isconvertable(from_def,passproc^.para1^.data,convtyp,ordconstn,false)=1)) then
  637. begin
  638. assignment_overloaded:=passproc;
  639. break;
  640. end;
  641. passproc:=passproc^.nextoverloaded;
  642. end;
  643. end;
  644. { local routines can't be assigned to procvars }
  645. procedure test_local_to_procvar(from_def:pprocvardef;to_def:pdef);
  646. begin
  647. if (from_def^.symtablelevel>1) and (to_def^.deftype=procvardef) then
  648. CGMessage(type_e_cannot_local_proc_to_procvar);
  649. end;
  650. end.
  651. {
  652. $Log$
  653. Revision 1.39 1999-09-17 17:14:04 peter
  654. * @procvar fixes for tp mode
  655. * @<id>:= gives now an error
  656. Revision 1.38 1999/08/17 13:26:07 peter
  657. * arrayconstructor -> arrayofconst fixed when arraycosntructor was not
  658. variant.
  659. Revision 1.37 1999/08/16 23:23:38 peter
  660. * arrayconstructor -> openarray type conversions for element types
  661. Revision 1.36 1999/08/06 12:49:36 jonas
  662. * vo_fpuregable is now also removed in make_not_regable
  663. Revision 1.35 1999/08/05 21:50:35 peter
  664. * removed warning
  665. Revision 1.34 1999/08/05 16:52:55 peter
  666. * V_Fatal=1, all other V_ are also increased
  667. * Check for local procedure when assigning procvar
  668. * fixed comment parsing because directives
  669. * oldtp mode directives better supported
  670. * added some messages to errore.msg
  671. Revision 1.33 1999/08/04 13:02:43 jonas
  672. * all tokens now start with an underscore
  673. * PowerPC compiles!!
  674. Revision 1.32 1999/08/03 22:02:53 peter
  675. * moved bitmask constants to sets
  676. * some other type/const renamings
  677. Revision 1.31 1999/07/16 10:04:32 peter
  678. * merged
  679. Revision 1.30 1999/06/28 16:02:30 peter
  680. * merged
  681. Revision 1.27.2.4 1999/07/16 09:52:18 peter
  682. * allow char(enum)
  683. Revision 1.27.2.3 1999/06/28 15:51:27 peter
  684. * tp7 fix
  685. Revision 1.27.2.2 1999/06/18 10:56:58 daniel
  686. - Enumerations no longer compatible with integer types
  687. Revision 1.27.2.1 1999/06/17 12:51:42 pierre
  688. * changed is_assignment_overloaded into
  689. function assignment_overloaded : pprocdef
  690. to allow overloading of assignment with only different result type
  691. Revision 1.27 1999/06/01 19:27:47 peter
  692. * better checks for procvar and methodpointer
  693. Revision 1.26 1999/05/20 14:58:26 peter
  694. * fixed arrayconstruct->set conversion which didn't work for enum sets
  695. Revision 1.25 1999/05/19 20:40:12 florian
  696. * fixed a couple of array related bugs:
  697. - var a : array[0..1] of char; p : pchar; p:=a+123; works now
  698. - open arrays with an odd size doesn't work: movsb wasn't generated
  699. - introduced some new array type helper routines (is_special_array) etc.
  700. - made the array type checking in isconvertable more strict, often
  701. open array can be used where is wasn't allowed etc...
  702. Revision 1.24 1999/05/06 10:10:02 peter
  703. * overloaded conversion has lower priority
  704. Revision 1.23 1999/04/26 09:30:47 peter
  705. * small tp7 fix
  706. * fix void pointer with formaldef
  707. Revision 1.22 1999/04/21 22:00:01 pierre
  708. + valid_for_formal_var and valid_for_formal_const added
  709. Revision 1.21 1999/04/21 16:31:40 pierre
  710. ra386att.pas : problem with commit -m !
  711. Revision 1.20 1999/04/15 08:56:27 peter
  712. * fixed bool-bool conversion
  713. Revision 1.19 1999/03/24 23:17:02 peter
  714. * fixed bugs 212,222,225,227,229,231,233
  715. Revision 1.18 1999/03/06 17:25:19 peter
  716. * moved comp<->real warning so it doesn't occure everytime that
  717. isconvertable is called with
  718. Revision 1.17 1999/03/02 18:24:20 peter
  719. * fixed overloading of array of char
  720. Revision 1.16 1999/01/27 13:53:27 pierre
  721. htypechk.pas
  722. Revision 1.15 1999/01/27 13:12:10 pierre
  723. * bool to int must be explicit
  724. Revision 1.14 1999/01/19 15:55:32 pierre
  725. * fix for boolean to comp conversion (now disabled)
  726. Revision 1.13 1998/12/15 17:11:37 peter
  727. * string:=pchar not allowed in tp mode
  728. Revision 1.12 1998/12/11 00:03:18 peter
  729. + globtype,tokens,version unit splitted from globals
  730. Revision 1.11 1998/12/10 09:47:21 florian
  731. + basic operations with int64/qord (compiler with -dint64)
  732. + rtti of enumerations extended: names are now written
  733. Revision 1.10 1998/11/29 12:40:23 peter
  734. * newcnv -> not oldcnv
  735. Revision 1.9 1998/11/26 13:10:42 peter
  736. * new int - int conversion -dNEWCNV
  737. * some function renamings
  738. Revision 1.8 1998/11/17 00:36:42 peter
  739. * more ansistring fixes
  740. Revision 1.7 1998/10/14 13:33:24 peter
  741. * fixed small typo
  742. Revision 1.6 1998/10/14 12:53:38 peter
  743. * fixed small tp7 things
  744. * boolean:=longbool and longbool fixed
  745. Revision 1.5 1998/10/12 09:49:58 florian
  746. + support of <procedure var type>:=<pointer> in delphi mode added
  747. Revision 1.4 1998/09/30 16:42:52 peter
  748. * fixed bool-bool cnv
  749. Revision 1.3 1998/09/24 23:49:05 peter
  750. + aktmodeswitches
  751. Revision 1.2 1998/09/24 09:02:14 peter
  752. * rewritten isconvertable to use case
  753. * array of .. and single variable are compatible
  754. Revision 1.1 1998/09/23 20:42:22 peter
  755. * splitted pass_1
  756. }