[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Tue, 2 May 2017 08:49:55 +0000 (10:49 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 2 May 2017 08:49:55 +0000 (10:49 +0200)
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

gcc/ada/ChangeLog
gcc/ada/atree.h
gcc/ada/checks.adb
gcc/ada/checks.ads
gcc/ada/einfo.adb
gcc/ada/einfo.ads
gcc/ada/sem_ch3.adb

index 0d53e03c9258163b221c67862d263c8db01bcd5b..499d6968b94c365c312fef14b34e4c39ef5dad9b 100644 (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
index bad07652c68d47b1e9585cccf22b30fd579fb9eb..7a388832c951bc940d3daccc613e292db3c0d2a0 100644 (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)
index e8f38f990e38fb2378ef17c1fff3c6aabddf6392..d4a3aa4ee46ff7d554128ea67765b6535a34a27f 100644 (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    =>
index 218bdca9a067ba50ee38b120628093cbd870311d..159cdbaee5e785536f3042cf183ea4bc4001b69f 100644 (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
index bfe96e537dbe15812aa183d3a8ed3036c0b3e229..76ab625ff435b39523fc831a382babddf756655c 100644 (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
index 61694bfec0851fd9ea29083b260779645ad9d716..f2b9d932887db745eaaa71a24ce979a6d76dfb4b 100644 (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
index e92a954fe503ad177096c153bc5324d32e848c45..f55e7d4f8fec6be2c844f0c376440ade9e6ce066 100644 (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;