[Ada] Crash on return of raise expression
authorJustin Squirek <squirek@adacore.com>
Thu, 24 May 2018 13:05:32 +0000 (13:05 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Thu, 24 May 2018 13:05:32 +0000 (13:05 +0000)
This patch fixes an issue whereby the compiler regarded assignments to limited
that consisted of raise expressions to be a compile-time error during
expansion.

2018-05-24  Justin Squirek  <squirek@adacore.com>

gcc/ada/

* exp_ch3.adb (Expand_N_Object_Declaration): Ignore raising an error in
expansion for limited tagged types when the node to be expanded is a
raise expression due to it not representing a valid object.
* exp_ch5.adb (Expand_N_Assignment_Statement): Add exception to error
message regarding assignments to limited types to ignore genereated
code.

gcc/testsuite/

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

From-SVN: r260654

gcc/ada/ChangeLog
gcc/ada/exp_ch3.adb
gcc/ada/exp_ch5.adb
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/raise_expr.adb [new file with mode: 0644]

index bf69dbf2d790297ca652536084341bcaa5443831..e0ea4595fa3d7ac4eae5e8da1298d48de2b95efd 100644 (file)
@@ -1,3 +1,12 @@
+2018-05-24  Justin Squirek  <squirek@adacore.com>
+
+       * exp_ch3.adb (Expand_N_Object_Declaration): Ignore raising an error in
+       expansion for limited tagged types when the node to be expanded is a
+       raise expression due to it not representing a valid object.
+       * exp_ch5.adb (Expand_N_Assignment_Statement): Add exception to error
+       message regarding assignments to limited types to ignore genereated
+       code.
+
 2018-05-24  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * exp_util.adb (New_Class_Wide_Subtype): Capture and restore relevant
index 4c5d940ee6baa4517a0ec6a7178a9151307e3b8f..4c3a7b768bc87a90218c7372e378dd3ecdb281db 100644 (file)
@@ -6952,9 +6952,11 @@ package body Exp_Ch3 is
 
                --  If we cannot convert the expression into a renaming we must
                --  consider it an internal error because the backend does not
-               --  have support to handle it.
+               --  have support to handle it. Also, when a raise expression is
+               --  encountered we ignore it since it doesn't return a value and
+               --  thus cannot trigger a copy.
 
-               else
+               elsif Nkind (Original_Node (Expr_Q)) /= N_Raise_Expression then
                   pragma Assert (False);
                   raise Program_Error;
                end if;
index 81fb162f39de5ad29cf9a1547ec78244e181635e..0989370d5e8a5bfda56256e5233afe56a6af03eb 100644 (file)
@@ -2467,12 +2467,19 @@ package body Exp_Ch5 is
                   --  extension of a limited interface, and the actual is
                   --  limited. This is an error according to AI05-0087, but
                   --  is not caught at the point of instantiation in earlier
-                  --  versions.
+                  --  versions. We also must verify that the limited type does
+                  --  not come from source as corner cases may exist where
+                  --  an assignment was not intended like the pathological case
+                  --  of a raise expression within a return statement.
 
                   --  This is wrong, error messages cannot be issued during
                   --  expansion, since they would be missed in -gnatc mode ???
 
-                  Error_Msg_N ("assignment not available on limited type", N);
+                  if Comes_From_Source (N) then
+                     Error_Msg_N
+                       ("assignment not available on limited type", N);
+                  end if;
+
                   return;
                end if;
 
index 8381235981c3060467d5f08cb6ec77d38efbb159..ad047a47412410f1648a5e7049e2000eef00f7be 100644 (file)
@@ -1,3 +1,7 @@
+2018-05-24  Justin Squirek  <squirek@adacore.com>
+
+       * gnat.dg/raise_expr.adb: New testcase.
+
 2018-05-24  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * gnat.dg/formal_containers.adb: New testcase.
diff --git a/gcc/testsuite/gnat.dg/raise_expr.adb b/gcc/testsuite/gnat.dg/raise_expr.adb
new file mode 100644 (file)
index 0000000..cdca906
--- /dev/null
@@ -0,0 +1,27 @@
+--  { dg-do compile }
+
+procedure Raise_Expr is
+
+   E : exception;
+
+   type T is tagged limited null record;
+   type TC is new T with null record;
+
+   function F0 return Boolean is
+   begin
+       return raise E;
+   end;
+
+   function F return T'Class is
+     TT : T;
+   begin
+      return raise E; -- Causes compile-time crash
+   end F;
+
+begin
+   declare
+      O : T'class  := F;
+   begin
+      null;
+   end;
+end Raise_Expr;