[Ada] Only allow Has_Discriminants on type entities

This patch enforces what the comment for Has_Discriminant says:

--    Has_Discriminants (Flag5)
--       Defined in all types and subtypes.

to avoid semantically undefined calls on non-type entities. It also adapts
other routines to respect this comment.

No user-visible impact.

2018-05-21  Piotr Trojanek  <trojanek@adacore.com>

gcc/ada/

	* einfo.adb (Has_Discriminants): Stronger assertion.
	(Set_Has_Discriminants): Stronger assertion.
	* sem_ch13.adb (Push_Scope_And_Install_Discriminants): Adapt to respect
	the stronger assertion on Has_Discriminant.
	(Uninstall_Discriminants_And_Pop_Scope): Same as above.
	* sem_util.adb (New_Copy_Tree): Same as above.
	* sem_ch7.adb (Generate_Parent_References): Prevent calls to
	Has_Discriminant on non-type entities that might happen when the
	compiled code has errors.
	* sem_ch3.adb (Derived_Type_Declaration): Only call
	Set_Has_Discriminant on type entities.

From-SVN: r260447

6 files changed, 35 insertions, 8 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f74cf3f..79f5759 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+2018-04-04  Piotr Trojanek  <trojanek@adacore.com>
+
+	* einfo.adb (Has_Discriminants): Stronger assertion.
+	(Set_Has_Discriminants): Stronger assertion.
+	* sem_ch13.adb (Push_Scope_And_Install_Discriminants): Adapt to respect
+	the stronger assertion on Has_Discriminant.
+	(Uninstall_Discriminants_And_Pop_Scope): Same as above.
+	* sem_util.adb (New_Copy_Tree): Same as above.
+	* sem_ch7.adb (Generate_Parent_References): Prevent calls to
+	Has_Discriminant on non-type entities that might happen when the
+	compiled code has errors.
+	* sem_ch3.adb (Derived_Type_Declaration): Only call
+	Set_Has_Discriminant on type entities.
+
 2018-04-04  Arnaud Charlet  <charlet@adacore.com>
 
 	* exp_unst.adb (Unnest_Subprogram): Unnest all subprograms relevant for
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index fa0924f..4e9aa08 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -1567,7 +1567,7 @@ package body Einfo is
 
    function Has_Discriminants (Id : E) return B is
    begin
-      pragma Assert (Nkind (Id) in N_Entity);
+      pragma Assert (Is_Type (Id));
       return Flag5 (Id);
    end Has_Discriminants;
 
@@ -4730,7 +4730,7 @@ package body Einfo is
 
    procedure Set_Has_Discriminants (Id : E; V : B := True) is
    begin
-      pragma Assert (Nkind (Id) in N_Entity);
+      pragma Assert (Is_Type (Id));
       Set_Flag5 (Id, V);
    end Set_Has_Discriminants;
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 185cae9..538fa9d 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -12307,7 +12307,7 @@ package body Sem_Ch13 is
 
    procedure Push_Scope_And_Install_Discriminants (E : Entity_Id) is
    begin
-      if Has_Discriminants (E) then
+      if Is_Type (E) and then Has_Discriminants (E) then
          Push_Scope (E);
 
          --  Make the discriminants visible for type declarations and protected
@@ -13491,7 +13491,7 @@ package body Sem_Ch13 is
 
    procedure Uninstall_Discriminants_And_Pop_Scope (E : Entity_Id) is
    begin
-      if Has_Discriminants (E) then
+      if Is_Type (E) and then Has_Discriminants (E) then
          Uninstall_Discriminants (E);
          Pop_Scope;
       end if;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 6350f24..2f8af66 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -16664,7 +16664,13 @@ package body Sem_Ch3 is
             Error_Msg_N
               ("elementary or array type cannot have discriminants",
                Defining_Identifier (First (Discriminant_Specifications (N))));
-            Set_Has_Discriminants (T, False);
+
+            --  Unset Has_Discriminants flag to prevent cascaded errors, but
+            --  only if we are not already processing a malformed syntax tree.
+
+            if Is_Type (T) then
+               Set_Has_Discriminants (T, False);
+            end if;
 
          --  The type is allowed to have discriminants
 
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 41af7c9..9302f1a 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -1399,10 +1399,13 @@ package body Sem_Ch7 is
 
             --  We are looking at an incomplete or private type declaration
             --  with a known_discriminant_part whose full view is an
-            --  Unchecked_Union.
+            --  Unchecked_Union. The seemingly useless check with Is_Type
+            --  prevents cascaded errors when routines defined only for type
+            --  entities are called with non-type entities.
 
             if Nkind_In (Decl, N_Incomplete_Type_Declaration,
                                N_Private_Type_Declaration)
+              and then Is_Type (Defining_Identifier (Decl))
               and then Has_Discriminants (Defining_Identifier (Decl))
               and then Present (Full_View (Defining_Identifier (Decl)))
               and then
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index c9d902e..2110563 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -19392,7 +19392,9 @@ package body Sem_Util is
       begin
          --  Discriminant_Constraint
 
-         if Has_Discriminants (Base_Type (Id)) then
+         if Is_Type (Id)
+           and then Has_Discriminants (Base_Type (Id))
+         then
             Set_Discriminant_Constraint (Id, Elist_Id (
               Copy_Field_With_Replacement
                 (Field    => Union_Id (Discriminant_Constraint (Id)),
@@ -19849,7 +19851,9 @@ package body Sem_Util is
 
          --  Discriminant_Constraint
 
-         if Has_Discriminants (Base_Type (Id)) then
+         if Is_Type (Id)
+           and then Has_Discriminants (Base_Type (Id))
+         then
             Visit_Field
               (Field    => Union_Id (Discriminant_Constraint (Id)),
                Semantic => True);