From 66dc8075f33117924fc1596721708e979912e20e Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 5 Sep 2011 14:51:44 +0200 Subject: [PATCH] [multiple changes] 2011-09-05 Ed Schonberg * sem_ch6.adb (Analyze_Expression_Function): If the expression function comes from source, indicate that so does its rewriting, so it is compatible with any subsequent expansion of the subprogram body (e.g. when it is a protected operation). * sem_ch4.adb: minor reformatting 2011-09-05 Hristian Kirtchev * lib.adb (Check_Same_Extended_Unit): Comment rewriting. Use Get_Source_Unit rather than Get_Code_Unit as instantiation unfolding may lead to wrong ancestor package in the case of instantiated subunit bodies. If a subunit is instantiated, follow the chain of instantiations rather than the stub structure. From-SVN: r178530 --- gcc/ada/ChangeLog | 16 ++++++++++++ gcc/ada/lib.adb | 63 ++++++++++++++++++++++----------------------- gcc/ada/sem_ch4.adb | 3 +-- gcc/ada/sem_ch6.adb | 6 +++++ 4 files changed, 54 insertions(+), 34 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ebf6ca9c371..2bfd148a259 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2011-09-05 Ed Schonberg + + * sem_ch6.adb (Analyze_Expression_Function): If the expression + function comes from source, indicate that so does its rewriting, + so it is compatible with any subsequent expansion of the + subprogram body (e.g. when it is a protected operation). + * sem_ch4.adb: minor reformatting + +2011-09-05 Hristian Kirtchev + + * lib.adb (Check_Same_Extended_Unit): Comment rewriting. Use + Get_Source_Unit rather than Get_Code_Unit as instantiation unfolding + may lead to wrong ancestor package in the case of instantiated subunit + bodies. If a subunit is instantiated, follow the chain of instantiations + rather than the stub structure. + 2011-09-02 Robert Dewar * sem_ch4.adb, sem_ch6.adb: Minor reformatting. diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index c5149bee3b0..2c5aa4c507f 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -293,10 +293,14 @@ package body Lib is Sloc1 := S1; Sloc2 := S2; - Unum1 := Get_Code_Unit (Sloc1); - Unum2 := Get_Code_Unit (Sloc2); + + Unum1 := Get_Source_Unit (Sloc1); + Unum2 := Get_Source_Unit (Sloc2); loop + -- Step 1: Check whether the two locations are in the same source + -- file. + Sind1 := Get_Source_File_Index (Sloc1); Sind2 := Get_Source_File_Index (Sloc2); @@ -310,28 +314,27 @@ package body Lib is end if; end if; - -- OK, the two nodes are in separate source elements, but this is not - -- decisive, because of the issue of subunits and instantiations. - - -- First we deal with subunits, since if the subunit is in an - -- instantiation, we know that the parent is in the corresponding - -- instantiation, since that is the only way we can have a subunit - -- that is part of an instantiation. + -- Step 2: Check subunits. If a subunit is instantiated, follow the + -- instantiation chain rather than the stub chain. Unit1 := Unit (Cunit (Unum1)); Unit2 := Unit (Cunit (Unum2)); + Inst1 := Instantiation (Sind1); + Inst2 := Instantiation (Sind2); if Nkind (Unit1) = N_Subunit and then Present (Corresponding_Stub (Unit1)) + and then Inst1 = No_Location then - -- Both in subunits. They could have a common ancestor. If they - -- do, then the deeper one must have a longer unit name. Replace - -- the deeper one with its corresponding stub, in order to find - -- nearest common ancestor, if any. - if Nkind (Unit2) = N_Subunit and then Present (Corresponding_Stub (Unit2)) + and then Inst2 = No_Location then + -- Both locations refer to subunits which may have a common + -- ancestor. If they do, the deeper subunit must have a longer + -- unit name. Replace the deeper one with its corresponding + -- stub in order to find the nearest ancestor. + if Length_Of_Name (Unit_Name (Unum1)) < Length_Of_Name (Unit_Name (Unum2)) then @@ -345,7 +348,7 @@ package body Lib is goto Continue; end if; - -- Nod1 in subunit, Nod2 not + -- Sloc1 in subunit, Sloc2 not else Sloc1 := Sloc (Corresponding_Stub (Unit1)); @@ -353,28 +356,25 @@ package body Lib is goto Continue; end if; - -- Nod2 in subunit, Nod1 not + -- Sloc2 in subunit, Sloc1 not elsif Nkind (Unit2) = N_Subunit and then Present (Corresponding_Stub (Unit2)) + and then Inst2 = No_Location then Sloc2 := Sloc (Corresponding_Stub (Unit2)); Unum2 := Get_Source_Unit (Sloc2); goto Continue; end if; - -- At this stage we know that neither is a subunit, so we deal - -- with instantiations, since we could have a common ancestor - - Inst1 := Instantiation (Sind1); - Inst2 := Instantiation (Sind2); + -- Step 3: Check instances. The two locations may yield a common + -- ancestor. if Inst1 /= No_Location then - - -- Both are instantiations - if Inst2 /= No_Location then + -- Both locations denote instantiations + Depth1 := Instantiation_Depth (Sloc1); Depth2 := Instantiation_Depth (Sloc2); @@ -396,7 +396,7 @@ package body Lib is goto Continue; end if; - -- Only first node is in instantiation + -- Sloc1 is an instantiation else Sloc1 := Inst1; @@ -404,7 +404,7 @@ package body Lib is goto Continue; end if; - -- Only second node is instantiation + -- Sloc2 is an instantiation elsif Inst2 /= No_Location then Sloc2 := Inst2; @@ -412,10 +412,9 @@ package body Lib is goto Continue; end if; - -- No instantiations involved, so we are not in the same unit - -- However, there is one case still to check, namely the case - -- where one location is in the spec, and the other in the - -- corresponding body (the spec location is earlier). + -- Step 4: One location in the spec, the other in the corresponding + -- body of the same unit. The location in the spec is considered + -- earlier. if Nkind (Unit1) = N_Subprogram_Body or else @@ -434,8 +433,8 @@ package body Lib is end if; end if; - -- If that special case does not occur, then we are certain that - -- the two locations are really in separate units. + -- At this point it is certain that the two locations denote two + -- entirely separate units. return No; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 5f404f3c45b..6c886d501ea 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4322,8 +4322,7 @@ package body Sem_Ch4 is Error_Msg_Node_2 := First_Subtype (Prefix_Type); Error_Msg_NE ("no selector& for}", N, Sel); - -- If prefix is incomplete, dd information - -- What is dd??? + -- If prefix is incomplete, add information if Is_Incomplete_Type (Type_To_Use) then declare diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 88c226b1944..b9788748903 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -298,6 +298,12 @@ package body Sem_Ch6 is Make_Simple_Return_Statement (LocX, Expression => Expression (N))))); + -- If the expression function comes from source, indicate that so does + -- its rewriting, so it is compatible with any subsequent expansion of + -- the subprogram body (e.g. when it is a protected operation). + + Set_Comes_From_Source (New_Body, Comes_From_Source (N)); + if Present (Prev) and then Ekind (Prev) = E_Generic_Function then -- 2.30.2