diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d216fcbe1a46..d14707df9b35 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2010-10-11 Robert Dewar + + * sem_ch6.adb, s-htable.ads: Minor reformatting. + +2010-10-11 Ed Schonberg + + * 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 + + * adaint.c (__gnat_number_of_cpus): Add implementation for Solaris, + AIX, Tru64, Darwin, IRIX and HP-UX. + 2010-10-11 Robert Dewar * a-textio.adb: Minor reformatting diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index a012ab639ab1..b6c19de0c79b 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 +#endif + +#if defined (__hpux__) +#include +#include +#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 fc97cf40940d..9e7d1044cc35 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 183de2d36edc..0a86369b89d6 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 f5dcd5c4713a..aeb7552b4793 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