freepascal bugtracker

Index: htypechk.pas
===================================================================
--- htypechk.pas	(revision 21756)
+++ htypechk.pas	(working copy)
@@ -221,6 +221,23 @@
               begin
                 allowed:=true;
               end;
+            enumdef:
+              begin
+                allowed := not (((treetyp = inn) and (rd.typ = setdef)) or
+                  ((treetyp in [equaln, unequaln, ltn, lten, gtn, gten]) and (rd.typ = enumdef)));
+              end;
+            setdef:
+              begin
+                allowed := not ((rd.typ = orddef) or
+                  ((treetyp in [equaln, unequaln, addn, subn, muln, ltn, lten, gtn, gten, symdifn]) and
+                    (rd.typ = setdef)) or
+                  (treetyp in [addn, subn]) and (rd.typ = enumdef));
+              end;
+            floatdef:
+              begin
+                allowed := not ((rd.typ in [orddef, floatdef]) and
+                  (treetyp in [equaln, unequaln, addn, subn, muln, divn, slashn, ltn, lten, gtn, gten]));
+              end;
             procvardef :
               begin
                 if (rd.typ in [pointerdef,procdef,procvardef]) then
@@ -232,7 +249,7 @@
               end;
             pointerdef :
               begin
-                if ((rd.typ in [orddef,enumdef,pointerdef,classrefdef,procvardef]) or
+                if ((rd.typ in [orddef,pointerdef,classrefdef,procvardef]) or
                     is_implicit_pointer_object_type(rd)) then
                  begin
                    allowed:=false;
@@ -267,7 +284,7 @@
                 if (is_chararray(ld) or is_widechararray(ld) or
                     is_open_chararray(ld) or is_open_widechararray(ld))
                    and
-                   ((rd.typ in [stringdef,orddef,enumdef]) or
+                   ((rd.typ in [stringdef,orddef]) or
                     is_pchar(rd) or
                     is_pwidechar(rd) or
                     is_chararray(rd) or
@@ -304,13 +321,14 @@
               end;
             stringdef :
               begin
-                if (rd.typ in [orddef,enumdef,stringdef]) or
+                if (treetyp in [addn, equaln, unequaln, gtn, gten, ltn, lten]) and
+                   ((rd.typ in [orddef,stringdef]) or
                    is_pchar(rd) or
                    is_pwidechar(rd) or
                    is_chararray(rd) or
                    is_widechararray(rd) or
                    is_open_chararray(rd) or
-                   is_open_widechararray(rd) then
+                   is_open_widechararray(rd)) then
                  begin
                    allowed:=false;
                    exit;

Index: defutil.pas
===================================================================
--- defutil.pas	(revision 21768)
+++ defutil.pas	(working copy)
@@ -46,6 +46,16 @@
     {# Returns true, if definition defines a string type }
     function is_string(def : tdef): boolean;
 
+    {# Returns True, if definition defines a type that behaves like a string,
+       namely that can be joined and compared with another string-like type }
+    function is_stringlike(def: TDef): Boolean;
+
+    {# Returns True, if definition defines an enumeration type }
+    function is_enum(def: TDef): Boolean;
+
+    {# Returns True, if definition defines a set type }
+    function is_set(def: TDef): Boolean;
+
     {# Returns the minimal integer value of the type }
     function get_min_value(def : tdef) : TConstExprInt;
 
@@ -405,7 +415,23 @@
         is_string := (assigned(def) and (def.typ = stringdef));
       end;
 
+    function is_stringlike(def: TDef): Boolean;
+    begin
+      Result := is_string(def) or is_anychar(def) or is_pchar(def) or
+        is_pwidechar(def) or is_chararray(def) or is_widechararray(def) or
+        is_open_chararray(def) or is_open_widechararray(def);
+    end;
 
+    function is_enum(def: TDef): Boolean;
+    begin
+      Result := def.typ = enumdef;
+    end;
+
+    function is_set(def: TDef): Boolean;
+    begin
+      Result := def.typ = setdef;
+    end;
+
     { returns the min. value of the type }
     function get_min_value(def : tdef) : TConstExprInt;
       begin
Index: htypechk.pas
===================================================================
--- htypechk.pas	(revision 21768)
+++ htypechk.pas	(working copy)
@@ -212,8 +212,26 @@
     function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean;
 
         function internal_check(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype;var allowed:boolean):boolean;
+        const
+          IdentityOperators = [equaln, unequaln];
+          OrderTheoreticOperators = IdentityOperators + [ltn, lten, gtn, gten];
+          ArithmeticOperators = [addn, subn, muln, divn, modn];
+          ArithmeticDivisionOperators = [divn, modn];
+          NumericalOperators = ArithmeticOperators + [slashn];
+          PointerArithmeticOperators = [addn, subn];
+          LogicalOperators = [andn, orn, xorn];
+          BitManipulationOperators = LogicalOperators + [shln, shrn];
+          SetSetOperators = IdentityOperators + [addn, subn, muln, symdifn] +
+            OrderTheoreticOperators;
+          ElementSetOperators = [inn];
+          StringComparisonOperators = OrderTheoreticOperators;
+          StringManipulationOperators = [addn];
+          StringOperators =
+            StringComparisonOperators + StringManipulationOperators;
         begin
           internal_check:=true;
+
+          { Reject the cases permitted by the default interpretation (DI). }
           case ld.typ of
             formaldef,
             recorddef,
@@ -221,6 +239,75 @@
               begin
                 allowed:=true;
               end;
+            enumdef:
+              begin
+                allowed := not (
+                    (is_set(rd) and (treetyp in ElementSetOperators)) or
+                    (is_enum(rd) and (treetyp in (
+                        OrderTheoreticOperators + [addn, subn]
+                      )))
+                  );
+              end;
+            setdef:
+              begin
+                allowed := not (
+                    (is_set(rd) and (treetyp in (
+                        SetSetOperators + IdentityOperators
+                      ))) or
+                    ((rd.typ in [enumdef, orddef]) and (treetyp = addn))
+                      { This clause is a hack but it’s due to a hack somewhere
+                        else---while set + element is not permitted by DI, it
+                        seems to be used when a set is constructed inline }
+                  );
+              end;
+            orddef, floatdef:
+              begin
+                allowed := not (
+                    ((rd.typ in [orddef, floatdef]) and
+                      (treetyp in OrderTheoreticOperators)) or
+                    (is_stringlike(rd) and (ld.typ = orddef) and
+                      (treetyp in StringComparisonOperators)) or
+                      { c.f. $(source)\tests\tmacpas5.pp }
+                    ((rd.typ = setdef) and (ld.typ = orddef) and
+                      (treetyp in ElementSetOperators))
+                      { This clause may be too restrictive---not all types under
+                        orddef have a corresponding set type; despite this the
+                        restriction should be very unlikely to become
+                        a practical obstacle, and can be relaxed by simply
+                        adding an extra check on TOrdDef(rd).ordtype }
+                  );
+
+                if allowed then begin
+                  if is_anychar(ld) then
+                    allowed := not (
+                        is_stringlike(rd) and (treetyp in StringOperators)
+                      )
+                  else if is_boolean(ld) then
+                    allowed := not (
+                        is_boolean(rd) and (treetyp in LogicalOperators)
+                      )
+                  else if is_integer(ld) then
+                    allowed := not (
+                        (is_integer(rd) and (treetyp in (
+                            BitManipulationOperators + NumericalOperators
+                          ))) or
+                        (is_fpu(rd) and (treetyp in (
+                            NumericalOperators - ArithmeticDivisionOperators
+                          ))) or
+                        ((rd.typ = pointerdef) and
+                          (treetyp in PointerArithmeticOperators - [subn]))
+                          { When an integer type is used as the first operand in
+                            pointer arithmetic, DI doesn’t accept minus as the
+                            operator }
+                      )
+                  else  { is_fpu(ld) = True }
+                    allowed := not (
+                        (is_fpu(rd) or is_integer(rd)) and (treetyp in (
+                            NumericalOperators - ArithmeticDivisionOperators
+                          ))
+                      );
+                end;
+              end;
             procvardef :
               begin
                 if (rd.typ in [pointerdef,procdef,procvardef]) then
@@ -232,25 +319,44 @@
               end;
             pointerdef :
               begin
-                if ((rd.typ in [orddef,enumdef,pointerdef,classrefdef,procvardef]) or
-                    is_implicit_pointer_object_type(rd)) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
+                { DI permits pointer arithmetic for pointer + pointer, pointer -
+                  integer, pointer - pointer, but not for pointer + pointer.
+                  The last case is only valid in DI when both sides are
+                  stringlike. }
 
-                { don't allow pchar+string }
-                if (is_pchar(ld) or is_pwidechar(ld)) and
-                   ((rd.typ=stringdef) or
-                    is_pchar(rd) or
-                    is_pwidechar(rd) or
-                    is_chararray(rd) or
-                    is_widechararray(rd)) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
-                allowed:=true;
+                if is_stringlike(ld) then
+                  if is_stringlike(rd) then
+                    { DI in this case permits string operations and pointer
+                      arithmetic. }
+                    allowed := not (treetyp in (
+                        StringOperators + PointerArithmeticOperators
+                      ))
+                  else if rd.typ = pointerdef then
+                    { DI in this case permits minus for pointer arithmetic and
+                      order-theoretic operators for pointer comparison. }
+                    allowed := not (
+                        treetyp in (
+                            PointerArithmeticOperators - [addn] +
+                            OrderTheoreticOperators
+                          )
+                      )
+                  else if is_integer(rd) then
+                    { DI in this case permits pointer arithmetic. }
+                    allowed := not (treetyp in PointerArithmeticOperators)
+                  else
+                    allowed := True
+                else
+                  allowed := not (
+                      (is_integer(rd) and
+                        (treetyp in PointerArithmeticOperators)) or
+                      ((rd.typ = pointerdef) and
+                        (treetyp in (
+                            PointerArithmeticOperators - [addn] +
+                            OrderTheoreticOperators
+                          ))) or
+                      ((lt = niln) and (rd.typ in [procvardef, procdef]) and
+                        (treetyp in IdentityOperators))
+                    );
               end;
             arraydef :
               begin
@@ -263,80 +369,57 @@
                    allowed:=false;
                    exit;
                  end;
-                { not chararray+[(wide)char,(wide)string,(wide)chararray] }
-                if (is_chararray(ld) or is_widechararray(ld) or
-                    is_open_chararray(ld) or is_open_widechararray(ld))
-                   and
-                   ((rd.typ in [stringdef,orddef,enumdef]) or
-                    is_pchar(rd) or
-                    is_pwidechar(rd) or
-                    is_chararray(rd) or
-                    is_widechararray(rd) or
-                    is_open_chararray(rd) or
-                    is_open_widechararray(rd) or
-                    (rt=niln)) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
+
+                if is_stringlike(ld) and (
+                    ((is_stringlike(rd) or (rt = niln)) and
+                      (treetyp in StringOperators)) or
+                    (is_integer(rd)
+                      and (treetyp in PointerArithmeticOperators)) or
+                    ((is_pchar(rd) or is_pwidechar(rd)) and
+                      (treetyp in PointerArithmeticOperators) and
+                      (TPointerDef(rd).pointeddef = TArrayDef(ld).elementdef))
+                  )
+                then begin
+                  allowed := False;
+                  Exit;
+                end;
+
                 { dynamic array compare with niln }
-                if ((is_dynamic_array(ld) and
-                   (rt=niln)) or
-                   (is_dynamic_array(ld) and is_dynamic_array(rd)))
-                   and
-                   (treetyp in [equaln,unequaln]) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
+                if is_dynamic_array(ld) and (treetyp in IdentityOperators) then
+                  if is_dynamic_array(rd) or (rt = niln) then begin
+                    allowed := False;
+                    Exit;
+                  end;
+
                 allowed:=true;
               end;
             objectdef :
               begin
                 { <> and = are defined for implicit pointer object types }
-                if (treetyp in [equaln,unequaln]) and
-                   is_implicit_pointer_object_type(ld) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
-                allowed:=true;
+                allowed := not (
+                    is_implicit_pointer_object_type(ld) and
+                    ((is_implicit_pointer_object_type(rd) or
+                      (rd.typ = pointerdef) or (rt = niln))) and
+                    (treetyp in IdentityOperators)
+                  );
               end;
             stringdef :
               begin
-                if (rd.typ in [orddef,enumdef,stringdef]) or
-                   is_pchar(rd) or
-                   is_pwidechar(rd) or
-                   is_chararray(rd) or
-                   is_widechararray(rd) or
-                   is_open_chararray(rd) or
-                   is_open_widechararray(rd) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
-                allowed:=true;
+                allowed := not (
+                    is_stringlike(rd) and (treetyp in StringOperators)
+                  );
               end;
             else
               internal_check:=false;
           end;
         end;
 
-      var
-        allowed : boolean;
       begin
         { power ** is always possible }
-        if (treetyp=starstarn) then
-         begin
-           isbinaryoperatoroverloadable:=true;
-           exit;
-         end;
-        { order of arguments does not matter so we have to check also
-          the reversed order }
-        allowed:=false;
-        if not internal_check(treetyp,ld,lt,rd,rt,allowed) then
-          internal_check(treetyp,rd,rt,ld,lt,allowed);
-        isbinaryoperatoroverloadable:=allowed;
+        Result := treetyp = starstarn;
+        if not Result then
+          if not internal_check(treetyp, ld, lt, rd, rt, Result) then
+            Result := False;
       end;
 
 
@@ -366,8 +449,7 @@
 
           notn :
             begin
-              if (ld.typ in [orddef,enumdef,floatdef]) then
-                exit;
+              if ld.typ = orddef then exit;
 
 {$ifdef SUPPORT_MMX}
               if (cs_mmx in current_settings.localswitches) and

Index: htypechk.pas
===================================================================
--- htypechk.pas	(revision 21798)
+++ htypechk.pas	(working copy)
@@ -212,8 +212,31 @@
     function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean;
 
         function internal_check(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype;var allowed:boolean):boolean;
+        const
+          IdentityOperators = [equaln, unequaln];
+          OrderTheoreticOperators = IdentityOperators + [ltn, lten, gtn, gten];
+          ArithmeticOperators = [addn, subn, muln, divn, modn];
+          RationalOperators = [addn, subn, muln, slashn];
+          NumericalOperators = ArithmeticOperators + [slashn];
+          PointerArithmeticOperators = [addn, subn];
+          LogicalOperators = [andn, orn, xorn];
+          BitManipulationOperators = LogicalOperators + [shln, shrn];
+          SetSetOperators = IdentityOperators + [addn, subn, muln, symdifn] +
+            OrderTheoreticOperators;
+          ElementSetOperators = [inn];
+          StringComparisonOperators = OrderTheoreticOperators;
+          StringManipulationOperators = [addn];
+          StringOperators =
+            StringComparisonOperators + StringManipulationOperators;
         begin
           internal_check:=true;
+
+          { Reject the cases permitted by the default interpretation (DI). }
           case ld.typ of
             formaldef,
             recorddef,
@@ -221,6 +244,83 @@
               begin
                 allowed:=true;
               end;
+            enumdef:
+              begin
+                allowed := not (
+                    (is_set(rd) and (treetyp in ElementSetOperators)) or
+                    (is_enum(rd) and (treetyp in (
+                        OrderTheoreticOperators + [addn, subn]
+                      )))
+                  );
+              end;
+            setdef:
+              begin
+                allowed := not (
+                    (is_set(rd) and (treetyp in (
+                        SetSetOperators + IdentityOperators
+                      ))) or
+                    ((rd.typ in [enumdef, orddef]) and (treetyp = addn))
+                      { This clause is a hack but it’s due to a hack somewhere
+                        else---while set + element is not permitted by DI, it
+                        seems to be used when a set is constructed inline }
+                  );
+              end;
+            orddef, floatdef:
+              begin
+                allowed := not (
+                    ((rd.typ in [orddef, floatdef]) and
+                      (treetyp in OrderTheoreticOperators)) or
+                    (is_stringlike(rd) and (ld.typ = orddef) and
+                      (treetyp in StringComparisonOperators)) or
+                      { c.f. $(source)\tests\tmacpas5.pp }
+                    ((rd.typ = setdef) and (ld.typ = orddef) and
+                      (treetyp in ElementSetOperators))
+                      { This clause may be too restrictive---not all types under
+                        orddef have a corresponding set type; despite this the
+                        restriction should be very unlikely to become
+                        a practical obstacle, and can be relaxed by simply
+                        adding an extra check on TOrdDef(rd).ordtype }
+                  );
+
+                { Note that Currency can be under either orddef or floatdef;
+                  when it’s under floatdef, is_float() implies is_currency();
+                  when it’s under orddef, is_integer() does NOT imply
+                  is_currency(). }
+                if allowed then begin
+                  if is_anychar(ld) then
+                    allowed := not (
+                        is_stringlike(rd) and (treetyp in StringOperators)
+                      )
+                  else if is_boolean(ld) then
+                    allowed := not (
+                        is_boolean(rd) and (treetyp in LogicalOperators)
+                      )
+                  else if is_integer(ld) or (
+                      (ld.typ = orddef) and is_currency(ld)
+                      { Here ld is Currency but behaves like an integer }
+                    )
+                  then
+                    allowed := not (
+                        ((is_integer(rd) or
+                          ((rd.typ = orddef) and is_currency(rd))) and
+                          (treetyp in (
+                              BitManipulationOperators + NumericalOperators
+                            ))) or
+                        (is_fpu(rd) and (treetyp in RationalOperators)) or
+                        (is_integer(ld) and (rd.typ = pointerdef) and
+                          (treetyp in PointerArithmeticOperators - [subn]))
+                          { When an integer type is used as the first operand in
+                            pointer arithmetic, DI doesn’t accept minus as the
+                            operator (Currency can’t be used in pointer
+                            arithmetic even if it’s under orddef)  }
+                      )
+                  else  { is_fpu(ld) = True }
+                    allowed := not (
+                        (is_fpu(rd) or is_integer(rd) or is_currency(rd)) and
+                          (treetyp in RationalOperators)
+                      );
+                end;
+              end;
             procvardef :
               begin
                 if (rd.typ in [pointerdef,procdef,procvardef]) then
@@ -232,25 +332,44 @@
               end;
             pointerdef :
               begin
-                if ((rd.typ in [orddef,enumdef,pointerdef,classrefdef,procvardef]) or
-                    is_implicit_pointer_object_type(rd)) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
+                { DI permits pointer arithmetic for pointer + pointer, pointer -
+                  integer, pointer - pointer, but not for pointer + pointer.
+                  The last case is only valid in DI when both sides are
+                  stringlike. }
 
-                { don't allow pchar+string }
-                if (is_pchar(ld) or is_pwidechar(ld)) and
-                   ((rd.typ=stringdef) or
-                    is_pchar(rd) or
-                    is_pwidechar(rd) or
-                    is_chararray(rd) or
-                    is_widechararray(rd)) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
-                allowed:=true;
+                if is_stringlike(ld) then
+                  if is_stringlike(rd) then
+                    { DI in this case permits string operations and pointer
+                      arithmetic. }
+                    allowed := not (treetyp in (
+                        StringOperators + PointerArithmeticOperators
+                      ))
+                  else if rd.typ = pointerdef then
+                    { DI in this case permits minus for pointer arithmetic and
+                      order-theoretic operators for pointer comparison. }
+                    allowed := not (
+                        treetyp in (
+                            PointerArithmeticOperators - [addn] +
+                            OrderTheoreticOperators
+                          )
+                      )
+                  else if is_integer(rd) then
+                    { DI in this case permits pointer arithmetic. }
+                    allowed := not (treetyp in PointerArithmeticOperators)
+                  else
+                    allowed := True
+                else
+                  allowed := not (
+                      (is_integer(rd) and
+                        (treetyp in PointerArithmeticOperators)) or
+                      ((rd.typ = pointerdef) and
+                        (treetyp in (
+                            PointerArithmeticOperators - [addn] +
+                            OrderTheoreticOperators
+                          ))) or
+                      ((lt = niln) and (rd.typ in [procvardef, procdef]) and
+                        (treetyp in IdentityOperators))
+                    );
               end;
             arraydef :
               begin
@@ -263,80 +382,57 @@
                    allowed:=false;
                    exit;
                  end;
-                { not chararray+[(wide)char,(wide)string,(wide)chararray] }
-                if (is_chararray(ld) or is_widechararray(ld) or
-                    is_open_chararray(ld) or is_open_widechararray(ld))
-                   and
-                   ((rd.typ in [stringdef,orddef,enumdef]) or
-                    is_pchar(rd) or
-                    is_pwidechar(rd) or
-                    is_chararray(rd) or
-                    is_widechararray(rd) or
-                    is_open_chararray(rd) or
-                    is_open_widechararray(rd) or
-                    (rt=niln)) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
+
+                if is_stringlike(ld) and (
+                    ((is_stringlike(rd) or (rt = niln)) and
+                      (treetyp in StringOperators)) or
+                    (is_integer(rd)
+                      and (treetyp in PointerArithmeticOperators)) or
+                    ((is_pchar(rd) or is_pwidechar(rd)) and
+                      (treetyp in PointerArithmeticOperators) and
+                      (TPointerDef(rd).pointeddef = TArrayDef(ld).elementdef))
+                  )
+                then begin
+                  allowed := False;
+                  Exit;
+                end;
+
                 { dynamic array compare with niln }
-                if ((is_dynamic_array(ld) and
-                   (rt=niln)) or
-                   (is_dynamic_array(ld) and is_dynamic_array(rd)))
-                   and
-                   (treetyp in [equaln,unequaln]) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
+                if is_dynamic_array(ld) and (treetyp in IdentityOperators) then
+                  if is_dynamic_array(rd) or (rt = niln) then begin
+                    allowed := False;
+                    Exit;
+                  end;
+
                 allowed:=true;
               end;
             objectdef :
               begin
                 { <> and = are defined for implicit pointer object types }
-                if (treetyp in [equaln,unequaln]) and
-                   is_implicit_pointer_object_type(ld) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
-                allowed:=true;
+                allowed := not (
+                    is_implicit_pointer_object_type(ld) and
+                    ((is_implicit_pointer_object_type(rd) or
+                      (rd.typ = pointerdef) or (rt = niln))) and
+                    (treetyp in IdentityOperators)
+                  );
               end;
             stringdef :
               begin
-                if (rd.typ in [orddef,enumdef,stringdef]) or
-                   is_pchar(rd) or
-                   is_pwidechar(rd) or
-                   is_chararray(rd) or
-                   is_widechararray(rd) or
-                   is_open_chararray(rd) or
-                   is_open_widechararray(rd) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
-                allowed:=true;
+                allowed := not (
+                    is_stringlike(rd) and (treetyp in StringOperators)
+                  );
               end;
             else
               internal_check:=false;
           end;
         end;
 
-      var
-        allowed : boolean;
       begin
         { power ** is always possible }
-        if (treetyp=starstarn) then
-         begin
-           isbinaryoperatoroverloadable:=true;
-           exit;
-         end;
-        { order of arguments does not matter so we have to check also
-          the reversed order }
-        allowed:=false;
-        if not internal_check(treetyp,ld,lt,rd,rt,allowed) then
-          internal_check(treetyp,rd,rt,ld,lt,allowed);
-        isbinaryoperatoroverloadable:=allowed;
+        Result := treetyp = starstarn;
+        if not Result then
+          if not internal_check(treetyp, ld, lt, rd, rt, Result) then
+            Result := False;
       end;
 
 
@@ -366,8 +462,7 @@
 
           notn :
             begin
-              if (ld.typ in [orddef,enumdef,floatdef]) then
-                exit;
+              if ld.typ = orddef then exit;
 
 {$ifdef SUPPORT_MMX}
               if (cs_mmx in current_settings.localswitches) and
Index: defutil.pas
===================================================================
--- defutil.pas	(revision 21798)
+++ defutil.pas	(working copy)
@@ -46,6 +46,16 @@
     {# Returns true, if definition defines a string type }
     function is_string(def : tdef): boolean;
 
+    {# Returns True, if definition defines a type that behaves like a string,
+       namely that can be joined and compared with another string-like type }
+    function is_stringlike(def: TDef): Boolean;
+
+    {# Returns True, if definition defines an enumeration type }
+    function is_enum(def: TDef): Boolean;
+
+    {# Returns True, if definition defines a set type }
+    function is_set(def: TDef): Boolean;
+
     {# Returns the minimal integer value of the type }
     function get_min_value(def : tdef) : TConstExprInt;
 
@@ -405,7 +415,23 @@
         is_string := (assigned(def) and (def.typ = stringdef));
       end;
 
+    function is_stringlike(def: TDef): Boolean;
+    begin
+      Result := is_string(def) or is_anychar(def) or is_pchar(def) or
+        is_pwidechar(def) or is_chararray(def) or is_widechararray(def) or
+        is_open_chararray(def) or is_open_widechararray(def);
+    end;
 
+    function is_enum(def: TDef): Boolean;
+    begin
+      Result := def.typ = enumdef;
+    end;
+
+    function is_set(def: TDef): Boolean;
+    begin
+      Result := def.typ = setdef;
+    end;
+
     { returns the min. value of the type }
     function get_min_value(def : tdef) : TConstExprInt;
       begin

Index: htypechk.pas
===================================================================
--- htypechk.pas	(revision 21798)
+++ htypechk.pas	(working copy)
@@ -212,8 +212,31 @@
     function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean;
 
         function internal_check(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype;var allowed:boolean):boolean;
+        const
+          IdentityOperators = [equaln, unequaln];
+          OrderTheoreticOperators = IdentityOperators + [ltn, lten, gtn, gten];
+          ArithmeticOperators = [addn, subn, muln, divn, modn];
+          RationalOperators = [addn, subn, muln, slashn];
+          NumericalOperators = ArithmeticOperators + [slashn];
+          PointerArithmeticOperators = [addn, subn];
+          LogicalOperators = [andn, orn, xorn];
+          BitManipulationOperators = LogicalOperators + [shln, shrn];
+          SetSetOperators = IdentityOperators + [addn, subn, muln, symdifn] +
+            OrderTheoreticOperators;
+          ElementSetOperators = [inn];
+          StringComparisonOperators = OrderTheoreticOperators;
+          StringManipulationOperators = [addn];
+          StringOperators =
+            StringComparisonOperators + StringManipulationOperators;
         begin
           internal_check:=true;
+
+          { Reject the cases permitted by the default interpretation (DI). }
           case ld.typ of
             formaldef,
             recorddef,
@@ -221,6 +244,83 @@
               begin
                 allowed:=true;
               end;
+            enumdef:
+              begin
+                allowed := not (
+                    (is_set(rd) and (treetyp in ElementSetOperators)) or
+                    (is_enum(rd) and (treetyp in (
+                        OrderTheoreticOperators + [addn, subn]
+                      )))
+                  );
+              end;
+            setdef:
+              begin
+                allowed := not (
+                    (is_set(rd) and (treetyp in (
+                        SetSetOperators + IdentityOperators
+                      ))) or
+                    ((rd.typ in [enumdef, orddef]) and (treetyp = addn))
+                      { This clause is a hack but it’s due to a hack somewhere
+                        else---while set + element is not permitted by DI, it
+                        seems to be used when a set is constructed inline }
+                  );
+              end;
+            orddef, floatdef:
+              begin
+                allowed := not (
+                    ((rd.typ in [orddef, floatdef]) and
+                      (treetyp in OrderTheoreticOperators)) or
+                    (is_stringlike(rd) and (ld.typ = orddef) and
+                      (treetyp in StringComparisonOperators)) or
+                      { c.f. $(source)\tests\tmacpas5.pp }
+                    ((rd.typ = setdef) and (ld.typ = orddef) and
+                      (treetyp in ElementSetOperators))
+                      { This clause may be too restrictive---not all types under
+                        orddef have a corresponding set type; despite this the
+                        restriction should be very unlikely to become
+                        a practical obstacle, and can be relaxed by simply
+                        adding an extra check on TOrdDef(rd).ordtype }
+                  );
+
+                { Note that Currency can be under either orddef or floatdef;
+                  when it’s under floatdef, is_currency() implies is_float();
+                  when it’s under orddef, is_currency() does NOT imply
+                  is_integer(). }
+                if allowed then begin
+                  if is_anychar(ld) then
+                    allowed := not (
+                        is_stringlike(rd) and (treetyp in StringOperators)
+                      )
+                  else if is_boolean(ld) then
+                    allowed := not (
+                        is_boolean(rd) and (treetyp in LogicalOperators)
+                      )
+                  else if is_integer(ld) or (
+                      (ld.typ = orddef) and is_currency(ld)
+                      { Here ld is Currency but behaves like an integer }
+                    )
+                  then
+                    allowed := not (
+                        ((is_integer(rd) or
+                          ((rd.typ = orddef) and is_currency(rd))) and
+                          (treetyp in (
+                              BitManipulationOperators + NumericalOperators
+                            ))) or
+                        (is_fpu(rd) and (treetyp in RationalOperators)) or
+                        (is_integer(ld) and (rd.typ = pointerdef) and
+                          (treetyp in PointerArithmeticOperators - [subn]))
+                          { When an integer type is used as the first operand in
+                            pointer arithmetic, DI doesn’t accept minus as the
+                            operator (Currency can’t be used in pointer
+                            arithmetic even if it’s under orddef)  }
+                      )
+                  else  { is_fpu(ld) = True }
+                    allowed := not (
+                        (is_fpu(rd) or is_integer(rd) or is_currency(rd)) and
+                          (treetyp in RationalOperators)
+                      );
+                end;
+              end;
             procvardef :
               begin
                 if (rd.typ in [pointerdef,procdef,procvardef]) then
@@ -232,25 +332,44 @@
               end;
             pointerdef :
               begin
-                if ((rd.typ in [orddef,enumdef,pointerdef,classrefdef,procvardef]) or
-                    is_implicit_pointer_object_type(rd)) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
+                { DI permits pointer arithmetic for pointer + pointer, pointer -
+                  integer, pointer - pointer, but not for pointer + pointer.
+                  The last case is only valid in DI when both sides are
+                  stringlike. }
 
-                { don't allow pchar+string }
-                if (is_pchar(ld) or is_pwidechar(ld)) and
-                   ((rd.typ=stringdef) or
-                    is_pchar(rd) or
-                    is_pwidechar(rd) or
-                    is_chararray(rd) or
-                    is_widechararray(rd)) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
-                allowed:=true;
+                if is_stringlike(ld) then
+                  if is_stringlike(rd) then
+                    { DI in this case permits string operations and pointer
+                      arithmetic. }
+                    allowed := not (treetyp in (
+                        StringOperators + PointerArithmeticOperators
+                      ))
+                  else if rd.typ = pointerdef then
+                    { DI in this case permits minus for pointer arithmetic and
+                      order-theoretic operators for pointer comparison. }
+                    allowed := not (
+                        treetyp in (
+                            PointerArithmeticOperators - [addn] +
+                            OrderTheoreticOperators
+                          )
+                      )
+                  else if is_integer(rd) then
+                    { DI in this case permits pointer arithmetic. }
+                    allowed := not (treetyp in PointerArithmeticOperators)
+                  else
+                    allowed := True
+                else
+                  allowed := not (
+                      (is_integer(rd) and
+                        (treetyp in PointerArithmeticOperators)) or
+                      ((rd.typ = pointerdef) and
+                        (treetyp in (
+                            PointerArithmeticOperators - [addn] +
+                            OrderTheoreticOperators
+                          ))) or
+                      ((lt = niln) and (rd.typ in [procvardef, procdef]) and
+                        (treetyp in IdentityOperators))
+                    );
               end;
             arraydef :
               begin
@@ -263,80 +382,57 @@
                    allowed:=false;
                    exit;
                  end;
-                { not chararray+[(wide)char,(wide)string,(wide)chararray] }
-                if (is_chararray(ld) or is_widechararray(ld) or
-                    is_open_chararray(ld) or is_open_widechararray(ld))
-                   and
-                   ((rd.typ in [stringdef,orddef,enumdef]) or
-                    is_pchar(rd) or
-                    is_pwidechar(rd) or
-                    is_chararray(rd) or
-                    is_widechararray(rd) or
-                    is_open_chararray(rd) or
-                    is_open_widechararray(rd) or
-                    (rt=niln)) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
+
+                if is_stringlike(ld) and (
+                    ((is_stringlike(rd) or (rt = niln)) and
+                      (treetyp in StringOperators)) or
+                    (is_integer(rd)
+                      and (treetyp in PointerArithmeticOperators)) or
+                    ((is_pchar(rd) or is_pwidechar(rd)) and
+                      (treetyp in PointerArithmeticOperators) and
+                      (TPointerDef(rd).pointeddef = TArrayDef(ld).elementdef))
+                  )
+                then begin
+                  allowed := False;
+                  Exit;
+                end;
+
                 { dynamic array compare with niln }
-                if ((is_dynamic_array(ld) and
-                   (rt=niln)) or
-                   (is_dynamic_array(ld) and is_dynamic_array(rd)))
-                   and
-                   (treetyp in [equaln,unequaln]) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
+                if is_dynamic_array(ld) and (treetyp in IdentityOperators) then
+                  if is_dynamic_array(rd) or (rt = niln) then begin
+                    allowed := False;
+                    Exit;
+                  end;
+
                 allowed:=true;
               end;
             objectdef :
               begin
                 { <> and = are defined for implicit pointer object types }
-                if (treetyp in [equaln,unequaln]) and
-                   is_implicit_pointer_object_type(ld) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
-                allowed:=true;
+                allowed := not (
+                    is_implicit_pointer_object_type(ld) and
+                    ((is_implicit_pointer_object_type(rd) or
+                      (rd.typ = pointerdef) or (rt = niln))) and
+                    (treetyp in IdentityOperators)
+                  );
               end;
             stringdef :
               begin
-                if (rd.typ in [orddef,enumdef,stringdef]) or
-                   is_pchar(rd) or
-                   is_pwidechar(rd) or
-                   is_chararray(rd) or
-                   is_widechararray(rd) or
-                   is_open_chararray(rd) or
-                   is_open_widechararray(rd) then
-                 begin
-                   allowed:=false;
-                   exit;
-                 end;
-                allowed:=true;
+                allowed := not (
+                    is_stringlike(rd) and (treetyp in StringOperators)
+                  );
               end;
             else
               internal_check:=false;
           end;
         end;
 
-      var
-        allowed : boolean;
       begin
         { power ** is always possible }
-        if (treetyp=starstarn) then
-         begin
-           isbinaryoperatoroverloadable:=true;
-           exit;
-         end;
-        { order of arguments does not matter so we have to check also
-          the reversed order }
-        allowed:=false;
-        if not internal_check(treetyp,ld,lt,rd,rt,allowed) then
-          internal_check(treetyp,rd,rt,ld,lt,allowed);
-        isbinaryoperatoroverloadable:=allowed;
+        Result := treetyp = starstarn;
+        if not Result then
+          if not internal_check(treetyp, ld, lt, rd, rt, Result) then
+            Result := False;
       end;
 
 
@@ -366,8 +462,7 @@
 
           notn :
             begin
-              if (ld.typ in [orddef,enumdef,floatdef]) then
-                exit;
+              if ld.typ = orddef then exit;
 
 {$ifdef SUPPORT_MMX}
               if (cs_mmx in current_settings.localswitches) and
Index: defutil.pas
===================================================================
--- defutil.pas	(revision 21798)
+++ defutil.pas	(working copy)
@@ -46,6 +46,16 @@
     {# Returns true, if definition defines a string type }
     function is_string(def : tdef): boolean;
 
+    {# Returns True, if definition defines a type that behaves like a string,
+       namely that can be joined and compared with another string-like type }
+    function is_stringlike(def: TDef): Boolean;
+
+    {# Returns True, if definition defines an enumeration type }
+    function is_enum(def: TDef): Boolean;
+
+    {# Returns True, if definition defines a set type }
+    function is_set(def: TDef): Boolean;
+
     {# Returns the minimal integer value of the type }
     function get_min_value(def : tdef) : TConstExprInt;
 
@@ -405,7 +415,23 @@
         is_string := (assigned(def) and (def.typ = stringdef));
       end;
 
+    function is_stringlike(def: TDef): Boolean;
+    begin
+      Result := is_string(def) or is_anychar(def) or is_pchar(def) or
+        is_pwidechar(def) or is_chararray(def) or is_widechararray(def) or
+        is_open_chararray(def) or is_open_widechararray(def);
+    end;
 
+    function is_enum(def: TDef): Boolean;
+    begin
+      Result := def.typ = enumdef;
+    end;
+
+    function is_set(def: TDef): Boolean;
+    begin
+      Result := def.typ = setdef;
+    end;
+
     { returns the min. value of the type }
     function get_min_value(def : tdef) : TConstExprInt;
       begin