[multiple changes]

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* stand.adb (Tree_Read): Read missing entities.
	(Tree_Write): Write missing entities.

2014-05-21  Ben Brosgol  <brosgol@adacore.com>

	* gnat_ugn.texi: Wordsmithing edits to Coupling Metrics Control
	section in gnatmetric chapter.

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* exp_ch6.adb (Expand_Actuals): Spec moved here, since not used
	outside Exp_Ch6 (Expand_Actuals): Deal with proper insertion of
	post-call copy write back (see detailed comment in code).
	* exp_ch6.ads (Expand_Actuals): Moved to body, not used outside
	Exp_Ch6.
	* tbuild.ads: Minor reformatting.

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* stand.ads: Add warning about adding new entities and
	Tree_Read/Tree_Write.

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* sem_util.adb (Set_Entity_With_Checks): Don't complain about
	references to restricted entities within the units in which they
	are declared.

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* gnat1drv.adb (Check_Bad_Body): Use Source_File_Is_Body to
	simplify the needed test, and also deal with failure to catch
	situations with non-standard names.
	* sinput-l.ads, sinput-l.adb (Source_File_Is_No_Body): New function
	(Source_File_Is_Subunit): Removed, no longer used.

2014-05-21  Javier Miranda  <miranda@adacore.com>

	* exp_ch4.adb
	(Expand_Allocator_Expression.Apply_Accessibility_Check): for a
	renaming of an access to interface object there is no need to
	generate extra code to reference the tag.

From-SVN: r210696

gcc/ada/ChangeLog

 2014-05-21  Robert Dewar  <dewar@adacore.com>
 
+	* stand.adb (Tree_Read): Read missing entities.
+	(Tree_Write): Write missing entities.
+
+2014-05-21  Ben Brosgol  <brosgol@adacore.com>
+
+	* gnat_ugn.texi: Wordsmithing edits to Coupling Metrics Control
+	section in gnatmetric chapter.
+
+2014-05-21  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch6.adb (Expand_Actuals): Spec moved here, since not used
+	outside Exp_Ch6 (Expand_Actuals): Deal with proper insertion of
+	post-call copy write back (see detailed comment in code).
+	* exp_ch6.ads (Expand_Actuals): Moved to body, not used outside
+	Exp_Ch6.
+	* tbuild.ads: Minor reformatting.
+
+2014-05-21  Robert Dewar  <dewar@adacore.com>
+
+	* stand.ads: Add warning about adding new entities and
+	Tree_Read/Tree_Write.
+
+2014-05-21  Robert Dewar  <dewar@adacore.com>
+
+	* sem_util.adb (Set_Entity_With_Checks): Don't complain about
+	references to restricted entities within the units in which they
+	are declared.
+
+2014-05-21  Robert Dewar  <dewar@adacore.com>
+
+	* gnat1drv.adb (Check_Bad_Body): Use Source_File_Is_Body to
+	simplify the needed test, and also deal with failure to catch
+	situations with non-standard names.
+	* sinput-l.ads, sinput-l.adb (Source_File_Is_No_Body): New function
+	(Source_File_Is_Subunit): Removed, no longer used.
+
+2014-05-21  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch4.adb
+	(Expand_Allocator_Expression.Apply_Accessibility_Check): for a
+	renaming of an access to interface object there is no need to
+	generate extra code to reference the tag.
+
+2014-05-21  Robert Dewar  <dewar@adacore.com>
+
 	* errout.adb, erroutc.adb, erroutc.ads: Allow warning tag in pragma
 	Warnings (Off, string).
 

gcc/ada/exp_ch4.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -831,13 +831,25 @@ package body Exp_Ch4 is
 
             --  Step 2: Create the accessibility comparison
 
+            --  Reference the tag: for a renaming of an access to an interface
+            --  object Obj_Ref already references the tag of the secondary
+            --  dispatch table.
+
+            if Present (Parent (Entity (Obj_Ref)))
+              and then Present (Renamed_Object (Entity (Obj_Ref)))
+              and then Is_Interface (DesigT)
+            then
+               null;
+
             --  Generate:
             --    Ref'Tag
 
-            Obj_Ref :=
-              Make_Attribute_Reference (Loc,
-                Prefix         => Obj_Ref,
-                Attribute_Name => Name_Tag);
+            else
+               Obj_Ref :=
+                 Make_Attribute_Reference (Loc,
+                   Prefix         => Obj_Ref,
+                   Attribute_Name => Name_Tag);
+            end if;
 
             --  For tagged types, determine the accessibility level by looking
             --  at the type specific data of the dispatch table. Generate:

gcc/ada/exp_ch6.adb

@@ -165,6 +165,41 @@ package body Exp_Ch6 is
    --  the values are not changed for the call, we know immediately that
    --  we have an infinite recursion.
 
