]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
gnat_ugn.texi: Document -gnatw.y/-gnatw.Y.
authorRobert Dewar <dewar@adacore.com>
Thu, 17 Oct 2013 10:36:08 +0000 (10:36 +0000)
committerArnaud Charlet <charlet@gcc.gnu.org>
Thu, 17 Oct 2013 10:36:08 +0000 (12:36 +0200)
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

gcc/ada/ChangeLog
gcc/ada/gnat_ugn.texi
gcc/ada/opt.ads
gcc/ada/prep.adb
gcc/ada/sem_ch7.adb
gcc/ada/ug_words
gcc/ada/usage.adb
gcc/ada/vms_data.ads
gcc/ada/warnsw.adb
gcc/ada/warnsw.ads

index f7e351b801619cd329a445f6b67e8716b23a4829..4a7bc8e34ea5cb01886d27c852150c4f2405a894 100644 (file)
@@ -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
index 1920c40b989efcbdec99d656bad9985f1e42e480..2140a62eea45240e155b363d00638cdc1480872b 100644 (file)
@@ -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})
index 762ba3959b48367cdb2ba088f07635e862e8e920..06d9a4bcbabfb22cef5e77c07051eb910c310c03 100644 (file)
@@ -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
index 7a5565d6b6da7bd3a1c1a890c46a99082b9e952f..c38234b052e6ae71bc84b3b13ddeb0d23f9f8d62 100644 (file)
@@ -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;
index 0239fa76d4b9de1f8a8dfc8c7b31f9498c0433d5..5dde5002cb00e116d1da459d31de8cecf749ec49 100644 (file)
@@ -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;
index e03b422aadf5d367a85b76e9d2125f3d84d22027..48999791e6258dcda6e0959570af14430c53ca9b 100644 (file)
@@ -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
index 2d541c4ae6642a08de2ec1e4206b53f2eb6f4675..3f566f47fb5687b76ae51adc8635d524e727d885 100644 (file)
@@ -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 " &
index 359419002e628b4af2a845794e69957be4439e5b..7b0fd2c95ec2a4b6144df0f4da6da28d6269c771 100644 (file)
@@ -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";
index a957138bdeda8ecd9c301d16163183e042acd6b4..009b450784c52eb544e822a7cf54505abecaa483 100644 (file)
@@ -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;
index b39f545802dfe1eb3e4af08e1763b5f1cf2d856c..0358fd77d4fbdb9a9cf66a851ff550fcba1672bc 100644 (file)
@@ -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;