OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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
This commit is contained in:
Arnaud Charlet 2010-10-11 10:28:58 +02:00
parent 9694c03951
commit 20261dc1c7
5 changed files with 94 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
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

21
gcc/ada/adaint.c
View File

@ -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;

4
gcc/ada/s-htable.ads
View File

@ -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

69
gcc/ada/sem_ch4.adb
View File

@ -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

12
gcc/ada/sem_ch6.adb
View File

@ -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