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 --git a/gcc/ada/libgnat/a-cbdlli.ads b/gcc/ada/libgnat/a-cbdlli.ads
index db6926ca117015b49b15a188e1e26239d17c39da..1206db2c70898bb19702a8b0af6b20de33df5766 100644 (file)
--- 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 c741b404da4d24c41a5a36e9b098425f6571e820..d5a25de9f840b198604063360c3870a61c4175fd 100644 (file)
--- 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 d2e91efe03e4be6c0d2ccf3f9f92b3349307ece9..d5d2eadc6dc8e3d5c7a75359472be2700f57a86d 100644 (file)
--- 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 251d3d36267b85c624292e79dd0594a172793e95..0d4a083cb37e6ca9e14f0e907e29431960efc06a 100644 (file)
--- 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 528f5962a81ecdfc07874c83383f6a4b8701b5eb..fd4963e86f5a13f75cda44e7f3e2bc1bff247b14 100644 (file)
--- 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 97f46bd14f994f5c866bd3af3c6dba54ba595892..e42c1c10c734185ce03b82d702d9e39e6e07b764 100644 (file)
--- 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 323226cd574889e1f7e9a2531352d50353f127c6..511eff38d2313fff99f779432c4b970859da3102 100644 (file)
--- 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 87b582d707c1cc79147e1ccb732a7a3cf87ecb51..77c1dc94a4e2456138449e6e87a6a9af29098be3 100644 (file)
--- 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 8862bbbab9f27e4fd647c401bceffc59a0e59726..70bea87d4532ea92ba2ff8cf8e3e13ab09b5a296 100644 (file)
--- 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 7efc9419bdc8d83dba806282808b40b445edeb94..94e8d3757f0e9395431afa04236fde629d6ac4bd 100644 (file)
--- 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 022ae5ed475cbd84c5a7be4a9fb5f58b845d23a7..ba1256c48b2d01cc9db863fb622e6529e57ff78e 100644 (file)
--- 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 acf86b6c70b319f188665d3bb69be89dffe87294..c091518092b69005ce80441038c218ceee920c79 100644 (file)
--- 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 894a4934671d882bfeeb1002c5e919a24f0498dd..973fd288f03124bc3dcc57f127eecbbd502af3fb 100644 (file)
--- 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 fcc1aa12e4ffd00fa289f279ae65af205002febe..4f140d7b64171902bb3e76d263be0d3f298f8498 100644 (file)
--- 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 5e019c3d8833445147291553d52200a99208007c..096c09a9f60c3c4005867a0b7ba3974bb15a343c 100644 (file)
--- 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 8f501e1c99f80f55f337fc0022cf20f6ba57b7b9..f8ab6a7a72aa6beb00c7bb10ac038f4329b2344d 100644 (file)
--- 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 6eb5b0c992a3b90461725f9b093b6c5c4111ad4d..298792eb1ff60ccb406064bad7d5cc7b979c5da5 100644 (file)
--- 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 dcb5b0cddda3b02acae61053fd3762a1d63c9e7c..c42c270fa403d4367212b1a959b87b8e63181455 100644 (file)
--- 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 a8d0cff84ed48da542aa896fc5e78e9f33d693e8..ebdaa7c98b74725cf306e6ecfb9ab31e6c5a0a37 100644 (file)
--- 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 65ff916c31cfa03dd12358bb85ef2921a92aac7a..9023def2a6e8f050fe1df5742bca0b6bfedc74b1 100644 (file)
--- 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 8291408a6130453908be240763b0bd4e8fb457eb..d8817f416f171d43a6c8cf33ad3129ffe07687fb 100644 (file)
--- 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 8fad465a1f34fdd06529e9bd847bdc6754cc5aff..9ad3f12a7e46d9fb5c77b9f18f18c55fe19049d6 100644 (file)
--- 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 644895c808e4347db4054a667e579ae6d8075b95..a9d30b6972869796ce3fc067f9671e6501927c33 100644 (file)
--- 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 89e878dbfcff9feb0416050a5af685e6aa24edd4..833f4fb094c3c5c8195532e7e1b3a1c3ebf75c03 100644 (file)
--- 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 c8c8bf04d60515c005e32d8abdd12527ca778f51..1e9959feba1a26a78a0a08b915827dcb3238c6a6 100644 (file)
--- 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 a767ee0b560fcdac4f628d097bb171e7dd1ea0eb..87e1b30369ea6c65e4cfff1b59fc23ff28e36316 100644 (file)
--- 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 1db373b58fb90c07c8d1e2db0cd3253685345eb0..885f51fe01271cf9df350dcd962fbb17f4cb854b 100644 (file)
--- 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;