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

[multiple changes]

Browse Source 
2017-05-02  Eric Botcazou  <ebotcazou@adacore.com>

	* atree.h (Flag290): Add missing terminating parenthesis.
	* einfo.adb (Is_Class_Wide_Clone): Use Flag290.
	(Set_Is_Class_Wide_Clone): Likewise.
	* einfo.ads (Is_Class_Wide_Clone): Likewise.

2017-05-02  Gary Dismukes  <dismukes@adacore.com>

	* checks.ads (Null_Exclusion_Static_Checks): Add Boolean
	parameter Array_Comp to indicate the case of an array object
	with null-excluding components.
	* checks.adb (Null_Exclusion_Static_Checks):
	Call Compile_Time_Constraint_Error instead of
	Apply_Compile_Time_Constraint_Error in the component case. Also
	call that when Array_Comp is True, with an appropriate warning for
	the array component case. Only create an explicit initialization
	by null in the case of an object of a null-excluding access type
	(and no longer do that in the component case).
	* sem_ch3.adb (Check_Component): Add a Boolean parameter
	Array_Comp defaulted to False.	Pass Empty for the Comp
	actual when calling Null_Exclusion_Static_Checks in the case
	where Comp_Decl matches Object_Decl, because we don't have a
	component in that case. In the case of an object or component
	of an array type, pass True for Array_Comp on the recursive call
	to Check_Component.

From-SVN: r247474
This commit is contained in:
Arnaud Charlet 2017-05-02 10:49:55 +02:00
parent d86fb53f20
commit 62d40a7a4e
7 changed files with 89 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
gcc/ada/ChangeLog
View File

@ -1,3 +1,30 @@
2017-05-02 Eric Botcazou <ebotcazou@adacore.com>
* atree.h (Flag290): Add missing terminating parenthesis.
* einfo.adb (Is_Class_Wide_Clone): Use Flag290.
(Set_Is_Class_Wide_Clone): Likewise.
* einfo.ads (Is_Class_Wide_Clone): Likewise.
2017-05-02 Gary Dismukes <dismukes@adacore.com>
* checks.ads (Null_Exclusion_Static_Checks): Add Boolean
parameter Array_Comp to indicate the case of an array object
with null-excluding components.
* checks.adb (Null_Exclusion_Static_Checks):
Call Compile_Time_Constraint_Error instead of
Apply_Compile_Time_Constraint_Error in the component case. Also
call that when Array_Comp is True, with an appropriate warning for
the array component case. Only create an explicit initialization
by null in the case of an object of a null-excluding access type
(and no longer do that in the component case).
* sem_ch3.adb (Check_Component): Add a Boolean parameter
Array_Comp defaulted to False. Pass Empty for the Comp
actual when calling Null_Exclusion_Static_Checks in the case
where Comp_Decl matches Object_Decl, because we don't have a
component in that case. In the case of an object or component
of an array type, pass True for Array_Comp on the recursive call
to Check_Component.
2017-05-02 Bob Duff <duff@adacore.com>
* s-taprop-linux.adb (Prio_To_Linux_Prio): New function to correctly

4
gcc/ada/atree.h
View File

@ -6,7 +6,7 @@
* *
* C Header File *
* *
* Copyright (C) 1992-2016, Free Software Foundation, Inc. *
* Copyright (C) 1992-2017, 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- *
@ -869,7 +869,7 @@ extern Node_Id Current_Error_Node;
#define Flag287(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.in_list)
#define Flag288(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.has_aspects)
#define Flag289(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.rewrite_ins)
#define Flag290(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.analyzed
#define Flag290(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.analyzed)
#define Flag291(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.c_f_s)
#define Flag292(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.error_posted)
#define Flag293(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.flag4)

46
gcc/ada/checks.adb
View File

