gnat1drv.adb (Gnat1drv): Properly set new flag Opt.Real_VMS_Target

2007-12-06  Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* gnat1drv.adb (Gnat1drv): Properly set new flag Opt.Real_VMS_Target

	* layout.adb (Resolve_Attribute, case 'Access): If designated type of
	context is a limited view, use non-limited view when available. If the
	non-limited view is an unconstrained array, this enforces consistency
	requirements in 3.10.2 (27).
	(Layout_Type): For an access type whose designated type is a limited
	view, examine its declaration to determine if it is an unconstrained
	array, and size the access type accordingly.
	(Layout_Type): Do not force 32-bits for convention c subprogram
	pointers in -gnatdm mode, only if real vms target.

	* sem_attr.adb (Analyze_Access_Attribute): Use new flag
	Has_Pragma_Inline_Always instead of obsolete function Is_Always_Inlined
	(Analyze_Access_Attribute,Attribute_Address): Remove checks for
	violations of the No_Implicit_Dynamic_Code restriction.
	(Resolve_Attribute, case 'Access): If designated type of context is a
	limited view, use non-limited view when available. If the non-limited
	view is an unconstrained array, this enforces consistency requirements
	in 3.10.2 (27).
	(Layout_Type): For an access type whose designated type is a limited
	view, examine its declaration to determine if it is an unconstrained
	array, and size the access type accordingly.

From-SVN: r130840

1 files changed, 35 insertions, 6 deletions

diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb
index f92a37d..a3ed757 100644
--- a/gcc/ada/layout.adb
+++ b/gcc/ada/layout.adb
@@ -2300,6 +2300,8 @@ package body Layout is
    -----------------
 
    procedure Layout_Type (E : Entity_Id) is
+      Desig_Type : Entity_Id;
+
    begin
       --  For string literal types, for now, kill the size always, this
       --  is because gigi does not like or need the size to be set ???
@@ -2321,6 +2323,18 @@ package body Layout is
 
       if Is_Access_Type (E) then
 
+         Desig_Type :=  Underlying_Type (Designated_Type (E));
+
+         --  If we only have a limited view of the type, see whether the
+         --  non-limited view is available.
+
+         if From_With_Type (Designated_Type (E))
+           and then Ekind (Designated_Type (E)) = E_Incomplete_Type
+           and then Present (Non_Limited_View (Designated_Type (E)))
+         then
+            Desig_Type := Non_Limited_View (Designated_Type (E));
+         end if;
+
          --  If Esize already set (e.g. by a size clause), then nothing
          --  further to be done here.
 
@@ -2344,11 +2358,10 @@ package body Layout is
          --  a fat pointer is used (pointer-to-unconstrained array case),
          --  twice the address size to accommodate a fat pointer.
 
-         elsif Present (Underlying_Type (Designated_Type (E)))
-            and then Is_Array_Type (Underlying_Type (Designated_Type (E)))
-            and then not Is_Constrained (Underlying_Type (Designated_Type (E)))
-            and then not Has_Completion_In_Body (Underlying_Type
-                                                 (Designated_Type (E)))
+         elsif Present (Desig_Type)
+            and then Is_Array_Type (Desig_Type)
+            and then not Is_Constrained (Desig_Type)
+            and then not Has_Completion_In_Body (Desig_Type)
             and then not Debug_Flag_6
          then
             Init_Size (E, 2 * System_Address_Size);
@@ -2365,6 +2378,19 @@ package body Layout is
                  ("?this access type does not correspond to C pointer", E);
             end if;
 
+         --  If the designated type is a limited view it is unanalyzed. We
+         --  can examine the declaration itself to determine whether it will
+         --  need a fat pointer.
+
+         elsif Present (Desig_Type)
+            and then Present (Parent (Desig_Type))
+            and then Nkind (Parent (Desig_Type)) = N_Full_Type_Declaration
+            and then
+              Nkind (Type_Definition (Parent (Desig_Type)))
+                 = N_Unconstrained_Array_Definition
+         then
+            Init_Size (E, 2 * System_Address_Size);
+
          --  When the target is AAMP, access-to-subprogram types are fat
          --  pointers consisting of the subprogram address and a static
          --  link (with the exception of library-level access types,
@@ -2395,7 +2421,10 @@ package body Layout is
          --  for this purpose, since it would be weird not to inherit the size
          --  in this case.
 
-         if OpenVMS_On_Target
+         --  We do NOT do this if we are in -gnatdm mode on a non-VMS target
+         --  since in that case we want the normal pointer representation.
+
+         if Opt.True_VMS_Target
            and then (Convention (E) = Convention_C
                       or else
                      Convention (E) = Convention_CPP)