[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Mon, 29 Aug 2011 14:26:53 +0000 (16:26 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Mon, 29 Aug 2011 14:26:53 +0000 (16:26 +0200)
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

gcc/ada/ChangeLog
gcc/ada/a-except-2005.adb
gcc/ada/a-except.adb
gcc/ada/sem_ch3.adb

index a9ae7fc..b89a0f8 100644 (file)
@@ -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,
index 8315a9d..509ea92 100644 (file)
@@ -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 --
    -------------
index 6805bf4..f34d497 100644 (file)
@@ -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);
index 5a3c570..d21e8a1 100644 (file)
@@ -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