diff mbox

[Ada] Compile-time warnings for uninitialized null-excluding components

Message ID 20170502082625.GA147025@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet May 2, 2017, 8:26 a.m. UTC 
This patch adds an enhancement for detecting and warning about constraint errors
in aggregate types with uninitialized null-excluding components at compile-time.
All composite types without aggregate initialization will now be recursivly
checked for such null-excluding components without default initialization and
extended information about the constraint error will be shown to the user.

------------
-- Source --
------------

--  main.adb

with Types; use Types;

procedure Main is
   Obj_1  : Named_Ptr;       --  OK
   pragma Unused (Obj_1);

   Obj_2  : Named_NE_Ptr;    --  ERROR
   pragma Unused (Obj_2);

   Obj_3  : Anon_Array;      --  OK
   Obj_4  : Anon_NE_Array;   --  ERROR
   Obj_5  : Named_Array;     --  OK
   Obj_6  : Named_NE_Array;  --  ERROR
   Obj_7  : Named_Inc;       --  OK
   pragma Unused (Obj_7);

   Obj_8  : Named_NE_Inc;    --  ERROR
   pragma Unused (Obj_8);

   Obj_9  : Named_Priv;      --  OK
   Obj_10 : Named_NE_Priv ;  --  ERROR
   Obj_11 : Priv_1;          --  OK
   pragma Unused (Obj_11);

   Obj_12 : Priv_2;          --  OK
   Obj_13 : Priv_3;          --  ERROR
   Obj_14 : Priv_4;          --  OK
   Obj_15 : Priv_5;          --  ERROR
   Obj_16 : Priv_6;          --  OK
   Obj_17 : Priv_7;          --  ERROR
   Obj_18 : Priv_8;          --  ERROR
   Obj_19 : Priv_9;          --  ERROR
   Obj_20 : Priv_10;         --  ERROR
   Obj_21 : Prot_1;          --  OK
   Obj_22 : Prot_2;          --  ERROR
   Obj_23 : Prot_3;          --  ERROR
   Obj_24 : Prot_4;          --  ERROR
   Obj_25 : Prot_5;          --  ERROR
   Obj_26 : Rec_1;           --  ERROR
   Obj_27 : Rec_2;           --  ERROR
   Obj_28 : Rec_3;           --  ERROR
   Obj_29 : Rec_4;           --  ERROR
   Obj_30 : Rec_5;           --  ERROR
   Obj_31 : Rec_6;           --  ERROR
   Obj_32 : Rec_7;           --  ERROR
   Obj_33 : Rec_8;           --  ERROR
   Obj_34 : Rec_9;           --  OK
   Obj_35 : Rec_10;          --  ERROR
   Obj_36 : Rec_11;          --  ERROR
   Obj_37 : Rec_12;          --  ERROR
   Obj_38 : Rec_13;          --  ERROR
   Obj_39 : Tag_1;           --  ERROR
   Obj_40 : Tag_2;           --  ERROR
   Obj_41 : Tag_3;           --  ERROR
   Obj_42 : Tag_4;           --  ERROR
   Obj_43 : Task_1;          --  OK
   Obj_44 : Named_Rec_Array; --  ERROR
   Obj_45 : Named_NE_Array_Array;     -- ERROR
   Obj_46 : Rec_14;                   --  ERROR
   Obj_47 : array (1 .. 2) of Rec_14; --  ERROR
begin
   null;
end Main;

--  types.ads

