diff options
Diffstat (limited to 'gcc/ada/s-finimp.adb')
| -rw-r--r-- | gcc/ada/s-finimp.adb | 48 |
1 files changed, 23 insertions, 25 deletions
diff --git a/gcc/ada/s-finimp.adb b/gcc/ada/s-finimp.adb index 225e461e120..9a5e534b4d4 100644 --- a/gcc/ada/s-finimp.adb +++ b/gcc/ada/s-finimp.adb @@ -6,25 +6,23 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, 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; |