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.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-05-24 Justin Squirek <squi...@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.--- gcc/ada/exp_ch3.adb
+++ gcc/ada/exp_ch3.adb
@@ -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;
--- gcc/ada/exp_ch5.adb
+++ gcc/ada/exp_ch5.adb
@@ -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;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/raise_expr.adb
@@ -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;
