diff mbox series

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

Message ID 20201019095422.GA91122@adacore.com
State New
Headers show
Series [Ada] Reject use of Relaxed_Initialization on scalar/access param or result | expand

Commit Message

Pierre-Marie de Rodat Oct. 19, 2020, 9:54 a.m. UTC 
The rules for Relaxed_Initialization have been tightened in SPARK RM, to
reject meaningless uses. This is implemented here.

Tested on x86_64-pc-linux-gnu, committed on trunk

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 mbox series

Patch

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
--- 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;