[Ada] Spurious visibility error with derivation and incomplete declaration

[Arnaud Charlet <charlet@adacore.com>]

[-- Attachment #1: Type: text/plain, Size: 2368 bytes --]

This patch fixes a spurious visibility error on an operator of a derived type,
when the parent type is declared in another unit, and has an incomplete type
declaration. The primitive operations of the derived types are to be found in
the scope of its base type, and not in that of its ancestor.

The following must compile quietly:

   gnatmake -q operator_use

---
with CALC_PACKAGE;
with STORE_PACKAGE;
with ADA.TEXT_IO;
use type CALC_PACKAGE.RECORD_TYPE;
procedure OPERATOR_USE is

  B : CALC_PACKAGE.RECORD_TYPE;

begin
  B := CALC_PACKAGE.GET_VALUE;

  if STORE_PACKAGE.STORE(4).MY_ACCESS.all.MY_VALUE > B
  then
    ADA.TEXT_IO.PUT_LINE("TRUE");
  end if;

  if CALC_PACKAGE.">"(STORE_PACKAGE.STORE(4).MY_ACCESS.all.MY_VALUE, B)
  then
    ADA.TEXT_IO.PUT_LINE("TRUE again");
  end if;

end OPERATOR_USE;
---
with TYPE_PACKAGE;
package CALC_PACKAGE is

  type RECORD_TYPE is new TYPE_PACKAGE.BASE_TYPE;

  function ">"
    (A : in RECORD_TYPE;
     B : in RECORD_TYPE)
    return BOOLEAN;

  function GET_VALUE
    return RECORD_TYPE;

end CALC_PACKAGE;
---
package body CALC_PACKAGE is
  C_VAL : INTEGER := 0;

  function GET_VALUE
    return RECORD_TYPE is
  begin
    C_VAL := C_VAL + 1;
    return (X => C_VAL,
            Y => 0);
  end GET_VALUE;

  function ">"
    (A : in RECORD_TYPE;
     B : in RECORD_TYPE)
     return BOOLEAN is
  begin
    return A.X > B.Y;
  end ">";
end CALC_PACKAGE;
---
with CALC_PACKAGE;
package STORE_PACKAGE is

  type INDEX_TYPE is range 1 .. 10;

  type RECORD_TYPE is
    record
      MY_VALUE : CALC_PACKAGE.RECORD_TYPE;
    end record;

  type RECORD_ACCESS_TYPE is access all RECORD_TYPE;

  type STORE_TYPE is
    record
      MY_ACCESS : RECORD_ACCESS_TYPE;
    end record;

  type ARRAY_TYPE is
    array (INDEX_TYPE)
       of STORE_TYPE;

  STORE : ARRAY_TYPE := (others => (my_access => new Record_Type));
end STORE_PACKAGE;
---
package TYPE_PACKAGE is
   type BASE_TYPE;

  type BASE_TYPE is
    record
      X : INTEGER := 1;
      Y : INTEGER := 0;
    end record;
end TYPE_PACKAGE;

Tested on x86_64-pc-linux-gnu, committed on trunk

2015-11-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Collect_Primitive_Operations): If the type is
	derived from a type declared elsewhere that has an incomplete
	type declaration, the primitives are found in the scope of the
	type nat that of its ancestor.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 663 bytes --]

Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 230239)
+++ sem_util.adb	(working copy)
@@ -4223,6 +4223,14 @@
          then
             Id := Defining_Entity (Incomplete_View (Parent (B_Type)));
 
+            --  If T is a derived from a type with an incomplete view declared
+            --  elsewhere, that incomplete view is irrelevant, we want the
+            --  operations in the scope of T.
+
+            if Scope (Id) /= Scope (B_Type) then
+               Id := Next_Entity (B_Type);
+            end if;
+
          else
             Id := Next_Entity (B_Type);
          end if;