package Types is

   --  Composite  - array [sub]type, concurrent, incomplete, private, record,
   --               string literal subtype

   --  Concurrent - protected [sub]type, task [sub]type
   --  Incomplete - incomplete [sub]type
   --  Private    - [limited] private [sub]type, record [sub]type with private
   --  Record     - class-wide [sub]type, record [sub]type [with private]

   ------------------
   -- Simple types --
   ------------------

   --  Access

   type Named_Ptr is access Integer;
   type Named_NE_Ptr is not null access Integer;

   --  Arrays

   --type Rec_4;
   type Anon_Array      is array (1 .. 2) of access Integer;
   type Anon_NE_Array   is array (1 .. 2) of not null access Integer;
   --type Named_Rec_Array is array (1 .. 2) of Rec_4;
   type Named_Array     is array (1 .. 2) of Named_Ptr;
   type Named_NE_Array  is array (1 .. 2) of Named_NE_Ptr;

   --  Incomplete

   type Named_Inc;
   type Named_NE_Inc;

   type Named_Inc is access Integer;
   type Named_NE_Inc is not null access Integer;

   --  Private

   type Named_Priv is private;
   type Named_NE_Priv is private;

   -------------------
   -- Complex types --
   -------------------

   --  Private

   type Priv_1 is private;
   type Priv_2 is private;
   type Priv_3 is private;
   type Priv_4 is private;
   type Priv_5 is private;
   type Priv_6 is private;
   type Priv_7 is private;
   type Priv_8 is private;
   type Priv_9 is private;
   type Priv_10 is limited private;

   --  Protected

   protected type Prot_1 is
   end Prot_1;

   protected type Prot_2 is
   private
      Comp_1 : Named_Ptr;
      Comp_A : Named_NE_Ptr;
   end Prot_2;

   protected type Prot_3 is
   private
      Comp_1 : Anon_Array;
      Comp_2 : Anon_NE_Array;
   end Prot_3;

   protected type Prot_4 is
   private
      Comp_1 : Named_Array;
      Comp_2 : Named_NE_Ptr;
   end Prot_4;

   protected type Prot_5 is
   private
      Comp_1 : Named_Priv;
      Comp_2 : Named_NE_Priv;
   end Prot_5;

   --  Record

   type Rec_1 is record
      Comp_1 : Named_Ptr;
      Comp_2 : Named_NE_Ptr;
   end record;

   type Rec_2 is record
      Comp_1 : Anon_Array;
      Comp_2 : Anon_NE_Array;
   end record;

   type Rec_3 is record
      Comp_1 : Named_Array;
      Comp_2 : Named_NE_Ptr;
   end record;

   type Rec_4 is record
      Comp_1 : Named_Priv;
      Comp_2 : Named_NE_Priv;
   end record;
   type Named_Rec_Array is array (1 .. 2) of Rec_4;

   type Rec_5 is record
      Comp : Rec_1;
   end record;

   type Rec_6 is record
      Comp : Rec_2;
   end record;

   type Rec_7 is record
      Comp : Rec_3;
   end record;

   type Rec_8 is record
      Comp : Rec_4;
   end record;

   type Rec_9 is record
      Comp : Prot_1;
   end record;

   type Rec_10 is record
      Comp : Prot_2;
   end record;

   type Rec_11 is record
      Comp : Prot_3;
   end record;

   type Rec_12 is record
      Comp : Prot_4;
   end record;

   type Rec_13 is record
      Comp : Prot_5;
   end record;

   type Named_NE_Array_Array is array (1 .. 2) of Named_NE_Array;

   type Rec_14 is record
      Comp : Named_NE_Array_Array;
   end record;

   --  Tagged

   type Tag_1 is tagged record
      Comp_1 : Anon_Array;
      Comp_2 : Rec_8;
   end record;

   type Tag_2 is tagged limited record
      Comp_1 : Named_Priv;
      Comp_2 : Rec_7;
   end record;

   type Tag_3 is tagged limited private;

   type Iface is limited interface;

   type Tag_4 is limited new Iface with private;

   --  Task

   task type Task_1 is
   end Task_1;

private
   -------------------
   --  Simple types --
   -------------------

   --  Private

   type Named_Priv is access Integer;
   type Named_NE_Priv is not null access Integer;

   -------------------
   -- Complex types --
   -------------------

   --  Private

   type Priv_1 is new Integer;
   type Priv_2 is access Integer;
   type Priv_3 is not null access Integer;
   type Priv_4 is array (1 .. 2) of access Integer;
   type Priv_5 is array (1 .. 2) of not null access Integer;
   type Priv_6 is array (1 .. 2) of Named_Ptr;
   type Priv_7 is array (1 .. 2) of Named_NE_Ptr;

   type Priv_8 is record
      Comp_1 : Named_Ptr;
      Comp_2 : Named_NE_Ptr;
   end record;

   type Priv_9 is record
      Comp : Rec_1;
   end record;

   type Priv_10 is limited record
      Comp_1 : Anon_Array;
      Comp_2 : Anon_NE_Array;
   end record;

   --  Tagged

   type Tag_3 is limited new Tag_2 with record
      Comp_3 : Rec_4;
   end record;

   type Tag_4 is limited new Iface with record
      Comp_1 : Named_Array;
      Comp_2 : Tag_3;
   end record;
end Types;

----------------------------
-- Compilation and output --
----------------------------

