2012-04-26 Robert Dewar <dewar@adacore.com>

	* sem_ch5.adb (Check_Unreachable_Code): Skip past pragmas.

2012-04-26  Hristian Kirtchev  <kirtchev@adacore.com>

	* s-finroo.ads: Remove with clause for
	Ada.Streams. Type Root_Controlled is now abstract tagged null
	record. Remove internal package Stream_Attributes. Root_Controlled
	doesn't need stream attribute redeclaration and avoids the
	dependency on streams.

2012-04-26  Tristan Gingold  <gingold@adacore.com>

	* adaint.c (to_host_path_spec): Removed (unused).
	Minor reformatting.

2012-04-26  Steve Baird  <baird@adacore.com>

	* gnat_rm.texi Improve description of Valid_Scalars attribute.

2012-04-26  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Can_Override_Operator): If the formal is a
	generic type the operator cannot be overriding.

2012-04-26  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Spec_Reloaded_For_Body): Check whether the type
	is declared in a package specification, and current unit is the
	corresponding package body. The use clauses themselves may be
	within a nested package.

2012-04-26  Bob Duff  <duff@adacore.com>

	* exp_ch2.adb (Param_Entity): Take into account the case where
	the type of the entry parameter has a representation clause.



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

8 files changed, 211 insertions, 162 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2b65223d7d8..db2dc69e674 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,41 @@
+2012-04-26  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch5.adb (Check_Unreachable_Code): Skip past pragmas.
+
+2012-04-26  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* s-finroo.ads: Remove with clause for
+	Ada.Streams. Type Root_Controlled is now abstract tagged null
+	record. Remove internal package Stream_Attributes. Root_Controlled
+	doesn't need stream attribute redeclaration and avoids the
+	dependency on streams.
+
+2012-04-26  Tristan Gingold  <gingold@adacore.com>
+
+	* adaint.c (to_host_path_spec): Removed (unused).
+	Minor reformatting.
+
+2012-04-26  Steve Baird  <baird@adacore.com>
+
+	* gnat_rm.texi Improve description of Valid_Scalars attribute.
+
+2012-04-26  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Can_Override_Operator): If the formal is a
+	generic type the operator cannot be overriding.
+
+2012-04-26  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb (Spec_Reloaded_For_Body): Check whether the type
+	is declared in a package specification, and current unit is the
+	corresponding package body. The use clauses themselves may be
+	within a nested package.
+
+2012-04-26  Bob Duff  <duff@adacore.com>
+
+	* exp_ch2.adb (Param_Entity): Take into account the case where
+	the type of the entry parameter has a representation clause.
+
 2012-04-26  Ed Schonberg  <schonberg@adacore.com>
 
 	* gnat_ugn.texi: Tweak dimensionality doc.
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index e13b01cdb6e..34136ff914d 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -3086,11 +3086,12 @@ __gnat_to_canonical_file_list_free ()
 char *
 __gnat_translate_vms (char *src)
 {
-  static char retbuf [NAM$C_MAXRSS+1];
+  static char retbuf [NAM$C_MAXRSS + 1];
   char *srcendpos, *pos1, *pos2, *retpos;
   int disp, path_present = 0;
 
-  if (!src) return NULL;
+  if (!src)
+    return NULL;
 
   srcendpos = strchr (src, '\0');
   retpos = retbuf;
@@ -3099,112 +3100,132 @@ __gnat_translate_vms (char *src)
   pos1 = src;
   pos2 = strchr (pos1, ':');
 
-  if (pos2 && (pos2 < srcendpos) && (*(pos2 + 1) == ':')) {
-    /* There is a node name. "node_name::" becomes "node_name!" */
-    disp = pos2 - pos1;
-    strncpy (retbuf, pos1, disp);
-    retpos [disp] = '!';
-    retpos = retpos + disp + 1;
-    pos1 = pos2 + 2;
-    pos2 = strchr (pos1, ':');
-  }
+  if (pos2 && (pos2 < srcendpos) && (*(pos2 + 1) == ':'))
+    {
+      /* There is a node name. "node_name::" becomes "node_name!" */
+      disp = pos2 - pos1;
+      strncpy (retbuf, pos1, disp);
+      retpos [disp] = '!';
+      retpos = retpos + disp + 1;
+      pos1 = pos2 + 2;
+      pos2 = strchr (pos1, ':');
+    }
 
-  if (pos2) {
-    /* There is a device name. "dev_name:" becomes "/dev_name/" */
-    *(retpos++) = '/';
-    disp = pos2 - pos1;
-    strncpy (retpos, pos1, disp);
-    retpos = retpos + disp;
-    pos1 = pos2 + 1;
-    *(retpos++) = '/';
-  }
+  if (pos2)
+    {
+      /* There is a device name. "dev_name:" becomes "/dev_name/" */
+      *(retpos++) = '/';
+      disp = pos2 - pos1;
+      strncpy (retpos, pos1, disp);
+      retpos = retpos + disp;
+      pos1 = pos2 + 1;
+      *(retpos++) = '/';
+    }
   else
     /* No explicit device; we must look ahead and prepend /sys$disk/ if
        the path is absolute */
     if ((*pos1 == '[' || *pos1 == '<') && (pos1 < srcendpos)
-        && !strchr (".-]>", *(pos1 + 1))) {
-      strncpy (retpos, "/sys$disk/", 10);
-      retpos += 10;
-    }
+        && !strchr (".-]>", *(pos1 + 1)))
+      {
+        strncpy (retpos, "/sys$disk/", 10);
+        retpos += 10;
+      }
 
   /* Process the path part */
