]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Ada: Fix bogus warning for character literal referenced in string literal
authorEric Botcazou <ebotcazou@adacore.com>
Wed, 15 Apr 2026 17:31:14 +0000 (19:31 +0200)
committerEric Botcazou <ebotcazou@adacore.com>
Wed, 15 Apr 2026 17:39:22 +0000 (19:39 +0200)
That's an ancient issue with -gnatwu, but the fix is again trivial.

gcc/ada/
PR ada/87170
* sem_res.adb (Resolve_String_Literal): Copy Comes_From_Source from
the string literal to the character literals.

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

gcc/ada/sem_res.adb
gcc/testsuite/gnat.dg/warn35.adb [new file with mode: 0644]

index 53cef024b3260c2875c8bbdb8fc85db76b807c85..e5abc01fc8b56c89e18bdcb08e440fff36f15a2c 100644 (file)
@@ -12266,12 +12266,13 @@ package body Sem_Res is
          end if;
       end if;
 
-      --  If we got here we meed to transform the string literal into the
+      --  If we got here, we need to transform the string literal into the
       --  equivalent qualified positional array aggregate. This is rather
       --  heavy artillery for this situation, but it is hard work to avoid.
 
       declare
          Lits : constant List_Id := New_List;
+         Lit  : Node_Id;
          P    : Source_Ptr := Loc + 1;
          C    : Char_Code;
 
@@ -12284,10 +12285,12 @@ package body Sem_Res is
             C := Get_String_Char (Str, J);
             Set_Character_Literal_Name (C);
 
-            Append_To (Lits,
+            Lit :=
               Make_Character_Literal (P,
                 Chars              => Name_Find,
-                Char_Literal_Value => UI_From_CC (C)));
+                Char_Literal_Value => UI_From_CC (C));
+            Preserve_Comes_From_Source (Lit, N);
+            Append_To (Lits, Lit);
 
             if In_Character_Range (C) then
                P := P + 1;
diff --git a/gcc/testsuite/gnat.dg/warn35.adb b/gcc/testsuite/gnat.dg/warn35.adb
new file mode 100644 (file)
index 0000000..27b0442
--- /dev/null
@@ -0,0 +1,16 @@
+-- { dg-do compile }
+-- { dg-options "-gnatwu" }
+
+procedure Warn35 is
+
+  type Bit is ('0', '1');
+
+  type Bit_Array is array (1 .. 2) of Bit;
+
+  Bits : constant Bit_Array := ("01");
+
+  B : Bit;
+
+begin
+  B := Bits (1);
+end;