& gnatmake -q main.adb
main.adb:6:04: warning: (Ada 2005) null-excluding objects must be initialized
main.adb:6:04: warning: "Constraint_Error" will be raised at run time
main.adb:9:04: warning: (Ada 2005) null-excluding objects must be initialized
main.adb:9:04: warning: "Constraint_Error" will be raised at run time
main.adb:11:04: warning: (Ada 2005) null-excluding objects must be initialized
main.adb:11:04: warning: "Constraint_Error" will be raised at run time
main.adb:14:04: warning: (Ada 2005) null-excluding objects must be initialized
main.adb:14:04: warning: "Constraint_Error" will be raised at run time
main.adb:17:04: warning: (Ada 2005) null-excluding component "Obj_10"
of object "Obj_10" must be initialized
main.adb:17:04: warning: "Constraint_Error" will be raised at run time
main.adb:21:04: warning: (Ada 2005) null-excluding component "Obj_13"
of object "Obj_13" must be initialized
main.adb:21:04: warning: "Constraint_Error" will be raised at run time
main.adb:23:04: warning: (Ada 2005) null-excluding objects must be initialized
main.adb:23:04: warning: "Constraint_Error" will be raised at run time
main.adb:25:04: warning: (Ada 2005) null-excluding objects must be initialized
main.adb:25:04: warning: "Constraint_Error" will be raised at run time
main.adb:26:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_18" must be initialized
main.adb:26:04: warning: "Constraint_Error" will be raised at run time
main.adb:27:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_19" must be initialized
main.adb:27:04: warning: "Constraint_Error" will be raised at run time
main.adb:28:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_20" must be initialized
main.adb:28:04: warning: "Constraint_Error" will be raised at run time
main.adb:30:04: warning: (Ada 2005) null-excluding component "Comp_A"
of object "Obj_22" must be initialized
main.adb:30:04: warning: "Constraint_Error" will be raised at run time
main.adb:31:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_23" must be initialized
main.adb:31:04: warning: "Constraint_Error" will be raised at run time
main.adb:32:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_24" must be initialized
main.adb:32:04: warning: "Constraint_Error" will be raised at run time
main.adb:33:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_25" must be initialized
main.adb:33:04: warning: "Constraint_Error" will be raised at run time
main.adb:34:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_26" must be initialized
main.adb:34:04: warning: "Constraint_Error" will be raised at run time
main.adb:35:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_27" must be initialized
main.adb:35:04: warning: "Constraint_Error" will be raised at run time
main.adb:36:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_28" must be initialized
main.adb:36:04: warning: "Constraint_Error" will be raised at run time
main.adb:37:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_29" must be initialized
main.adb:37:04: warning: "Constraint_Error" will be raised at run time
main.adb:38:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_30" must be initialized
main.adb:38:04: warning: "Constraint_Error" will be raised at run time
main.adb:39:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_31" must be initialized
main.adb:39:04: warning: "Constraint_Error" will be raised at run time
main.adb:40:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_32" must be initialized
main.adb:40:04: warning: "Constraint_Error" will be raised at run time
main.adb:41:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_33" must be initialized
main.adb:41:04: warning: "Constraint_Error" will be raised at run time
main.adb:43:04: warning: (Ada 2005) null-excluding component "Comp_A"
of object "Obj_35" must be initialized
main.adb:43:04: warning: "Constraint_Error" will be raised at run time
main.adb:44:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_36" must be initialized
main.adb:44:04: warning: "Constraint_Error" will be raised at run time
main.adb:45:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_37" must be initialized
main.adb:45:04: warning: "Constraint_Error" will be raised at run time
main.adb:46:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_38" must be initialized
main.adb:46:04: warning: "Constraint_Error" will be raised at run time
main.adb:47:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_39" must be initialized
main.adb:47:04: warning: "Constraint_Error" will be raised at run time
main.adb:48:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_40" must be initialized
main.adb:48:04: warning: "Constraint_Error" will be raised at run time
main.adb:49:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_41" must be initialized
main.adb:49:04: warning: "Constraint_Error" will be raised at run time
main.adb:50:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_42" must be initialized
main.adb:50:04: warning: "Constraint_Error" will be raised at run time
main.adb:52:04: warning: (Ada 2005) null-excluding component "Comp_2"
of object "Obj_44" must be initialized
main.adb:52:04: warning: "Constraint_Error" will be raised at run time
main.adb:53:04: warning: (Ada 2005) null-excluding objects must be initialized
main.adb:53:04: warning: "Constraint_Error" will be raised at run time
main.adb:54:04: warning: (Ada 2005) null-excluding component "Comp"
of object "Obj_46" must be initialized
main.adb:54:04: warning: "Constraint_Error" will be raised at run time
main.adb:55:04: warning: (Ada 2005) null-excluding component "Comp"
of object "Obj_47" must be initialized
main.adb:55:04: warning: "Constraint_Error" will be raised at run time
cannot generate code for file types.ads (package spec)
gnatmake: "types.ads" compilation error

