[multiple changes]

2010-10-11  Robert Dewar  <dewar@adacore.com>

	* sem_ch6.adb, s-htable.ads: Minor reformatting.

2010-10-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Analyze_Selected_Component): If the selector is
	invisible in an instantiation, and both the formal and the actual are
	private extensions of the same type, look for the desired component in
	the proper view of the parent type.

2010-10-11  Vincent Celier  <celier@adacore.com>

	* adaint.c (__gnat_number_of_cpus): Add implementation for Solaris,
	AIX, Tru64, Darwin, IRIX and HP-UX.

From-SVN: r165277

5 files changed, 94 insertions, 28 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d216fcb..d14707d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,21 @@
 2010-10-11  Robert Dewar  <dewar@adacore.com>
 
+	* sem_ch6.adb, s-htable.ads: Minor reformatting.
+
+2010-10-11  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch4.adb (Analyze_Selected_Component): If the selector is
+	invisible in an instantiation, and both the formal and the actual are
+	private extensions of the same type, look for the desired component in
+	the proper view of the parent type.
+
+2010-10-11  Vincent Celier  <celier@adacore.com>
+
+	* adaint.c (__gnat_number_of_cpus): Add implementation for Solaris,
+	AIX, Tru64, Darwin, IRIX and HP-UX.
+
+2010-10-11  Robert Dewar  <dewar@adacore.com>
+
 	* a-textio.adb: Minor reformatting
 
 2010-10-11  Robert Dewar  <dewar@adacore.com>
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index a012ab6..b6c19de 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -49,6 +49,15 @@
 
 #endif /* VxWorks */
 
+#if (defined (__mips) && defined (__sgi)) || defined (__APPLE__)
+#include <unistd.h>
+#endif
+
+#if defined (__hpux__)
+#include <sys/param.h>
+#include <sys/pstat.h>
+#endif
+
 #ifdef VMS
 #define _POSIX_EXIT 1
 #define HOST_EXECUTABLE_SUFFIX ".exe"
