From df2ecd14f5fa48d1bfc5913976a6c60d44828aa4 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Wed, 31 Oct 2007 15:11:13 +0000
Subject: [PATCH]   * fixed comparisons of orddefs with fourcharcodes in macpas
 mode + test

git-svn-id: trunk@9014 -
---
 .gitattributes         |  1 +
 compiler/nadd.pas      | 29 ++++++++++++++++++++++++++++-
 tests/test/tmacpas5.pp | 14 ++++++++++++++
 3 files changed, 43 insertions(+), 1 deletion(-)
 create mode 100644 tests/test/tmacpas5.pp

diff --git a/.gitattributes b/.gitattributes
index 1fe1b274ca..98ea17e397 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -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
diff --git a/compiler/nadd.pas b/compiler/nadd.pas
index e770ea263c..66e0082c99 100644
--- a/compiler/nadd.pas
+++ b/compiler/nadd.pas
@@ -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);
diff --git a/tests/test/tmacpas5.pp b/tests/test/tmacpas5.pp
new file mode 100644
index 0000000000..feeb6bbe05
--- /dev/null
+++ b/tests/test/tmacpas5.pp
@@ -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.