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 <squi...@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.
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;
