diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-10-11 10:28:58 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-10-11 10:28:58 +0200 |
commit | 20261dc1c7dacc89a7206a601c5f21c36c2c4b9e (patch) | |
tree | 53a36f30d39dd6dce627ca1d62602a2ede3ceae1 /gcc/ada/sem_ch4.adb | |
parent | 9694c03951602dd1216838de82dc1c2de54d2754 (diff) | |
download | gcc-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.adb | 69 |
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 |