exp_pakd.adb (Expand_Packed_Not): Use RM_Size rather than ESize to compute masking constant...

2007-04-20  Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* exp_pakd.adb (Expand_Packed_Not): Use RM_Size rather than ESize to
	compute masking constant, since we now set Esize properly to the
	underlying size.
	(Create_Packed_Array_Type): Set proper Esize value adjusted as required
	to match the alignment.
	(Create_Packed_Array_Type): Use Short_Short_Unsigned as base type for
	packed arrays of 8 bits or less.

	* freeze.adb (Freeze_Entity): When freezing the formals of a
	subprogram, freeze the designated type of a parameter of an access type
	only if it is an access parameter.
	Increase size of C convention enumeration object
	(Freeze_Entity, array type case): Make sure Esize value is properly
	adjusted for the alignment if it is known.
	(Freeze_Entity, array type case): When checking bit packed arrays for
	the size being incorrect, check RM_Size, not Esize.
	(Freeze_Record_Type): Check for bad discriminated record convention
	(In_Exp_Body): Return true if the body is generated for a subprogram
	renaming, either an attribute renaming or a renaming as body.
	(Check_Itype): If the designated type of an anonymous access component
	is a non-protected subprogram type, indicate that it is frozen, to
	prevent out-of-scope freeze node at some subsequent call.
	(Freeze_Subprogram): On OpenVMS, reject descriptor passing mechanism
	only if the subprogram is neither imported nor exported, as well as the
	NCA descriptor class if the subprogram is exported.

From-SVN: r125407

2 files changed, 196 insertions, 97 deletions

diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb
index fe2eb36..7e1efa3 100644
--- a/gcc/ada/exp_pakd.adb
+++ b/gcc/ada/exp_pakd.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -30,6 +30,8 @@ with Einfo;    use Einfo;
 with Errout;   use Errout;
 with Exp_Dbug; use Exp_Dbug;
 with Exp_Util; use Exp_Util;
+with Layout;   use Layout;
+with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
 with Rtsfind;  use Rtsfind;
@@ -772,7 +774,7 @@ package body Exp_Pakd is
          end if;
 
          if Scope (Typ) /= Current_Scope then
-            New_Scope (Scope (Typ));
+            Push_Scope (Scope (Typ));
             Pushed_Scope := True;
          end if;
 
@@ -785,15 +787,19 @@ package body Exp_Pakd is
          end if;
 
          --  Set Esize and RM_Size to the actual size of the packed object
-         --  Do not reset RM_Size if already set, as happens in the case
-         --  of a modular type.
+         --  Do not reset RM_Size if already set, as happens in the case of
+         --  a modular type.
 
-         Set_Esize (PAT, PASize);
+         if Unknown_Esize (PAT) then
+            Set_Esize (PAT, PASize);
+         end if;
 
          if Unknown_RM_Size (PAT) then
             Set_RM_Size (PAT, PASize);
          end if;
 
+         Adjust_Esize_Alignment (PAT);
+
          --  Set remaining fields of packed array type
 
          Init_Alignment                (PAT);
@@ -874,7 +880,7 @@ package body Exp_Pakd is
       --  type, since this size clearly belongs to the packed array type. The
       --  size of the conceptual unpacked type is always set to unknown.
 
-      PASize := Esize (Typ);
+      PASize := RM_Size (Typ);
 
       --  Case of an array where at least one index is of an enumeration
       --  type with a non-standard representation, but the component size