+   procedure Expand_Actuals (N : in out Node_Id; Subp : Entity_Id);
+   --  For each actual of an in-out or out parameter which is a numeric
+   --  (view) conversion of the form T (A), where A denotes a variable,
+   --  we insert the declaration:
+   --
+   --    Temp : T[ := T (A)];
+   --
+   --  prior to the call. Then we replace the actual with a reference to Temp,
+   --  and append the assignment:
+   --
+   --    A := TypeA (Temp);
+   --
+   --  after the call. Here TypeA is the actual type of variable A. For out
+   --  parameters, the initial declaration has no expression. If A is not an
+   --  entity name, we generate instead:
+   --
+   --    Var  : TypeA renames A;
+   --    Temp : T := Var;       --  omitting expression for out parameter.
+   --    ...
+   --    Var := TypeA (Temp);
+   --
+   --  For other in-out parameters, we emit the required constraint checks
+   --  before and/or after the call.
+   --
+   --  For all parameter modes, actuals that denote components and slices of
+   --  packed arrays are expanded into suitable temporaries.
+   --
+   --  For non-scalar objects that are possibly unaligned, add call by copy
+   --  code (copy in for IN and IN OUT, copy out for OUT and IN OUT).
+   --
+   --  The parameter N is IN OUT because in some cases, the expansion code
+   --  rewrites the call as an expression actions with the call inside. In
+   --  this case N is reset to point to the inside call so that the caller
+   --  can continue processing of this call.
+
    procedure Expand_Ctrl_Function_Call (N : Node_Id);
    --  N is a function call which returns a controlled object. Transform the
    --  call into a temporary which retrieves the returned object from the
@@ -939,7 +974,7 @@ package body Exp_Ch6 is
    -- Expand_Actuals --
    --------------------
 
-   procedure Expand_Actuals (N : Node_Id; Subp : Entity_Id) is
+   procedure Expand_Actuals (N : in out Node_Id; Subp : Entity_Id) is
       Loc       : constant Source_Ptr := Sloc (N);
       Actual    : Node_Id;
       Formal    : Entity_Id;
@@ -976,10 +1011,10 @@ package body Exp_Ch6 is
       --  the effect that this might lead to unaligned arguments.
 
       function Make_Var (Actual : Node_Id) return Entity_Id;
-      --  Returns an entity that refers to the given actual parameter,
-      --  Actual (not including any type conversion). If Actual is an
-      --  entity name, then this entity is returned unchanged, otherwise
-      --  a renaming is created to provide an entity for the actual.
+      --  Returns an entity that refers to the given actual parameter, Actual
+      --  (not including any type conversion). If Actual is an entity name,
+      --  then this entity is returned unchanged, otherwise a renaming is
+      --  created to provide an entity for the actual.
 
       procedure Reset_Packed_Prefix;
       --  The expansion of a packed array component reference is delayed in
@@ -1604,8 +1639,8 @@ package body Exp_Ch6 is
                   --  Also pass by copy if change of representation
 
                   or else not Same_Representation
-                               (Etype (Formal),
-                                Etype (Expression (Actual))))
+                                (Etype (Formal),
+                                 Etype (Expression (Actual))))
             then
                Add_Call_By_Copy_Code;
 
@@ -1809,7 +1844,7 @@ package body Exp_Ch6 is
                if In_Open_Scopes (Entity (Actual)) then
                   Rewrite (Actual,
                     (Make_Function_Call (Loc,
-                     Name => New_Occurrence_Of (RTE (RE_Self), Loc))));
+                       Name => New_Occurrence_Of (RTE (RE_Self), Loc))));
                   Analyze (Actual);
 
                --  A task type cannot otherwise appear as an actual
@@ -1831,36 +1866,93 @@ package body Exp_Ch6 is
          --  Cases where the call is not a member of a statement list
 
          if not Is_List_Member (N) then
-            declare
-               P :  Node_Id := Parent (N);
 
