diff options
| author | Ed Schonberg <schonberg@adacore.com> | 2015-03-02 09:07:01 +0000 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2015-03-02 10:07:01 +0100 |
| commit | 95e00a3a825cb27fb9b4db7007a94462aa311561 (patch) | |
| tree | 8fc6422a22f5d6a3f5cba63d37d1c4fb31121b1e /gcc | |
| parent | c4c0f336bc3bd0761ccac74d297dd45d45e299fe (diff) | |
| download | gcc-95e00a3a825cb27fb9b4db7007a94462aa311561.zip gcc-95e00a3a825cb27fb9b4db7007a94462aa311561.tar.gz gcc-95e00a3a825cb27fb9b4db7007a94462aa311561.tar.bz2 | |
sem_ch8.adb (Available_Subtype): Optimization in Find_Selected_Component...
2015-03-02 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Available_Subtype): Optimization in
Find_Selected_Component: when safe, use existing subtype of
array component, possibly discriminant-dependent, rather than
creating new subtype declaration for it. In this fashion different
occurrences of the component have the same subtype, rather than
just equivalent ones. Simplifies value tracing in GNATProve.
From-SVN: r221100
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 39 |
2 files changed, 47 insertions, 1 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5deda8f..ca420de 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2015-03-02 Ed Schonberg <schonberg@adacore.com> + + * sem_ch8.adb (Available_Subtype): Optimization in + Find_Selected_Component: when safe, use existing subtype of + array component, possibly discriminant-dependent, rather than + creating new subtype declaration for it. In this fashion different + occurrences of the component have the same subtype, rather than + just equivalent ones. Simplifies value tracing in GNATProve. + 2015-03-01 Arnaud Charlet <charlet@adacore.com> PR ada/65259 diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index c8d81f0..93998be 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -6454,6 +6454,13 @@ package body Sem_Ch8 is Nam : Node_Id; + function Available_Subtype return Boolean; + -- A small optimization: if the prefix is constrained and the component + -- is an array type we may already have a usable subtype for it, so we + -- can use it rather than generating a new one, because the bounds + -- will be the values of the discriminants and not discriminant refs. + -- This simplifies value tracing in GNATProve. + function Is_Reference_In_Subunit return Boolean; -- In a subunit, the scope depth is not a proper measure of hiding, -- because the context of the proper body may itself hide entities in @@ -6461,6 +6468,27 @@ package body Sem_Ch8 is -- because the proper body is inserted in the main unit and its context -- is simply added to that of the parent. + ----------------------- + -- Available_Subtype -- + ----------------------- + + function Available_Subtype return Boolean is + Comp : Entity_Id; + begin + Comp := First_Entity (Etype (P)); + while Present (Comp) loop + if Chars (Comp) = Chars (Selector_Name (N)) then + Set_Etype (N, Etype (Comp)); + Set_Etype (Selector_Name (N), Etype (Comp)); + return True; + end if; + + Next_Component (Comp); + end loop; + + return False; + end Available_Subtype; + ----------------------------- -- Is_Reference_In_Subunit -- ----------------------------- @@ -6563,6 +6591,15 @@ package body Sem_Ch8 is and then (not Is_Entity_Name (P) or else Chars (Entity (P)) /= Name_uInit) then + if Is_Entity_Name (P) + and then Ekind (Etype (P)) = E_Record_Subtype + and then Nkind (Parent (Etype (P))) = N_Subtype_Declaration + and then Is_Array_Type (Etype (Selector)) + and then not Is_Packed (Etype (Selector)) + and then Available_Subtype + then + return; + -- Do not build the subtype when referencing components of -- dispatch table wrappers. Required to avoid generating -- elaboration code with HI runtimes. JVM and .NET use a @@ -6570,7 +6607,7 @@ package body Sem_Ch8 is -- Dispatch_Table_Wrapper and RE_No_Dispatch_Table_Wrapper. -- Avoid raising RE_Not_Available exception in those cases. - if VM_Target = No_VM + elsif VM_Target = No_VM and then RTU_Loaded (Ada_Tags) and then ((RTE_Available (RE_Dispatch_Table_Wrapper) |