@@ -1144,15 +1150,13 @@ package body Exp_Pakd is
                --      range 0 .. 2 ** ((Typ'Length (1)
                --                * ... * Typ'Length (n)) * Csize) - 1;
 
-               --  The bounds are statically known, and btyp is one
-               --  of the unsigned types, depending on the length. If the
-               --  type is its first subtype, i.e. it is a user-defined
-               --  type, no object of the type will be larger, and it is
-               --  worthwhile to use a small unsigned type.
+               --  The bounds are statically known, and btyp is one of the
+               --  unsigned types, depending on the length.
 
-               if Len_Bits <= Standard_Short_Integer_Size
-                 and then First_Subtype (Typ) = Typ
-               then
+               if Len_Bits <= Standard_Short_Short_Integer_Size then
+                  Btyp := RTE (RE_Short_Short_Unsigned);
+
+               elsif Len_Bits <= Standard_Short_Integer_Size then
                   Btyp := RTE (RE_Short_Unsigned);
 
                elsif Len_Bits <= Standard_Integer_Size then
@@ -2200,7 +2204,7 @@ package body Exp_Pakd is
       --  one bits of length equal to the size of this packed type and
       --  rtyp is the actual subtype of the operand
 
-      Lit := Make_Integer_Literal (Loc, 2 ** Esize (PAT) - 1);
+      Lit := Make_Integer_Literal (Loc, 2 ** RM_Size (PAT) - 1);
       Set_Print_In_Hex (Lit);
 
       if not Is_Array_Type (PAT) then
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index f7876ba..6e448b1 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -35,6 +35,7 @@ with Exp_Util; use Exp_Util;
 with Exp_Tss;  use Exp_Tss;
 with Layout;   use Layout;
 with Lib.Xref; use Lib.Xref;
+with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
 with Opt;      use Opt;
@@ -537,7 +538,7 @@ package body Freeze is
             if RM_Size (T) < S then
                Error_Msg_Uint_1 := S;
                Error_Msg_NE
-                 ("size for & is too small, minimum is ^",
+                 ("size for & too small, minimum allowed is ^",
                   Size_Clause (T), T);
 
             elsif Unknown_Esize (T) then
@@ -1148,7 +1149,7 @@ package body Freeze is
               and then not Is_Child_Unit (E)
               and then not Is_Frozen (E)
             then
-               New_Scope (E);
+               Push_Scope (E);
                Install_Visible_Declarations (E);
                Install_Private_Declarations (E);
 
@@ -1162,7 +1163,7 @@ package body Freeze is
                    or else
                  Nkind (Parent (E)) = N_Single_Task_Declaration)
             then
-               New_Scope (E);
+               Push_Scope (E);
                Freeze_All (First_Entity (E), After);
                End_Scope;
 
@@ -1384,18 +1385,15 @@ package body Freeze is
 
       function After_Last_Declaration return Boolean is
          Spec  : constant Node_Id := Parent (Current_Scope);
-
       begin
          if Nkind (Spec) = N_Package_Specification then
             if Present (Private_Declarations (Spec)) then
                return Loc >= Sloc (Last (Private_Declarations (Spec)));
-
             elsif Present (Visible_Declarations (Spec)) then
                return Loc >= Sloc (Last (Visible_Declarations (Spec)));
             else
                return False;
             end if;
-
          else
             return False;
          end if;
@@ -1463,17 +1461,23 @@ package body Freeze is
          --  Set True if we find at least one component with a component
          --  clause (used to warn about useless Bit_Order pragmas).
 
-         procedure Check_Itype (Desig : Entity_Id);
-         --  If the component subtype is an access to a constrained subtype
-         --  of an already frozen type, make the subtype frozen as well. It
-         --  might otherwise be frozen in the wrong scope, and a freeze node
-         --  on subtype has no effect.
+         procedure Check_Itype (Typ : Entity_Id);
+         --  If the component subtype is an access to a constrained subtype of
+         --  an already frozen type, make the subtype frozen as well. It might
+         --  otherwise be frozen in the wrong scope, and a freeze node on
+         --  subtype has no effect. Similarly, if the component subtype is a
+         --  regular (not protected) access to subprogram, set the anonymous
+         --  subprogram type to frozen as well, to prevent an out-of-scope
+         --  freeze node at some eventual point of call. Protected operations
+         --  are handled elsewhere.
 
          -----------------
          -- Check_Itype --
          -----------------
 
-         procedure Check_Itype (Desig : Entity_Id) is
+         procedure Check_Itype (Typ : Entity_Id) is
+            Desig : constant Entity_Id := Designated_Type (Typ);
+
          begin
             if not Is_Frozen (Desig)
               and then Is_Frozen (Base_Type (Desig))
@@ -1481,8 +1485,8 @@ package body Freeze is
                Set_Is_Frozen (Desig);
 
                --  In addition, add an Itype_Reference to ensure that the
-               --  access subtype is elaborated early enough. This cannot
-               --  be done if the subtype may depend on discriminants.
+               --  access subtype is elaborated early enough. This cannot be
+               --  done if the subtype may depend on discriminants.
 
                if Ekind (Comp) = E_Component
                  and then Is_Itype (Etype (Comp))
@@ -1497,16 +1501,21 @@ package body Freeze is
                      Append (IR, Result);
                   end if;
                end if;
+
+            elsif Ekind (Typ) = E_Anonymous_Access_Subprogram_Type
+              and then Convention (Desig) /= Convention_Protected
+            then
+               Set_Is_Frozen (Desig);
             end if;
          end Check_Itype;
 
       --  Start of processing for Freeze_Record_Type
 
       begin
-         --  If this is a subtype of a controlled type, declared without
-         --  a constraint, the _controller may not appear in the component
-         --  list if the parent was not frozen at the point of subtype
-         --  declaration. Inherit the _controller component now.
+         --  If this is a subtype of a controlled type, declared without a
+         --  constraint, the _controller may not appear in the component list
+         --  if the parent was not frozen at the point of subtype declaration.
+         --  Inherit the _controller component now.
 
          if Rec /= Base_Type (Rec)
            and then Has_Controlled_Component (Rec)
@@ -1581,8 +1590,9 @@ package body Freeze is
                      if Inside_A_Generic then
                         null;
 
-                     elsif not Size_Known_At_Compile_Time
-                              (Underlying_Type (Etype (Comp)))
+                     elsif not
+                       Size_Known_At_Compile_Time
+                         (Underlying_Type (Etype (Comp)))
                      then
                         Error_Msg_N
                           ("component clause not allowed for variable " &
@@ -1601,8 +1611,8 @@ package body Freeze is
 
                      Set_Must_Be_On_Byte_Boundary (Rec);
 
-                     --  Check for component clause that is inconsistent
-                     --  with the required byte boundary alignment.
+                     --  Check for component clause that is inconsistent with
+                     --  the required byte boundary alignment.
 
                      if Present (CC)
                        and then Normalized_First_Bit (Comp) mod
@@ -1614,8 +1624,8 @@ package body Freeze is
                      end if;
                   end if;
 
-                  --  If component clause is present, then deal with the
-                  --  non-default bit order case for Ada 95 mode. The required
+                  --  If component clause is present, then deal with the non-
+                  --  default bit order case for Ada 95 mode. The required
                   --  processing for Ada 2005 mode is handled separately after
                   --  processing all components.
 
@@ -1833,7 +1843,7 @@ package body Freeze is
                      end if;
 
                   elsif Is_Itype (Designated_Type (Etype (Comp))) then
-                     Check_Itype (Designated_Type (Etype (Comp)));
+                     Check_Itype (Etype (Comp));
 
                   else
                      Freeze_And_Append
@@ -1844,7 +1854,7 @@ package body Freeze is
             elsif Is_Access_Type (Etype (Comp))
               and then Is_Itype (Designated_Type (Etype (Comp)))
             then
-               Check_Itype (Designated_Type (Etype (Comp)));
+               Check_Itype (Etype (Comp));
 
             elsif Is_Array_Type (Etype (Comp))
               and then Is_Access_Type (Component_Type (Etype (Comp)))
@@ -1980,6 +1990,41 @@ package body Freeze is
                Next_Component (Comp);
             end loop;
          end if;
+
+         --  Generate warning for applying C or C++ convention to a record
+         --  with discriminants. This is suppressed for the unchecked union
+         --  case, since the whole point in this case is interface C.
+
+         if Has_Discriminants (E)
+           and then not Is_Unchecked_Union (E)
+           and then not Warnings_Off (E)
+           and then not Warnings_Off (Base_Type (E))
+           and then (Convention (E) = Convention_C
+                       or else
+                     Convention (E) = Convention_CPP)
+           and then Comes_From_Source (E)
+         then
+            declare
+               Cprag : constant Node_Id := Get_Rep_Pragma (E, Name_Convention);
+               A2    : Node_Id;
+
+            begin
+               if Present (Cprag) then
+                  A2 := Next (First (Pragma_Argument_Associations (Cprag)));
+
+                  if Convention (E) = Convention_C then
+                     Error_Msg_N
+                       ("?variant record has no direct equivalent in C", A2);
+                  else
+                     Error_Msg_N
+                       ("?variant record has no direct equivalent in C++", A2);
+                  end if;
+
+                  Error_Msg_NE
+                    ("\?use of convention for type& is dubious", A2, E);
+               end if;
+            end;
+         end if;
       end Freeze_Record_Type;
 
    --  Start of processing for Freeze_Entity
@@ -2048,7 +2093,7 @@ package body Freeze is
 
       --  Similarly, an inlined instance body may make reference to global
       --  entities, but these references cannot be the proper freezing point
-      --  for them, and the the absence of inlining freezing will take place
+      --  for them, and in the absence of inlining freezing will take place
       --  in their own scope. Normally instance bodies are analyzed after
       --  the enclosing compilation, and everything has been frozen at the
       --  proper place, but with front-end inlining an instance body is
@@ -2056,7 +2101,7 @@ package body Freeze is
       --  out-of-order freezing must be prevented.
 
       elsif Front_End_Inlining
-        and then  In_Instance_Body
+        and then In_Instance_Body
         and then Present (Scope (Test_E))
       then
          declare
@@ -2111,7 +2156,7 @@ package body Freeze is
                --  If expression is an aggregate, assign to a temporary to
                --  ensure that the actual assignment is done atomically rather
                --  than component-wise (the assignment to the temp may be done
-               --  component-wise, but that is harmless.
+               --  component-wise, but that is harmless).
 
                if Nkind (Expr) = N_Aggregate then
                   Expand_Atomic_Aggregate (Expr, Etype (E));
@@ -2271,7 +2316,14 @@ package body Freeze is
                              ("(Ada 2005): invalid use of unconstrained tagged"
                               & " incomplete type", E);
 
-                        elsif Ekind (F_Type) = E_Subprogram_Type then
+                        --  If the formal is an anonymous_access_to_subprogram
+                        --  freeze the  subprogram type as well, to prevent
+                        --  scope anomalies in gigi, because there is no other
+                        --  clear point at which it could be frozen.
+
+                        elsif Is_Itype (Etype (Formal))
+                          and then Ekind (F_Type) = E_Subprogram_Type
+                        then
                            Freeze_And_Append (F_Type, Loc, Result);
                         end if;
                      end if;
@@ -2310,6 +2362,7 @@ package body Freeze is
                      elsif Ekind (Etype (E)) = E_Incomplete_Type
                        and then Is_Tagged_Type (Etype (E))
                        and then No (Full_View (Etype (E)))
+                       and then not Is_Value_Type (Etype (E))
                      then
                         Error_Msg_N
                           ("(Ada 2005): invalid use of tagged incomplete type",
@@ -2333,7 +2386,7 @@ package body Freeze is
 
          else
             --  If entity has a type, and it is not a generic unit, then
-            --  freeze it first (RM 13.14(10))
+            --  freeze it first (RM 13.14(10)).
 
             if Present (Etype (E))
               and then Ekind (E) /= E_Generic_Function
@@ -2362,7 +2415,7 @@ package body Freeze is
                --  for other unrelated reasons). Note that we delayed this
                --  processing till freeze time so that we can be sure not
                --  to set the flag if there is an address clause. If there
-               --  is such a clause, then the only purpose of the import
+               --  is such a clause, then the only purpose of the Import
                --  pragma is to suppress implicit initialization.
 
                if Is_Imported (E)
@@ -2370,10 +2423,31 @@ package body Freeze is
                then
                   Set_Is_Public (E);
                end if;
+
+               --  For convention C objects of an enumeration type, warn if
+               --  the size is not integer size and no explicit size given.
+               --  Skip warning for Boolean, and Character, assume programmer
+               --  expects 8-bit sizes for these cases.
+
+               if (Convention (E) = Convention_C
+                    or else
+                   Convention (E) = Convention_CPP)
+                 and then Is_Enumeration_Type (Etype (E))
+                 and then not Is_Character_Type (Etype (E))
+                 and then not Is_Boolean_Type (Etype (E))
+                 and then Esize (Etype (E)) < Standard_Integer_Size
+                 and then not Has_Size_Clause (E)
+               then
+                  Error_Msg_Uint_1 := UI_From_Int (Standard_Integer_Size);
+                  Error_Msg_N
+                    ("?convention C enumeration object has size less than ^",
+                     E);
+                  Error_Msg_N ("\?use explicit size clause to set size", E);
+               end if;
             end if;
 
             --  Check that a constant which has a pragma Volatile[_Components]
-            --  or Atomic[_Components] also has a pragma Import (RM C.6(13))
+            --  or Atomic[_Components] also has a pragma Import (RM C.6(13)).
 
             --  Note: Atomic[_Components] also sets Volatile[_Components]
 
@@ -2465,7 +2539,7 @@ package body Freeze is
                Freeze_And_Append (Atype, Loc, Result);
 
             --  Otherwise freeze the base type of the entity before
-            --  freezing the entity itself, (RM 13.14(15)).
+            --  freezing the entity itself (RM 13.14(15)).
 
             elsif E /= Base_Type (E) then
                Freeze_And_Append (Base_Type (E), Loc, Result);
@@ -2487,8 +2561,8 @@ package body Freeze is
                Pnod : Node_Id;
 
                Non_Standard_Enum : Boolean := False;
-               --  Set true if any of the index types is an enumeration
-               --  type with a non-standard representation.
+               --  Set true if any of the index types is an enumeration type
+               --  with a non-standard representation.
 
             begin
                Freeze_And_Append (Ctyp, Loc, Result);
@@ -2562,10 +2636,10 @@ package body Freeze is
                            Csiz := Uint_0;
                         end if;
 
-                        --  Set component size up to match alignment if
-                        --  it would otherwise be less than the alignment.
-                        --  This deals with cases of types whose alignment
-                        --  exceeds their sizes (padded types).
+                        --  Set component size up to match alignment if it
+                        --  would otherwise be less than the alignment. This
+                        --  deals with cases of types whose alignment exceeds
+                        --  their size (padded types).
 
                         if Csiz /= 0 then
                            declare
@@ -2586,9 +2660,9 @@ package body Freeze is
 
                         Set_Component_Size (Base_Type (E), Csiz);
 
-                        --  Check for base type of 8,16,32 bits, where the
+                        --  Check for base type of 8, 16, 32 bits, where the
                         --  subtype has a length one less than the base type
-                        --  and is unsigned (e.g. Natural subtype of Integer)
+                        --  and is unsigned (e.g. Natural subtype of Integer).
 
                         --  In such cases, if a component size was not set
                         --  explicitly, then generate a warning.
@@ -2613,8 +2687,8 @@ package body Freeze is
                            end if;
                         end if;
 
-                        --  Actual packing is not needed for 8,16,32,64
-                        --  Also not needed for 24 if alignment is 1
+                        --  Actual packing is not needed for 8, 16, 32, 64.
+                        --  Also not needed for 24 if alignment is 1.
 
                         if        Csiz = 8
                           or else Csiz = 16
@@ -2626,9 +2700,9 @@ package body Freeze is
                            --  the packing request had no effect, so Is_Packed
                            --  is reset.
 
-                           --  Note: semantically this means that we lose
-                           --  track of the fact that a derived type inherited
-                           --  a pack pragma that was non-effective, but that
+                           --  Note: semantically this means that we lose track
+                           --  of the fact that a derived type inherited a
+                           --  pragma Pack that was non-effective, but that
                            --  seems fine.
 
                            --  We regard a Pack pragma as a request to set a
@@ -2654,13 +2728,14 @@ package body Freeze is
 
                   if Unknown_Alignment (E) then
                      Set_Alignment (E, Alignment (Base_Type (E)));
+                     Adjust_Esize_Alignment (E);
                   end if;
                end if;
 
                --  For bit-packed arrays, check the size
 
                if Is_Bit_Packed_Array (E)
-                 and then Known_Esize (E)
+                 and then Known_RM_Size (E)
                then
                   declare
                      Discard : Boolean;
@@ -2668,14 +2743,14 @@ package body Freeze is
 
                   begin
                      --  It is not clear if it is possible to have no size
-                     --  clause at this stage, but this is not worth worrying
-                     --  about. Post the error on the entity name in the size
+                     --  clause at this stage, but it is not worth worrying
+                     --  about. Post error on the entity name in the size
                      --  clause if present, else on the type entity itself.
 
                      if Present (SizC) then
-                        Check_Size (Name (SizC), E, Esize (E), Discard);
+                        Check_Size (Name (SizC), E, RM_Size (E), Discard);
                      else
-                        Check_Size (E, E, Esize (E), Discard);
+                        Check_Size (E, E, RM_Size (E), Discard);
                      end if;
                   end;
                end if;
@@ -2714,15 +2789,15 @@ package body Freeze is
                                     UI_Max (Uint_0, Hiv - Lov + 1);
                            Rsiz : constant Uint := RM_Size (Ctyp);
 
-                        --  What we are looking for here is the situation
-                        --  where the Esize given would be exactly right
-                        --  if there was a pragma Pack (resulting in the
-                        --  component size being the same as the RM_Size).
-                        --  Furthermore, the component type size must be
-                        --  an odd size (not a multiple of storage unit)
+                        --  What we are looking for here is the situation where
+                        --  the RM_Size given would be exactly right if there
+                        --  was a pragma Pack (resulting in the component size
+                        --  being the same as the RM_Size). Furthermore, the
+                        --  component type size must be an odd size (not a
+                        --  multiple of storage unit)
 
                         begin
-                           if Esize (E) = Len * Rsiz
+                           if RM_Size (E) = Len * Rsiz
                              and then Rsiz mod System_Storage_Unit /= 0
                            then
                               Error_Msg_NE
@@ -3004,6 +3079,7 @@ package body Freeze is
             if Ekind (Etype (E)) = E_Incomplete_Type
               and then Is_Tagged_Type (Etype (E))
               and then No (Full_View (Etype (E)))
+              and then not Is_Value_Type (Etype (E))
             then
                Error_Msg_N
                  ("(Ada 2005): invalid use of tagged incomplete type", E);
@@ -3034,6 +3110,7 @@ package body Freeze is
                if Ekind (Etyp) = E_Incomplete_Type
                  and then Is_Tagged_Type (Etyp)
                  and then No (Full_View (Etyp))
+                 and then not Is_Value_Type (Etype (E))
                then
                   Error_Msg_N
                     ("(Ada 2005): invalid use of tagged incomplete type", E);
@@ -3069,24 +3146,24 @@ package body Freeze is
                if Small_Value (E) < Ureal_2_M_80 then
                   Error_Msg_Name_1 := Name_Small;
                   Error_Msg_N
-                    ("`&''%` is too small, minimum is 2.0'*'*(-80)", E);
+                    ("`&''%` too small, minimum allowed is 2.0'*'*(-80)", E);
 
                elsif Small_Value (E) > Ureal_2_80 then
                   Error_Msg_Name_1 := Name_Small;
                   Error_Msg_N
-                    ("`&''%` is too large, maximum is 2.0'*'*80", E);
+                    ("`&''%` too large, maximum allowed is 2.0'*'*80", E);
                end if;
 
                if Expr_Value_R (Type_Low_Bound (E)) < Ureal_M_10_36 then
                   Error_Msg_Name_1 := Name_First;
                   Error_Msg_N
-                    ("`&''%` is too small, minimum is -10.0'*'*36", E);
+                    ("`&''%` too small, minimum allowed is -10.0'*'*36", E);
                end if;
 
                if Expr_Value_R (Type_High_Bound (E)) > Ureal_10_36 then
                   Error_Msg_Name_1 := Name_Last;
                   Error_Msg_N
-                    ("`&''%` is too large, maximum is 10.0'*'*36", E);
+                    ("`&''%` too large, maximum allowed is 10.0'*'*36", E);
                end if;
             end if;
 
@@ -3214,7 +3291,7 @@ package body Freeze is
 
          --  Now that all types from which E may depend are frozen, see if the
          --  size is known at compile time, if it must be unsigned, or if
-         --  strict alignent is required
+         --  strict alignment is required
 
          Check_Compile_Time_Size (E);
          Check_Unsigned_Type (E);
@@ -3418,15 +3495,16 @@ package body Freeze is
       function In_Exp_Body (N : Node_Id) return Boolean;
       --  Given an N_Handled_Sequence_Of_Statements node N, determines whether
       --  it is the handled statement sequence of an expander-generated
-      --  subprogram (init proc, or stream subprogram). If so, it returns
-      --  True, otherwise False.
+      --  subprogram (init proc, stream subprogram, or renaming as body).
+      --  If so, this is not a freezing context.
 
       -----------------
       -- In_Exp_Body --
       -----------------
 
       function In_Exp_Body (N : Node_Id) return Boolean is
-         P : Node_Id;
+         P  : Node_Id;
+         Id : Entity_Id;
 
       begin
          if Nkind (N) = N_Subprogram_Body then
@@ -3439,14 +3517,16 @@ package body Freeze is
             return False;
 
          else
-            P := Defining_Unit_Name (Specification (P));
-
-            if Nkind (P) = N_Defining_Identifier
-              and then (Is_Init_Proc (P)              or else
-                        Is_TSS (P, TSS_Stream_Input)  or else
-                        Is_TSS (P, TSS_Stream_Output) or else
-                        Is_TSS (P, TSS_Stream_Read)   or else
-                        Is_TSS (P, TSS_Stream_Write))
+            Id := Defining_Unit_Name (Specification (P));
+
+            if Nkind (Id) = N_Defining_Identifier
+              and then (Is_Init_Proc (Id)              or else
+                        Is_TSS (Id, TSS_Stream_Input)  or else
+                        Is_TSS (Id, TSS_Stream_Output) or else
+                        Is_TSS (Id, TSS_Stream_Read)   or else
+                        Is_TSS (Id, TSS_Stream_Write)  or else
+                        Nkind (Original_Node (P)) =
+                          N_Subprogram_Renaming_Declaration)
             then
                return True;
             else
@@ -4202,7 +4282,8 @@ package body Freeze is
       if Actual_Size > 64 then
          Error_Msg_Uint_1 := UI_From_Int (Actual_Size);
          Error_Msg_N
-           ("size required (^) for type& too large, maximum is 64", Typ);
+           ("size required (^) for type& too large, maximum allowed is 64",
+            Typ);
          Actual_Size := 64;
       end if;
 
@@ -4213,7 +4294,7 @@ package body Freeze is
             Error_Msg_Uint_1 := RM_Size (Typ);
             Error_Msg_Uint_2 := UI_From_Int (Actual_Size);
             Error_Msg_NE
-              ("size given (^) for type& too small, minimum is ^",
+              ("size given (^) for type& too small, minimum allowed is ^",
                Size_Clause (Typ), Typ);
 
          else
@@ -4304,7 +4385,7 @@ package body Freeze is
                Error_Msg_Uint_1 := RM_Size (Typ);
                Error_Msg_Uint_2 := Minsiz;
                Error_Msg_NE
-                 ("size given (^) for type& too small, minimum is ^",
+                 ("size given (^) for type& too small, minimum allowed is ^",
                   Size_Clause (Typ), Typ);
             end if;
 
@@ -4624,17 +4705,31 @@ package body Freeze is
       end if;
 
       --  For VMS, descriptor mechanisms for parameters are allowed only
-      --  for imported subprograms.
+      --  for imported/exported subprograms.  Moreover, the NCA descriptor
+      --  is not allowed for parameters of exported subprograms.
 
       if OpenVMS_On_Target then
-         if not Is_Imported (E) then
+         if Is_Exported (E) then
+            F := First_Formal (E);
+            while Present (F) loop
+               if Mechanism (F) = By_Descriptor_NCA then
+                  Error_Msg_N
+                    ("'N'C'A' descriptor for parameter not permitted", F);
+                  Error_Msg_N
+                    ("\can only be used for imported subprogram", F);
+               end if;
+
+               Next_Formal (F);
+            end loop;
+
+         elsif not Is_Imported (E) then
             F := First_Formal (E);
             while Present (F) loop
                if Mechanism (F) in Descriptor_Codes then
                   Error_Msg_N
                     ("descriptor mechanism for parameter not permitted", F);
                   Error_Msg_N
-                    ("\can only be used for imported subprogram", F);
+                    ("\can only be used for imported/exported subprogram", F);
                end if;
 
                Next_Formal (F);