aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/sem_ch4.adb
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2010-10-11 10:28:58 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2010-10-11 10:28:58 +0200
commit20261dc1c7dacc89a7206a601c5f21c36c2c4b9e (patch)
tree53a36f30d39dd6dce627ca1d62602a2ede3ceae1 /gcc/ada/sem_ch4.adb
parent9694c03951602dd1216838de82dc1c2de54d2754 (diff)
downloadgcc-20261dc1c7dacc89a7206a601c5f21c36c2c4b9e.zip
gcc-20261dc1c7dacc89a7206a601c5f21c36c2c4b9e.tar.gz
gcc-20261dc1c7dacc89a7206a601c5f21c36c2c4b9e.tar.bz2
[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
Diffstat (limited to 'gcc/ada/sem_ch4.adb')
-rw-r--r--gcc/ada/sem_ch4.adb69
1 files changed, 50 insertions, 19 deletions
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