2011-08-03 Eric Botcazou <ebotcazou@adacore.com>

	* inline.adb: Revert previous change.

2011-08-03  Thomas Quinot  <quinot@adacore.com>

	* sem_cat.adb (Validate_RCI_Subprogram_Declaration): Reject a remote
	subprogram with a limited formal that does not support external
	streaming.

2011-08-03  Yannick Moy  <moy@adacore.com>

	* get_alfa.adb (Get_ALFA): add missing Skip_Spaces at start of
	continuation line
	* lib-xref-alfa.adb (Add_ALFA_File): split removal of scopes that are
	not from current unit in two phases, because it is not possible to
	change the table while iterating over its content.
	* put_alfa.adb (Put_ALFA): reset current file/scope at each new entity

2011-08-03  Sergey Rybin  <rybin@adacore.com>

	* vms_data.ads: Add qualifier for gnatmetric --no-static-loop option
	* gnat_ugn.texi: Update description of complexity metrics (gnatmetric)



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177255 138bc75d-0d04-0410-961f-82ee72b054a4

8 files changed, 351 insertions, 311 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 403cfe79bff..90df61211d4 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2011-08-03  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_cat.adb (Validate_RCI_Subprogram_Declaration): Reject a remote
+	subprogram with a limited formal that does not support external
+	streaming.
+
+2011-08-03  Yannick Moy  <moy@adacore.com>
+
+	* get_alfa.adb (Get_ALFA): add missing Skip_Spaces at start of
+	continuation line
+	* lib-xref-alfa.adb (Add_ALFA_File): split removal of scopes that are
+	not from current unit in two phases, because it is not possible to
+	change the table while iterating over its content.
+	* put_alfa.adb (Put_ALFA): reset current file/scope at each new entity
+
+2011-08-03  Sergey Rybin  <rybin@adacore.com>
+
+	* vms_data.ads: Add qualifier for gnatmetric --no-static-loop option
+	* gnat_ugn.texi: Update description of complexity metrics (gnatmetric)
+
 2011-08-03  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_res.adb (Resolve_Op_Concat_Arg): if the argument is an aggregate
@@ -22,7 +42,6 @@
 	discriminants.
 	* sem_type.adb (Disambiguate): an immediately visible operator hides a
 	user-defined function that is only use-visible.
-	* inline.adb: init procs are inlineable.
 
 2011-08-03  Robert Dewar  <dewar@adacore.com>
 
diff --git a/gcc/ada/get_alfa.adb b/gcc/ada/get_alfa.adb
index e78badcd0c8..94d5d9f4680 100644
--- a/gcc/ada/get_alfa.adb
+++ b/gcc/ada/get_alfa.adb
@@ -393,6 +393,7 @@ begin
                         Skip_EOL;
                         exit when Nextc /= '.';
                         Skipc;
+                        Skip_Spaces;
                      end if;
 
                      if Nextc = '.' then
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index e0521f44d0b..862278cb679 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -14360,12 +14360,14 @@ McCabe cyclomatic complexity;
 McCabe essential complexity;
 
 @item
-maximal loop nesting level
+maximal loop nesting level;
 
+@item
+extra exit points (for subprograms);
 @end itemize
 
 @noindent
