+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,
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);
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");
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);
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 --
-------------
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);
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");
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);
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
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
(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
git://gcc.gnu.org / gcc.git / commitdiff