Commit c06a59be by Justin Squirek Committed by Pierre-Marie de Rodat

[Ada] Crash on return of raise expression

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
parent fa3717c1
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> 2018-05-24 Hristian Kirtchev <kirtchev@adacore.com>
* exp_util.adb (New_Class_Wide_Subtype): Capture and restore relevant * exp_util.adb (New_Class_Wide_Subtype): Capture and restore relevant
......
...@@ -6952,9 +6952,11 @@ package body Exp_Ch3 is ...@@ -6952,9 +6952,11 @@ package body Exp_Ch3 is
-- If we cannot convert the expression into a renaming we must -- If we cannot convert the expression into a renaming we must
-- consider it an internal error because the backend does not -- 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); pragma Assert (False);
raise Program_Error; raise Program_Error;
end if; end if;
......
...@@ -2467,12 +2467,19 @@ package body Exp_Ch5 is ...@@ -2467,12 +2467,19 @@ package body Exp_Ch5 is
-- extension of a limited interface, and the actual is -- extension of a limited interface, and the actual is
-- limited. This is an error according to AI05-0087, but -- limited. This is an error according to AI05-0087, but
-- is not caught at the point of instantiation in earlier -- 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 -- This is wrong, error messages cannot be issued during
-- expansion, since they would be missed in -gnatc mode ??? -- 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; return;
end if; end if;
......
2018-05-24 Justin Squirek <squirek@adacore.com>
* gnat.dg/raise_expr.adb: New testcase.
2018-05-24 Hristian Kirtchev <kirtchev@adacore.com> 2018-05-24 Hristian Kirtchev <kirtchev@adacore.com>
* gnat.dg/formal_containers.adb: New testcase. * gnat.dg/formal_containers.adb: New testcase.
......
-- { 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment