htypechk.pas 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866
  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) then
  291. begin
  292. if is_equal(def_from,cchardef) and
  293. is_pchar(def_to) then
  294. begin
  295. doconv:=tc_cchar_2_pchar;
  296. b:=1;
  297. end
  298. else
  299. if is_integer(def_from) then
  300. begin
  301. doconv:=tc_cord_2_pointer;
  302. b:=1;
  303. end;
  304. end;
  305. end;
  306. arraydef :
  307. begin
  308. { chararray to pointer }
  309. if is_zero_based_array(def_from) and
  310. is_equal(parraydef(def_from)^.definition,ppointerdef(def_to)^.definition) then
  311. begin
  312. doconv:=tc_array_2_pointer;
  313. b:=1;
  314. end;
  315. end;
  316. pointerdef :
  317. begin
  318. { child class pointer can be assigned to anchestor pointers }
  319. if (
  320. (ppointerdef(def_from)^.definition^.deftype=objectdef) and
  321. (ppointerdef(def_to)^.definition^.deftype=objectdef) and
  322. pobjectdef(ppointerdef(def_from)^.definition)^.is_related(
  323. pobjectdef(ppointerdef(def_to)^.definition))
  324. ) or
  325. { all pointers can be assigned to void-pointer }
  326. is_equal(ppointerdef(def_to)^.definition,voiddef) or
  327. { in my opnion, is this not clean pascal }
  328. { well, but it's handy to use, it isn't ? (FK) }
  329. is_equal(ppointerdef(def_from)^.definition,voiddef) then
  330. begin
  331. doconv:=tc_equal;
  332. b:=1;
  333. end;
  334. end;
  335. procvardef :
  336. begin
  337. { procedure variable can be assigned to an void pointer }
  338. { Not anymore. Use the @ operator now.}
  339. if not(m_tp_procvar in aktmodeswitches) and
  340. (ppointerdef(def_to)^.definition^.deftype=orddef) and
  341. (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
  342. begin
  343. doconv:=tc_equal;
  344. b:=1;
  345. end;
  346. end;
  347. classrefdef,
  348. objectdef :
  349. begin
  350. { class types and class reference type
  351. can be assigned to void pointers }
  352. if (
  353. ((def_from^.deftype=objectdef) and pobjectdef(def_from)^.is_class) or
  354. (def_from^.deftype=classrefdef)
  355. ) and
  356. (ppointerdef(def_to)^.definition^.deftype=orddef) and
  357. (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
  358. begin
  359. doconv:=tc_equal;
  360. b:=1;
  361. end;
  362. end;
  363. end;
  364. end;
  365. setdef :
  366. begin
  367. { automatic arrayconstructor -> set conversion }
  368. if is_array_constructor(def_from) then
  369. begin
  370. doconv:=tc_arrayconstructor_2_set;
  371. b:=1;
  372. end;
  373. end;
  374. procvardef :
  375. begin
  376. { proc -> procvar }
  377. if (def_from^.deftype=procdef) then
  378. begin
  379. doconv:=tc_proc_2_procvar;
  380. if proc_to_procvar_equal(pprocdef(def_from),pprocvardef(def_to)) then
  381. b:=1;
  382. end
  383. else
  384. { for example delphi allows the assignement from pointers }
  385. { to procedure variables }
  386. if (m_pointer_2_procedure in aktmodeswitches) and
  387. (def_from^.deftype=pointerdef) and
  388. (ppointerdef(def_from)^.definition^.deftype=orddef) and
  389. (porddef(ppointerdef(def_from)^.definition)^.typ=uvoid) then
  390. begin
  391. doconv:=tc_equal;
  392. b:=1;
  393. end
  394. else
  395. { nil is compatible with procvars }
  396. if (fromtreetype=niln) then
  397. begin
  398. doconv:=tc_equal;
  399. b:=1;
  400. end;
  401. end;
  402. objectdef :
  403. begin
  404. { object pascal objects }
  405. if (def_from^.deftype=objectdef) {and
  406. pobjectdef(def_from)^.isclass and pobjectdef(def_to)^.isclass }then
  407. begin
  408. doconv:=tc_equal;
  409. if pobjectdef(def_from)^.is_related(pobjectdef(def_to)) then
  410. b:=1;
  411. end
  412. else
  413. { nil is compatible with class instances }
  414. if (fromtreetype=niln) and (pobjectdef(def_to)^.is_class) then
  415. begin
  416. doconv:=tc_equal;
  417. b:=1;
  418. end;
  419. end;
  420. classrefdef :
  421. begin
  422. { class reference types }
  423. if (def_from^.deftype=classrefdef) then
  424. begin
  425. doconv:=tc_equal;
  426. if pobjectdef(pclassrefdef(def_from)^.definition)^.is_related(
  427. pobjectdef(pclassrefdef(def_to)^.definition)) then
  428. b:=1;
  429. end
  430. else
  431. { nil is compatible with class references }
  432. if (fromtreetype=niln) then
  433. begin
  434. doconv:=tc_equal;
  435. b:=1;
  436. end;
  437. end;
  438. filedef :
  439. begin
  440. { typed files are all equal to the abstract file type
  441. name TYPEDFILE in system.pp in is_equal in types.pas
  442. the problem is that it sholud be also compatible to FILE
  443. but this would leed to a problem for ASSIGN RESET and REWRITE
  444. when trying to find the good overloaded function !!
  445. so all file function are doubled in system.pp
  446. this is not very beautiful !!}
  447. if (def_from^.deftype=filedef) and
  448. (
  449. (
  450. (pfiledef(def_from)^.filetype = ft_typed) and
  451. (pfiledef(def_to)^.filetype = ft_typed) and
  452. (
  453. (pfiledef(def_from)^.typed_as = pdef(voiddef)) or
  454. (pfiledef(def_to)^.typed_as = pdef(voiddef))
  455. )
  456. ) or
  457. (
  458. (
  459. (pfiledef(def_from)^.filetype = ft_untyped) and
  460. (pfiledef(def_to)^.filetype = ft_typed)
  461. ) or
  462. (
  463. (pfiledef(def_from)^.filetype = ft_typed) and
  464. (pfiledef(def_to)^.filetype = ft_untyped)
  465. )
  466. )
  467. ) then
  468. begin
  469. doconv:=tc_equal;
  470. b:=1;
  471. end
  472. end;
  473. else
  474. begin
  475. { assignment overwritten ?? }
  476. if assignment_overloaded(def_from,def_to)<>nil then
  477. b:=2;
  478. end;
  479. end;
  480. isconvertable:=b;
  481. end;
  482. {****************************************************************************
  483. Register Calculation
  484. ****************************************************************************}
  485. { marks an lvalue as "unregable" }
  486. procedure make_not_regable(p : ptree);
  487. begin
  488. case p^.treetype of
  489. typeconvn :
  490. make_not_regable(p^.left);
  491. loadn :
  492. if p^.symtableentry^.typ=varsym then
  493. pvarsym(p^.symtableentry)^.varoptions:=pvarsym(p^.symtableentry)^.varoptions-[vo_regable,vo_fpuregable];
  494. end;
  495. end;
  496. procedure left_right_max(p : ptree);
  497. begin
  498. if assigned(p^.left) then
  499. begin
  500. if assigned(p^.right) then
  501. begin
  502. p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
  503. p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
  504. {$ifdef SUPPORT_MMX}
  505. p^.registersmmx:=max(p^.left^.registersmmx,p^.right^.registersmmx);
  506. {$endif SUPPORT_MMX}
  507. end
  508. else
  509. begin
  510. p^.registers32:=p^.left^.registers32;
  511. p^.registersfpu:=p^.left^.registersfpu;
  512. {$ifdef SUPPORT_MMX}
  513. p^.registersmmx:=p^.left^.registersmmx;
  514. {$endif SUPPORT_MMX}
  515. end;
  516. end;
  517. end;
  518. { calculates the needed registers for a binary operator }
  519. procedure calcregisters(p : ptree;r32,fpu,mmx : word);
  520. begin
  521. left_right_max(p);
  522. { Only when the difference between the left and right registers < the
  523. wanted registers allocate the amount of registers }
  524. if assigned(p^.left) then
  525. begin
  526. if assigned(p^.right) then
  527. begin
  528. if (abs(p^.left^.registers32-p^.right^.registers32)<r32) then
  529. inc(p^.registers32,r32);
  530. if (abs(p^.left^.registersfpu-p^.right^.registersfpu)<fpu) then
  531. inc(p^.registersfpu,fpu);
  532. {$ifdef SUPPORT_MMX}
  533. if (abs(p^.left^.registersmmx-p^.right^.registersmmx)<mmx) then
  534. inc(p^.registersmmx,mmx);
  535. {$endif SUPPORT_MMX}
  536. end
  537. else
  538. begin
  539. if (p^.left^.registers32<r32) then
  540. inc(p^.registers32,r32);
  541. if (p^.left^.registersfpu<fpu) then
  542. inc(p^.registersfpu,fpu);
  543. {$ifdef SUPPORT_MMX}
  544. if (p^.left^.registersmmx<mmx) then
  545. inc(p^.registersmmx,mmx);
  546. {$endif SUPPORT_MMX}
  547. end;
  548. end;
  549. { error CGMessage, if more than 8 floating point }
  550. { registers are needed }
  551. if p^.registersfpu>8 then
  552. CGMessage(cg_e_too_complex_expr);
  553. end;
  554. {****************************************************************************
  555. Subroutine Handling
  556. ****************************************************************************}
  557. { protected field handling
  558. protected field can not appear in
  559. var parameters of function !!
  560. this can only be done after we have determined the
  561. overloaded function
  562. this is the reason why it is not in the parser, PM }
  563. procedure test_protected_sym(sym : psym);
  564. begin
  565. if (sp_protected in sym^.symoptions) and
  566. ((sym^.owner^.symtabletype=unitsymtable) or
  567. ((sym^.owner^.symtabletype=objectsymtable) and
  568. (pobjectdef(sym^.owner^.defowner)^.owner^.symtabletype=unitsymtable))
  569. ) then
  570. CGMessage(parser_e_cant_access_protected_member);
  571. end;
  572. procedure test_protected(p : ptree);
  573. begin
  574. case p^.treetype of
  575. loadn : test_protected_sym(p^.symtableentry);
  576. typeconvn : test_protected(p^.left);
  577. derefn : test_protected(p^.left);
  578. subscriptn : begin
  579. { test_protected(p^.left);
  580. Is a field of a protected var
  581. also protected ??? PM }
  582. test_protected_sym(p^.vs);
  583. end;
  584. end;
  585. end;
  586. function valid_for_formal_var(p : ptree) : boolean;
  587. var
  588. v : boolean;
  589. begin
  590. case p^.treetype of
  591. loadn : v:=(p^.symtableentry^.typ in [typedconstsym,varsym]);
  592. typeconvn : v:=valid_for_formal_var(p^.left);
  593. typen : v:=false;
  594. derefn,subscriptn,vecn,
  595. funcretn,selfn : v:=true;
  596. { procvars are callnodes first }
  597. calln : v:=assigned(p^.right) and not assigned(p^.left);
  598. { should this depend on mode ? }
  599. addrn : v:=true;
  600. { no other node accepted (PM) }
  601. else v:=false;
  602. end;
  603. valid_for_formal_var:=v;
  604. end;
  605. function valid_for_formal_const(p : ptree) : boolean;
  606. var
  607. v : boolean;
  608. begin
  609. { p must have been firstpass'd before }
  610. { accept about anything but not a statement ! }
  611. v:=true;
  612. if (p^.treetype in [calln,statementn]) then
  613. { if not assigned(p^.resulttype) or (p^.resulttype=pdef(voiddef)) then }
  614. v:=false;
  615. valid_for_formal_const:=v;
  616. end;
  617. function is_procsym_load(p:Ptree):boolean;
  618. begin
  619. is_procsym_load:=((p^.treetype=loadn) and (p^.symtableentry^.typ=procsym)) or
  620. ((p^.treetype=addrn) and (p^.left^.treetype=loadn)
  621. and (p^.left^.symtableentry^.typ=procsym)) ;
  622. end;
  623. { change a proc call to a procload for assignment to a procvar }
  624. { this can only happen for proc/function without arguments }
  625. function is_procsym_call(p:Ptree):boolean;
  626. begin
  627. is_procsym_call:=(p^.treetype=calln) and (p^.left=nil) and
  628. (((p^.symtableprocentry^.typ=procsym) and (p^.right=nil)) or
  629. ((p^.right<>nil) and (p^.right^.symtableprocentry^.typ=varsym)));
  630. end;
  631. function assignment_overloaded(from_def,to_def : pdef) : pprocdef;
  632. var
  633. passproc : pprocdef;
  634. convtyp : tconverttype;
  635. begin
  636. assignment_overloaded:=nil;
  637. if assigned(overloaded_operators[_assignment]) then
  638. passproc:=overloaded_operators[_assignment]^.definition
  639. else
  640. exit;
  641. while passproc<>nil do
  642. begin
  643. if is_equal(passproc^.retdef,to_def) and
  644. (is_equal(passproc^.para1^.data,from_def) or
  645. (isconvertable(from_def,passproc^.para1^.data,convtyp,ordconstn,false)=1)) then
  646. begin
  647. assignment_overloaded:=passproc;
  648. break;
  649. end;
  650. passproc:=passproc^.nextoverloaded;
  651. end;
  652. end;
  653. { local routines can't be assigned to procvars }
  654. procedure test_local_to_procvar(from_def:pprocvardef;to_def:pdef);
  655. begin
  656. if (from_def^.symtablelevel>1) and (to_def^.deftype=procvardef) then
  657. CGMessage(type_e_cannot_local_proc_to_procvar);
  658. end;
  659. end.
  660. {
  661. $Log$
  662. Revision 1.40 1999-09-26 21:30:15 peter
  663. + constant pointer support which can happend with typecasting like
  664. const p=pointer(1)
  665. * better procvar parsing in typed consts
  666. Revision 1.39 1999/09/17 17:14:04 peter
  667. * @procvar fixes for tp mode
  668. * @<id>:= gives now an error
  669. Revision 1.38 1999/08/17 13:26:07 peter
  670. * arrayconstructor -> arrayofconst fixed when arraycosntructor was not
  671. variant.
  672. Revision 1.37 1999/08/16 23:23:38 peter
  673. * arrayconstructor -> openarray type conversions for element types
  674. Revision 1.36 1999/08/06 12:49:36 jonas
  675. * vo_fpuregable is now also removed in make_not_regable
  676. Revision 1.35 1999/08/05 21:50:35 peter
  677. * removed warning
  678. Revision 1.34 1999/08/05 16:52:55 peter
  679. * V_Fatal=1, all other V_ are also increased
  680. * Check for local procedure when assigning procvar
  681. * fixed comment parsing because directives
  682. * oldtp mode directives better supported
  683. * added some messages to errore.msg
  684. Revision 1.33 1999/08/04 13:02:43 jonas
  685. * all tokens now start with an underscore
  686. * PowerPC compiles!!
  687. Revision 1.32 1999/08/03 22:02:53 peter
  688. * moved bitmask constants to sets
  689. * some other type/const renamings
  690. Revision 1.31 1999/07/16 10:04:32 peter
  691. * merged
  692. Revision 1.30 1999/06/28 16:02:30 peter
  693. * merged
  694. Revision 1.27.2.4 1999/07/16 09:52:18 peter
  695. * allow char(enum)
  696. Revision 1.27.2.3 1999/06/28 15:51:27 peter
  697. * tp7 fix
  698. Revision 1.27.2.2 1999/06/18 10:56:58 daniel
  699. - Enumerations no longer compatible with integer types
  700. Revision 1.27.2.1 1999/06/17 12:51:42 pierre
  701. * changed is_assignment_overloaded into
  702. function assignment_overloaded : pprocdef
  703. to allow overloading of assignment with only different result type
  704. Revision 1.27 1999/06/01 19:27:47 peter
  705. * better checks for procvar and methodpointer
  706. Revision 1.26 1999/05/20 14:58:26 peter
  707. * fixed arrayconstruct->set conversion which didn't work for enum sets
  708. Revision 1.25 1999/05/19 20:40:12 florian
  709. * fixed a couple of array related bugs:
  710. - var a : array[0..1] of char; p : pchar; p:=a+123; works now
  711. - open arrays with an odd size doesn't work: movsb wasn't generated
  712. - introduced some new array type helper routines (is_special_array) etc.
  713. - made the array type checking in isconvertable more strict, often
  714. open array can be used where is wasn't allowed etc...
  715. Revision 1.24 1999/05/06 10:10:02 peter
  716. * overloaded conversion has lower priority
  717. Revision 1.23 1999/04/26 09:30:47 peter
  718. * small tp7 fix
  719. * fix void pointer with formaldef
  720. Revision 1.22 1999/04/21 22:00:01 pierre
  721. + valid_for_formal_var and valid_for_formal_const added
  722. Revision 1.21 1999/04/21 16:31:40 pierre
  723. ra386att.pas : problem with commit -m !
  724. Revision 1.20 1999/04/15 08:56:27 peter
  725. * fixed bool-bool conversion
  726. Revision 1.19 1999/03/24 23:17:02 peter
  727. * fixed bugs 212,222,225,227,229,231,233
  728. Revision 1.18 1999/03/06 17:25:19 peter
  729. * moved comp<->real warning so it doesn't occure everytime that
  730. isconvertable is called with
  731. Revision 1.17 1999/03/02 18:24:20 peter
  732. * fixed overloading of array of char
  733. Revision 1.16 1999/01/27 13:53:27 pierre
  734. htypechk.pas
  735. Revision 1.15 1999/01/27 13:12:10 pierre
  736. * bool to int must be explicit
  737. Revision 1.14 1999/01/19 15:55:32 pierre
  738. * fix for boolean to comp conversion (now disabled)
  739. Revision 1.13 1998/12/15 17:11:37 peter
  740. * string:=pchar not allowed in tp mode
  741. Revision 1.12 1998/12/11 00:03:18 peter
  742. + globtype,tokens,version unit splitted from globals
  743. Revision 1.11 1998/12/10 09:47:21 florian
  744. + basic operations with int64/qord (compiler with -dint64)
  745. + rtti of enumerations extended: names are now written
  746. Revision 1.10 1998/11/29 12:40:23 peter
  747. * newcnv -> not oldcnv
  748. Revision 1.9 1998/11/26 13:10:42 peter
  749. * new int - int conversion -dNEWCNV
  750. * some function renamings
  751. Revision 1.8 1998/11/17 00:36:42 peter
  752. * more ansistring fixes
  753. Revision 1.7 1998/10/14 13:33:24 peter
  754. * fixed small typo
  755. Revision 1.6 1998/10/14 12:53:38 peter
  756. * fixed small tp7 things
  757. * boolean:=longbool and longbool fixed
  758. Revision 1.5 1998/10/12 09:49:58 florian
  759. + support of <procedure var type>:=<pointer> in delphi mode added
  760. Revision 1.4 1998/09/30 16:42:52 peter
  761. * fixed bool-bool cnv
  762. Revision 1.3 1998/09/24 23:49:05 peter
  763. + aktmodeswitches
  764. Revision 1.2 1998/09/24 09:02:14 peter
  765. * rewritten isconvertable to use case
  766. * array of .. and single variable are compatible
  767. Revision 1.1 1998/09/23 20:42:22 peter
  768. * splitted pass_1
  769. }