Skip to content

R
riscv-gcc-1
Commit 97ac2d62 by Arnaud Charlet
Options

Minor reformatting. 

From-SVN: r247476
parent 1804faa4
Showing with 52 additions and 39 deletions
gcc/ada/checks.adb
......@@ -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
=>
......
gcc/ada/sem_ch3.adb
......@@ -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
......
gcc/ada/sem_util.adb
......@@ -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
......
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