-The McCabe complexity metrics are defined
+The McCabe cyclomatic complexity metric is defined
 in @url{http://www.mccabe.com/pdf/mccabe-nist235r.pdf}
 
 According to McCabe, both control statements and short-circuit control forms
@@ -14386,6 +14388,34 @@ cyclomatic complexity, which is the sum of these two values.
 @end itemize
 
 @noindent
+
+The origin of cyclomatic complexity metric is the need to estimate the number
+of independent paths in the control flow graph that in turn gives the number
+of tests needed to satisfy paths coverage testing completeness criterion.
+Considered from the testing point of view, a static Ada @code{loop} (that is,
+the @code{loop} statement having static subtype in loop parameter
+specification) does not add to cyclomatic complexity. By providing
+@option{^--no-static-loop^NO_STATIC_LOOP^} option a user
+may specify that such loops should not be counted when computing the
+cyclomatic complexity metric
+
+The Ada essential complexity metric is a McCabe cyclomatic complexity metric
+counted for the code that is reduced by excluding all the pure structural Ada
+control statements. An compound statement is considered as a non-structural
+if it contains a @code{raise} or @code{return} statement as it subcomponent,
+or if it contains a @code{goto} statement that transfers the control outside
+the operator. A selective accept statement with @code{terminate} alternative
+is considered as non-structural statement. When computing this metric,
+@code{exit} statements are treated in the same way as @code{goto}
+statements unless @option{^-ne^NO_EXITS_AS_GOTOS^} option is specified.
+
+The Ada essential complexity metric defined here is intended to quantify
+the extent to which the software is unstructured. It is adapted from
+the McCabe essential complexity metric defined in
+http://www.mccabe.com/pdf/nist235r.pdf but is modified to be more
+suitable for typical Ada usage. For example, short circuit forms
+are not penalized as unstructured in the Ada essential complexity metric.
+
 When computing cyclomatic and essential complexity, @command{gnatmetric} skips
 the code in the exception handlers and in all the nested program units.
 
@@ -14439,6 +14469,10 @@ bodies, task bodies, entry bodies and statement sequences in package bodies
 Do not consider @code{exit} statements as @code{goto}s when
 computing Essential Complexity
 
+@cindex @option{^--no-static-loop^/NO_STATIC_LOOP^} (@command{gnatmetric})
+@item ^--no-static-loop^/NO_STATIC_LOOP^
+Do not consider static loops when computing cyclomatic complexity
+
 @item ^--extra-exit-points^/EXTRA_EXIT_POINTS^
 Report the extra exit points for subprogram bodies. As an exit point, this
 metric counts @code{return} statements and raise statements in case when the
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 0d184dd45b2..d85e0866a48 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -349,12 +349,6 @@ package body Inline is
                   Set_Is_Inlined (Pack);
                   Inlined_Bodies.Increment_Last;
                   Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack;
-
-               --  an initialization procedure should be inlined, but it does
-               --  not require the body of the package.
-
-               elsif Is_Init_Proc (E) then
-                  Set_Is_Inlined (Pack);
                end if;
             end if;
          end;
diff --git a/gcc/ada/lib-xref-alfa.adb b/gcc/ada/lib-xref-alfa.adb
index 94d2725b7d5..5e0edbc3e48 100644
--- a/gcc/ada/lib-xref-alfa.adb
+++ b/gcc/ada/lib-xref-alfa.adb
@@ -224,25 +224,47 @@ package body ALFA is
 
       --  Update scope numbers
 
-      for S in From .. ALFA_Scope_Table.Last loop
-         declare
-            E : Entity_Id renames ALFA_Scope_Table.Table (S).Scope_Entity;
-         begin
-            if Lib.Get_Source_Unit (E) = U then
-               ALFA_Scope_Table.Table (S).Scope_Num := Int (S - From) + 1;
-               ALFA_Scope_Table.Table (S).File_Num  := D;
+      declare
+         Count : Nat;
 
-            else
-               --  Remove scope S which is not located in unit U, for example
-               --  for scope inside generics that get instantiated.
+      begin
+         Count := 1;
+         for S in From .. ALFA_Scope_Table.Last loop
+            declare
+               E : Entity_Id renames ALFA_Scope_Table.Table (S).Scope_Entity;
+            begin
+               if Lib.Get_Source_Unit (E) = U then
+                  ALFA_Scope_Table.Table (S).Scope_Num := Count;
+                  ALFA_Scope_Table.Table (S).File_Num  := D;
+                  Count                                := Count + 1;
 
-               for J in S .. ALFA_Scope_Table.Last - 1 loop
-                  ALFA_Scope_Table.Table (J) := ALFA_Scope_Table.Table (J + 1);
-               end loop;
-               ALFA_Scope_Table.Set_Last (ALFA_Scope_Table.Last - 1);
+               else
+                  --  Mark for removal a scope S which is not located in unit
+                  --  U, for example for scope inside generics that get
+                  --  instantiated.
+
+                  ALFA_Scope_Table.Table (S).Scope_Num := 0;
+               end if;
+            end;
+         end loop;
+      end;
+
+      declare
+         Snew : Scope_Index;
+
+      begin
+         Snew := From;
+         for S in From .. ALFA_Scope_Table.Last loop
+            --  Remove those scopes previously marked for removal
+
+            if ALFA_Scope_Table.Table (S).Scope_Num /= 0 then
+               ALFA_Scope_Table.Table (Snew) := ALFA_Scope_Table.Table (S);
+               Snew := Snew + 1;
             end if;
-         end;
-      end loop;
+         end loop;
+
+         ALFA_Scope_Table.Set_Last (Snew - 1);
+      end;
 
       --  Make entry for new file in file table
 
diff --git a/gcc/ada/put_alfa.adb b/gcc/ada/put_alfa.adb
index 58021145d1b..d8819200e21 100644
--- a/gcc/ada/put_alfa.adb
+++ b/gcc/ada/put_alfa.adb
@@ -141,8 +141,6 @@ begin
                   Write_Info_Char (S.Scope_Name (N));
                end loop;
 
-               File        := F.File_Num;
-               Scope       := S.Scope_Num;
                Entity_Line := 0;
                Entity_Col  := 0;
 
@@ -175,6 +173,8 @@ begin
 
                         Entity_Line := R.Entity_Line;
                         Entity_Col  := R.Entity_Col;
+                        File        := F.File_Num;
+                        Scope       := S.Scope_Num;
                      end if;
 
                      if Write_Info_Col > 72 then
diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb
index 83d3d6a1c5b..80f017b5938 100644
--- a/gcc/ada/sem_cat.adb
+++ b/gcc/ada/sem_cat.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -35,6 +35,7 @@ with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Opt;      use Opt;
 with Sem;      use Sem;
+with Sem_Attr; use Sem_Attr;
 with Sem_Aux;  use Sem_Aux;
 with Sem_Eval; use Sem_Eval;
 with Sem_Util; use Sem_Util;
@@ -68,13 +69,21 @@ package body Sem_Cat is
    --  that no component is declared with a nonstatic default value.
    --  If a nonstatic default exists, report an error on Obj_Decl.
 
-   --  Iterate through the component list of a record definition, check
-   --  that no component is declared with a non-static default value.
+   function Has_Read_Write_Attributes (E : Entity_Id) return Boolean;
+   --  Return True if entity has attribute definition clauses for Read and
+   --  Write attributes that are visible at some place.
+
+   function Is_Non_Remote_Access_Type (E : Entity_Id) return Boolean;
+   --  Returns true if the entity is a type whose full view is a non-remote
+   --  access type, for the purpose of enforcing E.2.2(8) rules.
+
+   function Has_Non_Remote_Access (Typ : Entity_Id) return Boolean;
+   --  Return true if Typ or the type of any of its subcomponents is a non
+   --  remote access type and doesn't have user-defined stream attributes.
 
-   function Missing_Read_Write_Attributes (E : Entity_Id) return Boolean;
-   --  Return True if the entity or one of its subcomponents is of an access
-   --  type that does not have user-defined Read and Write attributes visible
-   --  at any place.
+   function No_External_Streaming (E : Entity_Id) return Boolean;
+   --  Return True if the entity or one of its subcomponents does not support
+   --  external streaming.
 
    function In_RCI_Declaration (N : Node_Id) return Boolean;
    --  Determines if a declaration is  within the visible part of a Remote
@@ -85,10 +94,6 @@ package body Sem_Cat is
    --  Determines if current scope is within the declaration of a Remote Types
    --  unit, for semantic checking purposes.
 
-   function Is_Non_Remote_Access_Type (E : Entity_Id) return Boolean;
-   --  Returns true if the entity is a type whose full view is a non-remote
-   --  access type, for the purpose of enforcing E.2.2(8) rules.
-
    function In_Shared_Passive_Unit return Boolean;
    --  Determines if current scope is within a Shared Passive compilation unit
 
@@ -104,6 +109,12 @@ package body Sem_Cat is
    --  also constraints about the primitive subprograms of the class-wide type.
    --  RM E.2 (9, 13, 14)
 
+   procedure Validate_RACW_Primitive
+     (Subp : Entity_Id;
+      RACW : Entity_Id);
+   --  Check legality of the declaration of primitive Subp of the designated
+   --  type of the given RACW type.
+
    ---------------------------------------
    -- Check_Categorization_Dependencies --
    ---------------------------------------
@@ -346,6 +357,62 @@ package body Sem_Cat is
       end loop;
    end Check_Non_Static_Default_Expr;
 
+   ---------------------------
+   -- Has_Non_Remote_Access --
+   ---------------------------
+
+   function Has_Non_Remote_Access (Typ : Entity_Id) return Boolean is
+      Component : Entity_Id;
+      Comp_Type : Entity_Id;
+      U_Typ     : constant Entity_Id := Underlying_Type (Typ);
+   begin
+      if No (U_Typ) then
+         return False;
+
+      elsif Has_Read_Write_Attributes (Typ)
+        or else Has_Read_Write_Attributes (U_Typ)
+      then
+         return False;
+
+      elsif Is_Non_Remote_Access_Type (U_Typ) then
+         return True;
+      end if;
+
+      if Is_Record_Type (U_Typ) then
+         Component := First_Entity (U_Typ);
+         while Present (Component) loop
+            if not Is_Tag (Component) then
+               Comp_Type := Etype (Component);
+
+               if Has_Non_Remote_Access (Comp_Type) then
+                  return True;
+               end if;
+            end if;
+
+            Next_Entity (Component);
+         end loop;
+
+      elsif Is_Array_Type (U_Typ) then
+         return Has_Non_Remote_Access (Component_Type (U_Typ));
+
+      end if;
+
+      return False;
+   end Has_Non_Remote_Access;
+
+   -------------------------------
+   -- Has_Read_Write_Attributes --
+   -------------------------------
+
+   function Has_Read_Write_Attributes (E : Entity_Id) return Boolean is
+   begin
+      return True
+        and then Has_Stream_Attribute_Definition (E,
+                   TSS_Stream_Read,  At_Any_Place => True)
+        and then Has_Stream_Attribute_Definition (E,
+                   TSS_Stream_Write, At_Any_Place => True);
+   end Has_Read_Write_Attributes;
+
    -------------------------------------
    -- Has_Stream_Attribute_Definition --
    -------------------------------------
@@ -555,64 +622,29 @@ package body Sem_Cat is
         and then not Is_Remote_Access_To_Subprogram_Type (U_E);
    end Is_Non_Remote_Access_Type;
 
-   ----------------------------------
-   -- Missing_Read_Write_Attribute --
-   ----------------------------------
-
-   function Missing_Read_Write_Attributes (E : Entity_Id) return Boolean is
-      Component      : Entity_Id;
-      Component_Type : Entity_Id;
-      U_E            : constant Entity_Id := Underlying_Type (E);
-
-      function Has_Read_Write_Attributes (E : Entity_Id) return Boolean;
-      --  Return True if entity has attribute definition clauses for Read and
-      --  Write attributes that are visible at some place.
-
-      -------------------------------
-      -- Has_Read_Write_Attributes --
-      -------------------------------
-
-      function Has_Read_Write_Attributes (E : Entity_Id) return Boolean is
-      begin
-         return True
-           and then Has_Stream_Attribute_Definition (E,
-                      TSS_Stream_Read,  At_Any_Place => True)
-           and then Has_Stream_Attribute_Definition (E,
-                      TSS_Stream_Write, At_Any_Place => True);
-      end Has_Read_Write_Attributes;
-
-   --  Start of processing for Missing_Read_Write_Attributes
+   ---------------------------
+   -- No_External_Streaming --
+   ---------------------------
 
+   function No_External_Streaming (E : Entity_Id) return Boolean is
+      U_E : constant Entity_Id := Underlying_Type (E);
    begin
       if No (U_E) then
          return False;
 
-      elsif Has_Read_Write_Attributes (E)
-        or else Has_Read_Write_Attributes (U_E)
-      then
+      elsif Has_Read_Write_Attributes (E) then
+         --  Note: availability of stream attributes is tested on E, not U_E.
+         --  There may be stream attributes defined on U_E that are not visible
+         --  at the place where support of external streaming is tested.
+
          return False;
 
-      elsif Is_Non_Remote_Access_Type (U_E) then
+      elsif Has_Non_Remote_Access (U_E) then
          return True;
       end if;
 
-      if Is_Record_Type (U_E) then
-         Component := First_Entity (U_E);
-         while Present (Component) loop
-            if not Is_Tag (Component) then
-               Component_Type := Etype (Component);
-
-               if Missing_Read_Write_Attributes (Component_Type) then
-                  return True;
-               end if;
-            end if;
-
-            Next_Entity (Component);
-         end loop;
-      end if;
-
-      return False;
-   end Missing_Read_Write_Attributes;
+      return Is_Limited_Type (E);
+   end No_External_Streaming;
 
    -------------------------------------
    -- Set_Categorization_From_Pragmas --
@@ -1311,156 +1343,155 @@ package body Sem_Cat is
 
    end Validate_Object_Declaration;
 
-   ------------------------------
-   -- Validate_RACW_Primitives --
-   ------------------------------
+   -----------------------------
+   -- Validate_RACW_Primitive --
+   -----------------------------
 
-   procedure Validate_RACW_Primitives (T : Entity_Id) is
-      Desig_Type             : Entity_Id;
-      Primitive_Subprograms  : Elist_Id;
-      Subprogram_Elmt        : Elmt_Id;
-      Subprogram             : Entity_Id;
-      Param_Spec             : Node_Id;
-      Param                  : Entity_Id;
-      Param_Type             : Entity_Id;
-      Rtyp                   : Node_Id;
+   procedure Validate_RACW_Primitive
+     (Subp : Entity_Id;
+      RACW : Entity_Id)
+   is
+      procedure Illegal_Remote_Subp (Msg : String; N : Node_Id);
+      --  Diagnose illegality on N. If RACW is present, report the error on it
+      --  rather than on N.
 
-      procedure Illegal_RACW (Msg : String; N : Node_Id);
-      --  Diagnose that T is illegal because of the given reason, associated
-      --  with the location of node N.
+      -------------------------
+      -- Illegal_Remote_Subp --
+      -------------------------
 
-      Illegal_RACW_Message_Issued : Boolean := False;
-      --  Set True once Illegal_RACW has been called
+      procedure Illegal_Remote_Subp (Msg : String; N : Node_Id) is
+      begin
+         if Present (RACW) then
+            if not Error_Posted (RACW) then
+               Error_Msg_N
+                 ("illegal remote access to class-wide type&", RACW);
+            end if;
 
-      ------------------
-      -- Illegal_RACW --
-      ------------------
+            Error_Msg_Sloc := Sloc (N);
+            Error_Msg_NE ("\\" & Msg & " in primitive& #", RACW, Subp);
 
-      procedure Illegal_RACW (Msg : String; N : Node_Id) is
-      begin
-         if not Illegal_RACW_Message_Issued then
-            Error_Msg_N
-              ("illegal remote access to class-wide type&", T);
-            Illegal_RACW_Message_Issued := True;
+         else
+            Error_Msg_NE (Msg & " in remote subprogram&", N, Subp);
          end if;
+      end Illegal_Remote_Subp;
 
-         Error_Msg_Sloc := Sloc (N);
-         Error_Msg_N ("\\" & Msg & " in primitive#", T);
-      end Illegal_RACW;
+      Rtyp       : Entity_Id;
+      Param      : Node_Id;
+      Param_Spec : Node_Id;
+      Param_Type : Entity_Id;
 
-   --  Start of processing for Validate_RACW_Primitives
+   --  Start of processing for Validate_RACW_Primitive
 
    begin
-      Desig_Type := Etype (Designated_Type (T));
+      --  Check return type
 
-      --  No action needed for concurrent types
+      if Ekind (Subp) = E_Function then
+         Rtyp := Etype (Subp);
 
-      if Is_Concurrent_Type (Desig_Type) then
-         return;
-      end if;
-
-      Primitive_Subprograms := Primitive_Operations (Desig_Type);
+         if Has_Controlling_Result (Subp) then
+            null;
 
-      Subprogram_Elmt := First_Elmt (Primitive_Subprograms);
-      while Subprogram_Elmt /= No_Elmt loop
-         Subprogram := Node (Subprogram_Elmt);
+         elsif Ekind (Rtyp) = E_Anonymous_Access_Type then
+            Illegal_Remote_Subp ("anonymous access result", Rtyp);
 
-         if Is_Predefined_Dispatching_Operation (Subprogram)
-           or else Is_Hidden (Subprogram)
-         then
-            goto Next_Subprogram;
+         elsif Is_Limited_Type (Rtyp) then
+            if No (TSS (Rtyp, TSS_Stream_Read))
+                 or else
+               No (TSS (Rtyp, TSS_Stream_Write))
+            then
+               Illegal_Remote_Subp
+                 ("limited return type must have Read and Write attributes",
+                     Parent (Subp));
+               Explain_Limited_Type (Rtyp, Parent (Subp));
+
+            --  Check that the return type supports external streaming.
+            --  Note that the language of the standard (E.2.2(14)) does not
+            --  explicitly mention that case, but it really does not make
+            --  sense to return a value containing a local access type.
+
+            elsif No_External_Streaming (Rtyp)
+                    and then not Error_Posted (Rtyp)
+            then
+               Illegal_Remote_Subp ("return type containing non-remote access "
+                 & "must have Read and Write attributes",
+                 Parent (Subp));
+            end if;
          end if;
+      end if;
 
-         --  Check return type
+      Param := First_Formal (Subp);
+      while Present (Param) loop
 
-         if Ekind (Subprogram) = E_Function then
-            Rtyp := Etype (Subprogram);
+         --  Now find out if this parameter is a controlling parameter
 
-            if Has_Controlling_Result (Subprogram) then
-               null;
+         Param_Spec := Parent (Param);
+         Param_Type := Etype (Param);
 
-            elsif Ekind (Rtyp) = E_Anonymous_Access_Type then
-               Illegal_RACW ("anonymous access result", Rtyp);
+         if Is_Controlling_Formal (Param) then
 
-            elsif Is_Limited_Type (Rtyp) then
-               if No (TSS (Rtyp, TSS_Stream_Read))
-                    or else
-                  No (TSS (Rtyp, TSS_Stream_Write))
-               then
-                  Illegal_RACW
-                    ("limited return type must have Read and Write attributes",
-                     Parent (Subprogram));
-                  Explain_Limited_Type (Rtyp, Parent (Subprogram));
-
-               --  Check that the return type supports external streaming.
-               --  Note that the language of the standard (E.2.2(14)) does not
-               --  explicitly mention that case, but it really does not make
-               --  sense to return a value containing a local access type.
-
-               elsif Missing_Read_Write_Attributes (Rtyp)
-                       and then not Error_Posted (Rtyp)
-               then
-                  Illegal_RACW ("return type containing non-remote access "
-                    & "must have Read and Write attributes",
-                    Parent (Subprogram));
-               end if;
+            --  It is a controlling parameter, so specific checks below do not
+            --  apply.
 
-            end if;
-         end if;
+            null;
 
-         Param := First_Formal (Subprogram);
-         while Present (Param) loop
+         elsif Ekind_In (Param_Type, E_Anonymous_Access_Type,
+                                     E_Anonymous_Access_Subprogram_Type)
+         then
+            --  From RM E.2.2(14), no anonymous access parameter other than
+            --  controlling ones may be used (because an anonymous access
+            --  type never supports external streaming).
 
-            --  Now find out if this parameter is a controlling parameter
+            Illegal_Remote_Subp
+              ("non-controlling access parameter", Param_Spec);
 
-            Param_Spec := Parent (Param);
-            Param_Type := Etype (Param);
+         elsif No_External_Streaming (Param_Type)
+            and then not Error_Posted (Param_Type)
+         then
+            Illegal_Remote_Subp ("formal parameter in remote subprogram must "
+              & "support external streaming", Param_Spec);
+         end if;
 
-            if Is_Controlling_Formal (Param) then
+         --  Check next parameter in this subprogram
 
-               --  It is a controlling parameter, so specific checks below
-               --  do not apply.
+         Next_Formal (Param);
+      end loop;
+   end Validate_RACW_Primitive;
 
-               null;
+   ------------------------------
+   -- Validate_RACW_Primitives --
+   ------------------------------
 
-            elsif Ekind_In (Param_Type, E_Anonymous_Access_Type,
-                                        E_Anonymous_Access_Subprogram_Type)
-            then
-               --  From RM E.2.2(14), no anonymous access parameter other than
-               --  controlling ones may be used (because an anonymous access
-               --  type never supports external streaming).
+   procedure Validate_RACW_Primitives (T : Entity_Id) is
+      Desig_Type             : Entity_Id;
+      Primitive_Subprograms  : Elist_Id;
+      Subprogram_Elmt        : Elmt_Id;
+      Subprogram             : Entity_Id;
 
-               Illegal_RACW ("non-controlling access parameter", Param_Spec);
+   begin
+      Desig_Type := Etype (Designated_Type (T));
 
-            elsif Is_Limited_Type (Param_Type) then
+      --  No action needed for concurrent types
 
-               --  Not a controlling parameter, so type must have Read and
-               --  Write attributes.
+      if Is_Concurrent_Type (Desig_Type) then
+         return;
+      end if;
 
-               if No (TSS (Param_Type, TSS_Stream_Read))
-                    or else
-                  No (TSS (Param_Type, TSS_Stream_Write))
-               then
-                  Illegal_RACW
-                    ("limited formal must have Read and Write attributes",
-                     Param_Spec);
-                  Explain_Limited_Type (Param_Type, Param_Spec);
-               end if;
+      Primitive_Subprograms := Primitive_Operations (Desig_Type);
 
-            elsif Missing_Read_Write_Attributes (Param_Type)
-               and then not Error_Posted (Param_Type)
-            then
-               Illegal_RACW ("parameter containing non-remote access "
-                 & "must have Read and Write attributes", Param_Spec);
-            end if;
+      Subprogram_Elmt := First_Elmt (Primitive_Subprograms);
+      while Subprogram_Elmt /= No_Elmt loop
+         Subprogram := Node (Subprogram_Elmt);
 
-            --  Check next parameter in this subprogram
+         if Is_Predefined_Dispatching_Operation (Subprogram)
+           or else Is_Hidden (Subprogram)
+         then
+            goto Next_Subprogram;
+         end if;
 
-            Next_Formal (Param);
-         end loop;
+         Validate_RACW_Primitive (Subp => Subprogram, RACW => T);
 
-         <<Next_Subprogram>>
-            Next_Elmt (Subprogram_Elmt);
+      <<Next_Subprogram>>
+         Next_Elmt (Subprogram_Elmt);
       end loop;
    end Validate_RACW_Primitives;
 
@@ -1487,8 +1518,7 @@ package body Sem_Cat is
                Error_Msg_N ("generic declaration not allowed in rci unit",
                  Parent (E));
 
-            elsif (Ekind (E) = E_Function
-                    or else Ekind (E) = E_Procedure)
+            elsif (Ekind (E) = E_Function or else Ekind (E) = E_Procedure)
               and then Has_Pragma_Inline (E)
             then
                Error_Msg_N
@@ -1527,9 +1557,6 @@ package body Sem_Cat is
       Id              : Node_Id;
       Param_Spec      : Node_Id;
       Param_Type      : Entity_Id;
-      Base_Param_Type : Entity_Id;
-      Base_Under_Type : Entity_Id;
-      Type_Decl       : Node_Id;
       Error_Node      : Node_Id := N;
 
    begin
@@ -1545,6 +1572,7 @@ package body Sem_Cat is
       end if;
 
       if K = N_Subprogram_Declaration then
+         Id := Defining_Unit_Name (Specification (N));
          Profile := Parameter_Specifications (Specification (N));
 
       else pragma Assert (K = N_Object_Declaration);
@@ -1574,7 +1602,6 @@ package body Sem_Cat is
          Param_Spec := First (Profile);
          while Present (Param_Spec) loop
             Param_Type := Etype (Defining_Identifier (Param_Spec));
-            Type_Decl  := Parent (Param_Type);
 
             if Ekind (Param_Type) = E_Anonymous_Access_Type then
                if K = N_Subprogram_Declaration then
@@ -1595,115 +1622,20 @@ package body Sem_Cat is
             --  declaration and ignore full type declaration, unless this is
             --  the only declaration for the type, e.g., as a limited record.
 
-            elsif Is_Limited_Type (Param_Type)
-              and then (Nkind (Type_Decl) = N_Private_Type_Declaration
-                         or else
-                        (Nkind (Type_Decl) = N_Full_Type_Declaration
-                          and then not (Has_Private_Declaration (Param_Type))
-                          and then Comes_From_Source (N)))
-            then
-               --  A limited parameter is legal only if user-specified Read and
-               --  Write attributes exist for it. Second part of RM E.2.3 (14).
-
-               if No (Full_View (Param_Type))
-                 and then Ekind (Param_Type) /= E_Record_Type
-               then
-                  --  Type does not have completion yet, so if declared in
-                  --  the current RCI scope it is illegal, and will be flagged
-                  --  subsequently.
-
-                  return;
-               end if;
-
-               --  In Ada 95 the rules permit using a limited type that has
-               --  user-specified Read and Write attributes that are specified
-               --  in the private part of the package, whereas Ada 2005
-               --  (AI-240) revises this to require the attributes to be
-               --  "available" (implying that the attribute clauses must be
-               --  visible to the RCI client). The Ada 95 rules violate the
-               --  contract model for privacy, but we support both semantics
-               --  for now for compatibility (note that ACATS test BXE2009
-               --  checks a case that conforms to the Ada 95 rules but is
-               --  illegal in Ada 2005). In the Ada 2005 case we check for the
-               --  possibilities of visible TSS stream subprograms or explicit
-               --  stream attribute definitions because the TSS subprograms
-               --  can be hidden in the private part while the attribute
-               --  definitions are still be available from the visible part.
-
-               Base_Param_Type := Base_Type (Param_Type);
-               Base_Under_Type := Base_Type (Underlying_Type
-                                              (Base_Param_Type));
-
-               if (Ada_Version < Ada_2005
-                     and then
-                       (No (TSS (Base_Param_Type, TSS_Stream_Read))
-                          or else
-                        No (TSS (Base_Param_Type, TSS_Stream_Write)))
-                     and then
-                       (No (TSS (Base_Under_Type, TSS_Stream_Read))
-                          or else
-                        No (TSS (Base_Under_Type, TSS_Stream_Write))))
-                 or else
-                   (Ada_Version >= Ada_2005
-                      and then
-                        (No (TSS (Base_Param_Type, TSS_Stream_Read))
-                           or else
-                         No (TSS (Base_Param_Type, TSS_Stream_Write))
-                           or else
-                         Is_Hidden (TSS (Base_Param_Type, TSS_Stream_Read))
-                           or else
-                         Is_Hidden (TSS (Base_Param_Type, TSS_Stream_Write)))
-                      and then
-                        (not Has_Stream_Attribute_Definition
-                               (Base_Param_Type, TSS_Stream_Read)
-                           or else
-                         not Has_Stream_Attribute_Definition
-                               (Base_Param_Type, TSS_Stream_Write)))
-               then
-                  if K = N_Subprogram_Declaration then
-                     Error_Node := Param_Spec;
-                  end if;
-
-                  if Ada_Version >= Ada_2005 then
-                     Error_Msg_N
-                       ("limited parameter in 'R'C'I unit "
-                          & "must have visible read/write attributes ",
-                        Error_Node);
-                  else
-                     Error_Msg_N
-                       ("limited parameter in 'R'C'I unit "
-                          & "must have read/write attributes ",
-                        Error_Node);
-                  end if;
-                  Explain_Limited_Type (Param_Type, Error_Node);
-               end if;
-
-            --  In Ada 95, any non-remote access type (or any type with a
-            --  component of a non-remote access type) that is visible in an
-            --  RCI unit comes from a Remote_Types or Remote_Call_Interface
-            --  unit, and thus is already guaranteed to support external
-            --  streaming. However in Ada 2005 we have to account for the case
-            --  of named access types from declared pure units as well, which
-            --  may or may not support external streaming, and so we need to
-            --  perform a specific check for E.2.3(14/2) here.
-
-            --  Note that if the declaration of the type itself is illegal, we
-            --  do not perform this check since it might be a cascaded error.
-
-            else
+            elsif No_External_Streaming (Param_Type) then
                if K = N_Subprogram_Declaration then
                   Error_Node := Param_Spec;
                end if;
 
-               if Missing_Read_Write_Attributes (Param_Type)
-                    and then not Error_Posted (Param_Type)
-               then
-                  Error_Msg_N
-                    ("parameter containing non-remote access in 'R'C'I "
-                     & "subprogram must have visible "
-                     & "Read and Write attributes", Error_Node);
+               Error_Msg_NE
+                 ("formal of remote subprogram& "
+                  & "must support external streaming",
+                  Error_Node, Id);
+               if Is_Limited_Type (Param_Type) then
+                  Explain_Limited_Type (Param_Type, Error_Node);
                end if;
             end if;
+
             Next (Param_Spec);
          end loop;
 
@@ -2005,6 +1937,27 @@ package body Sem_Cat is
       U_Typ          : Entity_Id;
       First_Priv_Ent : constant Entity_Id := First_Private_Entity (Name_U);
 
+      function Stream_Attributes_Available (Typ : Entity_Id) return Boolean;
+      --  True if any stream attribute is available for Typ
+
+      ---------------------------------
+      -- Stream_Attributes_Available --
+      ---------------------------------
+
+      function Stream_Attributes_Available (Typ : Entity_Id) return Boolean
+      is
+      begin
+         return Stream_Attribute_Available (Typ, TSS_Stream_Read)
+                  or else
+                Stream_Attribute_Available (Typ, TSS_Stream_Write)
+                  or else
+                Stream_Attribute_Available (Typ, TSS_Stream_Input)
+                  or else
+                Stream_Attribute_Available (Typ, TSS_Stream_Output);
+      end Stream_Attributes_Available;
+
+   --  Start of processing for Validate_RT_RAT_Component
+
    begin
       if not Is_Remote_Types (Name_U) then
          return;
@@ -2019,7 +1972,15 @@ package body Sem_Cat is
          end if;
 
          if Comes_From_Source (Typ) and then Is_Type (Typ) then
-            if Missing_Read_Write_Attributes (Typ) then
+
+            --  Check that the type can be meaningfully transmitted to another
+            --  partition (E.2.2(8)).
+
+            if (Ada_Version < Ada_2005 and then Has_Non_Remote_Access (U_Typ))
+                 or else
+               (Stream_Attributes_Available (Typ)
+                  and then No_External_Streaming (U_Typ))
+            then
                if Is_Non_Remote_Access_Type (Typ) then
                   Error_Msg_N ("error in non-remote access type", U_Typ);
                else
diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads
index 3d66e1833b6..75fd41485d3 100644
--- a/gcc/ada/vms_data.ads
+++ b/gcc/ada/vms_data.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1996-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-2011, 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- --
@@ -5456,6 +5456,14 @@ package VMS_Data is
    --   Do not count EXIT statements as GOTOs when computing the Essential
    --   Complexity.
 
+   S_Metric_No_Static_Loop : aliased constant S := "/NO_STATIC_LOOP " &
+                                                   "--no-static-loop";
+   --        /STATIC_LOOP (D)
+   --        /NO_STATIC_LOOP
+   --
+   --   Do not count static FOR loop statements when computing the Cyclomatic
+   --   Complexity.
+
    S_Metric_Mess    : aliased constant S := "/MESSAGES_PROJECT_FILE="      &
                                              "DEFAULT "                    &
                                                 "-vP0 "                    &
@@ -5554,6 +5562,7 @@ package VMS_Data is
                         S_Metric_Mess             'Access,
                         S_Metric_No_Exits_As_Gotos'Access,
                         S_Metric_No_Local         'Access,
+                        S_Metric_No_Static_Loop   'Access,
                         S_Metric_Project          'Access,
                         S_Metric_Quiet            'Access,
                         S_Metric_Suffix           'Access,