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

* rewritten isconvertable to use case

Browse Source 
* array of .. and single variable are compatible
This commit is contained in:
peter 1998-09-24 09:02:13 +00:00
parent 7f57cdf52c
commit 692155686a
3 changed files with 319 additions and 307 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
compiler/cg386cal.pas
View File

@ -55,6 +55,7 @@ implementation
procedure maybe_push_open_array_high; procedure maybe_push_open_array_high;
var var
r : preference; r : preference;
len : longint;
begin begin
{ open array ? } { open array ? }
{ defcoll^.data can be nil for read/write } { defcoll^.data can be nil for read/write }
@ -77,16 +78,17 @@ implementation
end end
else else
begin begin
if p^.left^.resulttype^.deftype=arraydef then
len:=parraydef(p^.left^.resulttype)^.highrange-parraydef(p^.left^.resulttype)^.lowrange
else
len:=0;
if inlined then if inlined then
begin begin
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize); r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L, exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L,len,r)));
parraydef(p^.left^.resulttype)^.highrange-
parraydef(p^.left^.resulttype)^.lowrange,r)));
end end
else else
push_int(parraydef(p^.left^.resulttype)^.highrange- push_int(len);
parraydef(p^.left^.resulttype)^.lowrange);
end; end;
end; end;
end; end;
@ -1394,7 +1396,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.26 1998-09-21 08:45:06 pierre Revision 1.27 1998-09-24 09:02:13 peter
* rewritten isconvertable to use case
* array of .. and single variable are compatible
Revision 1.26 1998/09/21 08:45:06 pierre
+ added vmt_offset in tobjectdef.write for fututre use + added vmt_offset in tobjectdef.write for fututre use
(first steps to have objects without vmt if no virtual !!) (first steps to have objects without vmt if no virtual !!)
+ added fpu_used field for tabstractprocdef : + added fpu_used field for tabstractprocdef :

426
compiler/htypechk.pas
View File

