Commit 97ac2d62 by Arnaud Charlet

Minor reformatting.

From-SVN: r247476
parent 1804faa4
...@@ -4047,45 +4047,45 @@ package body Checks is ...@@ -4047,45 +4047,45 @@ package body Checks is
Comp : Node_Id := Empty; Comp : Node_Id := Empty;
Array_Comp : Boolean := False) Array_Comp : Boolean := False)
is is
Error_Node : Node_Id; Has_Null : constant Boolean := Has_Null_Exclusion (N);
Expr : Node_Id; Kind : constant Node_Kind := Nkind (N);
Has_Null : constant Boolean := Has_Null_Exclusion (N); Error_Nod : Node_Id;
K : constant Node_Kind := Nkind (N); Expr : Node_Id;
Typ : Entity_Id; Typ : Entity_Id;
begin begin
pragma Assert pragma Assert
(Nkind_In (K, N_Component_Declaration, (Nkind_In (Kind, N_Component_Declaration,
N_Discriminant_Specification, N_Discriminant_Specification,
N_Function_Specification, N_Function_Specification,
N_Object_Declaration, N_Object_Declaration,
N_Parameter_Specification)); N_Parameter_Specification));
if K = N_Function_Specification then if Kind = N_Function_Specification then
Typ := Etype (Defining_Entity (N)); Typ := Etype (Defining_Entity (N));
else else
Typ := Etype (Defining_Identifier (N)); Typ := Etype (Defining_Identifier (N));
end if; end if;
case K is case Kind is
when N_Component_Declaration => when N_Component_Declaration =>
if Present (Access_Definition (Component_Definition (N))) then if Present (Access_Definition (Component_Definition (N))) then
Error_Node := Component_Definition (N); Error_Nod := Component_Definition (N);
else else
Error_Node := Subtype_Indication (Component_Definition (N)); Error_Nod := Subtype_Indication (Component_Definition (N));
end if; end if;
when N_Discriminant_Specification => when N_Discriminant_Specification =>
Error_Node := Discriminant_Type (N); Error_Nod := Discriminant_Type (N);
when N_Function_Specification => when N_Function_Specification =>
Error_Node := Result_Definition (N); Error_Nod := Result_Definition (N);
when N_Object_Declaration => when N_Object_Declaration =>
Error_Node := Object_Definition (N); Error_Nod := Object_Definition (N);
when N_Parameter_Specification => when N_Parameter_Specification =>
Error_Node := Parameter_Type (N); Error_Nod := Parameter_Type (N);
when others => when others =>
raise Program_Error; raise Program_Error;
...@@ -4098,17 +4098,15 @@ package body Checks is ...@@ -4098,17 +4098,15 @@ package body Checks is
if not Is_Access_Type (Typ) then if not Is_Access_Type (Typ) then
Error_Msg_N 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 -- 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. -- be applied to a [sub]type that does not exclude null already.
elsif Can_Never_Be_Null (Typ) elsif Can_Never_Be_Null (Typ) and then Comes_From_Source (Typ) then
and then Comes_From_Source (Typ)
then
Error_Msg_NE Error_Msg_NE
("`NOT NULL` not allowed (& already excludes null)", ("`NOT NULL` not allowed (& already excludes null)",
Error_Node, Typ); Error_Nod, Typ);
end if; end if;
end if; end if;
...@@ -4116,7 +4114,7 @@ package body Checks is ...@@ -4116,7 +4114,7 @@ package body Checks is
-- deferred constants, for which the expression will appear in the full -- deferred constants, for which the expression will appear in the full
-- declaration. -- declaration.
if K = N_Object_Declaration if Kind = N_Object_Declaration
and then No (Expression (N)) and then No (Expression (N))
and then not Constant_Present (N) and then not Constant_Present (N)
and then not No_Initialization (N) and then not No_Initialization (N)
...@@ -4172,11 +4170,11 @@ package body Checks is ...@@ -4172,11 +4170,11 @@ package body Checks is
-- assigned a null value. Otherwise generate a warning message and -- assigned a null value. Otherwise generate a warning message and
-- replace Expression (N) by an N_Constraint_Error node. -- replace Expression (N) by an N_Constraint_Error node.
if K /= N_Function_Specification then if Kind /= N_Function_Specification then
Expr := Expression (N); Expr := Expression (N);
if Present (Expr) and then Known_Null (Expr) then if Present (Expr) and then Known_Null (Expr) then
case K is case Kind is
when N_Component_Declaration when N_Component_Declaration
| N_Discriminant_Specification | N_Discriminant_Specification
=> =>
......
...@@ -3134,8 +3134,8 @@ package body Sem_Ch3 is ...@@ -3134,8 +3134,8 @@ package body Sem_Ch3 is
when N_Derived_Type_Definition => when N_Derived_Type_Definition =>
Derived_Type_Declaration (T, N, T /= Def_Id); Derived_Type_Declaration (T, N, T /= Def_Id);
-- Inherit predicates from parent, and protect against -- Inherit predicates from parent, and protect against illegal
-- illegal derivations. -- derivations.
if Is_Type (T) and then Has_Predicates (T) then if Is_Type (T) and then Has_Predicates (T) then
Set_Has_Predicates (Def_Id); Set_Has_Predicates (Def_Id);
...@@ -3626,12 +3626,17 @@ package body Sem_Ch3 is ...@@ -3626,12 +3626,17 @@ package body Sem_Ch3 is
-- Any other relevant delayed aspects on object declarations ??? -- Any other relevant delayed aspects on object declarations ???
--------------------------
-- Check_Dynamic_Object --
--------------------------
procedure Check_Dynamic_Object (Typ : Entity_Id) is procedure Check_Dynamic_Object (Typ : Entity_Id) is
Comp : Entity_Id; Comp : Entity_Id;
Obj_Type : Entity_Id; Obj_Type : Entity_Id;
begin begin
Obj_Type := Typ; Obj_Type := Typ;
if Is_Private_Type (Obj_Type) if Is_Private_Type (Obj_Type)
and then Present (Full_View (Obj_Type)) and then Present (Full_View (Obj_Type))
then then
...@@ -3656,12 +3661,14 @@ package body Sem_Ch3 is ...@@ -3656,12 +3661,14 @@ package body Sem_Ch3 is
elsif not Discriminated_Size (Comp) elsif not Discriminated_Size (Comp)
and then Comes_From_Source (Comp) and then Comes_From_Source (Comp)
then then
Error_Msg_NE ("component& of non-static size will violate " Error_Msg_NE
& "restriction No_Implicit_Heap_Allocation?", N, Comp); ("component& of non-static size will violate restriction "
& "No_Implicit_Heap_Allocation?", N, Comp);
elsif Is_Record_Type (Etype (Comp)) then elsif Is_Record_Type (Etype (Comp)) then
Check_Dynamic_Object (Etype (Comp)); Check_Dynamic_Object (Etype (Comp));
end if; end if;
Next_Component (Comp); Next_Component (Comp);
end loop; end loop;
end if; end if;
...@@ -3720,10 +3727,16 @@ package body Sem_Ch3 is ...@@ -3720,10 +3727,16 @@ package body Sem_Ch3 is
and then Can_Never_Be_Null (T) and then Can_Never_Be_Null (T)
then then
if Comp_Decl = Obj_Decl 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 else
Null_Exclusion_Static_Checks Null_Exclusion_Static_Checks
(Obj_Decl, Comp_Decl, Array_Comp); (N => Obj_Decl,
Comp => Comp_Decl,
Array_Comp => Array_Comp);
end if; end if;
-- Check array components -- Check array components
......
...@@ -6317,13 +6317,10 @@ package body Sem_Util is ...@@ -6317,13 +6317,10 @@ package body Sem_Util is
------------------------ ------------------------
function Discriminated_Size (Comp : Entity_Id) return Boolean 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; function Non_Static_Bound (Bound : Node_Id) return Boolean;
-- Check whether the bound of an index is non-static and does denote -- Check whether the bound of an index is non-static and does denote
-- a discriminant, in which case any object of the type (protected -- a discriminant, in which case any object of the type (protected or
-- or otherwise) will have a non-static size. -- otherwise) will have a non-static size.
---------------------- ----------------------
-- Non_Static_Bound -- -- Non_Static_Bound --
...@@ -6341,8 +6338,8 @@ package body Sem_Util is ...@@ -6341,8 +6338,8 @@ package body Sem_Util is
elsif Is_Entity_Name (Bound) elsif Is_Entity_Name (Bound)
and then and then
(Ekind (Entity (Bound)) = E_Discriminant (Ekind (Entity (Bound)) = E_Discriminant
or else Present (Discriminal_Link (Entity (Bound)))) or else Present (Discriminal_Link (Entity (Bound))))
then then
return False; return False;
...@@ -6351,6 +6348,11 @@ package body Sem_Util is ...@@ -6351,6 +6348,11 @@ package body Sem_Util is
end if; end if;
end Non_Static_Bound; end Non_Static_Bound;
-- Local variables
Typ : constant Entity_Id := Etype (Comp);
Index : Node_Id;
-- Start of processing for Discriminated_Size -- Start of processing for Discriminated_Size
begin begin
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment