From 62d40a7a4e9d8e16149d274f1370bd3024eb2bd5 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 2 May 2017 10:49:55 +0200 Subject: [PATCH] [multiple changes] 2017-05-02 Eric Botcazou * 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 * 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 --- gcc/ada/ChangeLog | 27 +++++++++++++++++++++++++++ gcc/ada/atree.h | 4 ++-- gcc/ada/checks.adb | 46 +++++++++++++++++++++++++++++++--------------- gcc/ada/checks.ads | 10 +++++++--- gcc/ada/einfo.adb | 11 +++++------ gcc/ada/einfo.ads | 2 +- gcc/ada/sem_ch3.adb | 23 ++++++++++++++++------- 7 files changed, 89 insertions(+), 34 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0d53e03..499d696 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2017-05-02 Eric Botcazou + + * 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 + + * 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 * s-taprop-linux.adb (Prio_To_Linux_Prio): New function to correctly diff --git a/gcc/ada/atree.h b/gcc/ada/atree.h index bad0765..7a38883 100644 --- a/gcc/ada/atree.h +++ b/gcc/ada/atree.h @@ -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) diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index e8f38f9..d4a3aa4 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -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 => diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads index 218bdca..159cdba 100644 --- a/gcc/ada/checks.ads +++ b/gcc/ada/checks.ads @@ -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 diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index bfe96e5..76ab625 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -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 diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 61694bf..f2b9d93 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -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 diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index e92a954..f55e7d4 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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; -- 2.7.4