Tested on x86_64-pc-linux-gnu, committed on trunk

2017-05-02  Justin Squirek  <squirek@adacore.com>

	* sem_ch3.adb (Check_For_Null_Excluding_Components): Created for
	recursivly searching composite-types for null-excluding access
	types and verifying them.
	(Analyze_Object_Declaration): Add a
	call to Check_Null_Excluding_Components for static verification
	of non-initialized objects.
	* checks.adb, checks.ads (Null_Exclusion_Static_Checks): Added
	a parameter for a composite-type's component and an extra case
	for printing component information.
diff mbox

Patch

Index: checks.adb
===================================================================
--- checks.adb	(revision 247461)
+++ checks.adb	(working copy)
@@ -4037,7 +4037,10 @@ 
    -- Null_Exclusion_Static_Checks --
    ----------------------------------
 
-   procedure Null_Exclusion_Static_Checks (N : Node_Id) is
+   procedure Null_Exclusion_Static_Checks
+     (N    : Node_Id;
+      Comp : Node_Id := Empty)
+   is
       Error_Node : Node_Id;
       Expr       : Node_Id;
       Has_Null   : constant Boolean := Has_Null_Exclusion (N);
@@ -4119,11 +4122,27 @@ 
          Set_Expression (N, Make_Null (Sloc (N)));
          Set_Etype (Expression (N), Etype (Defining_Identifier (N)));
 
-         Apply_Compile_Time_Constraint_Error
-           (N      => Expression (N),
-            Msg    =>
-              "(Ada 2005) null-excluding objects must be initialized??",
-            Reason => CE_Null_Not_Allowed);
+         if Present (Comp) then
+
+            --  Specialize the error message to indicate that we are dealing
+            --  with an uninitialized composite object that has a defaulted
+            --  null-excluding component.
+
+            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);
+         else
+            Apply_Compile_Time_Constraint_Error
+              (N      => Expression (N),
+               Msg    =>
+                 "(Ada 2005) null-excluding objects must be initialized??",
+               Reason => CE_Null_Not_Allowed);
+         end if;
       end if;
 
       --  Check that a null-excluding component, formal or object is not being
Index: checks.ads
===================================================================
--- checks.ads	(revision 247461)
+++ checks.ads	(working copy)
@@ -915,8 +915,14 @@ 
    --  Chars (Related_Id)_FIRST/_LAST. For suggested use of these parameters
    --  see the warning in the body of Sem_Ch3.Process_Range_Expr_In_Decl.
 
-   procedure Null_Exclusion_Static_Checks (N : Node_Id);
+   procedure Null_Exclusion_Static_Checks
+     (N    : Node_Id;
+      Comp : Node_Id := Empty);
    --  Ada 2005 (AI-231): Check bad usages of the null-exclusion issue
+   --
+   --  When a value for Comp is supplied (as in the case of an uninitialized
+   --  null-excluding component within a composite object), a reported error
+   --  will indicate the offending component instead of the object itself.
 
    procedure Remove_Checks (Expr : Node_Id);
    --  Remove all checks from Expr except those that are only executed
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 247461)
+++ sem_ch3.adb	(working copy)
@@ -3588,6 +3588,13 @@ 
 
       Prev_Entity : Entity_Id := Empty;
 
+      procedure Check_For_Null_Excluding_Components
+        (Obj_Typ  : Entity_Id;
+         Obj_Decl : Node_Id);
+      --  Recursively verify that each null-excluding component of an object
+      --  declaration's type has explicit initialization, and generate
+      --  compile-time warnings for each one that does not.
+
       function Count_Tasks (T : Entity_Id) return Uint;
       --  This function is called when a non-generic library level object of a
       --  task type is declared. Its function is to count the static number of
@@ -3607,6 +3614,100 @@ 
 
       --  Any other relevant delayed aspects on object declarations ???
 
