mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 10:50:51 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Robert Dewar 2007-06-06 12:27:26 +02:00 committed by Arnaud Charlet
parent b545a0f665
commit 7d8b9c9990
2 changed files with 195 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
gcc/ada/exp_pakd.adb
View File

@ -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

257
gcc/ada/freeze.adb
View File

@ -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));
Id := 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))
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);