The warning switch -gnatw.y(.Y) activates(deactivates) a mode in which
information messages are given that show why a package spec requires a
body. This can be useful if you have a large package which unexpectedly
requires a body.
1. package ReqBody is
|
>>> info: "ReqBody" requires body (Elaborate_Body)
2. pragma Elaborate_Body;
3. A : Integer;
4. B : Integer;
5. procedure K;
|
>>> info: "ReqBody" requires body ("K" requires completion)
6. end ReqBody;
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-10-17 Robert Dewar <de...@adacore.com>
* gnat_ugn.texi: Document -gnatw.y/-gnatw.Y.
* opt.ads (List_Body_Required_Info): New flag.
* prep.adb: Minor reformatting.
* sem_ch7.adb (Unit_Requires_Body_Info): New
procedure (Analyze_Package_Specification): Add call to
Unit_Requires_Body_Info.
* ug_words: Add entries for -gnatw.y and -gnatw.Y.
* usage.adb: Add line for new warning switch -gnatw.y/.Y.
* vms_data.ads: Add entry for [NO_]WHY_SPEC_NEEDS_BODY warning
qualifier.
* warnsw.ads, warnsw.adb: Implement new warning switch -gnatw.y/.Y.
Index: sem_ch7.adb
===================================================================
--- sem_ch7.adb (revision 203598)
+++ sem_ch7.adb (working copy)
@@ -136,6 +136,11 @@
-- inherited private operation has been overridden, then it's replaced by
-- the overriding operation.
+ procedure Unit_Requires_Body_Info (P : Entity_Id);
+ -- Outputs info messages showing why package specification P requires a
+ -- body. Caller has checked that the switch requesting this information
+ -- is set, and that the package does indeed require a body.
+
--------------------------
-- Analyze_Package_Body --
--------------------------
@@ -1515,6 +1520,15 @@
("\pragma Elaborate_Body is required in this case", P);
end;
end if;
+
+ -- If switch set, output information on why body required
+
+ if List_Body_Required_Info
+ and then In_Extended_Main_Source_Unit (Id)
+ and then Unit_Requires_Body (Id)
+ then
+ Unit_Requires_Body_Info (Id);
+ end if;
end Analyze_Package_Specification;
--------------------------------------
@@ -1686,8 +1700,8 @@
and then No (Interface_Alias (Node (Op_Elmt_2)))
then
-- The private inherited operation has been
- -- overridden by an explicit subprogram: replace
- -- the former by the latter.
+ -- overridden by an explicit subprogram:
+ -- replace the former by the latter.
New_Op := Node (Op_Elmt_2);
Replace_Elmt (Op_Elmt, New_Op);
@@ -2748,4 +2762,135 @@
return False;
end Unit_Requires_Body;
+ -----------------------------
+ -- Unit_Requires_Body_Info --
+ -----------------------------
+
+ procedure Unit_Requires_Body_Info (P : Entity_Id) is
+ E : Entity_Id;
+
+ begin
+ -- Imported entity never requires body. Right now, only subprograms can
+ -- be imported, but perhaps in the future we will allow import of
+ -- packages.
+
+ if Is_Imported (P) then
+ return;
+
+ -- Body required if library package with pragma Elaborate_Body
+
+ elsif Has_Pragma_Elaborate_Body (P) then
+ Error_Msg_N
+ ("?Y?info: & requires body (Elaborate_Body)", P);
+
+ -- Body required if subprogram
+
+ elsif Is_Subprogram (P) or else Is_Generic_Subprogram (P) then
+ Error_Msg_N ("?Y?info: & requires body (subprogram case)", P);
+
+ -- Body required if generic parent has Elaborate_Body
+
+ elsif Ekind (P) = E_Package
+ and then Nkind (Parent (P)) = N_Package_Specification
+ and then Present (Generic_Parent (Parent (P)))
+ then
+ declare
+ G_P : constant Entity_Id := Generic_Parent (Parent (P));
+ begin
+ if Has_Pragma_Elaborate_Body (G_P) then
+ Error_Msg_N
+ ("?Y?info: & requires body (generic parent Elaborate_Body)",
+ P);
+ end if;
+ end;
+
+ -- A [generic] package that introduces at least one non-null abstract
+ -- state requires completion. However, there is a separate rule that
+ -- requires that such a package have a reason other than this for a
+ -- body being required (if necessary a pragma Elaborate_Body must be
+ -- provided). If Ignore_Abstract_State is True, we don't do this check
+ -- (so we can use Unit_Requires_Body to check for some other reason).
+
+ elsif Ekind_In (P, E_Generic_Package, E_Package)
+ and then Present (Abstract_States (P))
+ and then
+ not Is_Null_State (Node (First_Elmt (Abstract_States (P))))
+ then
+ Error_Msg_N
+ ("?Y?info: & requires body (non-null abstract state aspect)",
+ P);
+ end if;
+
+ -- Otherwise search entity chain for entity requiring completion
+
+ E := First_Entity (P);
+ while Present (E) loop
+
+ -- Always ignore child units. Child units get added to the entity
+ -- list of a parent unit, but are not original entities of the
+ -- parent, and so do not affect whether the parent needs a body.
+
+ if Is_Child_Unit (E) then
+ null;
+
+ -- Ignore formal packages and their renamings
+
+ elsif Ekind (E) = E_Package
+ and then Nkind (Original_Node (Unit_Declaration_Node (E))) =
+ N_Formal_Package_Declaration
+ then
+ null;
+
+ -- Otherwise test to see if entity requires a completion.
+ -- Note that subprogram entities whose declaration does not come
+ -- from source are ignored here on the basis that we assume the
+ -- expander will provide an implicit completion at some point.
+
+ elsif (Is_Overloadable (E)
+ and then Ekind (E) /= E_Enumeration_Literal
+ and then Ekind (E) /= E_Operator
+ and then not Is_Abstract_Subprogram (E)
+ and then not Has_Completion (E)
+ and then Comes_From_Source (Parent (E)))
+
+ or else
+ (Ekind (E) = E_Package
+ and then E /= P
+ and then not Has_Completion (E)
+ and then Unit_Requires_Body (E))
+
+ or else
+ (Ekind (E) = E_Incomplete_Type
+ and then No (Full_View (E))
+ and then not Is_Generic_Type (E))
+
+ or else
+ (Ekind_In (E, E_Task_Type, E_Protected_Type)
+ and then not Has_Completion (E))
+
+ or else
+ (Ekind (E) = E_Generic_Package
+ and then E /= P
+ and then not Has_Completion (E)
+ and then Unit_Requires_Body (E))
+
+ or else
+ (Is_Generic_Subprogram (E)
+ and then not Has_Completion (E))
+
+ then
+ Error_Msg_Node_2 := E;
+ Error_Msg_NE
+ ("?Y?info: & requires body (& requires completion)",
+ E, P);
+
+ -- Entity that does not require completion
+
+ else
+ null;
+ end if;
+
+ Next_Entity (E);
+ end loop;
+ end Unit_Requires_Body_Info;
end Sem_Ch7;
Index: usage.adb
===================================================================
--- usage.adb (revision 203568)
+++ usage.adb (working copy)
@@ -576,6 +576,8 @@
Write_Line (" .X* turn off warnings for non-local exception");
Write_Line (" y*+ turn on warnings for Ada compatibility issues");
Write_Line (" Y turn off warnings for Ada compatibility issues");
+ Write_Line (" .y turn on info messages for why pkg body needed");
+ Write_Line (" .Y* turn off info messages for why pkg body needed");
Write_Line (" z*+ turn on warnings for suspicious " &
"unchecked conversion");
Write_Line (" Z turn off warnings for suspicious " &
Index: prep.adb
===================================================================
--- prep.adb (revision 203747)
+++ prep.adb (working copy)
@@ -284,13 +284,14 @@
end loop;
end if;
- -- And put the value in the result
-
- Result.Is_A_String := False;
-- Even if the value is a string, we still set Is_A_String to False,
-- to avoid adding additional quotes in the preprocessed sources when
-- replacing $<symbol>.
+ Result.Is_A_String := False;
+
+ -- Put the value in the result
+
Start_String;
Store_String_Chars (Definition (Index + 1 .. Definition'Last));
Result.Value := End_String;
Index: ug_words
===================================================================
--- ug_words (revision 203568)
+++ ug_words (working copy)
@@ -204,6 +204,8 @@
-gnatw.X ^ /WARNINGS=NOLOCAL_RAISE_HANDLING
-gnatwy ^ /WARNINGS=ADA_2005_COMPATIBILITY
-gnatwY ^ /WARNINGS=NOADA_2005_COMPATIBILITY
+-gnatw.y ^ /WARNINGS=WHY_SPEC_NEEDS_BODY
+-gnatw.Y ^ /WARNINGS=NOWHY_SPEC_NEEDS_BODY
-gnatwz ^ /WARNINGS=UNCHECKED_CONVERSIONS
-gnatwZ ^ /WARNINGS=NOUNCHECKED_CONVERSIONS
-gnatW8 ^ /WIDE_CHARACTER_ENCODING=UTF8
Index: gnat_ugn.texi
===================================================================
--- gnat_ugn.texi (revision 203747)
+++ gnat_ugn.texi (working copy)
@@ -5738,6 +5738,25 @@
This switch suppresses the warnings intended to help in identifying
incompatibilities between Ada language versions.
+@item -gnatw.y
+@emph{Activate information messages for why package spec needs body}
+@cindex @option{-gnatw.y} (@command{gcc})
+@cindex Package spec needing body
+There are a number of cases in which a package spec needs a body.
+For example, the use of pragma Elaborate_Body, or the declaration
+of a procedure specification requiring a completion. This switch
+causes information messages to be output showing why a package
+specification requires a body. This can be useful in the case of
+a large package specification which is unexpectedly requiring a
+body. The default is that such information messages are not output.
+
+@item -gnatw.Y
+@emph{Disable information messages for why package spec needs body}
+@cindex @option{-gnatw.Y} (@command{gcc})
+@cindex No information messages for why package spec needs body
+This switch suppresses the output of information messages showing why
+a package specification needs a body.
+
@item -gnatwz
@emph{Activate warnings on unchecked conversions.}
@cindex @option{-gnatwz} (@command{gcc})
Index: warnsw.adb
===================================================================
--- warnsw.adb (revision 203568)
+++ warnsw.adb (working copy)
@@ -51,6 +51,8 @@
W.Implementation_Unit_Warnings;
Ineffective_Inline_Warnings :=
W.Ineffective_Inline_Warnings;
+ List_Body_Required_Info :=
+ W.List_Body_Required_Info;
List_Inherited_Aspects :=
W.List_Inherited_Aspects;
Warning_Doc_Switch :=
@@ -145,6 +147,8 @@
Implementation_Unit_Warnings;
W.Ineffective_Inline_Warnings :=
Ineffective_Inline_Warnings;
+ W.List_Body_Required_Info :=
+ List_Body_Required_Info;
W.List_Inherited_Aspects :=
List_Inherited_Aspects;
W.Warning_Doc_Switch :=
@@ -257,6 +261,7 @@
Elab_Warnings := True;
Implementation_Unit_Warnings := True;
Ineffective_Inline_Warnings := True;
+ List_Body_Required_Info := True;
List_Inherited_Aspects := True;
Warning_Doc_Switch := True;
Warn_On_Ada_2005_Compatibility := True;
@@ -386,6 +391,12 @@
Warn_On_Non_Local_Exception := False;
No_Warn_On_Non_Local_Exception := True;
+ when 'y' =>
+ List_Body_Required_Info := True;
+
+ when 'Y' =>
+ List_Body_Required_Info := False;
+
when others =>
if Ignore_Unrecognized_VWY_Switches then
Write_Line ("unrecognized switch -gnatw." & C & " ignored");
@@ -411,6 +422,7 @@
Elab_Warnings := False;
Implementation_Unit_Warnings := False;
Ineffective_Inline_Warnings := True;
+ List_Body_Required_Info := False;
List_Inherited_Aspects := False;
Warning_Doc_Switch := False;
Warn_On_Ada_2005_Compatibility := True;
@@ -492,6 +504,7 @@
Elab_Warnings := False;
Implementation_Unit_Warnings := False;
Ineffective_Inline_Warnings := False;
+ List_Body_Required_Info := False;
List_Inherited_Aspects := False;
Warning_Doc_Switch := False;
Warn_On_Ada_2005_Compatibility := False;
Index: warnsw.ads
===================================================================
--- warnsw.ads (revision 203568)
+++ warnsw.ads (working copy)
@@ -68,6 +68,7 @@
Elab_Warnings : Boolean;
Implementation_Unit_Warnings : Boolean;
Ineffective_Inline_Warnings : Boolean;
+ List_Body_Required_Info : Boolean;
List_Inherited_Aspects : Boolean;
Warning_Doc_Switch : Boolean;
Warn_On_Ada_2005_Compatibility : Boolean;
Index: vms_data.ads
===================================================================
--- vms_data.ads (revision 203568)
+++ vms_data.ads (working copy)
@@ -3222,6 +3222,10 @@
"-gnatwy " &
"NOADA_2005_COMPATIBILITY " &
"-gnatwY " &
+ "WHY_SPEC_NEEDS_BODY " &
+ "-gnatw.y " &
+ "NO_WHY_SPEC_NEEDS_BODY " &
+ "-gnatw.Y " &
"UNCHECKED_CONVERSIONS " &
"-gnatwz " &
"NOUNCHECKED_CONVERSIONS " &
@@ -3487,12 +3491,11 @@
-- VARIABLES_UNINITIALIZED Activates warnings on unassigned variables.
-- Causes warnings to be generated when a variable
-- is accessed which may not be properly
- -- uninitialized.
- -- The default is that such warnings are
- -- generated.
+ -- uninitialized. The default is that such
+ -- warnings are generated.
--
- -- NOVARIABLES_UNINITIALIZED Suppress warnings for uninitialized
- -- variables.
+ -- NOVARIABLES_UNINITIALIZED
+ -- Suppress warnings for uninitialized variables.
--
-- TAG_WARNINGS Causes the string [xxx] to be added to warnings
-- that are controlled by the warning string xxx,
@@ -3500,6 +3503,12 @@
-- by default, the tag is [enabled by default].
--
-- NOTAG_WARNINGS Turns off warning tag output (default setting).
+ --
+ -- WHY_SPEC_NEEDS_BODY Generates information messages showing why a
+ -- package specification requires a body.
+ --
+ -- NO_WHY_SPEC_NEEDS_BODY Turns off information messages showing why a
+ -- package specification requires a body.
S_GCC_WarnX : aliased constant S := "/NOWARNINGS " &
"-gnatws";
Index: opt.ads
===================================================================
--- opt.ads (revision 203568)
+++ opt.ads (working copy)
@@ -841,6 +841,11 @@
-- Set to True to skip compile and bind steps (except when Bind_Only is
-- set to True).
+ List_Body_Required_Info : Boolean := False;
+ -- GNATMAKE
+ -- List info messages about why a package requires a body. Modified by use
+ -- of -gnatw.y/.Y.
+
List_Inherited_Aspects : Boolean := False;
-- GNAT
-- List inherited invariants, preconditions, and postconditions from