@@ -2363,8 +2372,18 @@ __gnat_number_of_cpus (void)
 {
   int cores = 1;
 
-#if defined (linux)
+#if defined (linux) || defined (sun) || defined (AIX) || \
+    (defined (__alpha__)  && defined (_osf_)) || defined (__APPLE__)
   cores = (int)sysconf(_SC_NPROCESSORS_ONLN);
+
+#elif (defined (__mips) && defined (__sgi))
+  cores = (int)sysconf(_SC_NPROC_ONLN);
+
+#elif defined (__hpux__)
+    struct pst_dynamic psd;
+    if (pstat_getdynamic(&psd, sizeof(psd), 1, 0) != -1)
+       cores = (int)psd.psd_proc_cnt;
+
 #endif
 
   return cores;
diff --git a/gcc/ada/s-htable.ads b/gcc/ada/s-htable.ads
index fc97cf4..9e7d104 100644
--- a/gcc/ada/s-htable.ads
+++ b/gcc/ada/s-htable.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 1995-2009, AdaCore                     --
+--                     Copyright (C) 1995-2010, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -80,7 +80,7 @@ package System.HTable is
 
       function Get (K : Key) return Element;
       --  Returns the Element associated with a key or No_Element if the
-      --  given key has not associated element
+      --  given key has no associated element.
 
       procedure Remove (K : Key);
       --  Removes the latest inserted element pointer associated with the
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 183de2d..0a86369 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -3375,6 +3375,14 @@ package body Sem_Ch4 is
       Is_Single_Concurrent_Object : Boolean;
       --  Set True if the prefix is a single task or a single protected object
 
+      procedure Find_Component_In_Instance (Rec : Entity_Id);
+      --  In an instance, a component of a private extension may not be visible
+      --  while it was visible in the generic. Search candidate scope for a
+      --  component with the proper identifier. This is only done if all other
+      --  searches have failed. When the match is found (it always will be),
+      --  the Etype of both N and Sel are set from this component, and the
+      --  entity of Sel is set to reference this component.
+
       function Has_Mode_Conformant_Spec (Comp : Entity_Id) return Boolean;
       --  It is known that the parent of N denotes a subprogram call. Comp
       --  is an overloadable component of the concurrent type of the prefix.
@@ -3382,6 +3390,31 @@ package body Sem_Ch4 is
       --  conformant. If the parent node is not analyzed yet it may be an
       --  indexed component rather than a function call.
 
+      --------------------------------
+      -- Find_Component_In_Instance --
+      --------------------------------
+
+      procedure Find_Component_In_Instance (Rec : Entity_Id) is
+         Comp : Entity_Id;
+
+      begin
+         Comp := First_Component (Rec);
+         while Present (Comp) loop
+            if Chars (Comp) = Chars (Sel) then
+               Set_Entity_With_Style_Check (Sel, Comp);
+               Set_Etype (Sel, Etype (Comp));
+               Set_Etype (N,   Etype (Comp));
+               return;
+            end if;
+
+            Next_Component (Comp);
+         end loop;
+
+         --  This must succeed because code was legal in the generic
+
+         raise Program_Error;
+      end Find_Component_In_Instance;
+
       ------------------------------
       -- Has_Mode_Conformant_Spec --
       ------------------------------
@@ -3961,33 +3994,31 @@ package body Sem_Ch4 is
             Analyze_Selected_Component (N);
             return;
 
+         --  Similarly, if this is the actual for a formal derived type, the
+         --  component inherited from the generic parent may not be visible
+         --  in the actual, but the selected component is legal.
+
          elsif Ekind (Prefix_Type) = E_Record_Subtype_With_Private
            and then Is_Generic_Actual_Type (Prefix_Type)
            and then Present (Full_View (Prefix_Type))
          then
-            --  Similarly, if this the actual for a formal derived type, the
-            --  component inherited from the generic parent may not be visible
-            --  in the actual, but the selected component is legal.
 
-            declare
-               Comp : Entity_Id;
+            Find_Component_In_Instance
+              (Generic_Parent_Type (Parent (Prefix_Type)));
+            return;
 
-            begin
-               Comp :=
-                 First_Component (Generic_Parent_Type (Parent (Prefix_Type)));
-               while Present (Comp) loop
-                  if Chars (Comp) = Chars (Sel) then
-                     Set_Entity_With_Style_Check (Sel, Comp);
-                     Set_Etype (Sel, Etype (Comp));
-                     Set_Etype (N,   Etype (Comp));
-                     return;
-                  end if;
+         --  Finally, the formal and the actual may be private extensions,
+         --  but the generic is declared in a child unit of the parent, and
+         --  an addtional step is needed to retrieve the proper scope.
 
-                  Next_Component (Comp);
-               end loop;
+         elsif In_Instance
+           and then Present (Parent_Subtype (Etype (Base_Type (Prefix_Type))))
+         then
+            Find_Component_In_Instance
+              (Parent_Subtype (Etype (Base_Type (Prefix_Type))));
+            return;
 
-               pragma Assert (Etype (N) /= Any_Type);
-            end;
+         --  Component not found, specialize error message when appropriate
 
          else
             if Ekind (Prefix_Type) = E_Record_Subtype then
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index f5dcd5c..aeb7552 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -501,17 +501,17 @@ package body Sem_Ch6 is
             elsif Warn_On_Ada_2005_Compatibility or GNAT_Mode then
                if Inside_A_Generic then
                   Error_Msg_N
-                    ("return of limited object not permitted in Ada2005 " &
-                       "(RM-2005 6.5(5.5/2))?", Expr);
+                    ("return of limited object not permitted in Ada2005 "
+                     & "(RM-2005 6.5(5.5/2))?", Expr);
 
                elsif Is_Immutably_Limited_Type (R_Type) then
                   Error_Msg_N
-                    ("return by reference not permitted in Ada 2005 " &
-                     "(RM-2005 6.5(5.5/2))?", Expr);
+                    ("return by reference not permitted in Ada 2005 "
+                     & "(RM-2005 6.5(5.5/2))?", Expr);
                else
                   Error_Msg_N
-                    ("cannot copy object of a limited type in Ada 2005 " &
-                     "(RM-2005 6.5(5.5/2))?", Expr);
+                    ("cannot copy object of a limited type in Ada 2005 "
+                     & "(RM-2005 6.5(5.5/2))?", Expr);
                end if;
 
             --  Ada 95 mode, compatibility warnings disabled