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

* fixed comparisons of orddefs with fourcharcodes in macpas mode + test

Browse Source 
git-svn-id: trunk@9014 -
This commit is contained in:
Jonas Maebe 2007-10-31 15:11:13 +00:00
parent 68570e5471
commit df2ecd14f5
3 changed files with 43 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6970,6 +6970,7 @@ tests/test/tmacpas1.pp svneol=native#text/plain
tests/test/tmacpas2.pp svneol=native#text/plain
tests/test/tmacpas3.pp svneol=native#text/plain
tests/test/tmacpas4.pp svneol=native#text/plain
tests/test/tmacpas5.pp svneol=native#text/plain
tests/test/tmacprocvar.pp svneol=native#text/plain
tests/test/tmath1.pp svneol=native#text/plain
tests/test/tmcbool2.pp svneol=native#text/plain

29
compiler/nadd.pas
View File

@ -868,6 +868,33 @@ implementation
rt:=right.nodetype;
lt:=left.nodetype;
{ 4 character constant strings are compatible with orddef }
{ in macpas mode (become cardinals) }
if (m_mac in current_settings.modeswitches) and
{ only allow for comparisons, additions etc are }
{ normally program errors }
(nodetype in [ltn,lten,gtn,gten,unequaln,equaln]) and
(((lt=stringconstn) and
(tstringconstnode(left).len=4) and
(rd.typ=orddef)) or
((rt=stringconstn) and
(tstringconstnode(right).len=4) and
(ld.typ=orddef))) then
begin
if (rt=stringconstn) then
begin
inserttypeconv(right,u32inttype);
rt:=right.nodetype;
rd:=right.resultdef;
end
else
begin
inserttypeconv(left,u32inttype);
lt:=left.nodetype;
ld:=left.resultdef;
end;
end;
{ but an int/int gives real/real! }
if (nodetype=slashn) and not(is_vector(left.resultdef)) and not(is_vector(right.resultdef)) then
begin
@ -1338,7 +1365,7 @@ implementation
CGMessage1(type_w_untyped_arithmetic_unportable,node2opstr(nodetype));
inserttypeconv(right,left.resultdef)
end
else if is_voidpointer(left.resultdef) then
else if is_voidpointer(left.resultdef) then
inserttypeconv(left,right.resultdef)
else if not(equal_defs(ld,rd)) then
IncompatibleTypes(ld,rd);

14
tests/test/tmacpas5.pp Normal file
View File

@ -0,0 +1,14 @@
{$mode macpas}
procedure test;
var
d: dword;
begin
d:=(65 shl 24) or (66 shl 16) or (67 shl 8) or 68;
if (d<>'ABCD') then
halt(1);
end;
begin
test;
end.