Commit 6e840989 by Hristian Kirtchev Committed by Arnaud Charlet

exp_ch7.adb (Process_Transient_Objects): Reimplement to properly handle…

exp_ch7.adb (Process_Transient_Objects): Reimplement to properly handle restriction No_Exception_Propagation.

2015-10-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Process_Transient_Objects): Reimplement to properly
	handle restriction No_Exception_Propagation.
	* exp_ch11.adb (Expand_At_End_Handler): Update the parameter
	profile and all references to Block.
	* exp_ch11.ads (Expand_At_End_Handler): Update the parameter
	profile and comment on usage.
	* exp_intr.adb (Expand_Unc_Deallocation): Reimplement to properly
	handle restriction No_Exception_Propagation.
	* gnat1drv.adb, restrict.adb: Update comment.

From-SVN: r229227
parent c79f6efd
2015-10-23 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch7.adb (Process_Transient_Objects): Reimplement to properly
handle restriction No_Exception_Propagation.
* exp_ch11.adb (Expand_At_End_Handler): Update the parameter
profile and all references to Block.
* exp_ch11.ads (Expand_At_End_Handler): Update the parameter
profile and comment on usage.
* exp_intr.adb (Expand_Unc_Deallocation): Reimplement to properly
handle restriction No_Exception_Propagation.
* gnat1drv.adb, restrict.adb: Update comment.
2015-10-23 Bob Duff <duff@adacore.com> 2015-10-23 Bob Duff <duff@adacore.com>
* exp_ch6.adb (Expand_N_Extended_Return_Statement): Do not call * exp_ch6.adb (Expand_N_Extended_Return_Statement): Do not call
......
...@@ -99,7 +99,7 @@ package body Exp_Ch11 is ...@@ -99,7 +99,7 @@ package body Exp_Ch11 is
-- and the code generator (e.g. gigi) must still handle proper generation -- and the code generator (e.g. gigi) must still handle proper generation
-- of cleanup calls for the non-exceptional case. -- of cleanup calls for the non-exceptional case.
procedure Expand_At_End_Handler (HSS : Node_Id; Block : Node_Id) is procedure Expand_At_End_Handler (HSS : Node_Id; Blk_Id : Entity_Id) is
Clean : constant Entity_Id := Entity (At_End_Proc (HSS)); Clean : constant Entity_Id := Entity (At_End_Proc (HSS));
Ohandle : Node_Id; Ohandle : Node_Id;
Stmnts : List_Id; Stmnts : List_Id;
...@@ -138,8 +138,8 @@ package body Exp_Ch11 is ...@@ -138,8 +138,8 @@ package body Exp_Ch11 is
return; return;
end if; end if;
if Present (Block) then if Present (Blk_Id) then
Push_Scope (Block); Push_Scope (Blk_Id);
end if; end if;
Ohandle := Ohandle :=
...@@ -175,7 +175,7 @@ package body Exp_Ch11 is ...@@ -175,7 +175,7 @@ package body Exp_Ch11 is
Analyze_List (Stmnts, Suppress => All_Checks); Analyze_List (Stmnts, Suppress => All_Checks);
Expand_Exception_Handlers (HSS); Expand_Exception_Handlers (HSS);
if Present (Block) then if Present (Blk_Id) then
Pop_Scope; Pop_Scope;
end if; end if;
end Expand_At_End_Handler; end Expand_At_End_Handler;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -40,12 +40,11 @@ package Exp_Ch11 is ...@@ -40,12 +40,11 @@ package Exp_Ch11 is
-- See runtime routine Ada.Exceptions for full details on the format and -- See runtime routine Ada.Exceptions for full details on the format and
-- content of these tables. -- content of these tables.
procedure Expand_At_End_Handler (HSS : Node_Id; Block : Node_Id); procedure Expand_At_End_Handler (HSS : Node_Id; Blk_Id : Entity_Id);
-- Given a handled statement sequence, HSS, for which the At_End_Proc -- Given handled statement sequence HSS for which the At_End_Proc field
-- field is set, and which currently has no exception handlers, this -- is set, and which currently has no exception handlers, this procedure
-- procedure expands the special exception handler required. -- expands the special exception handler required. This procedure also
-- This procedure also create a new scope for the given Block, if -- create a new scope for the given block, if Blk_Id is not Empty.
-- Block is not Empty.
procedure Expand_Exception_Handlers (HSS : Node_Id); procedure Expand_Exception_Handlers (HSS : Node_Id);
-- This procedure expands exception handlers, and is called as part -- This procedure expands exception handlers, and is called as part
......
...@@ -378,10 +378,7 @@ procedure Gnat1drv is ...@@ -378,10 +378,7 @@ procedure Gnat1drv is
Optimization_Level := 0; Optimization_Level := 0;
-- Enable some restrictions systematically to simplify the generated -- Enable some restrictions systematically to simplify the generated
-- code (and ease analysis). Note that restriction checks are also -- code (and ease analysis).
-- disabled in SPARK mode, see Restrict.Check_Restriction, and user
-- specified Restrictions pragmas are ignored, see
-- Sem_Prag.Process_Restrictions_Or_Restriction_Warnings.
Restrict.Restrictions.Set (No_Initialize_Scalars) := True; Restrict.Restrictions.Set (No_Initialize_Scalars) := True;
......
...@@ -498,14 +498,18 @@ package body Restrict is ...@@ -498,14 +498,18 @@ package body Restrict is
begin begin
Msg_Issued := False; Msg_Issued := False;
-- In CodePeer and SPARK mode, we do not want to check for any -- In CodePeer mode, we do not want to check for any restriction, or set
-- restriction, or set additional restrictions other than those already -- additional restrictions other than those already set in gnat1drv.adb
-- set in gnat1drv.adb so that we have consistency between each -- so that we have consistency between each compilation.
-- compilation.
-- In GNATprove mode restrictions are checked, except for
-- No_Initialize_Scalars, which is implicitely set in gnat1drv.adb.
-- Just checking, SPARK does not allow restrictions to be set ??? -- Just checking, SPARK does not allow restrictions to be set ???
if CodePeer_Mode then if CodePeer_Mode
or else (GNATprove_Mode and then R = No_Initialize_Scalars)
then
return; return;
end if; end if;
......
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