diff mbox series

[Ada] Diagnose properly illegal uses of Target_Name

Message ID 20210708135043.GA2466060@adacore.com
State New
Headers show
Series [Ada] Diagnose properly illegal uses of Target_Name | expand

Commit Message

Pierre-Marie de Rodat July 8, 2021, 1:50 p.m. UTC 
Ada_2022 introduces the notion of Target_Name, written @, to be used in
assignment statements, where it denotes the value of the left-hand side
prior to the assignment. This patch diagnoses illegal uses of the target
name outside of its legal context.

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

gcc/ada/

	* sem_ch5.adb (Analyze_Target_Name): Properly reject a
	Target_Name when it appears outside of an assignment statement,
	or within the left-hand side of one.
diff mbox series

Patch

diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -4233,10 +4233,50 @@  package body Sem_Ch5 is
    -------------------------
 
    procedure Analyze_Target_Name (N : Node_Id) is
+      procedure Report_Error;
+
+      ------------------
+      -- Report_Error --
+      ------------------
+
+      procedure Report_Error is
+      begin
+         Error_Msg_N
+           ("must appear in the right-hand side of an assignment statement",
+             N);
+         Rewrite (N, New_Occurrence_Of (Any_Id, Sloc (N)));
+      end Report_Error;
+
    begin
       --  A target name has the type of the left-hand side of the enclosing
       --  assignment.
 
+      --  First, verify that the context is the right-hand side of an
+      --  assignment statement.
+
+      if No (Current_Assignment) then
+         Report_Error;
+         return;
+
+      else
+         declare
+            P : Node_Id := N;
+         begin
+            while Present (P)
+              and then Nkind (Parent (P)) /= N_Assignment_Statement
+            loop
+               P := Parent (P);
+            end loop;
+
+            if No (P)
+              or else P /= Expression (Parent (P))
+            then
+               Report_Error;
+               return;
+            end if;
+         end;
+      end if;
+
       Set_Etype (N, Etype (Name (Current_Assignment)));
    end Analyze_Target_Name;