summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2025-11-12 09:03:18 +0100
committerEric Botcazou <ebotcazou@adacore.com>2025-11-12 09:17:25 +0100
commitf24307422d1d15f99b2f8af19894e573f7036fb1 (patch)
tree2a0d0c759d731e6692b4631c8a98da77bc03f4b8
parent5fac2f40b096dcc8d5cc3b5053d91ededeaf32b8 (diff)
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.
-rw-r--r--gcc/ada/sem_ch3.adb75
-rw-r--r--gcc/testsuite/gnat.dg/warn34.adb9
2 files changed, 39 insertions, 45 deletions
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 2d96545067f..225bff097bf 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -4365,10 +4365,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:
@@ -4649,17 +4656,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). Note:
@@ -5070,15 +5083,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;
@@ -5202,43 +5206,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
index 00000000000..57318a07549
--- /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;