https://gcc.gnu.org/g:0c3be0634a8b08024dd8624e78347c092c105b12
commit r16-5237-g0c3be0634a8b08024dd8624e78347c092c105b12 Author: Gary Dismukes <[email protected]> Date: Sat Oct 11 00:15:57 2025 +0000 ada: Type-resolution error on target name in assignment to indexed container The compiler fails to resolve expressions involving a target name (@ symbol) in assignment statements where the target object is an indexed container object, complaining that the target name is of the reference type associated with the container type. The target object is initially viewed as having the reference type, which is what the compiler was also setting as the type of the N_Target_Name node in the assignment's expression tree (leading to type errors), and it's only later expansion that changes the target object to a dereference whose type is the reference type's designated type, which is too late. This is addressed by implementing AI22-0082 and AI22-0112. The first AI is about changing the reference types declared in the predefined containers generics to be limited types. The second AI revises the resolution rules for assignment statements to exclude interpretations that are of limited types. Combining the two AIs, the case described above will resolve to the dereference of an indexed container component rather than the interpretation of the indexing as returning an object of a reference type. The AI22-0112 changes also avoid ambiguities for assignments involving indexed names (such as "C1(I) := C2(J);"), at least for cases involving the predefined containers (user-defined containers that declare nonlimited reference types can still run into such ambiguities). But apart from those AIs, GNAT was already doing things wrong in the case of overloaded variable names in assignment statements with container indexing, in determining the type of target names (@ symbols) as being of the reference type, which could result in wrong-type errors. GNAT wasn't following the requirement that the variable name in an assignment statement must be resolved as a "complete context". This is now corrected by separate resolution code that's done in the case where the expression of the assignment contains target names. Also, the existing code in Analyze_Assignment that's used in the non-target-name case is revised by removing incorrect code for ignoring the reference interpretations of generalized indexing and replacing it with code to remove interpretations of limited types (which, per AI22-0112, needs to be done whether or not there are target names involved). It should be noted that the changes to make reference types limited in the predefined container packages can affect existing code that happens to depend on the reference types being nonlimited, and code changes may be required to remove or work around such dependence. gcc/ada/ChangeLog: * libgnat/a-cbdlli.ads: Add "limited" to partial view of reference types. * libgnat/a-cbhama.ads: Likewise. * libgnat/a-cbhase.ads: Likewise. * libgnat/a-cbmutr.ads: Likewise. * libgnat/a-cborma.ads: Likewise. * libgnat/a-cborse.ads: Likewise. * libgnat/a-cdlili.ads: Likewise. * libgnat/a-cidlli.ads: Likewise. * libgnat/a-cihama.ads: Likewise. * libgnat/a-cihase.ads: Likewise. * libgnat/a-cimutr.ads: Likewise. * libgnat/a-ciorma.ads: Likewise. * libgnat/a-ciormu.ads: Likewise. * libgnat/a-ciorse.ads: Likewise. * libgnat/a-cobove.ads: Likewise. * libgnat/a-cohama.ads: Likewise. * libgnat/a-cohase.ads: Likewise. * libgnat/a-coinho.ads: Likewise. * libgnat/a-coinho__shared.ads: Likewise. * libgnat/a-coinve.ads: Likewise. * libgnat/a-comutr.ads: Likewise. * libgnat/a-convec.ads: Likewise. * libgnat/a-coorma.ads: Likewise. * libgnat/a-coormu.ads: Likewise. * libgnat/a-coorse.ads: Likewise. * sem_ch5.adb (Analyze_Assignment): Added code to resolve the target object (LHS) as a complete context when there are target names ("@") present in the expression of the assignment. Loop over interpretations, removing any that have a limited type, and set the type (T1) to be the type of the first nonlimited interpretation. Test for ambiguity by calling Is_Ambiguous_Operand. Delay analysis of Rhs in the target-name case. Replace existing test for generalized indexing with implicit dereference in existing analysis code with test of Is_Limited_Type along with calling Remove_Interp in the limited case. * sem_res.adb (Is_Ambiguous_Operand): Condition the calls to Report_Interpretation on Report_Errors being True. Diff: --- gcc/ada/libgnat/a-cbdlli.ads | 4 +- gcc/ada/libgnat/a-cbhama.ads | 6 +- gcc/ada/libgnat/a-cbhase.ads | 11 +- gcc/ada/libgnat/a-cbmutr.ads | 10 +- gcc/ada/libgnat/a-cborma.ads | 5 +- gcc/ada/libgnat/a-cborse.ads | 6 +- gcc/ada/libgnat/a-cdlili.ads | 4 +- gcc/ada/libgnat/a-cidlli.ads | 4 +- gcc/ada/libgnat/a-cihama.ads | 5 +- gcc/ada/libgnat/a-cihase.ads | 11 +- gcc/ada/libgnat/a-cimutr.ads | 10 +- gcc/ada/libgnat/a-ciorma.ads | 5 +- gcc/ada/libgnat/a-ciormu.ads | 5 +- gcc/ada/libgnat/a-ciorse.ads | 7 +- gcc/ada/libgnat/a-cobove.ads | 6 +- gcc/ada/libgnat/a-cohama.ads | 5 +- gcc/ada/libgnat/a-cohase.ads | 11 +- gcc/ada/libgnat/a-coinho.ads | 4 +- gcc/ada/libgnat/a-coinho__shared.ads | 4 +- gcc/ada/libgnat/a-coinve.ads | 5 +- gcc/ada/libgnat/a-comutr.ads | 10 +- gcc/ada/libgnat/a-convec.ads | 6 +- gcc/ada/libgnat/a-coorma.ads | 5 +- gcc/ada/libgnat/a-coormu.ads | 5 +- gcc/ada/libgnat/a-coorse.ads | 6 +- gcc/ada/sem_ch5.adb | 189 ++++++++++++++++++++++------------- gcc/ada/sem_res.adb | 6 +- 27 files changed, 216 insertions(+), 139 deletions(-) diff --git a/gcc/ada/libgnat/a-cbdlli.ads b/gcc/ada/libgnat/a-cbdlli.ads index db6926ca1170..1206db2c7089 100644 --- a/gcc/ada/libgnat/a-cbdlli.ads +++ b/gcc/ada/libgnat/a-cbdlli.ads @@ -99,12 +99,12 @@ is Process : not null access procedure (Element : in out Element_Type)); type Constant_Reference_Type - (Element : not null access constant Element_Type) is private + (Element : not null access constant Element_Type) is limited private with Implicit_Dereference => Element; type Reference_Type - (Element : not null access Element_Type) is private + (Element : not null access Element_Type) is limited private with Implicit_Dereference => Element; diff --git a/gcc/ada/libgnat/a-cbhama.ads b/gcc/ada/libgnat/a-cbhama.ads index c741b404da4d..d5a25de9f840 100644 --- a/gcc/ada/libgnat/a-cbhama.ads +++ b/gcc/ada/libgnat/a-cbhama.ads @@ -146,12 +146,12 @@ is -- a variable view) of the node designed by the cursor. type Constant_Reference_Type - (Element : not null access constant Element_Type) is - private + (Element : not null access constant Element_Type) is limited private with Implicit_Dereference => Element; - type Reference_Type (Element : not null access Element_Type) is private + type Reference_Type + (Element : not null access Element_Type) is limited private with Implicit_Dereference => Element; diff --git a/gcc/ada/libgnat/a-cbhase.ads b/gcc/ada/libgnat/a-cbhase.ads index d2e91efe03e4..d5d2eadc6dc8 100644 --- a/gcc/ada/libgnat/a-cbhase.ads +++ b/gcc/ada/libgnat/a-cbhase.ads @@ -154,8 +154,9 @@ is -- designated by the cursor. type Constant_Reference_Type - (Element : not null access constant Element_Type) is private - with Implicit_Dereference => Element; + (Element : not null access constant Element_Type) is limited private + with + Implicit_Dereference => Element; function Constant_Reference (Container : aliased Set; @@ -459,8 +460,10 @@ is -- completes. Otherwise, the node is removed from the map and -- Program_Error is raised. - type Reference_Type (Element : not null access Element_Type) is private - with Implicit_Dereference => Element; + type Reference_Type + (Element : not null access Element_Type) is limited private + with + Implicit_Dereference => Element; function Reference_Preserving_Key (Container : aliased in out Set; diff --git a/gcc/ada/libgnat/a-cbmutr.ads b/gcc/ada/libgnat/a-cbmutr.ads index 251d3d36267b..0d4a083cb37e 100644 --- a/gcc/ada/libgnat/a-cbmutr.ads +++ b/gcc/ada/libgnat/a-cbmutr.ads @@ -106,12 +106,14 @@ is Process : not null access procedure (Element : in out Element_Type)); type Constant_Reference_Type - (Element : not null access constant Element_Type) is private - with Implicit_Dereference => Element; + (Element : not null access constant Element_Type) is limited private + with + Implicit_Dereference => Element; type Reference_Type - (Element : not null access Element_Type) is private - with Implicit_Dereference => Element; + (Element : not null access Element_Type) is limited private + with + Implicit_Dereference => Element; function Constant_Reference (Container : aliased Tree; diff --git a/gcc/ada/libgnat/a-cborma.ads b/gcc/ada/libgnat/a-cborma.ads index 528f5962a81e..fd4963e86f5a 100644 --- a/gcc/ada/libgnat/a-cborma.ads +++ b/gcc/ada/libgnat/a-cborma.ads @@ -108,11 +108,12 @@ is procedure (Key : Key_Type; Element : in out Element_Type)); type Constant_Reference_Type - (Element : not null access constant Element_Type) is private + (Element : not null access constant Element_Type) is limited private with Implicit_Dereference => Element; - type Reference_Type (Element : not null access Element_Type) is private + type Reference_Type + (Element : not null access Element_Type) is limited private with Implicit_Dereference => Element; diff --git a/gcc/ada/libgnat/a-cborse.ads b/gcc/ada/libgnat/a-cborse.ads index 97f46bd14f99..e42c1c10c734 100644 --- a/gcc/ada/libgnat/a-cborse.ads +++ b/gcc/ada/libgnat/a-cborse.ads @@ -100,8 +100,7 @@ is Process : not null access procedure (Element : Element_Type)); type Constant_Reference_Type - (Element : not null access constant Element_Type) is - private + (Element : not null access constant Element_Type) is limited private with Implicit_Dereference => Element; @@ -290,7 +289,8 @@ is Process : not null access procedure (Element : in out Element_Type)); - type Reference_Type (Element : not null access Element_Type) is private + type Reference_Type + (Element : not null access Element_Type) is limited private with Implicit_Dereference => Element; diff --git a/gcc/ada/libgnat/a-cdlili.ads b/gcc/ada/libgnat/a-cdlili.ads index 323226cd5748..511eff38d231 100644 --- a/gcc/ada/libgnat/a-cdlili.ads +++ b/gcc/ada/libgnat/a-cdlili.ads @@ -102,12 +102,12 @@ is Process : not null access procedure (Element : in out Element_Type)); type Constant_Reference_Type - (Element : not null access constant Element_Type) is private + (Element : not null access constant Element_Type) is limited private with Implicit_Dereference => Element; type Reference_Type - (Element : not null access Element_Type) is private + (Element : not null access Element_Type) is limited private with Implicit_Dereference => Element; diff --git a/gcc/ada/libgnat/a-cidlli.ads b/gcc/ada/libgnat/a-cidlli.ads index 87b582d707c1..77c1dc94a4e2 100644 --- a/gcc/ada/libgnat/a-cidlli.ads +++ b/gcc/ada/libgnat/a-cidlli.ads @@ -100,12 +100,12 @@ is Process : not null access procedure (Element : in out Element_Type)); type Constant_Reference_Type - (Element : not null access constant Element_Type) is private + (Element : not null access constant Element_Type) is limited private with Implicit_Dereference => Element; type Reference_Type - (Element : not null access Element_Type) is private + (Element : not null access Element_Type) is limited private with Implicit_Dereference => Element; diff --git a/gcc/ada/libgnat/a-cihama.ads b/gcc/ada/libgnat/a-cihama.ads index 8862bbbab9f2..70bea87d4532 100644 --- a/gcc/ada/libgnat/a-cihama.ads +++ b/gcc/ada/libgnat/a-cihama.ads @@ -143,11 +143,12 @@ is -- a variable view) of the node designed by the cursor. type Constant_Reference_Type - (Element : not null access constant Element_Type) is private + (Element : not null access constant Element_Type) is limited private with Implicit_Dereference => Element; - type Reference_Type (Element : not null access Element_Type) is private + type Reference_Type + (Element : not null access Element_Type) is limited private with Implicit_Dereference => Element; diff --git a/gcc/ada/libgnat/a-cihase.ads b/gcc/ada/libgnat/a-cihase.ads index 7efc9419bdc8..94e8d3757f0e 100644 --- a/gcc/ada/libgnat/a-cihase.ads +++ b/gcc/ada/libgnat/a-cihase.ads @@ -154,8 +154,9 @@ is -- designated by the cursor. type Constant_Reference_Type - (Element : not null access constant Element_Type) is private - with Implicit_Dereference => Element; + (Element : not null access constant Element_Type) is limited private + with + Implicit_Dereference => Element; function Constant_Reference (Container : aliased Set; @@ -444,8 +445,10 @@ is -- completes. Otherwise, the node is removed from the map and -- Program_Error is raised. - type Reference_Type (Element : not null access Element_Type) is private - with Implicit_Dereference => Element; + type Reference_Type + (Element : not null access Element_Type) is limited private + with + Implicit_Dereference => Element; function Reference_Preserving_Key (Container : aliased in out Set; diff --git a/gcc/ada/libgnat/a-cimutr.ads b/gcc/ada/libgnat/a-cimutr.ads index 022ae5ed475c..ba1256c48b2d 100644 --- a/gcc/ada/libgnat/a-cimutr.ads +++ b/gcc/ada/libgnat/a-cimutr.ads @@ -107,12 +107,14 @@ is Process : not null access procedure (Element : in out Element_Type)); type Constant_Reference_Type - (Element : not null access constant Element_Type) is private - with Implicit_Dereference => Element; + (Element : not null access constant Element_Type) is limited private + with + Implicit_Dereference => Element; type Reference_Type - (Element : not null access Element_Type) is private - with Implicit_Dereference => Element; + (Element : not null access Element_Type) is limited private + with + Implicit_Dereference => Element; function Constant_Reference (Container : aliased Tree; diff --git a/gcc/ada/libgnat/a-ciorma.ads b/gcc/ada/libgnat/a-ciorma.ads index acf86b6c70b3..c091518092b6 100644 --- a/gcc/ada/libgnat/a-ciorma.ads +++ b/gcc/ada/libgnat/a-ciorma.ads @@ -106,11 +106,12 @@ is Element : in out Element_Type)); type Constant_Reference_Type - (Element : not null access constant Element_Type) is private + (Element : not null access constant Element_Type) is limited private with Implicit_Dereference => Element; - type Reference_Type (Element : not null access Element_Type) is private + type Reference_Type + (Element : not null access Element_Type) is limited private with Implicit_Dereference => Element; diff --git a/gcc/ada/libgnat/a-ciormu.ads b/gcc/ada/libgnat/a-ciormu.ads index 894a4934671d..973fd288f031 100644 --- a/gcc/ada/libgnat/a-ciormu.ads +++ b/gcc/ada/libgnat/a-ciormu.ads @@ -133,8 +133,9 @@ is -- with elements") will raise Program_Error. type Constant_Reference_Type - (Element : not null access constant Element_Type) is private - with Implicit_Dereference => Element; + (Element : not null access constant Element_Type) is limited private + with + Implicit_Dereference => Element; function Constant_Reference (Container : aliased Set; diff --git a/gcc/ada/libgnat/a-ciorse.ads b/gcc/ada/libgnat/a-ciorse.ads index fcc1aa12e4ff..4f140d7b6417 100644 --- a/gcc/ada/libgnat/a-ciorse.ads +++ b/gcc/ada/libgnat/a-ciorse.ads @@ -99,8 +99,8 @@ is Process : not null access procedure (Element : Element_Type)); type Constant_Reference_Type - (Element : not null access constant Element_Type) is - private with + (Element : not null access constant Element_Type) is limited private + with Implicit_Dereference => Element; function Constant_Reference @@ -305,7 +305,8 @@ is Process : not null access procedure (Element : in out Element_Type)); - type Reference_Type (Element : not null access Element_Type) is private + type Reference_Type + (Element : not null access Element_Type) is limited private with Implicit_Dereference => Element; diff --git a/gcc/ada/libgnat/a-cobove.ads b/gcc/ada/libgnat/a-cobove.ads index 5e019c3d8833..096c09a9f60c 100644 --- a/gcc/ada/libgnat/a-cobove.ads +++ b/gcc/ada/libgnat/a-cobove.ads @@ -160,12 +160,12 @@ package Ada.Containers.Bounded_Vectors is Process : not null access procedure (Element : in out Element_Type)); type Constant_Reference_Type - (Element : not null access constant Element_Type) is - private + (Element : not null access constant Element_Type) is limited private with Implicit_Dereference => Element; - type Reference_Type (Element : not null access Element_Type) is private + type Reference_Type + (Element : not null access Element_Type) is limited private with Implicit_Dereference => Element; diff --git a/gcc/ada/libgnat/a-cohama.ads b/gcc/ada/libgnat/a-cohama.ads index 8f501e1c99f8..f8ab6a7a72aa 100644 --- a/gcc/ada/libgnat/a-cohama.ads +++ b/gcc/ada/libgnat/a-cohama.ads @@ -226,11 +226,12 @@ is -- Process.all is propagated. type Constant_Reference_Type - (Element : not null access constant Element_Type) is private + (Element : not null access constant Element_Type) is limited private with Implicit_Dereference => Element; - type Reference_Type (Element : not null access Element_Type) is private + type Reference_Type + (Element : not null access Element_Type) is limited private with Implicit_Dereference => Element; diff --git a/gcc/ada/libgnat/a-cohase.ads b/gcc/ada/libgnat/a-cohase.ads index 6eb5b0c992a3..298792eb1ff6 100644 --- a/gcc/ada/libgnat/a-cohase.ads +++ b/gcc/ada/libgnat/a-cohase.ads @@ -165,8 +165,9 @@ is -- designed by the cursor. type Constant_Reference_Type - (Element : not null access constant Element_Type) is private - with Implicit_Dereference => Element; + (Element : not null access constant Element_Type) is limited private + with + Implicit_Dereference => Element; function Constant_Reference (Container : aliased Set; @@ -457,8 +458,10 @@ is -- completes. Otherwise, the node is removed from the set and -- Program_Error is raised. - type Reference_Type (Element : not null access Element_Type) is private - with Implicit_Dereference => Element; + type Reference_Type + (Element : not null access Element_Type) is limited private + with + Implicit_Dereference => Element; function Reference_Preserving_Key (Container : aliased in out Set; diff --git a/gcc/ada/libgnat/a-coinho.ads b/gcc/ada/libgnat/a-coinho.ads index dcb5b0cddda3..c42c270fa403 100644 --- a/gcc/ada/libgnat/a-coinho.ads +++ b/gcc/ada/libgnat/a-coinho.ads @@ -71,12 +71,12 @@ package Ada.Containers.Indefinite_Holders is Process : not null access procedure (Element : in out Element_Type)); type Constant_Reference_Type - (Element : not null access constant Element_Type) is private + (Element : not null access constant Element_Type) is limited private with Implicit_Dereference => Element; type Reference_Type - (Element : not null access Element_Type) is private + (Element : not null access Element_Type) is limited private with Implicit_Dereference => Element; diff --git a/gcc/ada/libgnat/a-coinho__shared.ads b/gcc/ada/libgnat/a-coinho__shared.ads index a8d0cff84ed4..ebdaa7c98b74 100644 --- a/gcc/ada/libgnat/a-coinho__shared.ads +++ b/gcc/ada/libgnat/a-coinho__shared.ads @@ -76,12 +76,12 @@ package Ada.Containers.Indefinite_Holders is Process : not null access procedure (Element : in out Element_Type)); type Constant_Reference_Type - (Element : not null access constant Element_Type) is private + (Element : not null access constant Element_Type) is limited private with Implicit_Dereference => Element; type Reference_Type - (Element : not null access Element_Type) is private + (Element : not null access Element_Type) is limited private with Implicit_Dereference => Element; diff --git a/gcc/ada/libgnat/a-coinve.ads b/gcc/ada/libgnat/a-coinve.ads index 65ff916c31cf..9023def2a6e8 100644 --- a/gcc/ada/libgnat/a-coinve.ads +++ b/gcc/ada/libgnat/a-coinve.ads @@ -120,11 +120,12 @@ is procedure Clear (Container : in out Vector); type Constant_Reference_Type - (Element : not null access constant Element_Type) is private + (Element : not null access constant Element_Type) is limited private with Implicit_Dereference => Element; - type Reference_Type (Element : not null access Element_Type) is private + type Reference_Type + (Element : not null access Element_Type) is limited private with Implicit_Dereference => Element; diff --git a/gcc/ada/libgnat/a-comutr.ads b/gcc/ada/libgnat/a-comutr.ads index 8291408a6130..d8817f416f17 100644 --- a/gcc/ada/libgnat/a-comutr.ads +++ b/gcc/ada/libgnat/a-comutr.ads @@ -107,12 +107,14 @@ is Process : not null access procedure (Element : in out Element_Type)); type Constant_Reference_Type - (Element : not null access constant Element_Type) is private - with Implicit_Dereference => Element; + (Element : not null access constant Element_Type) is limited private + with + Implicit_Dereference => Element; type Reference_Type - (Element : not null access Element_Type) is private - with Implicit_Dereference => Element; + (Element : not null access Element_Type) is limited private + with + Implicit_Dereference => Element; function Constant_Reference (Container : aliased Tree; diff --git a/gcc/ada/libgnat/a-convec.ads b/gcc/ada/libgnat/a-convec.ads index 8fad465a1f34..9ad3f12a7e46 100644 --- a/gcc/ada/libgnat/a-convec.ads +++ b/gcc/ada/libgnat/a-convec.ads @@ -291,12 +291,12 @@ is -- successful completion of this operation. type Constant_Reference_Type - (Element : not null access constant Element_Type) is - private + (Element : not null access constant Element_Type) is limited private with Implicit_Dereference => Element; - type Reference_Type (Element : not null access Element_Type) is private + type Reference_Type + (Element : not null access Element_Type) is limited private with Implicit_Dereference => Element; diff --git a/gcc/ada/libgnat/a-coorma.ads b/gcc/ada/libgnat/a-coorma.ads index 644895c808e4..a9d30b697286 100644 --- a/gcc/ada/libgnat/a-coorma.ads +++ b/gcc/ada/libgnat/a-coorma.ads @@ -108,11 +108,12 @@ is procedure (Key : Key_Type; Element : in out Element_Type)); type Constant_Reference_Type - (Element : not null access constant Element_Type) is private + (Element : not null access constant Element_Type) is limited private with Implicit_Dereference => Element; - type Reference_Type (Element : not null access Element_Type) is private + type Reference_Type + (Element : not null access Element_Type) is limited private with Implicit_Dereference => Element; diff --git a/gcc/ada/libgnat/a-coormu.ads b/gcc/ada/libgnat/a-coormu.ads index 89e878dbfcff..833f4fb094c3 100644 --- a/gcc/ada/libgnat/a-coormu.ads +++ b/gcc/ada/libgnat/a-coormu.ads @@ -132,8 +132,9 @@ is -- with elements") will raise Program_Error. type Constant_Reference_Type - (Element : not null access constant Element_Type) is private - with Implicit_Dereference => Element; + (Element : not null access constant Element_Type) is limited private + with + Implicit_Dereference => Element; function Constant_Reference (Container : aliased Set; diff --git a/gcc/ada/libgnat/a-coorse.ads b/gcc/ada/libgnat/a-coorse.ads index c8c8bf04d605..1e9959feba1a 100644 --- a/gcc/ada/libgnat/a-coorse.ads +++ b/gcc/ada/libgnat/a-coorse.ads @@ -99,8 +99,7 @@ is Process : not null access procedure (Element : Element_Type)); type Constant_Reference_Type - (Element : not null access constant Element_Type) is - private + (Element : not null access constant Element_Type) is limited private with Implicit_Dereference => Element; @@ -290,7 +289,8 @@ is Process : not null access procedure (Element : in out Element_Type)); - type Reference_Type (Element : not null access Element_Type) is private + type Reference_Type + (Element : not null access Element_Type) is limited private with Implicit_Dereference => Element; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index a767ee0b560f..87e1b30369ea 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -420,7 +420,6 @@ package body Sem_Ch5 is end if; Analyze (Lhs); - Analyze (Rhs); -- Ensure that we never do an assignment on a variable marked as -- Is_Safe_To_Reevaluate. @@ -434,91 +433,143 @@ package body Sem_Ch5 is T1 := Etype (Lhs); + if not Is_Overloaded (Lhs) then + Analyze (Rhs); + -- In the most general case, both Lhs and Rhs can be overloaded, and we -- must compute the intersection of the possible types on each side. + -- Note that only nonlimited interpretations are considered (see + -- AI22-0112, RM 5.2(4/6)). - if Is_Overloaded (Lhs) then - declare - I : Interp_Index; - It : Interp; + else + -- When there are target names ("@") present in the expression, + -- the assignment's left-hand side must be resolved as a complete + -- context (RM 8.6(9.1/5)), and the determined type will then be used + -- to resolve the right-hand side expression. - begin - T1 := Any_Type; - Get_First_Interp (Lhs, I, It); + if Has_Target_Names (N) then + declare + I : Interp_Index; + It : Interp; - while Present (It.Typ) loop + begin + T1 := Any_Type; + Get_First_Interp (Lhs, I, It); - -- An indexed component with generalized indexing is always - -- overloaded with the corresponding dereference. Discard the - -- interpretation that yields a reference type, which is not - -- assignable. + while Present (It.Typ) loop + if Is_Limited_Type (It.Typ) then + Remove_Interp (I); + elsif T1 = Any_Type then + T1 := It.Typ; + end if; - if Nkind (Lhs) = N_Indexed_Component - and then Present (Generalized_Indexing (Lhs)) - and then Has_Implicit_Dereference (It.Typ) - then - null; + Get_Next_Interp (I, It); + end loop; + + if Is_Ambiguous_Operand (Lhs, Report_Errors => False) then + Error_Msg_N ("ambiguous left-hand side in assignment", Lhs); + + Kill_Lhs; + goto Leave; + end if; + + if T1 = Any_Type then + Error_Msg_N + ("no valid types for left-hand side for assignment", Lhs); + Kill_Lhs; + goto Leave; + end if; + + end; + + -- We delay analyzing Rhs until Lhs has been resolved, so that the + -- type of Lhs has been determined and can be used for the type of + -- target names occurring in Rhs. + + Analyze (Rhs); + + -- Case where Lhs is overloaded, but Rhs does not have target names + + else + Analyze (Rhs); + + declare + I : Interp_Index; + It : Interp; + + begin + T1 := Any_Type; + Get_First_Interp (Lhs, I, It); + + while Present (It.Typ) loop + -- AI22-0112 restores the Ada 95 rule that excludes limited + -- types from consideration during resolution of the target + -- variable in assignment statements. + + if Is_Limited_Type (It.Typ) then + Remove_Interp (I); + + elsif Has_Compatible_Type (Rhs, It.Typ) then + if T1 = Any_Type then + T1 := It.Typ; + else + -- An explicit dereference is overloaded if the prefix + -- is. Try to remove the ambiguity on the prefix, the + -- error will be posted there if ambiguity is real. + + if Nkind (Lhs) = N_Explicit_Dereference then + declare + PI : Interp_Index; + PI1 : Interp_Index := 0; + PIt : Interp; + Found : Boolean; + + begin + Found := False; + Get_First_Interp (Prefix (Lhs), PI, PIt); + + while Present (PIt.Typ) loop + if Is_Access_Type (PIt.Typ) + and then Has_Compatible_Type + (Rhs, Designated_Type (PIt.Typ)) + then + if Found then + PIt := + Disambiguate (Prefix (Lhs), + PI1, PI, Any_Type); + + if PIt = No_Interp then + Error_Msg_N + ("ambiguous left-hand side in " + & "assignment", Lhs); + exit; + else + Resolve (Prefix (Lhs), PIt.Typ); + end if; - elsif Has_Compatible_Type (Rhs, It.Typ) then - if T1 = Any_Type then - T1 := It.Typ; - else - -- An explicit dereference is overloaded if the prefix - -- is. Try to remove the ambiguity on the prefix, the - -- error will be posted there if the ambiguity is real. - - if Nkind (Lhs) = N_Explicit_Dereference then - declare - PI : Interp_Index; - PI1 : Interp_Index := 0; - PIt : Interp; - Found : Boolean; - - begin - Found := False; - Get_First_Interp (Prefix (Lhs), PI, PIt); - - while Present (PIt.Typ) loop - if Is_Access_Type (PIt.Typ) - and then Has_Compatible_Type - (Rhs, Designated_Type (PIt.Typ)) - then - if Found then - PIt := - Disambiguate (Prefix (Lhs), - PI1, PI, Any_Type); - - if PIt = No_Interp then - Error_Msg_N - ("ambiguous left-hand side in " - & "assignment", Lhs); exit; else - Resolve (Prefix (Lhs), PIt.Typ); + Found := True; + PI1 := PI; end if; - - exit; - else - Found := True; - PI1 := PI; end if; - end if; - Get_Next_Interp (PI, PIt); - end loop; - end; + Get_Next_Interp (PI, PIt); + end loop; + end; - else - Error_Msg_N - ("ambiguous left-hand side in assignment", Lhs); - exit; + else + Error_Msg_N + ("ambiguous left-hand side in assignment", Lhs); + exit; + end if; end if; end if; - end if; - Get_Next_Interp (I, It); - end loop; - end; + Get_Next_Interp (I, It); + end loop; + end; + end if; if T1 = Any_Type then Error_Msg_N diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 1db373b58fb9..885f51fe0127 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -13742,8 +13742,10 @@ package body Sem_Res is -- Report the first two interpretations - Report_Interpretation (Operand, It.Nam, It.Typ); - Report_Interpretation (Operand, N1, T1); + if Report_Errors then + Report_Interpretation (Operand, It.Nam, It.Typ); + Report_Interpretation (Operand, N1, T1); + end if; return True; end if;
