فهرست منبع

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

git-svn-id: trunk@9014 -
Jonas Maebe 18 سال پیش
والد
کامیت
df2ecd14f5
3فایلهای تغییر یافته به همراه43 افزوده شده و 1 حذف شده
  1. 1 0
      .gitattributes
  2. 28 1
      compiler/nadd.pas
  3. 14 0
      tests/test/tmacpas5.pp

+ 1 - 0
.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

+ 28 - 1
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);

+ 14 - 0
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.