* 1.0.10 starting patch from Peter

This commit is contained in:
florian 2005-01-06 13:40:41 +00:00
parent 48c248d6c0
commit ef9b70f1f4
2 changed files with 40 additions and 39 deletions

View File

@ -78,7 +78,7 @@ interface
treelogfilename = 'tree.log';
{$if (defined(CPUARM) and defined(FPUFPA))}
{$if defined(CPUARM) and defined(FPUFPA)}
MathQNaN : tdoublearray = (0,0,252,255,0,0,0,0);
MathInf : tdoublearray = (0,0,240,127,0,0,0,0);
MathNegInf : tdoublearray = (0,0,240,255,0,0,0,0);
@ -2180,7 +2180,10 @@ end;
end.
{
$Log$
Revision 1.158 2005-01-06 09:20:36 karoly
Revision 1.159 2005-01-06 13:40:41 florian
* 1.0.10 starting patch from Peter
Revision 1.158 2005/01/06 09:20:36 karoly
* made Shell() work correctly on MorphOS
Revision 1.157 2005/01/04 17:40:33 karoly

View File

@ -660,7 +660,7 @@ implementation
var
chartype : string[8];
begin
if is_widechar(tarraydef(left.resulttype).elementtype.def) then
if is_widechar(tarraydef(left.resulttype.def).elementtype.def) then
chartype:='widechar'
else
chartype:='char';
@ -691,7 +691,7 @@ implementation
result := nil;
exit;
end;
if is_widechar(tarraydef(resulttype).elementtype.def) then
if is_widechar(tarraydef(resulttype.def).elementtype.def) then
chartype:='widechar'
else
chartype:='char';
@ -1471,42 +1471,37 @@ implementation
(resulttype.def.deftype <> floatdef)) then
make_not_regable(left);
{ class to class or object to object, with checkobject support }
if (resulttype.def.deftype=objectdef) and
(left.resulttype.def.deftype=objectdef) then
{ class/interface to class/interface, with checkobject support }
if is_class_or_interface(resulttype.def) and
is_class_or_interface(left.resulttype.def) then
begin
{ check if the types are related }
if not(nf_internal in flags) and
(not(tobjectdef(left.resulttype.def).is_related(tobjectdef(resulttype.def)))) and
(not(tobjectdef(resulttype.def).is_related(tobjectdef(left.resulttype.def)))) then
begin
{ Give an error when typecasting class to interface, this is compatible
with delphi }
if is_interface(resulttype.def) and
not is_interface(left.resulttype.def) then
CGMessage2(type_e_classes_not_related,
FullTypeName(left.resulttype.def,resulttype.def),
FullTypeName(resulttype.def,left.resulttype.def))
else
CGMessage2(type_w_classes_not_related,
FullTypeName(left.resulttype.def,resulttype.def),
FullTypeName(resulttype.def,left.resulttype.def))
end;
{ Add runtime check? }
if (cs_check_object in aktlocalswitches) then
begin
if is_class_or_interface(resulttype.def) then
begin
{ we can translate the typeconvnode to 'as' when
typecasting to a class or interface }
hp:=casnode.create(left,cloadvmtaddrnode.create(ctypenode.create(resulttype)));
left:=nil;
result:=hp;
exit;
end;
end
else
begin
{ check if the types are related }
if not(nf_internal in flags) and
(not(tobjectdef(left.resulttype.def).is_related(tobjectdef(resulttype.def)))) and
(not(tobjectdef(resulttype.def).is_related(tobjectdef(left.resulttype.def)))) then
begin
{ Give an error when typecasting class to interface, this is compatible
with delphi }
if is_interface(resulttype.def) and
not is_interface(left.resulttype.def) then
CGMessage2(type_e_classes_not_related,
FullTypeName(left.resulttype.def,resulttype.def),
FullTypeName(resulttype.def,left.resulttype.def))
else
CGMessage2(type_w_classes_not_related,
FullTypeName(left.resulttype.def,resulttype.def),
FullTypeName(resulttype.def,left.resulttype.def))
end;
end;
begin
{ we can translate the typeconvnode to 'as' when
typecasting to a class or interface }
hp:=casnode.create(left,cloadvmtaddrnode.create(ctypenode.create(resulttype)));
left:=nil;
result:=hp;
end;
end
else
@ -2551,7 +2546,10 @@ begin
end.
{
$Log$
Revision 1.171 2005-01-06 13:30:41 florian
Revision 1.172 2005-01-06 13:40:41 florian
* 1.0.10 starting patch from Peter
Revision 1.171 2005/01/06 13:30:41 florian
* widechararray patch from Peter
Revision 1.170 2005/01/03 17:55:57 florian