@ -143,41 +143,68 @@ implementation
end; end;
b:=false; b:=false;
{ we walk the wanted (def_to) types and check then the def_from
{ handle ord to ord first } types if there is a conversion possible }
if (def_from^.deftype=orddef) and (def_to^.deftype=orddef) then case def_to^.deftype of
orddef : begin
if (def_from^.deftype=orddef) then
begin begin
doconv:=basedefconverts[porddef(def_from)^.typ,porddef(def_to)^.typ]; doconv:=basedefconverts[porddef(def_from)^.typ,porddef(def_to)^.typ];
{ Don't allow automatic int->bool. if (doconv<>tc_not_possible) and
Very Bad Hack !!!! (PFV) } (explicit or not(doconv in [tc_int_2_bool])) then
if (doconv=tc_int_2_bool) and (not explicit) then
b:=false
else
if doconv<>tc_not_possible then
b:=true; b:=true;
end end;
else end;
stringdef : begin
if (def_from^.deftype=orddef) and (def_to^.deftype=floatdef) then case def_from^.deftype of
stringdef : begin
doconv:=tc_string_to_string;
b:=true;
end;
orddef : begin
{ char to string}
if is_equal(def_from,cchardef) then
begin begin
doconv:=tc_char_to_string;
b:=true;
end;
end;
arraydef : begin
{ string to array of char, the length check is done by the firstpass of this node }
if is_equal(parraydef(def_from)^.definition,cchardef) then
begin
doconv:=tc_chararray_2_string;
b:=true;
end;
end;
pointerdef : begin
{ pchar can be assigned to short/ansistrings }
if is_pchar(def_from) then
begin
doconv:=tc_pchar_2_string;
b:=true;
end;
end;
end;
end;
floatdef : begin
case def_from^.deftype of
orddef : begin { ordinal to real }
if pfloatdef(def_to)^.typ=f32bit then if pfloatdef(def_to)^.typ=f32bit then
doconv:=tc_int_2_fix doconv:=tc_int_2_fix
else else
doconv:=tc_int_2_real; doconv:=tc_int_2_real;
b:=true; b:=true;
end end;
else floatdef : begin { 2 float types ? }
{ 2 float types ? }
if (def_from^.deftype=floatdef) and (def_to^.deftype=floatdef) then
begin
if pfloatdef(def_from)^.typ=pfloatdef(def_to)^.typ then if pfloatdef(def_from)^.typ=pfloatdef(def_to)^.typ then
doconv:=tc_equal doconv:=tc_equal
else else
begin begin
if pfloatdef(def_from)^.typ=f32bit then if pfloatdef(def_from)^.typ=f32bit then
doconv:=tc_fix_2_real doconv:=tc_fix_2_real
else if pfloatdef(def_to)^.typ=f32bit then else
if pfloatdef(def_to)^.typ=f32bit then
doconv:=tc_real_2_fix doconv:=tc_real_2_fix
else else
doconv:=tc_real_2_real; doconv:=tc_real_2_real;
@ -190,11 +217,11 @@ implementation
{$endif} {$endif}
end; end;
b:=true; b:=true;
end end;
else end;
end;
{ enum to enum } enumdef : begin
if (def_from^.deftype=enumdef) and (def_to^.deftype=enumdef) then if (def_from^.deftype=enumdef) then
begin begin
if assigned(penumdef(def_from)^.basedef) then if assigned(penumdef(def_from)^.basedef) then
hd1:=penumdef(def_from)^.basedef hd1:=penumdef(def_from)^.basedef
@ -205,40 +232,171 @@ implementation
else else
hd2:=def_to; hd2:=def_to;
b:=(hd1=hd2); b:=(hd1=hd2);
end;
end;
arraydef : begin
{ open array is also compatible with a single element of its base type }
if is_open_array(def_to) and
is_equal(parraydef(def_to)^.definition,def_from) then
begin
doconv:=tc_equal;
b:=true;
end end
else else
begin
{ assignment overwritten ?? } case def_from^.deftype of
if is_assignment_overloaded(def_from,def_to) then pointerdef : begin
b:=true if (parraydef(def_to)^.lowrange=0) and
else
if (def_from^.deftype=pointerdef) and (def_to^.deftype=arraydef) and
(parraydef(def_to)^.lowrange=0) and
is_equal(ppointerdef(def_from)^.definition,parraydef(def_to)^.definition) then is_equal(ppointerdef(def_from)^.definition,parraydef(def_to)^.definition) then
begin begin
doconv:=tc_pointer_to_array; doconv:=tc_pointer_to_array;
b:=true; b:=true;
end end;
else end;
stringdef : begin
if (def_from^.deftype=arraydef) and (def_to^.deftype=pointerdef) and { array of char to string }
(parraydef(def_from)^.lowrange=0) and if is_equal(parraydef(def_to)^.definition,cchardef) then
begin
doconv:=tc_string_chararray;
b:=true;
end;
end;
end;
end;
end;
pointerdef : begin
case def_from^.deftype of
stringdef : begin
{ string constant to zero terminated string constant }
if (fromtreetype=stringconstn) and
is_pchar(def_to) then
begin
doconv:=tc_cstring_charpointer;
b:=true;
end;
end;
orddef : begin
{ char constant to zero terminated string constant }
if (fromtreetype=ordconstn) and is_equal(def_from,cchardef) and
is_pchar(def_to) then
begin
doconv:=tc_cchar_charpointer;
b:=true;
end;
end;
arraydef : begin
{ chararray to pointer }
if (parraydef(def_from)^.lowrange=0) and
is_equal(parraydef(def_from)^.definition,ppointerdef(def_to)^.definition) then is_equal(parraydef(def_from)^.definition,ppointerdef(def_to)^.definition) then
begin begin
doconv:=tc_array_to_pointer; doconv:=tc_array_to_pointer;
b:=true; b:=true;
end end;
else end;
pointerdef : begin
if (def_from^.deftype=arraydef) and (def_to^.deftype=setdef) and { child class pointer can be assigned to anchestor pointers }
(parraydef(def_from)^.IsConstructor) then if (
(ppointerdef(def_from)^.definition^.deftype=objectdef) and
(ppointerdef(def_to)^.definition^.deftype=objectdef) and
pobjectdef(ppointerdef(def_from)^.definition)^.isrelated(
pobjectdef(ppointerdef(def_to)^.definition))
) or
{ all pointers can be assigned to void-pointer }
is_equal(ppointerdef(def_to)^.definition,voiddef) or
{ in my opnion, is this not clean pascal }
{ well, but it's handy to use, it isn't ? (FK) }
is_equal(ppointerdef(def_from)^.definition,voiddef) then
begin
doconv:=tc_equal;
b:=true;
end;
end;
procvardef : begin
{ procedure variable can be assigned to an void pointer }
{ Not anymore. Use the @ operator now.}
if not(cs_tp_compatible in aktmoduleswitches) and
(ppointerdef(def_to)^.definition^.deftype=orddef) and
(porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
begin
doconv:=tc_equal;
b:=true;
end;
end;
classrefdef,
objectdef : begin
{ class types and class reference type
can be assigned to void pointers }
if (
((def_from^.deftype=objectdef) and pobjectdef(def_from)^.isclass) or
(def_from^.deftype=classrefdef)
) and
(ppointerdef(def_to)^.definition^.deftype=orddef) and
(porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
begin
doconv:=tc_equal;
b:=true;
end;
end;
end;
end;
setdef : begin
{ automatic arrayconstructor -> set conversion }
if (def_from^.deftype=arraydef) and (parraydef(def_from)^.IsConstructor) then
begin begin
doconv:=tc_arrayconstructor_2_set; doconv:=tc_arrayconstructor_2_set;
b:=true; b:=true;
end;
end;
procvardef : begin
{ proc -> procvar }
if (def_from^.deftype=procdef) then
begin
def_from^.deftype:=procvardef;
doconv:=tc_proc2procvar;
b:=is_equal(def_from,def_to);
def_from^.deftype:=procdef;
end end
else else
{ nil is compatible with procvars }
if (fromtreetype=niln) then
begin
doconv:=tc_equal;
b:=true;
end;
end;
objectdef : begin
{ object pascal objects }
if (def_from^.deftype=objectdef) {and
pobjectdef(def_from)^.isclass and pobjectdef(def_to)^.isclass }then
begin
doconv:=tc_equal;
b:=pobjectdef(def_from)^.isrelated(pobjectdef(def_to));
end
else
{ nil is compatible with class instances }
if (fromtreetype=niln) and (pobjectdef(def_to)^.isclass) then
begin
doconv:=tc_equal;
b:=true;
end;
end;
classrefdef : begin
{ class reference types }
if (def_from^.deftype=classrefdef) then
begin
doconv:=tc_equal;
b:=pobjectdef(pclassrefdef(def_from)^.definition)^.isrelated(
pobjectdef(pclassrefdef(def_to)^.definition));
end
else
{ nil is compatible with class references }
if (fromtreetype=niln) then
begin
doconv:=tc_equal;
b:=true;
end;
end;
filedef : begin
{ typed files are all equal to the abstract file type { typed files are all equal to the abstract file type
name TYPEDFILE in system.pp in is_equal in types.pas name TYPEDFILE in system.pp in is_equal in types.pas
the problem is that it sholud be also compatible to FILE the problem is that it sholud be also compatible to FILE
@ -246,7 +404,7 @@ implementation
when trying to find the good overloaded function !! when trying to find the good overloaded function !!
so all file function are doubled in system.pp so all file function are doubled in system.pp
this is not very beautiful !!} this is not very beautiful !!}
if (def_from^.deftype=filedef) and (def_to^.deftype=filedef) and if (def_from^.deftype=filedef) and
( (
( (
(pfiledef(def_from)^.filetype = ft_typed) and (pfiledef(def_from)^.filetype = ft_typed) and
@ -271,149 +429,14 @@ implementation
doconv:=tc_equal; doconv:=tc_equal;
b:=true; b:=true;
end end
end;
else else
{ object pascal objects }
if (def_from^.deftype=objectdef) and (def_to^.deftype=objectdef) {and
pobjectdef(def_from)^.isclass and pobjectdef(def_to)^.isclass }then
begin begin
doconv:=tc_equal; { assignment overwritten ?? }
b:=pobjectdef(def_from)^.isrelated( if is_assignment_overloaded(def_from,def_to) then
pobjectdef(def_to));
end
else
{ class types and class reference type
can be assigned to void pointers }
if (((def_from^.deftype=objectdef) and
pobjectdef(def_from)^.isclass) or
(def_from^.deftype=classrefdef)
) and
(def_to^.deftype=pointerdef) and
(ppointerdef(def_to)^.definition^.deftype=orddef) and
(porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
begin
doconv:=tc_equal;
b:=true;
end
else
{ class reference types }
if (def_from^.deftype=classrefdef) and (def_from^.deftype=classrefdef) then
begin
doconv:=tc_equal;
b:=pobjectdef(pclassrefdef(def_from)^.definition)^.isrelated(
pobjectdef(pclassrefdef(def_to)^.definition));
end
else
if (def_from^.deftype=pointerdef) and (def_to^.deftype=pointerdef) then
begin
{ child class pointer can be assigned to anchestor pointers }
if (
(ppointerdef(def_from)^.definition^.deftype=objectdef) and
(ppointerdef(def_to)^.definition^.deftype=objectdef) and
pobjectdef(ppointerdef(def_from)^.definition)^.isrelated(
pobjectdef(ppointerdef(def_to)^.definition))
) or
{ all pointers can be assigned to void-pointer }
is_equal(ppointerdef(def_to)^.definition,voiddef) or
{ in my opnion, is this not clean pascal }
{ well, but it's handy to use, it isn't ? (FK) }
is_equal(ppointerdef(def_from)^.definition,voiddef) then
begin
doconv:=tc_equal;
b:=true;
end
end
else
if (def_from^.deftype=stringdef) and (def_to^.deftype=stringdef) then
begin
doconv:=tc_string_to_string;
b:=true;
end
else
{ char to string}
if is_equal(def_from,cchardef) and (def_to^.deftype=stringdef) then
begin
doconv:=tc_char_to_string;
b:=true;
end
else
{ string constant to zero terminated string constant }
if (fromtreetype=stringconstn) and
is_pchar(def_to) then
begin
doconv:=tc_cstring_charpointer;
b:=true;
end
else
{ array of char to string, the length check is done by the firstpass of this node }
if (def_from^.deftype=stringdef) and
((def_to^.deftype=arraydef) and is_equal(parraydef(def_to)^.definition,cchardef)) then
begin
doconv:=tc_string_chararray;
b:=true;
end
else
{ string to array of char, the length check is done by the firstpass of this node }
if ((def_from^.deftype=arraydef) and is_equal(parraydef(def_from)^.definition,cchardef)) and
(def_to^.deftype=stringdef) then
begin
doconv:=tc_chararray_2_string;
b:=true;
end
else
if (fromtreetype=ordconstn) and is_equal(def_from,cchardef) then
begin
if (def_to^.deftype=pointerdef) and
is_equal(ppointerdef(def_to)^.definition,cchardef) then
begin
doconv:=tc_cchar_charpointer;
b:=true; b:=true;
end; end;
end end;
else
if (def_to^.deftype=procvardef) and (def_from^.deftype=procdef) then
begin
def_from^.deftype:=procvardef;
doconv:=tc_proc2procvar;
b:=is_equal(def_from,def_to);
def_from^.deftype:=procdef;
end
else
{ nil is compatible with class instances }
if (fromtreetype=niln) and (def_to^.deftype=objectdef)
and (pobjectdef(def_to)^.isclass) then
begin
doconv:=tc_equal;
b:=true;
end
else
{ nil is compatible with class references }
if (fromtreetype=niln) and (def_to^.deftype=classrefdef) then
begin
doconv:=tc_equal;
b:=true;
end
else
{ nil is compatible with procvars }
if (fromtreetype=niln) and (def_to^.deftype=procvardef) then
begin
doconv:=tc_equal;
b:=true;
end
else
{ nil is compatible with ansi- and wide strings } { nil is compatible with ansi- and wide strings }
{ no, that isn't true, (FK) { no, that isn't true, (FK)
@ -450,35 +473,6 @@ implementation
end end
else else
} }
{ pchar can be assigned to short/ansistrings }
if (def_to^.deftype=stringdef) and
((def_from^.deftype=pointerdef) and
(ppointerdef(def_from)^.definition^.deftype=orddef) and
(porddef(ppointerdef(def_from)^.definition)^.typ=uchar)) then
begin
if (pstringdef(def_to)^.string_typ in [st_shortstring,st_ansistring]) then
begin
doconv:=tc_pchar_2_string;
b:=true;
end;
end
else
{ procedure variable can be assigned to an void pointer }
{ Not anymore. Use the @ operator now.}
if not (cs_tp_compatible in aktmoduleswitches) then
begin
if (def_from^.deftype=procvardef) and
(def_to^.deftype=pointerdef) and
(ppointerdef(def_to)^.definition^.deftype=orddef) and
(porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
begin
doconv:=tc_equal;
b:=true;
end;
end;
isconvertable:=b; isconvertable:=b;
end; end;
@ -645,7 +639,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.1 1998-09-23 20:42:22 peter Revision 1.2 1998-09-24 09:02:14 peter
* rewritten isconvertable to use case
* array of .. and single variable are compatible
Revision 1.1 1998/09/23 20:42:22 peter
* splitted pass_1 * splitted pass_1
} }

12
compiler/tccal.pas
View File

@ -134,7 +134,11 @@ implementation
(defcoll^.data^.deftype=objectdef) and (defcoll^.data^.deftype=objectdef) and
pobjectdef(p^.left^.resulttype)^.isrelated(pobjectdef(defcoll^.data)) pobjectdef(p^.left^.resulttype)^.isrelated(pobjectdef(defcoll^.data))
) and ) and
{ passing a single element to a openarray of the same type }
not(
(is_open_array(defcoll^.data) and
is_equal(parraydef(defcoll^.data)^.definition,p^.left^.resulttype))
) and
{ an implicit file conversion is also allowed } { an implicit file conversion is also allowed }
{ from a typed file to an untyped one } { from a typed file to an untyped one }
not( not(
@ -895,7 +899,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.1 1998-09-23 20:42:24 peter Revision 1.2 1998-09-24 09:02:16 peter
* rewritten isconvertable to use case
* array of .. and single variable are compatible
Revision 1.1 1998/09/23 20:42:24 peter
* splitted pass_1 * splitted pass_1
} }