[Ada] Reject use of Relaxed_Initialization on scalar/access param or result
authorYannick Moy <moy@adacore.com>
Mon, 6 Jul 2020 12:58:28 +0000 (14:58 +0200)
committerPierre-Marie de Rodat <derodat@adacore.com>
Mon, 19 Oct 2020 09:53:38 +0000 (05:53 -0400)
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.

gcc/ada/sem_ch13.adb

index ce058ddc90a439679db56491db54165135e97e9b..b40c575695f7adc139405cf6c71ad4fd9078e5ad 100644 (file)
@@ -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;