-            begin
-               --  In Ada 2012 the call may be a function call in an expression
-               --  (since OUT and IN OUT parameters are now allowed for such
-               --  calls. The write-back of (in)-out parameters is handled
-               --  by the back-end, but the constraint checks generated when
-               --  subtypes of formal and actual don't match must be inserted
-               --  in the form of assignments, at the nearest point after the
-               --  declaration or statement that contains the call.
-
-               if Ada_Version >= Ada_2012
-                 and then Nkind (N) = N_Function_Call
-               then
-                  while Nkind (P) not in N_Declaration
-                    and then
-                      Nkind (P) not in N_Statement_Other_Than_Procedure_Call
-                  loop
-                     P := Parent (P);
-                  end loop;
+            --  In Ada 2012 the call may be a function call in an expression
+            --  (since OUT and IN OUT parameters are now allowed for such
+            --  calls). The write-back of (in)-out parameters is handled
+            --  by the back-end, but the constraint checks generated when
+            --  subtypes of formal and actual don't match must be inserted
+            --  in the form of assignments.
 
-                  Insert_Actions_After (P, Post_Call);
+            if Ada_Version >= Ada_2012
+              and then Nkind (N) = N_Function_Call
+            then
+               --  We used to just do handle this by climbing up parents to
+               --  a non-statement/declaration and then simply making a call
+               --  to Insert_Actions_After (P, Post_Call), but that doesn't
+               --  work. If we are in the middle of an expression, e.g. the
+               --  condition of an IF, this call would insert after the IF
+               --  statement, which is much too late to be doing the write
+               --  back. For example:
+
+               --     if Clobber (X) then
+               --        Put_Line (X'Img);
+               --     else
+               --        goto Junk
+               --     end if;
+
+               --  Now assume Clobber changes X, if we put the write back
+               --  after the IF, the Put_Line gets the wrong value and the
+               --  goto causes the write back to be skipped completely.
+
+               --  To deal with this, we replace the call by
+
+               --    do
+               --       Tnnn : function-result-type renames function-call;
+               --       Post_Call actions
+               --    in
+               --       Tnnn;
+               --    end;
+
+               --  Note: this won't do in Modify_Tree_For_C mode, but we
+               --  will deal with that later (it will require creating a
+               --  declaration for Temp, using Insert_Declaration) ???
 
-               --  If not the special Ada 2012 case of a function call, then
-               --  we must have the triggering statement of a triggering
-               --  alternative or an entry call alternative, and we can add
-               --  the post call stuff to the corresponding statement list.
+               declare
+                  Tnnn  : constant Entity_Id := Make_Temporary (Loc, 'T');
+                  FRTyp : constant Entity_Id := Etype (N);
+                  Name  : constant Node_Id   := Relocate_Node (N);
 
-               else
+               begin
+                  Prepend_To (Post_Call,
+                    Make_Object_Renaming_Declaration (Loc,
+                      Defining_Identifier => Tnnn,
+                      Subtype_Mark        => New_Occurrence_Of (FRTyp, Loc),
+                      Name                => Name));
+
+                  Rewrite (N,
+                    Make_Expression_With_Actions (Loc,
+                      Actions    => Post_Call,
+                      Expression => New_Occurrence_Of (Tnnn, Loc)));
+
+                  --  We don't want to just blindly call Analyze_And_Resolve
+                  --  because that would cause unwanted recursion on the call.
+                  --  So for a moment set the call as analyzed to prevent that
+                  --  recursion, and get the rest analyzed properly, then reset
+                  --  the analyzed flag, so our caller can continue.
+
+                  Set_Analyzed (Name, True);
+                  Analyze_And_Resolve (N, FRTyp);
+                  Set_Analyzed (Name, False);
+
+                  --  Reset calling argument to point to function call inside
+                  --  the expression with actions so the caller can continue
+                  --  to process the call.
+
+                  N := Name;
+               end;
+
+            --  If not the special Ada 2012 case of a function call, then
+            --  we must have the triggering statement of a triggering
+            --  alternative or an entry call alternative, and we can add
+            --  the post call stuff to the corresponding statement list.
+
+            else
+               declare
+                  P : Node_Id;
+
+               begin
+                  P := Parent (N);
                   pragma Assert (Nkind_In (P, N_Triggering_Alternative,
                                               N_Entry_Call_Alternative));
 
@@ -1870,15 +1962,17 @@ package body Exp_Ch6 is
                   else
                      Set_Statements (P, Post_Call);
                   end if;
-               end if;
 
-            end;
+                  return;
+               end;
+            end if;
 
          --  Otherwise, normal case where N is in a statement sequence,
          --  just put the post-call stuff after the call statement.
 
          else
             Insert_Actions_After (N, Post_Call);
+            return;
          end if;
       end if;
 

gcc/ada/exp_ch6.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -37,36 +37,6 @@ package Exp_Ch6 is
    procedure Expand_N_Subprogram_Body_Stub      (N : Node_Id);
    procedure Expand_N_Subprogram_Declaration    (N : Node_Id);
 
-   procedure Expand_Actuals (N : Node_Id; Subp : Entity_Id);
-   --  For each actual of an in-out or out parameter which is a numeric
-   --  (view) conversion of the form T (A), where A denotes a variable,
-   --  we insert the declaration:
-   --
-   --    Temp : T[ := T (A)];
-   --
-   --  prior to the call. Then we replace the actual with a reference to Temp,
-   --  and append the assignment:
-   --
-   --    A := TypeA (Temp);
-   --
-   --  after the call. Here TypeA is the actual type of variable A. For out
-   --  parameters, the initial declaration has no expression. If A is not an
-   --  entity name, we generate instead:
-   --
-   --    Var  : TypeA renames A;
-   --    Temp : T := Var;       --  omitting expression for out parameter.
-   --    ...
-   --    Var := TypeA (Temp);
-   --
-   --  For other in-out parameters, we emit the required constraint checks
-   --  before and/or after the call.
-   --
-   --  For all parameter modes, actuals that denote components and slices of
-   --  packed arrays are expanded into suitable temporaries.
-   --
-   --  For non-scalar objects that are possibly unaligned, add call by copy
-   --  code (copy in for IN and IN OUT, copy out for OUT and IN OUT).
-
    procedure Expand_Call (N : Node_Id);
    --  This procedure contains common processing for Expand_N_Function_Call,
    --  Expand_N_Procedure_Statement, and Expand_N_Entry_Call.

gcc/ada/gnat1drv.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -633,7 +633,6 @@ procedure Gnat1drv is
          Sname := Unit_Name (Main_Unit);
 
          --  If we do not already have a body name, then get the body name
-         --  (but how can we have a body name here???)
 
          if not Is_Body_Name (Sname) then
             Sname := Get_Body_Name (Sname);
@@ -651,19 +650,15 @@ procedure Gnat1drv is
          --  to include both in a partition, this is diagnosed at bind time. In
          --  Ada 83 mode this is not a warning case.
 
-         --  Note: if weird file names are being used, we can have a situation
-         --  where the file name that supposedly contains body in fact contains
-         --  a spec, or we can't tell what it contains. Skip the error message
-         --  in these cases.
-
-         --  Also ignore body that is nothing but pragma No_Body; (that's the
-         --  whole point of this pragma, to be used this way and to cause the
-         --  body file to be ignored in this context).
+         --  Note that in general we do not give the message if the file in
+         --  question does not look like a body. This includes weird cases,
+         --  but in particular means that if the file is just a No_Body pragma,
+         --  then we won't give the message (that's the whole point of this
+         --  pragma, to be used this way and to cause the body file to be
+         --  ignored in this context).
 
          if Src_Ind /= No_Source_File
-           and then Get_Expected_Unit_Type (Fname) = Expect_Body
-           and then not Source_File_Is_Subunit (Src_Ind)
-           and then not Source_File_Is_No_Body (Src_Ind)
+           and then Source_File_Is_Body (Src_Ind)
          then
             Errout.Finalize (Last_Call => False);
 
@@ -693,8 +688,8 @@ procedure Gnat1drv is
             else
                --  For generic instantiations, we never allow a body
 
-               if Nkind (Original_Node (Unit (Main_Unit_Node)))
-               in N_Generic_Instantiation
+               if Nkind (Original_Node (Unit (Main_Unit_Node))) in
+                                                    N_Generic_Instantiation
                then
                   Bad_Body_Error
                     ("generic instantiation for $$ does not allow a body");

gcc/ada/gnat_ugn.texi

@@ -16232,50 +16232,48 @@ Do not report the extra exit points for subprogram bodies
 @cindex Coupling metrics control in @command{gnatmetric}
 
 @noindent
-@cindex Coupling metrics (in in @command{gnatmetric})
+@cindex Coupling metrics (in @command{gnatmetric})
 Coupling metrics measure the dependencies between a given entity and other
-entities the program consists of. The goal of these metrics is to estimate the
-stability of the whole program considered as the collection of entities
-(modules, classes etc.).
+entities in the program. This information is useful since high coupling
+may signal potential issues with maintainability as the program evolves.
 
-Gnatmetric computes the following coupling metrics:
+@command{gnatmetric} computes the following coupling metrics:
 
 @itemize @bullet
 
 @item
-@emph{object-oriented coupling} - for classes in traditional object-oriented
+@emph{object-oriented coupling}, for classes in traditional object-oriented
 sense;
 
 @item
-@emph{unit coupling} - for all the program units making up a program;
+@emph{unit coupling}, for all the program units making up a program;
 
 @item
-@emph{control coupling} - this metric counts dependencies between a unit and
-only those units that define subprograms;
+@emph{control coupling}, reflecting dependencies between a unit and
+other units that contain subprograms.
 @end itemize
 
 @noindent
 Two kinds of coupling metrics are computed:
 
-@table @asis
-@item fan-out coupling (efferent coupling)
+@itemize @bullet
+@item fan-out coupling (``efferent coupling''):
 @cindex fan-out coupling
 @cindex efferent coupling
-the number of entities the given entity depends upon. It
-estimates in what extent the given entity depends on the changes in
-``external world''
+the number of entities the given entity depends upon. This metric
+reflects how the given entity depends on the changes in the
+``external world''.
 
-@item fan-in coupling (afferent coupling)
+@item fan-in coupling (``afferent'' coupling):
 @cindex fan-in coupling
 @cindex afferent coupling
 the number of entities that depend on a given entity.
-It estimates in what extent the ``external world'' depends on the changes in a
-given entity
-@end table
+This metric reflects how the ``external world'' depends on the changes in a
+given entity.
+@end itemize
 
 @noindent
-
-Object-oriented coupling metrics are metrics that measure the dependencies
+Object-oriented coupling metrics measure the dependencies
 between a given class (or a group of classes) and the other classes in the
 program. In this subsection the term ``class'' is used in its traditional
 object-oriented programming sense (an instantiable module that contains data
@@ -16292,68 +16290,78 @@ that depend upon @code{K}.
 A category's fan-in coupling is the number of classes outside the
 category that depend on classes belonging to the category.
 
-Ada's implementation of the object-oriented paradigm does not use the
-traditional class notion, so the definition of the coupling
+Ada's object-oriented paradigm separates the instantiable entity
+(type) from the module (package), so the definition of the coupling
 metrics for Ada maps the class and class category notions
 onto Ada constructs.
 
-For the coupling metrics, several kinds of modules -- a library package,
-a library generic package, and a library generic package instantiation --
-that define a tagged type or an interface type are
-considered to be a class. A category consists of a library package (or
+For the coupling metrics, several kinds of modules that define a tagged type
+or an interface type  -- library packages, library generic packages, and
+library generic package instantiations -- are considered to be classes.
+A category consists of a library package (or
 a library generic package) that defines a tagged or an interface type,
 together with all its descendant (generic) packages that define tagged
-or interface types. That is a
-category is an Ada hierarchy of library-level program units. So class coupling
-in case of Ada is called as tagged coupling, and category coupling - as
-hierarchy coupling.
-
-For any package counted as a class, its body and subunits (if any) are
-considered together with its spec when counting the dependencies, and coupling
-metrics are reported for spec units only. For dependencies between classes,
-the Ada semantic dependencies are considered. For object-oriented coupling
-metrics, only dependencies on units that are considered as classes, are
+or interface types. Thus a
+category is an Ada hierarchy of library-level program units. Class
+coupling in Ada is referred to as ``tagged coupling'', and category coupling
+is referred to as ``hierarchy coupling''.
+
+For any package serving as a class, its body and subunits (if any) are
+considered together with its spec when computing dependencies, and coupling
+metrics are reported for spec units only. Dependencies between classes
+mean Ada semantic dependencies. For object-oriented coupling
+metrics, only dependencies on units treated as classes are
 considered.
 
-For unit and control coupling also not compilation units but program units are
-counted. That is, for a package, its spec, its body and its subunits (if any)
-are considered as making up one unit, and the dependencies that are counted
-are the dependencies of all these compilation units collected together as
-the dependencies as a (whole) unit. And metrics are reported for spec
-compilation units only (or for a subprogram body unit in case if there is no
+Similarly, for unit and control coupling an entity is considered to be the
+conceptual construct consisting of the entity's specification, body, and
+any subunits (transitively).
+@command{gnatmetric} computes
+the dependencies of all these units as a whole, but
+metrics are only reported for spec
+units (or for a subprogram body unit in case if there is no
 separate spec for the given subprogram).
 
-For unit coupling, dependencies between all kinds of program units are
-considered. For control coupling, for each unit the dependencies of this unit
-upon units that define subprograms are counted, so control fan-out coupling
-is reported for all units, but control fan-in coupling - only for the units
+For unit coupling, dependencies are computed between all kinds of program
+units. For control coupling, the dependencies of a given unit are limited to
+those units that define subprograms. Thus control fan-out coupling is reported
+for all units, but control fan-in coupling is only reported for units
 that define subprograms.
 
 The following simple example illustrates the difference between unit coupling
 and control coupling metrics:
 
 @smallexample @c ada
+@group
 package Lib_1 is
     function F_1 (I : Integer) return Integer;
 end Lib_1;
+@end group
 
+@group
 package Lib_2 is
     type T_2 is new Integer;
 end Lib_2;
+@end group
 
+@group
 package body Lib_1 is
     function F_1 (I : Integer) return Integer is
     begin
        return I + 1;
     end F_1;
 end Lib_1;
+@end group
 
+@group
 with Lib_2; use Lib_2;
 package Pack is
     Var : T_2;
     function Fun (I : Integer) return Integer;
 end Pack;
+@end group
 
+@group
 with Lib_1; use Lib_1;
 package body Pack is
     function Fun (I : Integer) return Integer is
@@ -16361,13 +16369,15 @@ package body Pack is
        return F_1 (I);
     end Fun;
 end Pack;
+@end group
 @end smallexample
 
 @noindent
-if we apply @command{gnatmetric} with @code{--coupling-all} option to these
-units, the result will be:
+If we apply @command{gnatmetric} with the @option{--coupling-all} option to
+these units, the result will be:
 
 @smallexample
+@group
 Coupling metrics:
 =================
     Unit Lib_1 (C:\customers\662\L406-007\lib_1.ads)
@@ -16375,45 +16385,49 @@ Coupling metrics:
        control fan-in coupling   : 1
        unit fan-out coupling     : 0
        unit fan-in coupling      : 1
+@end group
 
+@group
     Unit Pack (C:\customers\662\L406-007\pack.ads)
        control fan-out coupling  : 1
        control fan-in coupling   : 0
        unit fan-out coupling     : 2
        unit fan-in coupling      : 0
+@end group
 
+@group
     Unit Lib_2 (C:\customers\662\L406-007\lib_2.ads)
        control fan-out coupling  : 0
        unit fan-out coupling     : 0
        unit fan-in coupling      : 1
+@end group
 @end smallexample
 
 @noindent
 The result does not contain values for object-oriented
-coupling because none of the argument unit contains a tagged type and
+coupling because none of the argument units contains a tagged type and
 therefore none of these units can be treated as a class.
 
-@code{Pack} (considered as a program unit, that is spec+body) depends on two
-units - @code{Lib_1} @code{and Lib_2}, therefore it has unit fan-out coupling
-equals to 2. And nothing depend on it, so its unit fan-in coupling is 0 as
-well as control fan-in coupling. Only one of the units @code{Pack} depends
+The @code{Pack} package (spec and body) depends on two
+units -- @code{Lib_1} @code{and Lib_2} -- and so its unit fan-out coupling
+is 2. Since nothing depends on it, its unit fan-in coupling is 0, as
+is its control fan-in coupling. Only one of the units @code{Pack} depends
 upon defines a subprogram, so its control fan-out coupling is 1.
 
-@code{Lib_2} depends on nothing, so fan-out metrics for it are 0. It does
-not define a subprogram, so control fan-in metric cannot be applied to it,
-and there is one unit that depends on it (@code{Pack}), so it has
-unit fan-in coupling equals to 1.
+@code{Lib_2} depends on nothing, so its fan-out metrics are 0. It does
+not define any subprograms, so it has no control fan-in metric.
+One unit (@code{Pack}) depends on it , so its unit fan-in coupling is 1.
 
 @code{Lib_1} is similar to @code{Lib_2}, but it does define a subprogram.
-So it has control fan-in coupling equals to 1 (because there is a unit
+Its control fan-in coupling is 1 (because there is one unit
 depending on it).
 
 When computing coupling metrics, @command{gnatmetric} counts only
 dependencies between units that are arguments of the @command{gnatmetric}
-call. Coupling metrics are program-wide (or project-wide) metrics, so to
-get a valid result, you should call @command{gnatmetric} for
-the whole set of sources that make up your program. It can be done
-by calling @command{gnatmetric} from the GNAT driver with @option{-U}
+invocation. Coupling metrics are program-wide (or project-wide) metrics, so
+you should invoke @command{gnatmetric} for
+the complete set of sources comprising your program. This can be done
+by invoking @command{gnatmetric} from the GNAT driver with the @option{-U}
 option (see @ref{The GNAT Driver and Project Files} for details).
 
 By default, all the coupling metrics are disabled. You can use the following

gcc/ada/sem_util.adb

@@ -15877,6 +15877,11 @@ package body Sem_Util is
 
       if Restriction_Check_Required (No_Abort_Statements)
         and then (Is_RTE (Val, RE_Abort_Task))
+
+        --  A special extra check, don't complain about a reference from within
+        --  the Ada.Task_Identification package itself!
+
+        and then not In_Same_Extended_Unit (N, Val)
       then
          Check_Restriction (No_Abort_Statements, Post_Node);
       end if;
@@ -15892,6 +15897,10 @@ package body Sem_Util is
                   Is_RTE (Val, RE_Exchange_Handler) or else
                   Is_RTE (Val, RE_Detach_Handler)   or else
                   Is_RTE (Val, RE_Reference))
+        --  A special extra check, don't complain about a reference from within
+        --  the Ada.Interrupts package itself!
+
+        and then not In_Same_Extended_Unit (N, Val)
       then
          Check_Restriction (No_Dynamic_Attachment, Post_Node);
       end if;

gcc/ada/sinput-l.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -795,9 +795,106 @@ package body Sinput.L is
       Prep_Buffer (Prep_Buffer_Last) := C;
    end Put_Char_In_Prep_Buffer;
 
-   -----------------------------------
-   -- Source_File_Is_Pragma_No_Body --
-   -----------------------------------
+   -------------------------
+   -- Source_File_Is_Body --
+   -------------------------
+
+   function Source_File_Is_Body (X : Source_File_Index) return Boolean is
+      Pcount : Natural;
+
+   begin
+      Initialize_Scanner (No_Unit, X);
+
+      --  Loop to look for subprogram or package body
+
+      loop
+         case Token is
+
+            --  PRAGMA, WITH, USE (which can appear before a body)
+
+            when Tok_Pragma | Tok_With | Tok_Use =>
+
+               --  We just want to skip any of these, do it by skipping to a
+               --  semicolon, but check for EOF, in case we have bad syntax.
+
+               loop
+                  if Token = Tok_Semicolon then
+                     Scan;
+                     exit;
+                  elsif Token = Tok_EOF then
+                     return False;
+                  else
+                     Scan;
+                  end if;
+               end loop;
+
+            --  PACKAGE
+
+            when Tok_Package =>
+               Scan; -- Past PACKAGE
+
+               --  We have a body if and only if BODY follows
+
+               return Token = Tok_Body;
+
+            --  FUNCTION or PROCEDURE
+
+            when Tok_Procedure | Tok_Function =>
+               Pcount := 0;
+
+               --  Loop through tokens following PROCEDURE or FUNCTION
+
+               loop
+                  Scan;
+
+                  case Token is
+
+                     --  For parens, count paren level (note that paren level
+                     --  can get greater than 1 if we have default parameters).
+
+                     when Tok_Left_Paren =>
+                        Pcount := Pcount + 1;
+
+                     when Tok_Right_Paren =>
+                        Pcount := Pcount - 1;
+
+                     --  EOF means something weird, probably no body
+
+                     when Tok_EOF =>
+                        return False;
+
+                     --  BEGIN or IS or END definitely means body is present
+
+                     when Tok_Begin | Tok_Is | Tok_End =>
+                        return True;
+
+                     --  Semicolon means no body present if at outside any
+                     --  parens. If within parens, ignore, since it could be
+                     --  a parameter separator.
+
+                     when Tok_Semicolon =>
+                        if Pcount = 0 then
+                           return False;
+                        end if;
+
+                     --  Skip anything else
+
+                     when others =>
+                        null;
+                  end case;
+               end loop;
+
+            --  Anything else in main scan means we don't have a body
+
+            when others =>
+               return False;
+         end case;
+      end loop;
+   end Source_File_Is_Body;
+
+   ----------------------------
+   -- Source_File_Is_No_Body --
+   ----------------------------
 
    function Source_File_Is_No_Body (X : Source_File_Index) return Boolean is
    begin
@@ -826,27 +923,4 @@ package body Sinput.L is
       return Token = Tok_EOF;
    end Source_File_Is_No_Body;
 
-   ----------------------------
-   -- Source_File_Is_Subunit --
-   ----------------------------
-
-   function Source_File_Is_Subunit (X : Source_File_Index) return Boolean is
-   begin
-      Initialize_Scanner (No_Unit, X);
-
-      --  We scan past junk to the first interesting compilation unit token, to
-      --  see if it is SEPARATE. We ignore WITH keywords during this and also
-      --  PRIVATE. The reason for ignoring PRIVATE is that it handles some
-      --  error situations, and also to handle PRIVATE WITH in Ada 2005 mode.
-
-      while Token = Tok_With
-        or else Token = Tok_Private
-        or else (Token not in Token_Class_Cunit and then Token /= Tok_EOF)
-      loop
-         Scan;
-      end loop;
-
-      return Token = Tok_Separate;
-   end Source_File_Is_Subunit;
-
 end Sinput.L;

gcc/ada/sinput-l.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -64,19 +64,16 @@ package Sinput.L is
    --  Called on completing the parsing of a source file. This call completes
    --  the source file table entry for the current source file.
 
+   function Source_File_Is_Body (X : Source_File_Index) return Boolean;
+   --  Returns true if the designated source file contains a subprogram body
+   --  or a package body. This is a limited scan just to determine the answer
+   --  to this question..
+
    function Source_File_Is_No_Body (X : Source_File_Index) return Boolean;
    --  Returns true if the designated source file contains pragma No_Body;
    --  and no other tokens. If the source file contains anything other than
    --  this sequence of three tokens, then False is returned.
 
-   function Source_File_Is_Subunit (X : Source_File_Index) return Boolean;
-   --  This function determines if a source file represents a subunit. It
-   --  works by scanning for the first compilation unit token, and returning
-   --  True if it is the token SEPARATE. It will return False otherwise,
-   --  meaning that the file cannot possibly be a legal subunit. This
-   --  function does NOT do a complete parse of the file, or build a
-   --  tree. It is used in the main driver in the check for bad bodies.
-
    -------------------------------------------------
    -- Subprograms for Dealing With Instantiations --
    -------------------------------------------------

gcc/ada/stand.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013,  Free Software Foundation, Inc.        --
+--          Copyright (C) 1992-2014,  Free Software Foundation, Inc.        --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -29,6 +29,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Elists;  use Elists;
 with System;  use System;
 with Tree_IO; use Tree_IO;
 
@@ -46,9 +47,32 @@ package body Stand is
       Tree_Read_Int (Int (Standard_Package_Node));
       Tree_Read_Int (Int (Last_Standard_Node_Id));
       Tree_Read_Int (Int (Last_Standard_List_Id));
+
+      Tree_Read_Int (Int (Boolean_Literals (False)));
+      Tree_Read_Int (Int (Boolean_Literals (True)));
+
       Tree_Read_Int (Int (Standard_Void_Type));
       Tree_Read_Int (Int (Standard_Exception_Type));
       Tree_Read_Int (Int (Standard_A_String));
+      Tree_Read_Int (Int (Standard_A_Char));
+      Tree_Read_Int (Int (Standard_Debug_Renaming_Type));
+
+      --  Deal with Predefined_Float_Types, which is an Elist. We wrote the
+      --  entities out in sequence, terminated by an Empty entry.
+
+      declare
+         Elmt : Entity_Id;
+      begin
+         Predefined_Float_Types := New_Elmt_List;
+         loop
+            Tree_Read_Int (Int (Elmt));
+            exit when Elmt = Empty;
+            Append_Elmt (Elmt, Predefined_Float_Types);
+         end loop;
+      end;
+
+      --  Remainder of special entities
+
       Tree_Read_Int (Int (Any_Id));
       Tree_Read_Int (Int (Any_Type));
       Tree_Read_Int (Int (Any_Access));
@@ -59,10 +83,12 @@ package body Stand is
       Tree_Read_Int (Int (Any_Discrete));
       Tree_Read_Int (Int (Any_Fixed));
       Tree_Read_Int (Int (Any_Integer));
+      Tree_Read_Int (Int (Any_Modular));
       Tree_Read_Int (Int (Any_Numeric));
       Tree_Read_Int (Int (Any_Real));
       Tree_Read_Int (Int (Any_Scalar));
       Tree_Read_Int (Int (Any_String));
+      Tree_Read_Int (Int (Raise_Type));
       Tree_Read_Int (Int (Universal_Integer));
       Tree_Read_Int (Int (Universal_Real));
       Tree_Read_Int (Int (Universal_Fixed));
@@ -70,12 +96,12 @@ package body Stand is
       Tree_Read_Int (Int (Standard_Integer_16));
       Tree_Read_Int (Int (Standard_Integer_32));
       Tree_Read_Int (Int (Standard_Integer_64));
-      Tree_Read_Int (Int (Standard_Unsigned_64));
       Tree_Read_Int (Int (Standard_Short_Short_Unsigned));
       Tree_Read_Int (Int (Standard_Short_Unsigned));
       Tree_Read_Int (Int (Standard_Unsigned));
       Tree_Read_Int (Int (Standard_Long_Unsigned));
       Tree_Read_Int (Int (Standard_Long_Long_Unsigned));
+      Tree_Read_Int (Int (Standard_Unsigned_64));
       Tree_Read_Int (Int (Abort_Signal));
       Tree_Read_Int (Int (Standard_Op_Rotate_Left));
       Tree_Read_Int (Int (Standard_Op_Rotate_Right));
@@ -96,9 +122,34 @@ package body Stand is
       Tree_Write_Int (Int (Standard_Package_Node));
       Tree_Write_Int (Int (Last_Standard_Node_Id));
       Tree_Write_Int (Int (Last_Standard_List_Id));
+
+      Tree_Write_Int (Int (Boolean_Literals (False)));
+      Tree_Write_Int (Int (Boolean_Literals (True)));
+
       Tree_Write_Int (Int (Standard_Void_Type));
       Tree_Write_Int (Int (Standard_Exception_Type));
       Tree_Write_Int (Int (Standard_A_String));
+      Tree_Write_Int (Int (Standard_A_Char));
+      Tree_Write_Int (Int (Standard_Debug_Renaming_Type));
+
+      --  Deal with Predefined_Float_Types, which is an Elist. Write the
+      --  entities out in sequence, terminated by an Empty entry.
+
+      declare
+         Elmt : Elmt_Id;
+
+      begin
+         Elmt := First_Elmt (Predefined_Float_Types);
+         while Present (Elmt) loop
+            Tree_Write_Int (Int (Node (Elmt)));
+            Next_Elmt (Elmt);
+         end loop;
+
+         Tree_Write_Int (Int (Empty));
+      end;
+
+      --  Remainder of special entries
+
       Tree_Write_Int (Int (Any_Id));
       Tree_Write_Int (Int (Any_Type));
       Tree_Write_Int (Int (Any_Access));
@@ -109,10 +160,12 @@ package body Stand is
       Tree_Write_Int (Int (Any_Discrete));
       Tree_Write_Int (Int (Any_Fixed));
       Tree_Write_Int (Int (Any_Integer));
+      Tree_Write_Int (Int (Any_Modular));
       Tree_Write_Int (Int (Any_Numeric));
       Tree_Write_Int (Int (Any_Real));
       Tree_Write_Int (Int (Any_Scalar));
       Tree_Write_Int (Int (Any_String));
+      Tree_Write_Int (Int (Raise_Type));
       Tree_Write_Int (Int (Universal_Integer));
       Tree_Write_Int (Int (Universal_Real));
       Tree_Write_Int (Int (Universal_Fixed));
@@ -120,12 +173,12 @@ package body Stand is
       Tree_Write_Int (Int (Standard_Integer_16));
       Tree_Write_Int (Int (Standard_Integer_32));
       Tree_Write_Int (Int (Standard_Integer_64));
-      Tree_Write_Int (Int (Standard_Unsigned_64));
       Tree_Write_Int (Int (Standard_Short_Short_Unsigned));
       Tree_Write_Int (Int (Standard_Short_Unsigned));
       Tree_Write_Int (Int (Standard_Unsigned));
       Tree_Write_Int (Int (Standard_Long_Unsigned));
       Tree_Write_Int (Int (Standard_Long_Long_Unsigned));
+      Tree_Write_Int (Int (Standard_Unsigned_64));
       Tree_Write_Int (Int (Abort_Signal));
       Tree_Write_Int (Int (Standard_Op_Rotate_Left));
       Tree_Write_Int (Int (Standard_Op_Rotate_Right));

gcc/ada/stand.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -37,6 +37,11 @@ with Types; use Types;
 
 package Stand is
 
+   --  Warning: the entities defined in this package are written out by the
+   --  Tree_Write routine, and read back in by the Tree_Read routine, so be
+   --  sure to modify these two routines if you add entities that are not
+   --  part of Standard_Entity.
+
    type Standard_Entity_Type is (
    --  This enumeration type contains an entry for each name in Standard
 

gcc/ada/tbuild.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -205,8 +205,6 @@ package Tbuild is
    --  captures the value of an expression (e.g. an aggregate). It should be
    --  set whenever possible to point to the expression that is being captured.
    --  This is provided to get better error messages, e.g. from CodePeer.
-   --
-   --  Make_Temp_Id would probably be a better name for this function???
 
    function Make_Unsuppress_Block
      (Loc   : Source_Ptr;