Minor reformatting.
From-SVN: r247476
This commit is contained in:
parent
1804faa419
commit
97ac2d62fa
3 changed files with 52 additions and 39 deletions
|
@ -4047,45 +4047,45 @@ package body Checks is
|
|||
Comp : Node_Id := Empty;
|
||||
Array_Comp : Boolean := False)
|
||||
is
|
||||
Error_Node : Node_Id;
|
||||
Expr : Node_Id;
|
||||
Has_Null : constant Boolean := Has_Null_Exclusion (N);
|
||||
K : constant Node_Kind := Nkind (N);
|
||||
Typ : Entity_Id;
|
||||
Has_Null : constant Boolean := Has_Null_Exclusion (N);
|
||||
Kind : constant Node_Kind := Nkind (N);
|
||||
Error_Nod : Node_Id;
|
||||
Expr : Node_Id;
|
||||
Typ : Entity_Id;
|
||||
|
||||
begin
|
||||
pragma Assert
|
||||
(Nkind_In (K, N_Component_Declaration,
|
||||
N_Discriminant_Specification,
|
||||
N_Function_Specification,
|
||||
N_Object_Declaration,
|
||||
N_Parameter_Specification));
|
||||
(Nkind_In (Kind, N_Component_Declaration,
|
||||
N_Discriminant_Specification,
|
||||
N_Function_Specification,
|
||||
N_Object_Declaration,
|
||||
N_Parameter_Specification));
|
||||
|
||||
if K = N_Function_Specification then
|
||||
if Kind = N_Function_Specification then
|
||||
Typ := Etype (Defining_Entity (N));
|
||||
else
|
||||
Typ := Etype (Defining_Identifier (N));
|
||||
end if;
|
||||
|
||||
case K is
|
||||
case Kind is
|
||||
when N_Component_Declaration =>
|
||||
if Present (Access_Definition (Component_Definition (N))) then
|
||||
Error_Node := Component_Definition (N);
|
||||
Error_Nod := Component_Definition (N);
|
||||
else
|
||||
Error_Node := Subtype_Indication (Component_Definition (N));
|
||||
Error_Nod := Subtype_Indication (Component_Definition (N));
|
||||
end if;
|
||||
|
||||
when N_Discriminant_Specification =>
|
||||
Error_Node := Discriminant_Type (N);
|
||||
Error_Nod := Discriminant_Type (N);
|
||||
|
||||
when N_Function_Specification =>
|
||||
Error_Node := Result_Definition (N);
|
||||
Error_Nod := Result_Definition (N);
|
||||
|
||||
when N_Object_Declaration =>
|
||||
Error_Node := Object_Definition (N);
|
||||
Error_Nod := Object_Definition (N);
|
||||
|
||||
when N_Parameter_Specification =>
|
||||
Error_Node := Parameter_Type (N);
|
||||
Error_Nod := Parameter_Type (N);
|
||||
|
||||
when others =>
|
||||
raise Program_Error;
|
||||
|
@ -4098,17 +4098,15 @@ package body Checks is
|
|||
|
||||
if not Is_Access_Type (Typ) then
|
||||
Error_Msg_N
|
||||
("`NOT NULL` allowed only for an access type", Error_Node);
|
||||
("`NOT NULL` allowed only for an access type", Error_Nod);
|
||||
|
||||
-- Enforce legality rule RM 3.10(14/1): A null exclusion can only
|
||||
-- be applied to a [sub]type that does not exclude null already.
|
||||
|
||||
elsif Can_Never_Be_Null (Typ)
|
||||
and then Comes_From_Source (Typ)
|
||||
then
|
||||
elsif Can_Never_Be_Null (Typ) and then Comes_From_Source (Typ) then
|
||||
Error_Msg_NE
|
||||
("`NOT NULL` not allowed (& already excludes null)",
|
||||
Error_Node, Typ);
|
||||
Error_Nod, Typ);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
|
@ -4116,7 +4114,7 @@ package body Checks is
|
|||
-- deferred constants, for which the expression will appear in the full
|
||||
-- declaration.
|
||||
|
||||
if K = N_Object_Declaration
|
||||
if Kind = N_Object_Declaration
|
||||
and then No (Expression (N))
|
||||
and then not Constant_Present (N)
|
||||
and then not No_Initialization (N)
|
||||
|
@ -4172,11 +4170,11 @@ package body Checks is
|
|||
-- assigned a null value. Otherwise generate a warning message and
|
||||
-- replace Expression (N) by an N_Constraint_Error node.
|
||||
|
||||
if K /= N_Function_Specification then
|
||||
if Kind /= N_Function_Specification then
|
||||
Expr := Expression (N);
|
||||
|
||||
if Present (Expr) and then Known_Null (Expr) then
|
||||
case K is
|
||||
case Kind is
|
||||
when N_Component_Declaration
|
||||
| N_Discriminant_Specification
|
||||
=>
|
||||
|
|
|
@ -3134,8 +3134,8 @@ package body Sem_Ch3 is
|
|||
when N_Derived_Type_Definition =>
|
||||
Derived_Type_Declaration (T, N, T /= Def_Id);
|
||||
|
||||
-- Inherit predicates from parent, and protect against
|
||||
-- illegal derivations.
|
||||
-- Inherit predicates from parent, and protect against illegal
|
||||
-- derivations.
|
||||
|
||||
if Is_Type (T) and then Has_Predicates (T) then
|
||||
Set_Has_Predicates (Def_Id);
|
||||
|
@ -3626,12 +3626,17 @@ package body Sem_Ch3 is
|
|||
|
||||
-- Any other relevant delayed aspects on object declarations ???
|
||||
|
||||
--------------------------
|
||||
-- Check_Dynamic_Object --
|
||||
--------------------------
|
||||
|
||||
procedure Check_Dynamic_Object (Typ : Entity_Id) is
|
||||
Comp : Entity_Id;
|
||||
Obj_Type : Entity_Id;
|
||||
|
||||
begin
|
||||
Obj_Type := Typ;
|
||||
|
||||
if Is_Private_Type (Obj_Type)
|
||||
and then Present (Full_View (Obj_Type))
|
||||
then
|
||||
|
@ -3656,12 +3661,14 @@ package body Sem_Ch3 is
|
|||
elsif not Discriminated_Size (Comp)
|
||||
and then Comes_From_Source (Comp)
|
||||
then
|
||||
Error_Msg_NE ("component& of non-static size will violate "
|
||||
& "restriction No_Implicit_Heap_Allocation?", N, Comp);
|
||||
Error_Msg_NE
|
||||
("component& of non-static size will violate restriction "
|
||||
& "No_Implicit_Heap_Allocation?", N, Comp);
|
||||
|
||||
elsif Is_Record_Type (Etype (Comp)) then
|
||||
Check_Dynamic_Object (Etype (Comp));
|
||||
end if;
|
||||
|
||||
Next_Component (Comp);
|
||||
end loop;
|
||||
end if;
|
||||
|
@ -3720,10 +3727,16 @@ package body Sem_Ch3 is
|
|||
and then Can_Never_Be_Null (T)
|
||||
then
|
||||
if Comp_Decl = Obj_Decl then
|
||||
Null_Exclusion_Static_Checks (Obj_Decl, Empty, Array_Comp);
|
||||
Null_Exclusion_Static_Checks
|
||||
(N => Obj_Decl,
|
||||
Comp => Empty,
|
||||
Array_Comp => Array_Comp);
|
||||
|
||||
else
|
||||
Null_Exclusion_Static_Checks
|
||||
(Obj_Decl, Comp_Decl, Array_Comp);
|
||||
(N => Obj_Decl,
|
||||
Comp => Comp_Decl,
|
||||
Array_Comp => Array_Comp);
|
||||
end if;
|
||||
|
||||
-- Check array components
|
||||
|
|
|
@ -6317,13 +6317,10 @@ package body Sem_Util is
|
|||
------------------------
|
||||
|
||||
function Discriminated_Size (Comp : Entity_Id) return Boolean is
|
||||
Typ : constant Entity_Id := Etype (Comp);
|
||||
Index : Node_Id;
|
||||
|
||||
function Non_Static_Bound (Bound : Node_Id) return Boolean;
|
||||
-- Check whether the bound of an index is non-static and does denote
|
||||
-- a discriminant, in which case any object of the type (protected
|
||||
-- or otherwise) will have a non-static size.
|
||||
-- a discriminant, in which case any object of the type (protected or
|
||||
-- otherwise) will have a non-static size.
|
||||
|
||||
----------------------
|
||||
-- Non_Static_Bound --
|
||||
|
@ -6341,8 +6338,8 @@ package body Sem_Util is
|
|||
|
||||
elsif Is_Entity_Name (Bound)
|
||||
and then
|
||||
(Ekind (Entity (Bound)) = E_Discriminant
|
||||
or else Present (Discriminal_Link (Entity (Bound))))
|
||||
(Ekind (Entity (Bound)) = E_Discriminant
|
||||
or else Present (Discriminal_Link (Entity (Bound))))
|
||||
then
|
||||
return False;
|
||||
|
||||
|
@ -6351,6 +6348,11 @@ package body Sem_Util is
|
|||
end if;
|
||||
end Non_Static_Bound;
|
||||
|
||||
-- Local variables
|
||||
|
||||
Typ : constant Entity_Id := Etype (Comp);
|
||||
Index : Node_Id;
|
||||
|
||||
-- Start of processing for Discriminated_Size
|
||||
|
||||
begin
|
||||
|
|
Loading…
Add table
Reference in a new issue