[Ada] Spurious errors on aspect specifications in generic units

This patch fixes spurious errors on aspect specifications on record
types when the aspect expression references a component of the type that
is not a discriminant. The patch also cleans up the legality checks on
aspect specifications, and improves error message on illegal aspect
specifications whose expressions are not conformant between
specification and freeze point, because of changes in visibility.

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

gcc/ada/

	* sem_ch13.adb (Push_Type, Pop_Type): New procedures, used for
	analysis of aspect expressions for record types, whose
	components (not only discriminants) may be referenced in aspect
	expressions.
	(Analyze_Aspect_Specifications, Analyze_Aspects_At_Freeze_Point,
	Analyze_Aspect_At_End-Of_Declarations,
	Resolve_Aspect_Expressions): Use the new subprograms.
	(Check_Aspect_At_End_Of_Declarations): Improve error message.
	(Build_Predicate_Functions): Do not build their bodies in a
	generic unit.
	(Is_Derived_Type_With_Constraint): New subprogram to uncover and
	reject aspect specificationss on types that appear after the
	type is frozen.
	* sem_ch13.ads (Push_Scope_And_Install_Discriminants,
	Uninstall_Discriminants_And_Pop_Scope): Remove.
	* sem_ch6.adb, sem_ch6.ads (Fully_Conformant_Expressions):
	Additional parameter to improve error message on illegal aspect
	specifications whose resolution differ between aspect
	specification and freeze point.
	* freeze.adb: Remove references to
	Install/Uninstall_Discriminants.

gcc/testsuite/

	* gnat.dg/aspect1.adb, gnat.dg/aspect1_horizontal.adb,
	gnat.dg/aspect1_horizontal.ads, gnat.dg/aspect1_vectors_2d.ads:
	New testcase.
	* gnat.dg/static_pred1.adb: Expect an error message.

From-SVN: r266980

gcc/ada/ChangeLog

+2018-12-11  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Push_Type, Pop_Type): New procedures, used for
+	analysis of aspect expressions for record types, whose
+	components (not only discriminants) may be referenced in aspect
+	expressions.
+	(Analyze_Aspect_Specifications, Analyze_Aspects_At_Freeze_Point,
+	Analyze_Aspect_At_End-Of_Declarations,
+	Resolve_Aspect_Expressions): Use the new subprograms.
+	(Check_Aspect_At_End_Of_Declarations): Improve error message.
+	(Build_Predicate_Functions): Do not build their bodies in a
+	generic unit.
+	(Is_Derived_Type_With_Constraint): New subprogram to uncover and
+	reject aspect specificationss on types that appear after the
+	type is frozen.
+	* sem_ch13.ads (Push_Scope_And_Install_Discriminants,
+	Uninstall_Discriminants_And_Pop_Scope): Remove.
+	* sem_ch6.adb, sem_ch6.ads (Fully_Conformant_Expressions):
+	Additional parameter to improve error message on illegal aspect
+	specifications whose resolution differ between aspect
+	specification and freeze point.
+	* freeze.adb: Remove references to
+	Install/Uninstall_Discriminants.
+
 2018-12-11  Pierre-Marie de Rodat  <derodat@adacore.com>
 
 	* doc/gnat_ugn/building_executable_programs_with_gnat.rst:

gcc/ada/freeze.adb

@@ -1938,12 +1938,6 @@ package body Freeze is
             --  for a description of how we handle aspect visibility).
 
             elsif Has_Delayed_Aspects (E) then
-
-               --  Retrieve the visibility to the discriminants in order to
-               --  analyze properly the aspects.
-
-               Push_Scope_And_Install_Discriminants (E);
-
                declare
                   Ritem : Node_Id;
 
@@ -1960,8 +1954,6 @@ package body Freeze is
                      Ritem := Next_Rep_Item (Ritem);
                   end loop;
                end;
-
-               Uninstall_Discriminants_And_Pop_Scope (E);
             end if;
 
             --  If an incomplete type is still not frozen, this may be a

gcc/ada/sem_ch13.ads

@@ -354,27 +354,10 @@ package Sem_Ch13 is
    --  for First, Next, and Has_Element. Optionally an Element primitive may
    --  also be defined.
 
-   -----------------------------------------------------------
-   --  Visibility of Discriminants in Aspect Specifications --
-   -----------------------------------------------------------
-
-   --  The discriminants of a type are visible when analyzing the aspect
-   --  specifications of a type declaration or protected type declaration,
-   --  but not when analyzing those of a subtype declaration. The following
-   --  routines enforce this distinction.
-
    procedure Install_Discriminants (E : Entity_Id);
    --  Make visible the discriminants of type entity E
 
-   procedure Push_Scope_And_Install_Discriminants (E : Entity_Id);
-   --  Push scope E and makes visible the discriminants of type entity E if E
-   --  has discriminants and is not a subtype.
-
    procedure Uninstall_Discriminants (E : Entity_Id);
    --  Remove visibility to the discriminants of type entity E
 
-   procedure Uninstall_Discriminants_And_Pop_Scope (E : Entity_Id);
-   --  Remove visibility to the discriminants of type entity E and pop the
-   --  scope stack if E has discriminants and is not a subtype.
-
 end Sem_Ch13;

gcc/ada/sem_ch6.adb

@@ -8823,7 +8823,8 @@ package body Sem_Ch6 is
 
    function Fully_Conformant_Expressions
      (Given_E1 : Node_Id;
-      Given_E2 : Node_Id) return Boolean
+      Given_E2 : Node_Id;
+      Report   : Boolean := False) return Boolean
    is
       E1 : constant Node_Id := Original_Node (Given_E1);
       E2 : constant Node_Id := Original_Node (Given_E2);
