[Ada] Crash on 'Img attribute
authorJustin Squirek <squirek@adacore.com>
Tue, 9 Jul 2019 07:55:33 +0000 (07:55 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Tue, 9 Jul 2019 07:55:33 +0000 (07:55 +0000)
This patch fixes and issue whereby applying 'Img to a constant
enumerated character type would result in a compiler crash when
assertions are enabled and infinite recursion when they are not.

2019-07-09  Justin Squirek  <squirek@adacore.com>

gcc/ada/

* sem_eval.adb (Expr_Value_E): Add conditional to correctly
handle constant enumerated character types.

gcc/testsuite/

* gnat.dg/image1.adb: New testcase.

From-SVN: r273292

gcc/ada/ChangeLog
gcc/ada/sem_eval.adb
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/image1.adb [new file with mode: 0644]

index cfbdf89a5821126cf31255a8b340637c2ea16c38..524adfd1540e269dfcf36a667e70609416a49932 100644 (file)
@@ -1,3 +1,8 @@
+2019-07-09  Justin Squirek  <squirek@adacore.com>
+
+       * sem_eval.adb (Expr_Value_E): Add conditional to correctly
+       handle constant enumerated character types.
+
 2019-07-09  Eric Botcazou  <ebotcazou@adacore.com>
 
        * libgnarl/s-osinte__mingw.ads (CRITICAL_SECTION): Use proper
index ff3359fb0e29789230c5695c762c22168133e76a..e140fa72ffbdc91fcc92d89867160789393576b1 100644 (file)
@@ -4281,7 +4281,15 @@ package body Sem_Eval is
          return Ent;
       else
          pragma Assert (Ekind (Ent) = E_Constant);
-         return Expr_Value_E (Constant_Value (Ent));
+
+         --  We may be dealing with a enumerated character type constant, so
+         --  handle that case here.
+
+         if Nkind (Constant_Value (Ent)) = N_Character_Literal then
+            return Ent;
+         else
+            return Expr_Value_E (Constant_Value (Ent));
+         end if;
       end if;
    end Expr_Value_E;
 
index fa53a2fc46107da5a4a918c32aacf692fe73919d..d2b1c6b95caa4e9050104622c1895c3413491daa 100644 (file)
@@ -1,3 +1,7 @@
+2019-07-09  Justin Squirek  <squirek@adacore.com>
+
+       * gnat.dg/image1.adb: New testcase.
+
 2019-07-09  Javier Miranda  <miranda@adacore.com>
 
        * gnat.dg/rep_clause8.adb: New testcase.
diff --git a/gcc/testsuite/gnat.dg/image1.adb b/gcc/testsuite/gnat.dg/image1.adb
new file mode 100644 (file)
index 0000000..ae8d680
--- /dev/null
@@ -0,0 +1,12 @@
+--  { dg-do run }
+
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Characters.Latin_1;
+
+procedure Image1 is
+   Str : String := Ada.Characters.Latin_1.LF'Img;
+begin
+   if Str /= "LF" then
+      raise Program_Error;
+   end if;
+end Image1;