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

* 1.0.10 starting patch from Peter

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
compiler/globals.pas
View File

@ -78,7 +78,7 @@ interface
treelogfilename = 'tree.log'; 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); MathQNaN : tdoublearray = (0,0,252,255,0,0,0,0);
MathInf : tdoublearray = (0,0,240,127,0,0,0,0); MathInf : tdoublearray = (0,0,240,127,0,0,0,0);
MathNegInf : tdoublearray = (0,0,240,255,0,0,0,0); MathNegInf : tdoublearray = (0,0,240,255,0,0,0,0);
@ -2180,7 +2180,10 @@ end;
end. end.
{ {
$Log$ $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 * made Shell() work correctly on MorphOS
Revision 1.157 2005/01/04 17:40:33 karoly Revision 1.157 2005/01/04 17:40:33 karoly

72
compiler/ncnv.pas
View File

@ -660,7 +660,7 @@ implementation
var var
chartype : string[8]; chartype : string[8];
begin begin
if is_widechar(tarraydef(left.resulttype).elementtype.def) then if is_widechar(tarraydef(left.resulttype.def).elementtype.def) then
chartype:='widechar' chartype:='widechar'
else else
chartype:='char'; chartype:='char';
@ -691,7 +691,7 @@ implementation
result := nil; result := nil;
exit; exit;
end; end;
if is_widechar(tarraydef(resulttype).elementtype.def) then if is_widechar(tarraydef(resulttype.def).elementtype.def) then
chartype:='widechar' chartype:='widechar'
else else
chartype:='char'; chartype:='char';
@ -1471,42 +1471,37 @@ implementation
(resulttype.def.deftype <> floatdef)) then (resulttype.def.deftype <> floatdef)) then
make_not_regable(left); make_not_regable(left);
{ class to class or object to object, with checkobject support } { class/interface to class/interface, with checkobject support }
if (resulttype.def.deftype=objectdef) and if is_class_or_interface(resulttype.def) and
(left.resulttype.def.deftype=objectdef) then is_class_or_interface(left.resulttype.def) then
begin 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 if (cs_check_object in aktlocalswitches) then
begin begin
if is_class_or_interface(resulttype.def) then { we can translate the typeconvnode to 'as' when
begin typecasting to a class or interface }
{ we can translate the typeconvnode to 'as' when hp:=casnode.create(left,cloadvmtaddrnode.create(ctypenode.create(resulttype)));
typecasting to a class or interface } left:=nil;
hp:=casnode.create(left,cloadvmtaddrnode.create(ctypenode.create(resulttype))); result:=hp;
left:=nil; end;
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;
end end
else else
@ -2551,7 +2546,10 @@ begin
end. end.
{ {
$Log$ $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 * widechararray patch from Peter
Revision 1.170 2005/01/03 17:55:57 florian Revision 1.170 2005/01/03 17:55:57 florian