2009-07-07 Manuel López-Ibáñez <manu@gcc.gnu.org>

[pf3gnuchains/gcc-fork.git] / gcc / ada / s-finimp.adb

diff --git a/gcc/ada/s-finimp.adb b/gcc/ada/s-finimp.adb
index 2d6defb..9a5e534 100644 (file)
--- a/gcc/ada/s-finimp.adb
+++ b/gcc/ada/s-finimp.adb
@@ -6,25 +6,23 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- 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- --
--- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
--- for  more details.  You should have  received  a copy of the GNU General --
--- Public License  distributed with GNAT;  see file COPYING.  If not, write --
--- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
--- Boston, MA 02110-1301, USA.                                              --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
 --                                                                          --
--- As a special exception,  if other files  instantiate  generics from this --
--- unit, or you link  this unit with other files  to produce an executable, --
--- this  unit  does not  by itself cause  the resulting  executable  to  be --
--- covered  by the  GNU  General  Public  License.  This exception does not --
--- however invalidate  any other reasons why  the executable file  might be --
--- covered by the  GNU Public License.                                      --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
 --                                                                          --
 -- GNAT was originally developed  by the GNAT team at  New York University. --
 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
@@ -90,11 +88,11 @@ package body System.Finalization_Implementation is
    -- Adjust --
    ------------
 
-   procedure Adjust (Object : in out Record_Controller) is
+   overriding procedure Adjust (Object : in out Record_Controller) is
 
       First_Comp : Finalizable_Ptr;
-      My_Offset : constant SSE.Storage_Offset :=
-                    Object.My_Address - Object'Address;
+      My_Offset  : constant SSE.Storage_Offset :=
+                     Object.My_Address - Object'Address;
 
       procedure Ptr_Adjust (Ptr : in out Finalizable_Ptr);
       --  Subtract the offset to the pointer
@@ -125,7 +123,7 @@ package body System.Finalization_Implementation is
             Ptr_Adjust (P.Next);
             Reverse_Adjust (P.Next);
             Adjust (P.all);
-            Object.F := P;   --  Successfully adjusted, so place in list.
+            Object.F := P;   --  Successfully adjusted, so place in list
          end if;
       end Reverse_Adjust;
 
@@ -263,7 +261,6 @@ package body System.Finalization_Implementation is
 
    procedure Detach_From_Final_List (Obj : in out Finalizable) is
    begin
-
       --  When objects are not properly attached to a doubly linked list do
       --  not try to detach them. The only case where it can happen is when
       --  dealing with Finalize_Storage_Only objects which are not always
@@ -293,7 +290,7 @@ package body System.Finalization_Implementation is
    -- Finalize --
    --------------
 
-   procedure Finalize   (Object : in out Limited_Record_Controller) is
+   overriding procedure Finalize (Object : in out Limited_Record_Controller) is
    begin
       Finalize_List (Object.F);
    end Finalize;
@@ -392,7 +389,7 @@ package body System.Finalization_Implementation is
 
    begin
       --  Fetch the controller from the Parent or above if necessary
-      --  when there are no controller at this level
+      --  when there are no controller at this level.
 
       while Offset = -2 loop
          The_Tag := Ada.Tags.Parent_Tag (The_Tag);
@@ -455,13 +452,15 @@ package body System.Finalization_Implementation is
    -- Initialize --
    ----------------
 
-   procedure Initialize (Object : in out Limited_Record_Controller) is
+   overriding procedure Initialize
+     (Object : in out Limited_Record_Controller)
+   is
       pragma Warnings (Off, Object);
    begin
       null;
    end Initialize;
 
-   procedure Initialize (Object : in out Record_Controller) is
+   overriding procedure Initialize (Object : in out Record_Controller) is
    begin
       Object.My_Address := Object'Address;
    end Initialize;
@@ -503,8 +502,8 @@ package body System.Finalization_Implementation is
       From_Abort : Boolean;
       E_Occ      : Exception_Occurrence)
    is
-      P   : Finalizable_Ptr := L;
-      Q   : Finalizable_Ptr;
+      P : Finalizable_Ptr := L;
+      Q : Finalizable_Ptr;
 
    begin
       --  We already got an exception. We now finalize the remainder of
@@ -538,5 +537,4 @@ package body System.Finalization_Implementation is
 
 begin
    SSL.Finalize_Global_List := Finalize_Global_List'Access;
-
 end System.Finalization_Implementation;