-  while (*pos1 == '[' || *pos1 == '<') {
-    path_present++;
-    pos1++;
-    if (*pos1 == ']' || *pos1 == '>') {
-      /* Special case, [] translates to '.' */
-      *(retpos++) = '.';
+  while (*pos1 == '[' || *pos1 == '<')
+    {
+      path_present++;
       pos1++;
-    }
-    else {
-      /* '[000000' means root dir. It can be present in the middle of
-         the path due to expansion of logical devices, in which case
-         we skip it */
-      if (!strncmp (pos1, "000000", 6) && path_present > 1 &&
-         (*(pos1 + 6) == ']' || *(pos1 + 6) == '>' || *(pos1 + 6) == '.')) {
-          pos1 += 6;
-          if (*pos1 == '.') pos1++;
+      if (*pos1 == ']' || *pos1 == '>')
+        {
+          /* Special case, [] translates to '.' */
+          *(retpos++) = '.';
+          pos1++;
         }
-      else if (*pos1 == '.') {
-        /* Relative path */
-        *(retpos++) = '.';
-      }
-
-      /* There is a qualified path */
-      while (*pos1 && *pos1 != ']' && *pos1 != '>') {
-        switch (*pos1) {
-          case '.':
-            /* '.' is used to separate directories. Replace it with '/' but
-               only if there isn't already '/' just before */
-            if (*(retpos - 1) != '/') *(retpos++) = '/';
-            pos1++;
-            if (pos1 + 1 < srcendpos && *pos1 == '.' && *(pos1 + 1) == '.') {
-              /* ellipsis refers to entire subtree; replace with '**' */
-              *(retpos++) = '*'; *(retpos++) = '*'; *(retpos++) = '/';
-              pos1 += 2;
+      else
+        {
+          /* '[000000' means root dir. It can be present in the middle of
+             the path due to expansion of logical devices, in which case
+             we skip it */
+          if (!strncmp (pos1, "000000", 6) && path_present > 1 &&
+              (*(pos1 + 6) == ']' || *(pos1 + 6) == '>' || *(pos1 + 6) == '.'))
+            {
+              pos1 += 6;
+              if (*pos1 == '.') pos1++;
             }
-            break;
-          case '-' :
-            /* When after '.' '[' '<' is equivalent to Unix ".." but there
-            may be several in a row */
-            if (*(pos1 - 1) == '.' || *(pos1 - 1) == '[' ||
-                *(pos1 - 1) == '<') {
-              while (*pos1 == '-') {
-                pos1++;
-                *(retpos++) = '.'; *(retpos++) = '.'; *(retpos++) = '/';
-              }
-              retpos--;
-              break;
+          else if (*pos1 == '.')
+            {
+              /* Relative path */
+              *(retpos++) = '.';
+            }
+
+          /* There is a qualified path */
+          while (*pos1 && *pos1 != ']' && *pos1 != '>')
+            {
+              switch (*pos1)
+                {
+                case '.':
+                  /* '.' is used to separate directories. Replace it with '/' but
+                     only if there isn't already '/' just before */
+                  if (*(retpos - 1) != '/')
+                    *(retpos++) = '/';
+                  pos1++;
+                  if (pos1 + 1 < srcendpos && *pos1 == '.' && *(pos1 + 1) == '.')
+                    {
+                      /* ellipsis refers to entire subtree; replace with '**' */
+                      *(retpos++) = '*';
+                      *(retpos++) = '*';
+                      *(retpos++) = '/';
+                      pos1 += 2;
+                    }
+                  break;
+                case '-' :
+                  /* When after '.' '[' '<' is equivalent to Unix ".." but there
+                     may be several in a row */
+                  if (*(pos1 - 1) == '.' || *(pos1 - 1) == '[' ||
+                      *(pos1 - 1) == '<')
+                    {
+                      while (*pos1 == '-')
+                        {
+                          pos1++;
+                          *(retpos++) = '.';
+                          *(retpos++) = '.';
+                          *(retpos++) = '/';
+                        }
+                      retpos--;
+                      break;
+                    }
+                  /* otherwise fall through to default */
+                default:
+                  *(retpos++) = *(pos1++);
+                }
             }
-            /* otherwise fall through to default */
-          default:
-            *(retpos++) = *(pos1++);
+          pos1++;
         }
-      }
-      pos1++;
     }
-  }
 
-  if (pos1 < srcendpos) {
-    /* Now add the actual file name, until the version suffix if any */
-    if (path_present) *(retpos++) = '/';
-    pos2 = strchr (pos1, ';');
-    disp = pos2? (pos2 - pos1) : (srcendpos - pos1);
-    strncpy (retpos, pos1, disp);
-    retpos += disp;
-    if (pos2 && pos2 < srcendpos) {
-      /* There is a non-empty version suffix. ";<ver>" becomes ".<ver>" */
-      *retpos++ = '.';
-      disp = srcendpos - pos2 - 1;
-      strncpy (retpos, pos2 + 1, disp);
+  if (pos1 < srcendpos)
+    {
+      /* Now add the actual file name, until the version suffix if any */
+      if (path_present)
+        *(retpos++) = '/';
+      pos2 = strchr (pos1, ';');
+      disp = pos2? (pos2 - pos1) : (srcendpos - pos1);
+      strncpy (retpos, pos1, disp);
       retpos += disp;
+      if (pos2 && pos2 < srcendpos)
+        {
+          /* There is a non-empty version suffix. ";<ver>" becomes ".<ver>" */
+          *retpos++ = '.';
+          disp = srcendpos - pos2 - 1;
+          strncpy (retpos, pos2 + 1, disp);
+          retpos += disp;
+        }
     }
-  }
 
   *retpos = '\0';
 
   return retbuf;
-
 }
 
 /* Translate a VMS syntax directory specification in to Unix syntax.  If
@@ -3355,52 +3376,13 @@ __gnat_to_canonical_path_spec (char *pathspec)
 static char filename_buff [MAXPATH];
 
 static int
-translate_unix (char *name, int type)
+translate_unix (char *name, int type ATTRIBUTE_UNUSED)
 {
   strncpy (filename_buff, name, MAXPATH);
   filename_buff [MAXPATH - 1] = (char) 0;
   return 0;
 }
 
-/* Translate a Unix syntax path spec into a VMS style (comma separated list of
-   directories.  */
-
-static char *
-to_host_path_spec (char *pathspec)
-{
-  char *curr, *next, buff [MAXPATH];
-
-  if (pathspec == 0)
-    return pathspec;
-
-  /* Can't very well test for colons, since that's the Unix separator!  */
-  if (strchr (pathspec, ']') || strchr (pathspec, ','))
-    return pathspec;
-
-  new_host_pathspec[0] = 0;
-  curr = pathspec;
-
-  for (;;)
-    {
-      next = strchr (curr, ':');
-      if (next == 0)
-        next = strchr (curr, 0);
-
-      strncpy (buff, curr, next - curr);
-      buff[next - curr] = 0;
-
-      strncat (new_host_pathspec, __gnat_to_host_dir_spec (buff, 0), MAXPATH);
-      if (*next == 0)
-        break;
-      strncat (new_host_pathspec, ",", MAXPATH);
-      curr = next + 1;
-    }
-
-  new_host_pathspec [MAXPATH - 1] = (char) 0;
-
-  return new_host_pathspec;
-}
-
 /* Translate a Unix syntax directory specification into VMS syntax.  The
    PREFIXFLAG has no effect, but is kept for symmetry with
    to_canonical_dir_spec.  If indicators of VMS syntax found, return input
@@ -3592,7 +3574,8 @@ char __gnat_environment_char = '$';
    Returns 0 if operation was successful and -1 in case of error. */
 
 int
-__gnat_copy_attribs (char *from, char *to, int mode)
+__gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED,
+                     int mode ATTRIBUTE_UNUSED)
 {
 #if defined (VMS) || (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) || \
   defined (__nucleus__)
diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb
index 80f381b82a1..2f19d20996b 100644
--- a/gcc/ada/exp_ch2.adb
+++ b/gcc/ada/exp_ch2.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -723,6 +723,8 @@ package body Exp_Ch2 is
    --    typ!(recobj).rec.all'Constrained
 
    --  where rec is a selector whose Entry_Formal link points to the formal
+   --  If the type of the entry parameter has a representation clause, then an
+   --  extra temp is involved (see below).
    --  For a formal of a task entity, the formal is rewritten as a local
    --  renaming.
 
@@ -760,10 +762,30 @@ package body Exp_Ch2 is
       else
          if Nkind (N) = N_Explicit_Dereference then
             declare
-               P : constant Node_Id := Prefix (N);
-               S : Node_Id;
+               P    : Node_Id := Prefix (N);
+               S    : Node_Id;
+               E    : Entity_Id;
+               Decl : Node_Id;
 
             begin
+               --  If the type of an entry parameter has a representation
+               --  clause, then the prefix is not a selected component, but
+               --  instead a reference to a temp pointing at the selected
+               --  component. In this case, set P to be the initial value of
+               --  that temp.
+
+               if Nkind (P) = N_Identifier then
+                  E := Entity (P);
+
+                  if Ekind (E) = E_Constant then
+                     Decl := Parent (E);
+
+                     if Nkind (Decl) = N_Object_Declaration then
+                        P := Expression (Decl);
+                     end if;
+                  end if;
+               end if;
+
                if Nkind (P) = N_Selected_Component then
                   S := Selector_Name (P);
 
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 96e3ab150f2..88a30f9fe5d 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -6998,18 +6998,22 @@ caller.
 @findex Valid_Scalars
 @noindent
 The @code{'Valid_Scalars} attribute is intended to make it easier to
-check the validity of scalar subcomponents of composite objects.  It
-is defined for any prefix @code{X} that denotes a scalar or composite
-object (after any implicit dereference), that is not of classwide type
-or of a formal generic type with an unknown discriminant.
-@code{X'Valid_Scalars} yields True if and only if @code{X'Valid}
-yields True, if @code{X} is a scalar object, or @code{Y'Valid} yields
-True for every scalar subcomponent @code{Y} of @code{X}, if @code{X}
-is a composite object. If computing the value of
-@code{X'Valid_Scalars} involves evaluations of subtype predicates, it
-is unspecified in which order these evaluations take place, or if they
-take place at all in case the result is False. The value of this
-attribute is of the predefined type Boolean.
+check the validity of scalar subcomponents of composite objects. It
+is defined for any prefix @code{X} that denotes an object.
+The value of this attribute is of the predefined type Boolean.
+@code{X'Valid_Scalars} yields True if and only if evaluation of
+@code{P'Valid} yields True for every scalar part P of X or if X has
+no scalar parts. It is not specified in what order the scalar parts
+are checked, nor whether any more are checked after any one of them
+is determined to be invalid. If the prefix @code{X} is of a class-wide
+type @code{T'Class} (where @code{T} is the associated specific type),
+or if the prefix @code{X} is of a specific tagged type @code{T}, then
+only the scalar parts of components of @code{T} are traversed; in other
+words, components of extensions of @code{T} are not traversed even if
+@code{T'Class (X)'Tag /= T'Tag} . The compiler will issue a warning if it can
+be determined at compile time that the prefix of the attribute has no
+scalar parts (e.g., if the prefix is of an access type, an interface type,
+an undiscriminated task type, or an undiscriminated protected type).
 
 @node VADS_Size
 @unnumberedsec VADS_Size
diff --git a/gcc/ada/s-finroo.ads b/gcc/ada/s-finroo.ads
index 4de2b7c0375..0e1a16f933e 100644
--- a/gcc/ada/s-finroo.ads
+++ b/gcc/ada/s-finroo.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -31,30 +31,16 @@
 
 --  This unit provides the basic support for controlled (finalizable) types
 
-with Ada.Streams;
-
 package System.Finalization_Root is
    pragma Preelaborate;
 
    --  The base for types Controlled and Limited_Controlled declared in Ada.
    --  Finalization.
 
-   type Root_Controlled is tagged null record;
+   type Root_Controlled is abstract tagged null record;
 
    procedure Adjust     (Object : in out Root_Controlled);
    procedure Finalize   (Object : in out Root_Controlled);
    procedure Initialize (Object : in out Root_Controlled);
 
-   package Stream_Attributes is
-      procedure Read
-        (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
-         Item   : out Root_Controlled) is null;
-
-      procedure Write
-        (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
-         Item   : Root_Controlled) is null;
-   end Stream_Attributes;
-
-   for Root_Controlled'Read  use Stream_Attributes.Read;
-   for Root_Controlled'Write use Stream_Attributes.Write;
 end System.Finalization_Root;
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 6feb84cdefa..3d96591967a 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -2767,6 +2767,12 @@ package body Sem_Ch5 is
          begin
             Nxt := Original_Node (Next (N));
 
+            --  Skip past pragmas
+
+            while Nkind (Nxt) = N_Pragma loop
+               Nxt := Original_Node (Next (Nxt));
+            end loop;
+
             --  If a label follows us, then we never have dead code, since
             --  someone could branch to the label, so we just ignore it, unless
             --  we are in formal mode where goto statements are not allowed.
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 920cb0cd0ac..e8aa81c307c 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -7383,6 +7383,7 @@ package body Sem_Ch6 is
 
    function Can_Override_Operator (Subp : Entity_Id) return Boolean is
       Typ : Entity_Id;
+
    begin
       if Nkind (Subp) /= N_Defining_Operator_Symbol then
          return False;
@@ -7390,7 +7391,10 @@ package body Sem_Ch6 is
       else
          Typ := Base_Type (Etype (First_Formal (Subp)));
 
+         --  Check explicitly that the operation is a primitive of the type
+
          return Operator_Matches_Spec (Subp, Subp)
+           and then not Is_Generic_Type (Typ)
            and then Scope (Subp) = Scope (Typ)
            and then not Is_Class_Wide_Type (Typ);
       end if;
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index dda30af7e1c..f31110b088a 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -7963,10 +7963,16 @@ package body Sem_Ch8 is
                Spec : constant Node_Id :=
                         Parent (List_Containing (Parent (Id)));
             begin
+
+               --  Check whether type is declared in a package specification,
+               --  and current unit is the corresponding package body. The
+               --  use clauses themselves may be within a nested package.
+
                return
                  Nkind (Spec) = N_Package_Specification
-                   and then Corresponding_Body (Parent (Spec)) =
-                              Cunit_Entity (Current_Sem_Unit);
+                 and then
+                   In_Same_Source_Unit (Corresponding_Body (Parent (Spec)),
+                              Cunit_Entity (Current_Sem_Unit));
             end;
          end if;