From: Ed Schonberg <schonberg@adacore.com>
Date: Thu, 12 Aug 2021 14:39:21 +0000 (-0400)
Subject: [Ada] Crash on improper use of GNAT attribute Type_Key
X-Git-Tag: basepoints/gcc-13~4291
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=1c37d1960adf1c30fa700b89d588182c84f8f22d;p=thirdparty%2Fgcc.git

[Ada] Crash on improper use of GNAT attribute Type_Key

gcc/ada/

	* sem_attr.adb (Analyze_Attribute, case Type_Key): Attribute can
	be applied to a formal type.
	* sem_ch5.adb (Analyze_Case_Statement): If Extensions_Allowed is
	not enabled, verify that the type of the expression is discrete.
---

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 7b6dc21b6f0b..4265df6b8c02 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -6643,7 +6643,9 @@ package body Sem_Attr is
          Initialize (CRC);
          Compute_Type_Key (Entity (P));
 
-         if not Is_Frozen (Entity (P)) then
+         if not Is_Frozen (Entity (P))
+           and then not Is_Generic_Type (Entity (P))
+         then
             Error_Msg_N ("premature usage of Type_Key?", N);
          end if;
 
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 63bb80c12914..45d24574c28f 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -1681,6 +1681,13 @@ package body Sem_Ch5 is
          Error_Msg_N
            ("(Ada 83) case expression cannot be of a generic type", Exp);
          return;
+
+      elsif not Extensions_Allowed
+        and then not Is_Discrete_Type (Exp_Type)
+      then
+         Error_Msg_N
+           ("expression in case statement must be of a discrete_Type", Exp);
+         return;
       end if;
 
       --  If the case expression is a formal object of mode in out, then treat