From: Yannick Moy <moy@adacore.com>
Date: Mon, 6 Jul 2020 12:58:28 +0000 (+0200)
Subject: [Ada] Reject use of Relaxed_Initialization on scalar/access param or result
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=be8d605f16ed6ab090b411a7810911f4b7b7719a;p=gcc.git

[Ada] Reject use of Relaxed_Initialization on scalar/access param or result

gcc/ada/

	* sem_ch13.adb (Analyze_Aspect_Relaxed_Initialization): Fix bug
	where a call to Error_Msg_N leads to crash due to
	Error_Msg_Name_1 being removed by the call, while a subsequent
	call to Error_Msg_N tries to use it. The variable
	Error_Msg_Name_1 should be restored prior to the next call. Also
	add checking for the new rules.
---

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index ce058ddc90a..b40c575695f 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2165,6 +2165,9 @@ package body Sem_Ch13 is
                   Seen    : in out Elist_Id)
                is
                begin
+                  --  Set name of the aspect for error messages
+                  Error_Msg_Name_1 := Nam;
+
                   --  The relaxed parameter is a formal parameter
 
                   if Nkind (Param) in N_Identifier | N_Expanded_Name then
@@ -2179,6 +2182,14 @@ package body Sem_Ch13 is
 
                            pragma Assert (Is_Formal (Item));
 
+                           --  It must not have scalar or access type
+
+                           if Is_Elementary_Type (Etype (Item)) then
+                              Error_Msg_N ("illegal aspect % item", Param);
+                              Error_Msg_N
+                                ("\item must not have elementary type", Param);
+                           end if;
+
                            --  Detect duplicated items
 
                            if Contains (Seen, Item) then
@@ -2205,6 +2216,16 @@ package body Sem_Ch13 is
                           and then
                             Entity (Pref) = Subp_Id
                         then
+                           --  Function result must not have scalar or access
+                           --  type.
+
+                           if Is_Elementary_Type (Etype (Pref)) then
+                              Error_Msg_N ("illegal aspect % item", Param);
+                              Error_Msg_N
+                                ("\function result must not have elementary"
+                                 & " type", Param);
+                           end if;
+
                            --  Detect duplicated items
 
                            if Contains (Seen, Subp_Id) then
@@ -2345,12 +2366,14 @@ package body Sem_Ch13 is
                                     if not Is_OK_Static_Expression
                                       (Expression (Assoc))
                                     then
+                                       Error_Msg_Name_1 := Nam;
                                        Error_Msg_N
                                          ("expression of aspect %" &
                                           "must be static", Aspect);
                                     end if;
 
                                  else
+                                    Error_Msg_Name_1 := Nam;
                                     Error_Msg_N
                                       ("illegal aspect % expression", Expr);
                                  end if;