+      -----------------------------------------
+      -- Check_For_Null_Excluding_Components --
+      -----------------------------------------
+
+      procedure Check_For_Null_Excluding_Components
+        (Obj_Typ  : Entity_Id;
+         Obj_Decl : Node_Id)
+      is
+
+         procedure Check_Component
+           (Comp_Typ  : Entity_Id;
+            Comp_Decl : Node_Id := Empty);
+         --  Perform compile-time null-exclusion checks on a given component
+         --  and all of its subcomponents, if any.
+
+         ---------------------
+         -- Check_Component --
+         ---------------------
+
+         procedure Check_Component
+           (Comp_Typ  : Entity_Id;
+            Comp_Decl : Node_Id := Empty)
+         is
+            Comp : Entity_Id;
+            T    : Entity_Id;
+
+         begin
+            --  Return without further checking if the component has explicit
+            --  initialization or does not come from source.
+
+            if Present (Comp_Decl) then
+               if not Comes_From_Source (Comp_Decl)
+                 or else Present (Expression (Comp_Decl))
+               then
+                  return;
+               end if;
+            end if;
+
+            if Is_Incomplete_Or_Private_Type (Comp_Typ)
+              and then Present (Full_View (Comp_Typ))
+            then
+               T := Full_View (Comp_Typ);
+            else
+               T := Comp_Typ;
+            end if;
+
+            --  Verify a component of a null-excluding access type
+
+            if Is_Access_Type (T)
+              and then Can_Never_Be_Null (T)
+            then
+               Null_Exclusion_Static_Checks (Obj_Decl, Comp_Decl);
+
+            --  Check array type components
+
+            elsif Is_Array_Type (T) then
+               --  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.
+
+               if Comp_Decl = Obj_Decl then
+                  Check_Component (Component_Type (T));
+               else
+                  Check_Component (Component_Type (T), Comp_Decl);
+               end if;
+
+            --  If T allows named components, then iterate through them,
+            --  recursively verifying all subcomponents.
+
+            --  NOTE: Due to the complexities involved with checking components
+            --  of nontrivial types with discriminants (variant records and
+            --  the like), no static checking is performed on them. ???
+
+            elsif (Is_Concurrent_Type (T)
+                    or else Is_Incomplete_Or_Private_Type (T)
+                    or else Is_Record_Type (T))
+               and then not Has_Discriminants (T)
+            then
+               Comp := First_Component (T);
+               while Present (Comp) loop
+                  Check_Component (Etype (Comp), Parent (Comp));
+
+                  Comp := Next_Component (Comp);
+               end loop;
+            end if;
+         end Check_Component;
+
+      --  Start processing for Check_For_Null_Excluding_Components
+
+      begin
+         Check_Component (Obj_Typ, Obj_Decl);
+      end Check_For_Null_Excluding_Components;
+
       -----------------
       -- Count_Tasks --
       -----------------
@@ -3808,25 +3909,34 @@ 
       --  Ada 2005 (AI-231): Propagate the null-excluding attribute and carry
       --  out some static checks.
 
-      if Ada_Version >= Ada_2005 and then Can_Never_Be_Null (T) then
-
+      if Ada_Version >= Ada_2005 then
          --  In case of aggregates we must also take care of the correct
          --  initialization of nested aggregates bug this is done at the
          --  point of the analysis of the aggregate (see sem_aggr.adb) ???
 
-         if Present (Expression (N))
-           and then Nkind (Expression (N)) = N_Aggregate
-         then
-            null;
+         if Can_Never_Be_Null (T) then
 
+            if Present (Expression (N))
+              and then Nkind (Expression (N)) = N_Aggregate
+            then
+               null;
+
+            else
+               declare
+                  Save_Typ : constant Entity_Id := Etype (Id);
+               begin
+                  Set_Etype (Id, T); --  Temp. decoration for static checks
+                  Null_Exclusion_Static_Checks (N);
+                  Set_Etype (Id, Save_Typ);
+               end;
+            end if;
+
+         --  We might be dealing with an object of a composite type containing
+         --  null-excluding components without an aggregate, so we must verify
+         --  that such components have default initialization.
+
          else
-            declare
-               Save_Typ : constant Entity_Id := Etype (Id);
-            begin
-               Set_Etype (Id, T); --  Temp. decoration for static checks
-               Null_Exclusion_Static_Checks (N);
-               Set_Etype (Id, Save_Typ);
-            end;
+            Check_For_Null_Excluding_Components (T, N);
          end if;
       end if;