A pragma No_Return that applies to a procedure body is illegal. This
patch fixes a bug that caused the compiler to fail to give an error.
The following test should get an error:
no_return.adb:6:04: representation item appears too late
package No_Return is
procedure P;
end No_Return;
package body No_Return is
procedure P is
begin
null;
end P;
pragma No_Return(P);
end No_Return;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Bob Duff <d...@adacore.com>
* sem_prag.adb (No_Return): Give an error if the pragma applies
to a body. Specialize the error for the specless body case,
as is done for (e.g.) pragma Convention.
* debug.adb: Add switch -gnatd.J to disable the above legality
checks. This is mainly for use in our test suite, to avoid
rewriting a lot of illegal (but working) code. It might also
be useful to customers. Under this switch, if a pragma No_Return
applies to a body, and the procedure raises an exception (as it
should), the pragma has no effect. If the procedure does return,
execution is erroneous.
Index: debug.adb
===================================================================
--- debug.adb (revision 247177)
+++ debug.adb (working copy)
@@ -127,7 +127,7 @@
-- d.G Ignore calls through generic formal parameters for elaboration
-- d.H GNSA mode for ASIS
-- d.I Do not ignore enum representation clauses in CodePeer mode
- -- d.J
+ -- d.J Relaxed rules for pragma No_Return
-- d.K Enable generation of contract-only procedures in CodePeer mode
-- d.L Depend on back end for limited types in if and case expressions
-- d.M Relaxed RM semantics
@@ -645,6 +645,11 @@
-- cases being able to change this default might be useful to remove
-- some false positives.
+ -- d.J Relaxed rules for pragma No_Return. A pragma No_Return is illegal
+ -- if it applies to a body. This switch disables the legality check
+ -- for that. If the procedure does in fact return normally, execution
+ -- is erroneous, and therefore unpredictable.
+
-- d.K Enable generation of contract-only procedures in CodePeer mode and
-- report a warning on subprograms for which the contract-only body
-- cannot be built. Currently reported on subprograms defined in
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 247177)
+++ sem_prag.adb (working copy)
@@ -7621,7 +7621,7 @@
end if;
-- Check that we are not applying this to a specless body. Relax this
- -- check if Relaxed_RM_Semantics to accomodate other Ada compilers.
+ -- check if Relaxed_RM_Semantics to accommodate other Ada compilers.
if Is_Subprogram (E)
and then Nkind (Parent (Declaration_Node (E))) = N_Subprogram_Body
@@ -8084,8 +8084,8 @@
N_Subprogram_Body
then
Error_Pragma
- ("pragma% requires separate spec"
- & " and must come before body");
+ ("pragma% requires separate spec" &
+ " and must come before body");
end if;
-- Test result type if given, note that the result type
@@ -18177,6 +18177,29 @@
and then Scope (E) = Current_Scope
loop
if Ekind_In (E, E_Procedure, E_Generic_Procedure) then
+ -- Check that the pragma is not applied to a body.
+ -- First check the specless body case, to give a
+ -- different error message. These checks do not apply
+ -- if Relaxed_RM_Semantics, to accommodate other Ada
+ -- compilers. Disable these checks under -gnatd.J.
+
+ if not Debug_Flag_Dot_JJ then
+ if Nkind (Parent (Declaration_Node (E))) =
+ N_Subprogram_Body
+ and then not Relaxed_RM_Semantics
+ then
+ Error_Pragma
+ ("pragma% requires separate spec" &
+ " and must come before body");
+ end if;
+
+ -- Now the "specful" body case
+
+ if Rep_Item_Too_Late (E, N) then
+ raise Pragma_Exit;
+ end if;
+ end if;
+
Set_No_Return (E);
-- A pragma that applies to a Ghost entity becomes Ghost
@@ -26125,7 +26148,7 @@
raise Program_Error;
end if;
- -- To accomodate partial decoration of disabled SPARK features, this
+ -- To accommodate partial decoration of disabled SPARK features, this
-- routine may be called with illegal input. If this is the case, do
-- not raise Program_Error.
@@ -28031,7 +28054,7 @@
(Item => First (Choices (Clause)),
Is_Input => False);
- -- To accomodate partial decoration of disabled SPARK features, this
+ -- To accommodate partial decoration of disabled SPARK features, this
-- routine may be called with illegal input. If this is the case, do
-- not raise Program_Error.
@@ -28105,7 +28128,7 @@
end loop;
end if;
- -- To accomodate partial decoration of disabled SPARK features, this
+ -- To accommodate partial decoration of disabled SPARK features, this
-- routine may be called with illegal input. If this is the case, do
-- not raise Program_Error.
