[multiple changes]
2011-08-29 Thomas Quinot <quinot@adacore.com> * a-except.adb, a-except-2005.adb: Minor comment rewording and reformatting. 2011-08-29 Yannick Moy <moy@adacore.com> * sem_ch3.adb (Array_Type_Declaration): Remove insertion of declaration for Itypes in Alfa mode. From-SVN: r178246
This commit is contained in:
Arnaud Charlet
parent
d85fd922e1
commit
8027b4559b
4 changed files with 50 additions and 94 deletions
|
|
@ -1,3 +1,13 @@
|
|||
2011-08-29 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* a-except.adb, a-except-2005.adb: Minor comment rewording and
|
||||
reformatting.
|
||||
|
||||
2011-08-29 Yannick Moy <moy@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Array_Type_Declaration): Remove insertion of
|
||||
declaration for Itypes in Alfa mode.
|
||||
|
||||
2011-08-29 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
|
||||
|
|
|
|||
|
|
@ -422,7 +422,6 @@ package body Ada.Exceptions is
|
|||
procedure Rcheck_19 (File : System.Address; Line : Integer);
|
||||
procedure Rcheck_20 (File : System.Address; Line : Integer);
|
||||
procedure Rcheck_21 (File : System.Address; Line : Integer);
|
||||
procedure Rcheck_22 (File : System.Address; Line : Integer);
|
||||
procedure Rcheck_23 (File : System.Address; Line : Integer);
|
||||
procedure Rcheck_24 (File : System.Address; Line : Integer);
|
||||
procedure Rcheck_25 (File : System.Address; Line : Integer);
|
||||
|
|
@ -445,6 +444,14 @@ package body Ada.Exceptions is
|
|||
procedure Rcheck_12_Ext
|
||||
(File : System.Address; Line, Column, Index, First, Last : Integer);
|
||||
|
||||
procedure Rcheck_22 (File : System.Address; Line : Integer);
|
||||
-- This routine is separated out because it has quite different behavior
|
||||
-- from the others. This is the "finalize/adjust raised exception". This
|
||||
-- subprogram is always called with abort deferred, unlike all other
|
||||
-- Rcheck_* routines, it needs to call Raise_Exception_No_Defer.
|
||||
--
|
||||
-- It should probably have a distinguished name ???
|
||||
|
||||
pragma Export (C, Rcheck_00, "__gnat_rcheck_00");
|
||||
pragma Export (C, Rcheck_01, "__gnat_rcheck_01");
|
||||
pragma Export (C, Rcheck_02, "__gnat_rcheck_02");
|
||||
|
|
@ -1151,19 +1158,6 @@ package body Ada.Exceptions is
|
|||
Raise_Program_Error_Msg (File, Line, Rmsg_21'Address);
|
||||
end Rcheck_21;
|
||||
|
||||
procedure Rcheck_22 (File : System.Address; Line : Integer) is
|
||||
E : constant Exception_Id := Program_Error_Def'Access;
|
||||
begin
|
||||
-- This is "finalize/adjust raised exception".
|
||||
-- As this exception is only raised with aborts defered, it must
|
||||
-- call Raise_Exception_No_Defer, contrary to all other Rcheck
|
||||
-- subprograms (which defer aborts).
|
||||
-- This is coherent with Raise_From_Controlled_Operation.
|
||||
|
||||
Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address);
|
||||
Raise_Current_Excep (E);
|
||||
end Rcheck_22;
|
||||
|
||||
procedure Rcheck_23 (File : System.Address; Line : Integer) is
|
||||
begin
|
||||
Raise_Program_Error_Msg (File, Line, Rmsg_23'Address);
|
||||
|
|
@ -1262,6 +1256,24 @@ package body Ada.Exceptions is
|
|||
Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
|
||||
end Rcheck_12_Ext;
|
||||
|
||||
---------------
|
||||
-- Rcheck_22 --
|
||||
---------------
|
||||
|
||||
procedure Rcheck_22 (File : System.Address; Line : Integer) is
|
||||
E : constant Exception_Id := Program_Error_Def'Access;
|
||||
|
||||
begin
|
||||
-- This is "finalize/adjust raised exception". This subprogram is always
|
||||
-- called with abort deferred, unlike all other Rcheck_* routines, it
|
||||
-- needs to call Raise_Exception_No_Defer.
|
||||
|
||||
-- This is consistent with Raise_From_Controlled_Operation
|
||||
|
||||
Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address);
|
||||
Raise_Current_Excep (E);
|
||||
end Rcheck_22;
|
||||
|
||||
-------------
|
||||
-- Reraise --
|
||||
-------------
|
||||
|
|
|
|||
|
|
@ -381,7 +381,6 @@ package body Ada.Exceptions is
|
|||
procedure Rcheck_19 (File : System.Address; Line : Integer);
|
||||
procedure Rcheck_20 (File : System.Address; Line : Integer);
|
||||
procedure Rcheck_21 (File : System.Address; Line : Integer);
|
||||
procedure Rcheck_22 (File : System.Address; Line : Integer);
|
||||
procedure Rcheck_23 (File : System.Address; Line : Integer);
|
||||
procedure Rcheck_24 (File : System.Address; Line : Integer);
|
||||
procedure Rcheck_25 (File : System.Address; Line : Integer);
|
||||
|
|
@ -395,6 +394,14 @@ package body Ada.Exceptions is
|
|||
procedure Rcheck_33 (File : System.Address; Line : Integer);
|
||||
procedure Rcheck_34 (File : System.Address; Line : Integer);
|
||||
|
||||
procedure Rcheck_22 (File : System.Address; Line : Integer);
|
||||
-- This routine is separated out because it has quite different behavior
|
||||
-- from the others. This is the "finalize/adjust raised exception". This
|
||||
-- subprogram is always called with abort deferred, unlike all other
|
||||
-- Rcheck_* routines, it needs to call Raise_Exception_No_Defer.
|
||||
--
|
||||
-- It should probably have a distinguished name ???
|
||||
|
||||
pragma Export (C, Rcheck_00, "__gnat_rcheck_00");
|
||||
pragma Export (C, Rcheck_01, "__gnat_rcheck_01");
|
||||
pragma Export (C, Rcheck_02, "__gnat_rcheck_02");
|
||||
|
|
@ -1084,12 +1091,13 @@ package body Ada.Exceptions is
|
|||
|
||||
procedure Rcheck_22 (File : System.Address; Line : Integer) is
|
||||
E : constant Exception_Id := Program_Error_Def'Access;
|
||||
|
||||
begin
|
||||
-- This is "finalize/adjust raised exception".
|
||||
-- As this exception is only raised with aborts defered, it must
|
||||
-- call Raise_Exception_No_Defer, contrary to all other Rcheck
|
||||
-- subprograms (which defer aborts).
|
||||
-- This is coherent with Raise_From_Controlled_Operation.
|
||||
-- This is "finalize/adjust raised exception". This subprogram is always
|
||||
-- called with abort deferred, unlike all other Rcheck_* routines, it
|
||||
-- needs to call Raise_Exception_No_Defer.
|
||||
|
||||
-- This is consistent with Raise_From_Controlled_Operation
|
||||
|
||||
Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address);
|
||||
Raise_Current_Excep (E);
|
||||
|
|
|
|||
|
|
@ -4741,41 +4741,6 @@ package body Sem_Ch3 is
|
|||
|
||||
Make_Index (Index, P, Related_Id, Nb_Index);
|
||||
|
||||
-- In formal verification mode, create an explicit declaration for
|
||||
-- Itypes created for index types. Having a declaration for all type
|
||||
-- entities facilitates the task of the formal verification back-end.
|
||||
-- Notice that this declaration is not attached to the tree.
|
||||
|
||||
if ALFA_Mode
|
||||
and then Is_Itype (Etype (Index))
|
||||
then
|
||||
declare
|
||||
Loc : constant Source_Ptr := Sloc (Def);
|
||||
Sub_Ind : Node_Id;
|
||||
Decl : Entity_Id;
|
||||
|
||||
begin
|
||||
if Nkind (Index) = N_Subtype_Indication then
|
||||
Sub_Ind := Relocate_Node (Index);
|
||||
else
|
||||
Sub_Ind :=
|
||||
Make_Subtype_Indication (Loc,
|
||||
Subtype_Mark =>
|
||||
New_Occurrence_Of (Base_Type (Etype (Index)), Loc),
|
||||
Constraint =>
|
||||
Make_Range_Constraint (Loc,
|
||||
Range_Expression => Relocate_Node (Index)));
|
||||
end if;
|
||||
|
||||
Decl :=
|
||||
Make_Subtype_Declaration (Loc,
|
||||
Defining_Identifier => Etype (Index),
|
||||
Subtype_Indication => Sub_Ind);
|
||||
|
||||
Analyze (Decl);
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- Check error of subtype with predicate for index type
|
||||
|
||||
Bad_Predicated_Subtype_Use
|
||||
|
|
@ -4793,24 +4758,6 @@ package body Sem_Ch3 is
|
|||
if Present (Component_Typ) then
|
||||
Element_Type := Process_Subtype (Component_Typ, P, Related_Id, 'C');
|
||||
|
||||
-- In formal verification mode, create an explicit declaration for
|
||||
-- the Itype created for a component type. Having a declaration for
|
||||
-- all type entities facilitates the task of the formal verification
|
||||
-- back-end. Note: this declaration is not attached to the tree.
|
||||
|
||||
if ALFA_Mode and then Is_Itype (Element_Type) then
|
||||
declare
|
||||
Loc : constant Source_Ptr := Sloc (Def);
|
||||
Decl : Entity_Id;
|
||||
begin
|
||||
Decl :=
|
||||
Make_Subtype_Declaration (Loc,
|
||||
Defining_Identifier => Element_Type,
|
||||
Subtype_Indication => Relocate_Node (Component_Typ));
|
||||
Analyze (Decl);
|
||||
end;
|
||||
end if;
|
||||
|
||||
Set_Etype (Component_Typ, Element_Type);
|
||||
|
||||
if not Nkind_In (Component_Typ, N_Identifier, N_Expanded_Name) then
|
||||
|
|
@ -4897,27 +4844,6 @@ package body Sem_Ch3 is
|
|||
(Implicit_Base, Finalize_Storage_Only
|
||||
(Element_Type));
|
||||
|
||||
-- In ALFA mode, generate a declaration for Itype T, so that the
|
||||
-- formal verification back-end can use it.
|
||||
|
||||
if ALFA_Mode and then Is_Itype (T) then
|
||||
declare
|
||||
Loc : constant Source_Ptr := Sloc (Def);
|
||||
Decl : Node_Id;
|
||||
begin
|
||||
Decl :=
|
||||
Make_Full_Type_Declaration (Loc,
|
||||
Defining_Identifier => T,
|
||||
Type_Definition =>
|
||||
Make_Constrained_Array_Definition (Loc,
|
||||
Discrete_Subtype_Definitions =>
|
||||
New_Copy_List (Discrete_Subtype_Definitions (Def)),
|
||||
Component_Definition =>
|
||||
Relocate_Node (Component_Definition (Def))));
|
||||
Analyze (Decl);
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- Unconstrained array case
|
||||
|
||||
else
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue