paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-24 02:00:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

* allow class -> voidpointer for delphi mode

Browse Source
This commit is contained in:
peter 2000-02-01 09:41:27 +00:00
parent ba0b8a2e1b
commit f387340dbc
1 changed files with 59 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
compiler/htypechk.pas
View File

@ -448,6 +448,17 @@ implementation
b:=1; b:=1;
end end
else else
{ Class specific }
if (pobjectdef(def_to)^.is_class) then
begin
{ void pointer also for delphi mode }
if (m_delphi in aktmodeswitches) and
is_voidpointer(def_from) then
begin
doconv:=tc_equal;
b:=1;
end
else
{ nil is compatible with class instances } { nil is compatible with class instances }
if (fromtreetype=niln) and (pobjectdef(def_to)^.is_class) then if (fromtreetype=niln) and (pobjectdef(def_to)^.is_class) then
begin begin
@ -455,6 +466,7 @@ implementation
b:=1; b:=1;
end; end;
end; end;
end;
classrefdef : classrefdef :
begin begin
@ -725,11 +737,15 @@ implementation
function valid_for_assign(p:ptree;allowprop:boolean):boolean; function valid_for_assign(p:ptree;allowprop:boolean):boolean;
var var
hp : ptree; hp : ptree;
gotsubscript,
gotpointer, gotpointer,
gotclass,
gotderef : boolean; gotderef : boolean;
begin begin
valid_for_assign:=false; valid_for_assign:=false;
gotsubscript:=false;
gotderef:=false; gotderef:=false;
gotclass:=false;
gotpointer:=false; gotpointer:=false;
hp:=p; hp:=p;
while assigned(hp) do while assigned(hp) do
@ -748,19 +764,31 @@ implementation
end; end;
typeconvn : typeconvn :
begin begin
if hp^.resulttype^.deftype=pointerdef then case hp^.resulttype^.deftype of
pointerdef :
gotpointer:=true; gotpointer:=true;
objectdef :
gotclass:=pobjectdef(hp^.resulttype)^.is_class;
classrefdef :
gotclass:=true;
arraydef :
begin
{ pointer -> array conversion is done then we need to see it { pointer -> array conversion is done then we need to see it
as a deref, because a ^ is then not required anymore } as a deref, because a ^ is then not required anymore }
if (hp^.resulttype^.deftype=arraydef) and if (hp^.left^.resulttype^.deftype=pointerdef) then
(hp^.left^.resulttype^.deftype=pointerdef) then
gotderef:=true; gotderef:=true;
end;
end;
hp:=hp^.left; hp:=hp^.left;
end; end;
vecn, vecn,
asn, asn :
subscriptn :
hp:=hp^.left; hp:=hp^.left;
subscriptn :
begin
gotsubscript:=true;
hp:=hp^.left;
end;
subn, subn,
addn : addn :
begin begin
@ -788,9 +816,20 @@ implementation
end; end;
calln : calln :
begin begin
{ only allow writing if it returns a pointer and we've { check return type }
found a deref } case hp^.resulttype^.deftype of
if ((hp^.resulttype^.deftype=pointerdef) and gotderef) or pointerdef :
gotpointer:=true;
objectdef :
gotclass:=pobjectdef(hp^.resulttype)^.is_class;
classrefdef :
gotclass:=true;
end;
{ 1. if it returns a pointer and we've found a deref,
2. if it returns a class and a subscription is found,
3. property is allowed }
if (gotpointer and gotderef) or
(gotclass and gotsubscript) or
(hp^.isproperty and allowprop) then (hp^.isproperty and allowprop) then
valid_for_assign:=true valid_for_assign:=true
else else
@ -848,7 +887,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.55 2000-01-07 01:14:27 peter Revision 1.56 2000-02-01 09:41:27 peter
* allow class -> voidpointer for delphi mode
Revision 1.55 2000/01/07 01:14:27 peter
* updated copyright to 2000 * updated copyright to 2000
Revision 1.54 1999/12/31 14:26:27 peter Revision 1.54 1999/12/31 14:26:27 peter