gnat_ugn.texi: Document -gnatw.y/-gnatw.Y.

2013-10-17  Robert Dewar  <dewar@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.

From-SVN: r203748

10 files changed, 221 insertions, 10 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f7e351b..4a7bc8e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+2013-10-17  Robert Dewar  <dewar@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.
+
 2013-10-17  Yannick Moy  <moy@adacore.com>
 
 	* sem_ch8.adb (Find_Direct_Name): Keep track of assignments for
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 1920c40..2140a62 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -5738,6 +5738,25 @@ This warning can also be turned on using @option{-gnatwa}.
 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})
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 762ba39..06d9a4b 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -841,6 +841,11 @@ package Opt is
    --  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
diff --git a/gcc/ada/prep.adb b/gcc/ada/prep.adb
index 7a5565d..c38234b 100644
--- a/gcc/ada/prep.adb
+++ b/gcc/ada/prep.adb
@@ -284,13 +284,14 @@ package body Prep is
             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;
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 0239fa7..5dde500 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -136,6 +136,11 @@ package body Sem_Ch7 is
    --  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 @@ package body Sem_Ch7 is
               ("\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 @@ package body Sem_Ch7 is
                           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 @@ package body Sem_Ch7 is
       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;
diff --git a/gcc/ada/ug_words b/gcc/ada/ug_words
index e03b422..4899979 100644
--- a/gcc/ada/ug_words
+++ b/gcc/ada/ug_words
@@ -204,6 +204,8 @@ gcc -c          ^ GNAT COMPILE
 -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
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index 2d541c4..3f566f4 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.adb
@@ -576,6 +576,8 @@ begin
    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 " &
diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads
index 3594190..7b0fd2c9 100644
--- a/gcc/ada/vms_data.ads
+++ b/gcc/ada/vms_data.ads
@@ -3222,6 +3222,10 @@ package VMS_Data is
                                                "-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 @@ package VMS_Data is
    --   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 @@ package VMS_Data is
    --                           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";
diff --git a/gcc/ada/warnsw.adb b/gcc/ada/warnsw.adb
index a957138..009b450 100644
--- a/gcc/ada/warnsw.adb
+++ b/gcc/ada/warnsw.adb
@@ -51,6 +51,8 @@ package body Warnsw is
         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 @@ package body Warnsw is
         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 @@ package body Warnsw is
             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 @@ package body Warnsw is
             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 @@ package body Warnsw is
       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 @@ package body Warnsw is
             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;
diff --git a/gcc/ada/warnsw.ads b/gcc/ada/warnsw.ads
index b39f545..0358fd7 100644
--- a/gcc/ada/warnsw.ads
+++ b/gcc/ada/warnsw.ads
@@ -68,6 +68,7 @@ package Warnsw is
       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;