Fix bug21497: do not create an indirection for access to complex type.

Add a type check in mcode for New_Address.

3 files changed, 19 insertions, 0 deletions

diff --git a/ortho/mcode/ortho_code-exprs.adb b/ortho/mcode/ortho_code-exprs.adb
index 4f7140753..b2dfa1a67 100644
--- a/ortho/mcode/ortho_code-exprs.adb
+++ b/ortho/mcode/ortho_code-exprs.adb
@@ -1035,6 +1035,11 @@ package body Ortho_Code.Exprs is
          if Get_Type_Kind (Atype) /= OT_Access then
             raise Syntax_Error;
          end if;
+         if Get_Base_Type (Get_Enode_Type (O_Enode (Lvalue)))
+           /= Get_Base_Type (Get_Type_Access_Type (Atype))
+         then
+            raise Syntax_Error;
+         end if;
          Check_Ref (Lvalue);
       end if;
 
diff --git a/ortho/mcode/ortho_code-types.adb b/ortho/mcode/ortho_code-types.adb
index 79569653d..d15722865 100644
--- a/ortho/mcode/ortho_code-types.adb
+++ b/ortho/mcode/ortho_code-types.adb
@@ -774,6 +774,17 @@ package body Ortho_Code.Types is
       end case;
    end Get_Type_Next;
 
+   function Get_Base_Type (Atype : O_Tnode) return O_Tnode
+   is
+   begin
+      case Get_Type_Kind (Atype) is
+         when OT_Subarray =>
+            return Get_Type_Subarray_Base (Atype);
+         when others =>
+            return Atype;
+      end case;
+   end Get_Base_Type;
+
    procedure Mark (M : out Mark_Type) is
    begin
       M.Tnode := Tnodes.Last;
diff --git a/ortho/mcode/ortho_code-types.ads b/ortho/mcode/ortho_code-types.ads
index c8d8cc03f..86a6c2cd3 100644
--- a/ortho/mcode/ortho_code-types.ads
+++ b/ortho/mcode/ortho_code-types.ads
@@ -149,6 +149,9 @@ package Ortho_Code.Types is
    function New_Constrained_Array_Type (Atype : O_Tnode; Length : Uns32)
      return O_Tnode;
 
+   --  Return the base type of ATYPE: for a subarray this is the uc array,
+   --  otherwise this is the type.
+   function Get_Base_Type (Atype : O_Tnode) return O_Tnode;
 
    type O_Element_List is limited private;