+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
#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"
{
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;
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.
-- 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 --
------------------------------
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
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
projects / thirdparty / gcc.git / commitdiff