@ -4043,8 +4043,9 @@ package body Checks is
----------------------------------
procedure Null_Exclusion_Static_Checks
(N : Node_Id;
Comp : Node_Id := Empty)
(N : Node_Id;
Comp : Node_Id := Empty;
Array_Comp : Boolean := False)
is
Error_Node : Node_Id;
Expr : Node_Id;
@ -4120,13 +4121,6 @@ package body Checks is
and then not Constant_Present (N)
and then not No_Initialization (N)
then
-- Add an expression that assigns null. This node is needed by
-- Apply_Compile_Time_Constraint_Error, which will replace this with
-- a Constraint_Error node.
Set_Expression (N, Make_Null (Sloc (N)));
Set_Etype (Expression (N), Etype (Defining_Identifier (N)));
if Present (Comp) then
-- Specialize the warning message to indicate that we are dealing
@ -4136,14 +4130,36 @@ package body Checks is
Error_Msg_Name_1 := Chars (Defining_Identifier (Comp));
Error_Msg_Name_2 := Chars (Defining_Identifier (N));
Apply_Compile_Time_Constraint_Error
(N => Expression (N),
Msg =>
"(Ada 2005) null-excluding component % of object % must be "
& "initialized??",
Reason => CE_Null_Not_Allowed);
Discard_Node
(Compile_Time_Constraint_Error
(N => N,
Msg =>
"(Ada 2005) null-excluding component % of object % must "
& "be initialized??",
Ent => Defining_Identifier (Comp)));
-- This is a case of an array with null-excluding components, so
-- indicate that in the warning.
elsif Array_Comp then
Discard_Node
(Compile_Time_Constraint_Error
(N => N,
Msg =>
"(Ada 2005) null-excluding array components must "
& "be initialized??",
Ent => Defining_Identifier (N)));
-- Normal case of object of a null-excluding access type
else
-- Add an expression that assigns null. This node is needed by
-- Apply_Compile_Time_Constraint_Error, which will replace this
-- with a Constraint_Error node.
Set_Expression (N, Make_Null (Sloc (N)));
Set_Etype (Expression (N), Etype (Defining_Identifier (N)));
Apply_Compile_Time_Constraint_Error
(N => Expression (N),
Msg =>

10
gcc/ada/checks.ads
View File

@ -916,13 +916,17 @@ package Checks is
-- see the warning in the body of Sem_Ch3.Process_Range_Expr_In_Decl.
procedure Null_Exclusion_Static_Checks
(N : Node_Id;
Comp : Node_Id := Empty);
-- Ada 2005 (AI-231): Check bad usages of the null-exclusion issue
(N : Node_Id;
Comp : Node_Id := Empty;
Array_Comp : Boolean := False);
-- Ada 2005 (AI-231): Test for and warn on null-excluding objects or
-- components that will raise an exception due to initialization by null.
--
-- When a value for Comp is supplied (as in the case of an uninitialized
-- null-excluding component within a composite object), a reported warning
-- will indicate the offending component instead of the object itself.
-- Array_Comp being True indicates an array object with null-excluding
-- components, and any reported warning will indicate that.
procedure Remove_Checks (Expr : Node_Id);
-- Remove all checks from Expr except those that are only executed

11
gcc/ada/einfo.adb
View File

@ -603,8 +603,7 @@ package body Einfo is
-- Rewritten_For_C Flag287
-- Predicates_Ignored Flag288
-- Has_Timing_Event Flag289
-- (unused) Flag290 -- ??? flag breaks einfo.h
-- Is_Class_Wide_Clone Flag290
-- Has_Inherited_Invariants Flag291
-- Is_Partial_Invariant_Procedure Flag292
@ -615,10 +614,10 @@ package body Einfo is
-- Is_Entry_Wrapper Flag297
-- Is_Underlying_Full_View Flag298
-- Body_Needed_For_Inlining Flag299
-- Has_Private_Extension Flag300
-- Ignore_SPARK_Mode_Pragmas Flag301
-- Is_Class_Wide_Clone Flag302
-- (unused) Flag302
-- (unused) Flag303
-- (unused) Flag304
-- (unused) Flag305
@ -2134,7 +2133,7 @@ package body Einfo is
function Is_Class_Wide_Clone (Id : E) return B is
begin
return Flag302 (Id);
return Flag290 (Id);
end Is_Class_Wide_Clone;
function Is_Class_Wide_Equivalent_Type (Id : E) return B is
@ -5258,7 +5257,7 @@ package body Einfo is
procedure Set_Is_Class_Wide_Clone (Id : E; V : B := True) is
begin
Set_Flag302 (Id, V);
Set_Flag290 (Id, V);
end Set_Is_Class_Wide_Clone;
procedure Set_Is_Class_Wide_Equivalent_Type (Id : E; V : B := True) is

2
gcc/ada/einfo.ads
View File

@ -2356,7 +2356,7 @@ package Einfo is
-- Defined in all entities. Set only for defining entities of program
-- units that are child units (but False for subunits).
-- Is_Class_Wide_Clone (Flag302)
-- Is_Class_Wide_Clone (Flag290)
-- Defined on subprogram entities. Set for subprograms built in order
-- to implement properly the inheritance of class-wide pre- or post-
-- conditions when the condition contains calls to other primitives

23
gcc/ada/sem_ch3.adb
View File

@ -3648,7 +3648,9 @@ package body Sem_Ch3 is
then
Comp := First_Component (Obj_Type);
while Present (Comp) loop
if Known_Static_Esize (Etype (Comp)) then
if Known_Static_Esize (Etype (Comp))
or else Size_Known_At_Compile_Time (Etype (Comp))
then
null;
elsif not Discriminated_Size (Comp)
@ -3674,8 +3676,9 @@ package body Sem_Ch3 is
Obj_Decl : Node_Id)
is
procedure Check_Component
(Comp_Typ : Entity_Id;
Comp_Decl : Node_Id := Empty);
(Comp_Typ : Entity_Id;
Comp_Decl : Node_Id := Empty;
Array_Comp : Boolean := False);
-- Apply a compile-time null-exclusion check on a component denoted
-- by its declaration Comp_Decl and type Comp_Typ, and all of its
-- subcomponents (if any).
@ -3686,7 +3689,8 @@ package body Sem_Ch3 is
procedure Check_Component
(Comp_Typ : Entity_Id;
Comp_Decl : Node_Id := Empty)
Comp_Decl : Node_Id := Empty;
Array_Comp : Boolean := False)
is
Comp : Entity_Id;
T : Entity_Id;
@ -3715,7 +3719,12 @@ package body Sem_Ch3 is
if Is_Access_Type (T)
and then Can_Never_Be_Null (T)
then
Null_Exclusion_Static_Checks (Obj_Decl, Comp_Decl);
if Comp_Decl = Obj_Decl then
Null_Exclusion_Static_Checks (Obj_Decl, Empty, Array_Comp);
else
Null_Exclusion_Static_Checks
(Obj_Decl, Comp_Decl, Array_Comp);
end if;
-- Check array components
@ -3724,10 +3733,10 @@ package body Sem_Ch3 is
-- There is no suitable component when the object is of an
-- array type. However, a namable component may appear at some
-- point during the recursive inspection, but not at the top
-- level.
-- level. At the top level just indicate array component case.
if Comp_Decl = Obj_Decl then
Check_Component (Component_Type (T));
Check_Component (Component_Type (T), Array_Comp => True);
else
Check_Component (Component_Type (T), Comp_Decl);
end if;