| Message ID | 20151112132550.GA63333@adacore.com |
|---|---|
| State | New |
| Headers | show |
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;
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.