From: Arnaud Charlet Date: Thu, 16 Jul 2020 16:38:10 +0000 (-0400) Subject: [Ada] New warning on not fully initialized box aggregate X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=66b69678563a18c87985456c797b397676094ff0;p=gcc.git [Ada] New warning on not fully initialized box aggregate 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 index 7afe76df10c..1dec48754c4 100644 --- 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 index c98fe761480..47618f64135 100644 --- 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 index 7f16368a599..7e8627aeca8 100644 --- 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 index 82b3d60c977..a9fb55ac973 100644 --- 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 index 61504fa33e7..225db218408 100644 --- 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 index 61312396c63..f7dbf042b7c 100644 --- 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 index 4c8905cf51e..d0a12510305 100644 --- 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 index 9033c52a518..2b98928a59b 100644 --- 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 index 0ae2abd3bac..4f00bd6ce61 100644 --- 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 index 7f274979b8f..b30d35398b5 100644 --- 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 index 22b7be94eff..4d36a84fd75 100644 --- 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 index 95aca9b9269..2945bca78f9 100644 --- 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 index 2edc2e358ac..566a6967bee 100644 --- 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 index eb695617566..e5cdb4f9b11 100644 --- 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 index b0b4e147fe5..cbbc71d4d0b 100644 --- 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 index 78108e99956..d7a8bb0fd5e 100644 --- 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 index ae7c5b7ac89..66ad1e49f5a 100644 --- 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 index b67bb7d5865..89e5696ef01 100644 --- 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 index 918981410e9..e02e4260c45 100644 --- 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;