+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
* *
* 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- *
#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)
----------------------------------
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;
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
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 =>
-- 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
-- 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
-- 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
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
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
-- 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
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)
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).
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;
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
-- 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;
projects / gcc.git / commitdiff