@@ -8831,8 +8832,12 @@ package body Sem_Ch6 is
       --  for analysis and/or expansion to make things look as though they
       --  conform when they do not, e.g. by converting 1+2 into 3.
 
-      function FCE (Given_E1, Given_E2 : Node_Id) return Boolean
-        renames Fully_Conformant_Expressions;
+      Result : Boolean;
+      function FCE (Given_E1, Given_E2 : Node_Id) return Boolean;
+      function FCE (Given_E1, Given_E2 : Node_Id) return Boolean is
+      begin
+         return Fully_Conformant_Expressions (Given_E1, Given_E2, Report);
+      end FCE;
 
       function FCL (L1, L2 : List_Id) return Boolean;
       --  Compare elements of two lists for conformance. Elements have to be
@@ -8917,6 +8922,8 @@ package body Sem_Ch6 is
    --  Start of processing for Fully_Conformant_Expressions
 
    begin
+      Result := True;
+
       --  Nonconformant if paren count does not match. Note: if some idiot
       --  complains that we don't do this right for more than 3 levels of
       --  parentheses, they will be treated with the respect they deserve.
@@ -8929,7 +8936,7 @@ package body Sem_Ch6 is
 
       elsif Is_Entity_Name (E1) and then Is_Entity_Name (E2) then
          if Present (Entity (E1)) then
-            return Entity (E1) = Entity (E2)
+            Result := Entity (E1) = Entity (E2)
 
               --  One may be a discriminant that has been replaced by the
               --  corresponding discriminal.
@@ -8968,6 +8975,14 @@ package body Sem_Ch6 is
                    and then Is_Intrinsic_Subprogram (Entity (E1))
                    and then Is_Generic_Instance (Entity (E1))
                    and then Entity (E2) = Alias (Entity (E1)));
+            if Report and not Result then
+               Error_Msg_Sloc :=
+                 Text_Ptr'Max (Sloc (Entity (E1)), Sloc (Entity (E2)));
+               Error_Msg_NE
+                 ("Meaning of& differs because of declaration#", E1, E2);
+            end if;
+
+            return Result;
 
          elsif Nkind (E1) = N_Expanded_Name
            and then Nkind (E2) = N_Expanded_Name

gcc/ada/sem_ch6.ads

@@ -172,7 +172,8 @@ package Sem_Ch6 is
 
    function Fully_Conformant_Expressions
      (Given_E1 : Node_Id;
-      Given_E2 : Node_Id) return Boolean;
+      Given_E2 : Node_Id;
+      Report   : Boolean := False) return Boolean;
    --  Determines if two (non-empty) expressions are fully conformant
    --  as defined by (RM 6.3.1(18-21))
 

gcc/testsuite/ChangeLog

+2018-12-11  Ed Schonberg  <schonberg@adacore.com>
+
+	* gnat.dg/aspect1.adb, gnat.dg/aspect1_horizontal.adb,
+	gnat.dg/aspect1_horizontal.ads, gnat.dg/aspect1_vectors_2d.ads:
+	New testcase.
+	* gnat.dg/static_pred1.adb: Expect an error message.
+
 2018-12-11  Jakub Jelinek  <jakub@redhat.com>
 
 	PR lto/86004

gcc/testsuite/gnat.dg/aspect1.adb

+--  { dg-do compile }
+
+with Aspect1_Horizontal;
+with Aspect1_Vectors_2D;
+
+procedure Aspect1 is
+   type Speed is new Float;
+   package Distances is new Aspect1_Vectors_2D (Float);
+   package Velocities is new Aspect1_Vectors_2D (Speed);
+   package Motion is new Aspect1_Horizontal (Distances, Velocities);
+begin
+   null;
+end;

gcc/testsuite/gnat.dg/aspect1_horizontal.adb

+package body Aspect1_Horizontal is
+   function Theta_D(s: Position_2d_Pkg.Vect2; nzv: Speed_2d_Pkg.Nz_vect2)
+      return float
+   is
+        a: constant float := 0.0;
+   begin
+      return 0.0;
+   end Theta_D;
+end Aspect1_Horizontal;

gcc/testsuite/gnat.dg/aspect1_horizontal.ads

+with Aspect1_Vectors_2D;
+
+generic
+   with package Position_2d_Pkg is new Aspect1_Vectors_2D (<>);
+   with package Speed_2d_Pkg is new Aspect1_Vectors_2D (<>);
+package Aspect1_Horizontal is
+   function Theta_D(s: Position_2d_Pkg.Vect2; nzv: Speed_2d_Pkg.Nz_vect2)
+      return float;
+end Aspect1_Horizontal;

gcc/testsuite/gnat.dg/aspect1_vectors_2d.ads

+generic
+   type T_horizontal is new float;
+
+-- Declaration of types, constants, and common functions on 3D vectors.
+-- Corresponds to PVS theory vectors/vectors_2D
+package Aspect1_Vectors_2D is
+
+   -- A 2D vector, represented by an x and a y coordinate.
+   type Vect2 is record
+      x: T_horizontal;
+      y: T_horizontal;
+   end record;
+
+   subtype Nz_vect2 is Vect2
+     with Predicate => (Nz_vect2.x /= 0.0 and then Nz_Vect2.y /= 0.0);
+end Aspect1_Vectors_2D;

gcc/testsuite/gnat.dg/static_pred1.adb

@@ -8,7 +8,7 @@ package body Static_Pred1 is
      Enum_Subrange in A | C;
 
    function "not" (Kind : Enum_Subrange) return Enum_Subrange is
-     (case Kind is
+     (case Kind is -- { dg-error "missing case value: \"B\"" }
       when A => C,
       when C => A);