diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 20 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 73 | ||||
| -rw-r--r-- | gcc/ada/sem_disp.adb | 26 |
4 files changed, 123 insertions, 1 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 12a9978..bceb632 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2011-09-05 Ed Schonberg <schonberg@adacore.com> + + * sem_disp.adb (Find_Controlling_Arg): Add checks for + interface type conversions, that are expanded into dereferences. + +2011-09-05 Hristian Kirtchev <kirtchev@adacore.com> + + * sem_ch6.adb (Analyze_Subprogram_Body_Helper): + Examine the parameter and return profile of a subprogram and swap + any incomplete types coming from a limited context with their + corresponding non-limited views. + (Exchange_Limited_Views): New routine. + +2011-09-05 Ed Schonberg <schonberg@adacore.com> + + * sem_ch3.adb (Prepare_Private_Subtype_Completion): Set parent + of internal entity to the subtype declaration, so that when + entities are subsequently exchanged in a package body, the tree + remains properly formatted for ASIS. + 2011-09-05 Johannes Kanig <kanig@adacore.com> * g-comlin.adb (Set_Usage): Additional optional argument to set help diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 8802ae5..c42e37c 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -17052,13 +17052,16 @@ package body Sem_Ch3 is -- The Base_Type is already completed, we can complete the subtype -- now. We have to create a new entity with the same name, Thus we - -- can't use Create_Itype. + -- can't use Create_Itype. The entity may be exchanged when entering + -- exiting a package body, so it has to have a proper parent field, + -- so that the tree is always properly formatted for ASIS. -- This is messy, should be fixed ??? Full := Make_Defining_Identifier (Sloc (Id), Chars (Id)); Set_Is_Itype (Full); Set_Associated_Node_For_Itype (Full, Related_Nod); + Set_Parent (Full, Parent (Id)); Complete_Private_Subtype (Id, Full, Full_B, Related_Nod); end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 1ea8978..fbfef08 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1727,6 +1727,11 @@ package body Sem_Ch6 is -- mechanism is used to find the corresponding spec of the primitive -- body. + procedure Exchange_Limited_Views (Subp_Id : Entity_Id); + -- Ada 2012 (AI05-0151): Detect whether the profile of Subp_Id contains + -- incomplete types coming from a limited context and swap their limited + -- views with the non-limited ones. + function Is_Private_Concurrent_Primitive (Subp_Id : Entity_Id) return Boolean; -- Determine whether subprogram Subp_Id is a primitive of a concurrent @@ -2092,6 +2097,65 @@ package body Sem_Ch6 is return Spec_N; end Disambiguate_Spec; + ---------------------------- + -- Exchange_Limited_Views -- + ---------------------------- + + procedure Exchange_Limited_Views (Subp_Id : Entity_Id) is + procedure Detect_And_Exchange (Id : Entity_Id); + -- Determine whether Id's type denotes an incomplete type associated + -- with a limited with clause and exchange the limited view with the + -- non-limited one. + + ------------------------- + -- Detect_And_Exchange -- + ------------------------- + + procedure Detect_And_Exchange (Id : Entity_Id) is + Typ : constant Entity_Id := Etype (Id); + + begin + if Ekind (Typ) = E_Incomplete_Type + and then From_With_Type (Typ) + and then Present (Non_Limited_View (Typ)) + then + Set_Etype (Id, Non_Limited_View (Typ)); + end if; + end Detect_And_Exchange; + + -- Local variables + + Formal : Entity_Id; + + -- Start of processing for Exchange_Limited_Views + + begin + if No (Subp_Id) then + return; + + -- Do not process subprogram bodies as they already use the non- + -- limited view of types. + + elsif not Ekind_In (Subp_Id, E_Function, E_Procedure) then + return; + end if; + + -- Examine all formals and swap views when applicable + + Formal := First_Formal (Subp_Id); + while Present (Formal) loop + Detect_And_Exchange (Formal); + + Next_Formal (Formal); + end loop; + + -- Process the return type of a function + + if Ekind (Subp_Id) = E_Function then + Detect_And_Exchange (Subp_Id); + end if; + end Exchange_Limited_Views; + ------------------------------------- -- Is_Private_Concurrent_Primitive -- ------------------------------------- @@ -2726,6 +2790,15 @@ package body Sem_Ch6 is (Sloc (N), Spec_Id, Prot_Typ, N, Declarations (N)); end if; + -- Ada 2012 (AI05-0151): Incomplete types coming from a limited context + -- may now appear in parameter and result profiles. Since the analysis + -- of a subprogram body may use the parameter and result profile of the + -- spec, swap any limited views with their non-limited counterpart. + + if Ada_Version >= Ada_2012 then + Exchange_Limited_Views (Spec_Id); + end if; + -- Analyze the declarations (this call will analyze the precondition -- Check pragmas we prepended to the list, as well as the declaration -- of the _Postconditions procedure). diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index fb20b1a..2d80676 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -1616,6 +1616,32 @@ package body Sem_Disp is then return Controlling_Argument (Orig_Node); + -- Type conversions are dynamically tagged if the target type, or its + -- designated type, are classwide. An interface conversion expands into + -- a dereference, so test must be performed on the original node. + + elsif Nkind (Orig_Node) = N_Type_Conversion + and then Nkind (N) = N_Explicit_Dereference + and then Is_Controlling_Actual (N) + then + declare + Target_Type : constant Entity_Id := + Entity (Subtype_Mark (Orig_Node)); + + begin + if Is_Class_Wide_Type (Target_Type) then + return N; + + elsif Is_Access_Type (Target_Type) + and then Is_Class_Wide_Type (Designated_Type (Target_Type)) + then + return N; + + else + return Empty; + end if; + end; + -- Normal case elsif Is_Controlling_Actual (N) |