From 7d8b9c9990b3e3cc13303e3dd0057ff87994120b Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Wed, 6 Jun 2007 12:27:26 +0200 Subject: [PATCH] exp_pakd.adb (Expand_Packed_Not): Use RM_Size rather than ESize to compute masking constant... 2007-04-20 Robert Dewar Ed Schonberg * 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 --- gcc/ada/exp_pakd.adb | 34 +++--- gcc/ada/freeze.adb | 259 +++++++++++++++++++++++++++++-------------- 2 files changed, 196 insertions(+), 97 deletions(-) diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index fe2eb369fd1..7e1efa3e30a 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 f7876bafa86..6e448b15305 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); -- 2.30.2