This new warning detect cases of aggregates of the form (others => <>)
where the type doesn't have full default values for all its components.
Refine handling of -gnatwv by not warning when an object of a type with
partial initialization is declared (and used): this generates a better
ratio of useful messages vs uninteresting ones and in particular does
not generate a warning when e.g. a controlled type with effects
performed via Initialize/Finalize is declared.
Fix a few latent bugs along the way related to the use of continuation
lines with no primary line, now visible with the suppressed warning in
a-except.ads.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* sem_aggr.adb (Resolve_Aggregate): Warn on not fully
initialized box aggregate.
* sem_aggr.ads: Fix typo.
* sem_res.adb (Resolve_Actuals): Fix typo in error message
format marking it incorrectly as a continuation message.
* sem_elab.adb (Check_Internal_Call_Continue): Similarly, add
missing primary message in case of a call to an actual generic
subprogram.
* sem_warn.adb (Check_References): Do not warn on read but never
assigned variables if the type is partially initialized.
* libgnat/a-except.ads, libgnat/a-ststun.ads,
libgnat/g-sechas.ads, libgnat/a-cbdlli.ads,
libgnat/a-cfdlli.ads, libgnat/a-cobove.ads,
libgnat/a-cohata.ads, libgnat/a-crbltr.ads,
libgnat/a-cbmutr.ads, libgnat/a-crdlli.ads,
libgnat/a-cbsyqu.ads: Address new warning.
* doc/gnat_ugn/building_executable_programs_with_gnat.rst:
Update doc on -gnatwv.
* gnat_ugn.texi: Regenerate.
gcc/testsuite/
* gnat.dg/opt11.adb: Add new expected warning.diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
--- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
+++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
@@ -3865,8 +3865,14 @@ of the pragma in the :title:`GNAT_Reference_manual`).
This switch activates warnings for access to variables which
may not be properly initialized. The default is that
- such warnings are generated.
+ such warnings are generated. This switch will also be emitted when
+ initializing an array or record object via the following aggregate:
+ .. code-block:: ada
+
+ Array_Or_Record : XXX := (others => <>);
+
+ unless the relevant type fully initializes all components.
.. index:: -gnatwV (gcc)
@@ -3875,17 +3881,6 @@ of the pragma in the :title:`GNAT_Reference_manual`).
This switch suppresses warnings for access to variables which
may not be properly initialized.
- For variables of a composite type, the warning can also be suppressed in
- Ada 2005 by using a default initialization with a box. For example, if
- Table is an array of records whose components are only partially uninitialized,
- then the following code:
-
- .. code-block:: ada
-
- Tab : Table := (others => <>);
-
- will suppress warnings on subsequent statements that access components
- of variable Tab.
.. index:: -gnatw.v (gcc)
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -12224,7 +12224,14 @@ that no warnings are given for comparisons or subranges for any type.
This switch activates warnings for access to variables which
may not be properly initialized. The default is that
-such warnings are generated.
+such warnings are generated. This switch will also be emitted when
+initializing an array or record object via the following aggregate:
+
+@example
+Array_Or_Record : XXX := (others => <>);
+@end example
+
+unless the relevant type fully initializes all components.
@end table
@geindex -gnatwV (gcc)
@@ -12238,17 +12245,6 @@ such warnings are generated.
This switch suppresses warnings for access to variables which
may not be properly initialized.
-For variables of a composite type, the warning can also be suppressed in
-Ada 2005 by using a default initialization with a box. For example, if
-Table is an array of records whose components are only partially uninitialized,
-then the following code:
-
-@example
-Tab : Table := (others => <>);
-@end example
-
-will suppress warnings on subsequent statements that access components
-of variable Tab.
@end table
@geindex -gnatw.v (gcc)
diff --git a/gcc/ada/libgnat/a-cbdlli.ads b/gcc/ada/libgnat/a-cbdlli.ads
--- a/gcc/ada/libgnat/a-cbdlli.ads
+++ b/gcc/ada/libgnat/a-cbdlli.ads
@@ -274,7 +274,7 @@ private
type Node_Array is array (Count_Type range <>) of Node_Type;
type List (Capacity : Count_Type) is tagged record
- Nodes : Node_Array (1 .. Capacity) := (others => <>);
+ Nodes : Node_Array (1 .. Capacity);
Free : Count_Type'Base := -1;
First : Count_Type := 0;
Last : Count_Type := 0;
diff --git a/gcc/ada/libgnat/a-cbmutr.ads b/gcc/ada/libgnat/a-cbmutr.ads
--- a/gcc/ada/libgnat/a-cbmutr.ads
+++ b/gcc/ada/libgnat/a-cbmutr.ads
@@ -303,8 +303,8 @@ private
type Element_Array is array (Count_Type range <>) of aliased Element_Type;
type Tree (Capacity : Count_Type) is tagged record
- Nodes : Tree_Node_Array (0 .. Capacity) := (others => <>);
- Elements : Element_Array (1 .. Capacity) := (others => <>);
+ Nodes : Tree_Node_Array (0 .. Capacity);
+ Elements : Element_Array (1 .. Capacity);
Free : Count_Type'Base := No_Node;
TC : aliased Tamper_Counts;
Count : Count_Type := 0;
diff --git a/gcc/ada/libgnat/a-cbsyqu.ads b/gcc/ada/libgnat/a-cbsyqu.ads
--- a/gcc/ada/libgnat/a-cbsyqu.ads
+++ b/gcc/ada/libgnat/a-cbsyqu.ads
@@ -78,7 +78,7 @@ is
First, Last : Count_Type := 0;
Length : Count_Type := 0;
Max_Length : Count_Type := 0;
- Elements : Element_Array (1 .. Capacity) := (others => <>);
+ Elements : Element_Array (1 .. Capacity);
end record;
end Implementation;
diff --git a/gcc/ada/libgnat/a-cfdlli.ads b/gcc/ada/libgnat/a-cfdlli.ads
--- a/gcc/ada/libgnat/a-cfdlli.ads
+++ b/gcc/ada/libgnat/a-cfdlli.ads
@@ -1617,7 +1617,7 @@ private
Length : Count_Type := 0;
First : Count_Type := 0;
Last : Count_Type := 0;
- Nodes : Node_Array (1 .. Capacity) := (others => <>);
+ Nodes : Node_Array (1 .. Capacity);
end record;
Empty_List : constant List := (0, others => <>);
diff --git a/gcc/ada/libgnat/a-cobove.ads b/gcc/ada/libgnat/a-cobove.ads
--- a/gcc/ada/libgnat/a-cobove.ads
+++ b/gcc/ada/libgnat/a-cobove.ads
@@ -390,7 +390,7 @@ private
function "=" (L, R : Elements_Array) return Boolean is abstract;
type Vector (Capacity : Count_Type) is tagged record
- Elements : Elements_Array (1 .. Capacity) := (others => <>);
+ Elements : Elements_Array (1 .. Capacity);
Last : Extended_Index := No_Index;
TC : aliased Tamper_Counts;
end record with Put_Image => Put_Image;
diff --git a/gcc/ada/libgnat/a-cohata.ads b/gcc/ada/libgnat/a-cohata.ads
--- a/gcc/ada/libgnat/a-cohata.ads
+++ b/gcc/ada/libgnat/a-cohata.ads
@@ -72,7 +72,7 @@ package Ada.Containers.Hash_Tables is
Length : Count_Type := 0;
TC : aliased Helpers.Tamper_Counts;
Free : Count_Type'Base := -1;
- Nodes : Nodes_Type (1 .. Capacity) := (others => <>);
+ Nodes : Nodes_Type (1 .. Capacity);
Buckets : Buckets_Type (1 .. Modulus) := (others => 0);
end record;
diff --git a/gcc/ada/libgnat/a-crbltr.ads b/gcc/ada/libgnat/a-crbltr.ads
--- a/gcc/ada/libgnat/a-crbltr.ads
+++ b/gcc/ada/libgnat/a-crbltr.ads
@@ -60,9 +60,7 @@ package Ada.Containers.Red_Black_Trees is
-- Note that objects of type Tree_Type are logically initialized (in the
-- sense that representation invariants of type are satisfied by dint of
-- default initialization), even without the Nodes component also having
- -- its own initialization expression. We only initializae the Nodes
- -- component here in order to prevent spurious compiler warnings about
- -- the container object not being fully initialized.
+ -- its own initialization expression.
type Tree_Type (Capacity : Count_Type) is tagged record
First : Count_Type := 0;
@@ -71,7 +69,7 @@ package Ada.Containers.Red_Black_Trees is
Length : Count_Type := 0;
TC : aliased Helpers.Tamper_Counts;
Free : Count_Type'Base := -1;
- Nodes : Nodes_Type (1 .. Capacity) := (others => <>);
+ Nodes : Nodes_Type (1 .. Capacity);
end record;
package Implementation is new Helpers.Generic_Implementation;
diff --git a/gcc/ada/libgnat/a-crdlli.ads b/gcc/ada/libgnat/a-crdlli.ads
--- a/gcc/ada/libgnat/a-crdlli.ads
+++ b/gcc/ada/libgnat/a-crdlli.ads
@@ -314,7 +314,7 @@ private
type Node_Array is array (Count_Type range <>) of Node_Type;
type List (Capacity : Count_Type) is tagged limited record
- Nodes : Node_Array (1 .. Capacity) := (others => <>);
+ Nodes : Node_Array (1 .. Capacity);
Free : Count_Type'Base := -1;
First : Count_Type := 0;
Last : Count_Type := 0;
diff --git a/gcc/ada/libgnat/a-except.ads b/gcc/ada/libgnat/a-except.ads
--- a/gcc/ada/libgnat/a-except.ads
+++ b/gcc/ada/libgnat/a-except.ads
@@ -301,6 +301,8 @@ private
pragma Stream_Convert (Exception_Occurrence, String_To_EO, EO_To_String);
-- Functions for implementing Exception_Occurrence stream attributes
+ pragma Warnings (Off, "aggregate not fully initialized");
Null_Occurrence : constant Exception_Occurrence := (others => <>);
+ pragma Warnings (On, "aggregate not fully initialized");
end Ada.Exceptions;
diff --git a/gcc/ada/libgnat/a-ststun.ads b/gcc/ada/libgnat/a-ststun.ads
--- a/gcc/ada/libgnat/a-ststun.ads
+++ b/gcc/ada/libgnat/a-ststun.ads
@@ -71,7 +71,7 @@ private
EA : Stream_Element_Array (1 .. Last);
end record;
- Empty_Elements : aliased Elements_Type := (Last => 0, EA => (others => <>));
+ Empty_Elements : aliased Elements_Type (0);
type Elements_Access is access all Elements_Type;
diff --git a/gcc/ada/libgnat/g-sechas.ads b/gcc/ada/libgnat/g-sechas.ads
--- a/gcc/ada/libgnat/g-sechas.ads
+++ b/gcc/ada/libgnat/g-sechas.ads
@@ -218,7 +218,9 @@ package GNAT.Secure_Hashes is
-- HMAC key
end record;
+ pragma Warnings (Off, "aggregate not fully initialized");
Initial_Context : constant Context (KL => 0) := (others => <>);
+ pragma Warnings (On, "aggregate not fully initialized");
-- Initial values are provided by default initialization of Context
type Hash_Stream (C : access Context) is
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -791,6 +791,31 @@ package body Sem_Aggr is
-- The actual aggregate subtype. This is not necessarily the same as Typ
-- which is the subtype of the context in which the aggregate was found.
+ Others_Box : Boolean := False;
+ -- Set to True if N represents a simple aggregate with only
+ -- (others => <>), not nested as part of another aggregate.
+
+ function Within_Aggregate (N : Node_Id) return Boolean;
+ -- Return True if N is part of an N_Aggregate
+
+ ----------------------
+ -- Within_Aggregate --
+ ----------------------
+
+ function Within_Aggregate (N : Node_Id) return Boolean is
+ P : Node_Id := Parent (N);
+ begin
+ while Present (P) loop
+ if Nkind (P) = N_Aggregate then
+ return True;
+ end if;
+
+ P := Parent (P);
+ end loop;
+
+ return False;
+ end Within_Aggregate;
+
begin
-- Ignore junk empty aggregate resulting from parser error
@@ -811,16 +836,26 @@ package body Sem_Aggr is
and then Present (Component_Associations (N))
then
declare
- Comp : Node_Id;
+ Comp : Node_Id;
+ First_Comp : Boolean := True;
begin
Comp := First (Component_Associations (N));
while Present (Comp) loop
if Box_Present (Comp) then
+ if First_Comp
+ and then No (Expressions (N))
+ and then Nkind (First (Choices (Comp))) = N_Others_Choice
+ and then not Within_Aggregate (N)
+ then
+ Others_Box := True;
+ end if;
+
Insert_Actions (N, Freeze_Entity (Typ, N));
exit;
end if;
+ First_Comp := False;
Next (Comp);
end loop;
end;
@@ -1045,6 +1080,13 @@ package body Sem_Aggr is
Set_Analyzed (N);
end if;
+ if Warn_On_No_Value_Assigned
+ and then Others_Box
+ and then not Is_Fully_Initialized_Type (Etype (N))
+ then
+ Error_Msg_N ("?v?aggregate not fully initialized", N);
+ end if;
+
Check_Function_Writable_Actuals (N);
end Resolve_Aggregate;
diff --git a/gcc/ada/sem_aggr.ads b/gcc/ada/sem_aggr.ads
--- a/gcc/ada/sem_aggr.ads
+++ b/gcc/ada/sem_aggr.ads
@@ -39,7 +39,7 @@ package Sem_Aggr is
-- Returns True is aggregate Aggr consists of a single OTHERS choice
function Is_Single_Aggregate (Aggr : Node_Id) return Boolean;
- -- Returns True is aggregate Aggr consists of a single choice
+ -- Returns True if aggregate Aggr consists of a single choice
-- WARNING: There is a matching C declaration of this subprogram in fe.h
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -18633,16 +18633,17 @@ package body Sem_Elab is
elsif Nkind (N) = N_Attribute_Reference then
Error_Msg_NE
("Access attribute of & before body seen<<", N, Orig_Ent);
- Error_Msg_N ("\possible Program_Error on later references<", N);
+ Error_Msg_N
+ ("\possible Program_Error on later references<<", N);
Insert_Check := False;
elsif Nkind (Unit_Declaration_Node (Orig_Ent)) /=
N_Subprogram_Renaming_Declaration
+ or else Is_Generic_Actual_Subprogram (Orig_Ent)
then
Error_Msg_NE
("cannot call& before body seen<<", N, Orig_Ent);
-
- elsif not Is_Generic_Actual_Subprogram (Orig_Ent) then
+ else
Insert_Check := False;
end if;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -4143,11 +4143,11 @@ package body Sem_Res is
-- types.
if Is_By_Reference_Type (Etype (F))
- or else Is_By_Reference_Type (Expr_Typ)
+ or else Is_By_Reference_Type (Expr_Typ)
then
Error_Msg_N
("view conversion between unrelated by reference "
- & "array types not allowed (\'A'I-00246)", A);
+ & "array types not allowed ('A'I-00246)", A);
-- In Ada 2005 mode, check view conversion component
-- type cannot be private, tagged, or volatile. Note
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -1416,8 +1416,14 @@ package body Sem_Warn is
and then not Warnings_Off_E1
and then not Has_Junk_Name (E1)
then
- Output_Reference_Error
- ("?v?variable& is read but never assigned!");
+ if Is_Access_Type (E1T)
+ or else
+ not Is_Partially_Initialized_Type (E1T, False)
+ then
+ Output_Reference_Error
+ ("?v?variable& is read but never assigned!");
+ end if;
+
May_Need_Initialized_Actual (E1);
end if;
diff --git a/gcc/testsuite/gnat.dg/opt11.adb b/gcc/testsuite/gnat.dg/opt11.adb
--- a/gcc/testsuite/gnat.dg/opt11.adb
+++ b/gcc/testsuite/gnat.dg/opt11.adb
@@ -6,7 +6,7 @@ package body Opt11 is
procedure Proc is
R : Rec;
begin
- R := (others => <>);
+ R := (others => <>); -- { dg-warning "aggregate not fully initialized" }
end;
end Opt11;
