Ada: Fix variable initialized with if-expression not flagged as constant

This is a regression present on the mainline and 15 branch: the -gnatwk
switch no longer flags a string variable initialized with an if-expression
as constant when it is not modified in the program.  The fix is to set the
Has_Initial_Value and Never_Set_In_Source flags earlier during analysis in
the Analyze_Object_Declaration procedure.

gcc/ada/
	PR ada/122640
	* sem_ch3.adb (Analyze_Object_Declaration): Set Is_True_Constant
	on entry for constants and Never_Set_In_Source in all cases.
	If an initialization expression is present, set Has_Initial_Value
	and Is_True_Constant on variables.

gcc/testsuite/
	* gnat.dg/warn34.adb: New test.

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index ba0af27471d8431cbb76aaa2aec9b8a07b084014..cc26ecab6ae10733dc7279f1902f07865e5db68d 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -4415,10 +4415,17 @@ package body Sem_Ch3 is
    begin
       if Constant_Present (N) then
          Mutate_Ekind (Id, E_Constant);
+         Set_Is_True_Constant (Id);
       else
          Mutate_Ekind (Id, E_Variable);
       end if;
 
+      --  Indicate this is not set in source. Certainly true for constants, and
+      --  true for variables so far (will be reset for a variable if and when
+      --  we encounter a modification in the source).
+
+      Set_Never_Set_In_Source (Id);
+
       --  There are three kinds of implicit types generated by an
       --  object declaration:
 
@@ -4701,17 +4708,23 @@ package body Sem_Ch3 is
             Set_Etype (E, T);
          end if;
 
-         --  If an initialization expression is present, then we set the
-         --  Is_True_Constant flag. It will be reset if this is a variable
-         --  and it is indeed modified.
-
-         Set_Is_True_Constant (Id, True);
-
          --  If we are analyzing a constant declaration, set its completion
          --  flag after analyzing and resolving the expression.
 
          if Constant_Present (N) then
             Set_Has_Completion (Id);
+
+         --  Set Has_Initial_Value if initialization expression present. Note
+         --  that if there is no initializing expression, we leave the state
+         --  of this flag unchanged (usually it will be False, but notably in
+         --  the case of exception choice variables, it will already be true).
+
+         --  Set Is_True_Constant if initialization expression is present. It
+         --  will be reset if the variable is indeed modified.
+
+         else
+            Set_Has_Initial_Value (Id);
+            Set_Is_True_Constant (Id);
          end if;
 
          --  Set type and resolve (type may be overridden later on)
@@ -5120,15 +5133,6 @@ package body Sem_Ch3 is
                   --  that subsequent uses of this entity are not rejected
                   --  via the same mechanism that (correctly) rejects
                   --  "X : Integer := X;".
-
-                  if Constant_Present (N) then
-                     Set_Is_True_Constant (Id);
-                  else
-                     if Present (E) then
-                        Set_Has_Initial_Value (Id);
-                     end if;
-                  end if;
-
                   goto Leave;
                end if;
 
@@ -5261,43 +5265,24 @@ package body Sem_Ch3 is
 
       Check_Wide_Character_Restriction (T, Object_Definition (N));
 
-      --  Indicate this is not set in source. Certainly true for constants, and
-      --  true for variables so far (will be reset for a variable if and when
-      --  we encounter a modification in the source).
-
-      Set_Never_Set_In_Source (Id);
-
       --  Now establish the proper kind and type of the object
 
       if Ekind (Id) = E_Void then
          Reinit_Field_To_Zero (Id, F_Next_Inlined_Subprogram);
       end if;
 
-      if Constant_Present (N) then
-         Set_Is_True_Constant (Id);
+      --  A variable is set as shared passive if it appears in a shared
+      --  passive package, and is at the outer level. This is not done for
+      --  entities generated during expansion, because those are always
+      --  manipulated locally.
 
-      else
-         --  A variable is set as shared passive if it appears in a shared
-         --  passive package, and is at the outer level. This is not done for
-         --  entities generated during expansion, because those are always
-         --  manipulated locally.
-
-         if Is_Shared_Passive (Current_Scope)
-           and then Is_Library_Level_Entity (Id)
-           and then Comes_From_Source (Id)
-         then
-            Set_Is_Shared_Passive (Id);
-            Check_Shared_Var (Id, T, N);
-         end if;
-
-         --  Set Has_Initial_Value if initializing expression present. Note
-         --  that if there is no initializing expression, we leave the state
-         --  of this flag unchanged (usually it will be False, but notably in
-         --  the case of exception choice variables, it will already be true).
-
-         if Present (E) then
-            Set_Has_Initial_Value (Id);
-         end if;
+      if not Constant_Present (N)
+        and then Is_Shared_Passive (Current_Scope)
+        and then Is_Library_Level_Entity (Id)
+        and then Comes_From_Source (Id)
+      then
+         Set_Is_Shared_Passive (Id);
+         Check_Shared_Var (Id, T, N);
       end if;
 
       --  Set the SPARK mode from the current context (may be overwritten later

diff --git a/gcc/testsuite/gnat.dg/warn34.adb b/gcc/testsuite/gnat.dg/warn34.adb
new file mode 100644 (file)
index 0000000..57318a0
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/warn34.adb
@@ -0,0 +1,9 @@
+-- { dg-do compile }
+-- { dg-options "-gnatwk" }
+
+function Warn34 (F : Boolean) return String is
+  S : String := -- { dg-warning "could be declared constant" }
+        (if F then "foo" else "bar");
+begin
+  return S;
+end;