* exp_ch7.adb (Build_Adjust_Or_Finalize_Statements): Create the objects
associated with exception handling unconditionally.
(Build_Adjust_Statements): Create the objects associated with
exception handling unconditionally.
(Build_Components): Create the objects associated with exception
handling unconditionally.
(Build_Finalize_Statements): Create the objects associated with
exception handling unconditionally.
(Build_Initialize_Statements): Create the objects associated with
exception handling unconditionally.
(Build_Object_Declarations): Set the proper location of the data
record when exception propagation is forbidden.
2011-12-22 Gary Dismukes <dismukes@adacore.com>
* a-tienio.adb (Put): Test validity of Item parameters before
applying Image, and raise Constraint_Error for invalid values.
2011-12-22 Bob Duff <duff@adacore.com>
* a-stwima.ads (Initialize,Adjust,Finalize): Add overriding indicators.
* a-ststio.ads (AFCB_Allocate,AFCB_Close,AFCB_Free,Read,Write): Add
overriding indicators.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@182619
138bc75d-0d04-0410-961f-
82ee72b054a4
+2011-12-22 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch7.adb (Build_Adjust_Or_Finalize_Statements): Create the objects
+ associated with exception handling unconditionally.
+ (Build_Adjust_Statements): Create the objects associated with
+ exception handling unconditionally.
+ (Build_Components): Create the objects associated with exception
+ handling unconditionally.
+ (Build_Finalize_Statements): Create the objects associated with
+ exception handling unconditionally.
+ (Build_Initialize_Statements): Create the objects associated with
+ exception handling unconditionally.
+ (Build_Object_Declarations): Set the proper location of the data
+ record when exception propagation is forbidden.
+
+2011-12-22 Gary Dismukes <dismukes@adacore.com>
+
+ * a-tienio.adb (Put): Test validity of Item parameters before
+ applying Image, and raise Constraint_Error for invalid values.
+
+2011-12-22 Bob Duff <duff@adacore.com>
+
+ * a-stwima.ads (Initialize,Adjust,Finalize): Add overriding indicators.
+ * a-ststio.ads (AFCB_Allocate,AFCB_Close,AFCB_Free,Read,Write): Add
+ overriding indicators.
+
2011-12-22 Arnaud Charlet <charlet@adacore.com>
* s-osinte-hpux-dce.ads: Update header to GPLv3
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
type File_Type is access all Stream_AFCB;
- function AFCB_Allocate (Control_Block : Stream_AFCB) return FCB.AFCB_Ptr;
+ overriding function AFCB_Allocate
+ (Control_Block : Stream_AFCB) return FCB.AFCB_Ptr;
- procedure AFCB_Close (File : not null access Stream_AFCB);
- procedure AFCB_Free (File : not null access Stream_AFCB);
+ overriding procedure AFCB_Close (File : not null access Stream_AFCB);
+ overriding procedure AFCB_Free (File : not null access Stream_AFCB);
- procedure Read
+ overriding procedure Read
(File : in out Stream_AFCB;
Item : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
-- Read operation used when Stream_IO file is treated directly as Stream
- procedure Write
+ overriding procedure Write
(File : in out Stream_AFCB;
Item : Ada.Streams.Stream_Element_Array);
-- Write operation used when Stream_IO file is treated directly as Stream
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- incorrect attempts to finalize constants that are statically
-- declared here and in Ada.Strings.Wide_Maps, which is incorrect.
- procedure Initialize (Object : in out Wide_Character_Set);
- procedure Adjust (Object : in out Wide_Character_Set);
- procedure Finalize (Object : in out Wide_Character_Set);
+ overriding procedure Initialize (Object : in out Wide_Character_Set);
+ overriding procedure Adjust (Object : in out Wide_Character_Set);
+ overriding procedure Finalize (Object : in out Wide_Character_Set);
Null_Range : aliased constant Wide_Character_Ranges :=
(1 .. 0 => (Low => ' ', High => ' '));
-- incorrect attempts to finalize constants that are statically
-- declared here and in Ada.Strings.Wide_Maps, which is incorrect.
- procedure Initialize (Object : in out Wide_Character_Mapping);
- procedure Adjust (Object : in out Wide_Character_Mapping);
- procedure Finalize (Object : in out Wide_Character_Mapping);
+ overriding procedure Initialize (Object : in out Wide_Character_Mapping);
+ overriding procedure Adjust (Object : in out Wide_Character_Mapping);
+ overriding procedure Finalize (Object : in out Wide_Character_Mapping);
Null_Map : aliased constant Wide_Character_Mapping_Values :=
(Length => 0,
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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- --
Width : Field := Default_Width;
Set : Type_Set := Default_Setting)
is
- Image : constant String := Enum'Image (Item);
begin
- Aux.Put (File, Image, Width, Set);
+ -- Ensure that Item is valid before attempting to retrieve the Image, to
+ -- prevent the possibility of out-of-bounds addressing of index or image
+ -- tables. Units in the run-time library are normally compiled with
+ -- checks suppressed, which includes instantiated generics.
+
+ if not Item'Valid then
+ raise Constraint_Error;
+ end if;
+
+ declare
+ Image : constant String := Enum'Image (Item);
+ begin
+ Aux.Put (File, Image, Width, Set);
+ end;
end Put;
procedure Put
Item : Enum;
Set : Type_Set := Default_Setting)
is
- Image : constant String := Enum'Image (Item);
begin
- Aux.Puts (To, Image, Set);
+ -- Ensure that Item is valid before attempting to retrieve the Image, to
+ -- prevent the possibility of out-of-bounds addressing of index or image
+ -- tables. Units in the run-time library are normally compiled with
+ -- checks suppressed, which includes instantiated generics.
+
+ if not Item'Valid then
+ raise Constraint_Error;
+ end if;
+
+ declare
+ Image : constant String := Enum'Image (Item);
+ begin
+ Aux.Puts (To, Image, Set);
+ end;
end Put;
end Ada.Text_IO.Enumeration_IO;
Finalizer_Decls := New_List;
- if Exceptions_OK then
- Build_Object_Declarations
- (Finalizer_Data, Finalizer_Decls, Loc, For_Package);
- end if;
+ Build_Object_Declarations
+ (Finalizer_Data, Finalizer_Decls, Loc, For_Package);
-- Since the total number of controlled objects is always known,
-- build a subtype of Natural with precise bounds. This allows
begin
pragma Assert (Decls /= No_List);
+ -- Always set the proper location as it may be needed even when
+ -- exception propagation is forbidden.
+
+ Data.Loc := Loc;
+
if Restriction_Active (No_Exception_Propagation) then
- Data.Abort_Id := Empty;
- Data.E_Id := Empty;
+ Data.Abort_Id := Empty;
+ Data.E_Id := Empty;
Data.Raised_Id := Empty;
return;
end if;
Data.Abort_Id := Make_Temporary (Loc, 'A');
Data.E_Id := Make_Temporary (Loc, 'E');
Data.Raised_Id := Make_Temporary (Loc, 'R');
- Data.Loc := Loc;
-- In certain scenarios, finalization can be triggered by an abort. If
-- the finalization itself fails and raises an exception, the resulting
-- Start of processing for Build_Adjust_Or_Finalize_Statements
begin
- Build_Indices;
+ Finalizer_Decls := New_List;
- if Exceptions_OK then
- Finalizer_Decls := New_List;
- Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
- end if;
+ Build_Indices;
+ Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
Comp_Ref :=
Make_Indexed_Component (Loc,
-- Start of processing for Build_Initialize_Statements
begin
- Build_Indices;
-
Counter_Id := Make_Temporary (Loc, 'C');
+ Finalizer_Decls := New_List;
- if Exceptions_OK then
- Finalizer_Decls := New_List;
- Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
- end if;
+ Build_Indices;
+ Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
-- Generate the block which houses the finalization call, the index
-- guard and the handler which triggers Program_Error later on.
-- Start of processing for Build_Adjust_Statements
begin
- if Exceptions_OK then
- Finalizer_Decls := New_List;
- Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
- end if;
+ Finalizer_Decls := New_List;
+ Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
if Nkind (Typ_Def) = N_Derived_Type_Definition then
Rec_Def := Record_Extension_Part (Typ_Def);
-- Start of processing for Build_Finalize_Statements
begin
- if Exceptions_OK then
- Finalizer_Decls := New_List;
- Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
- end if;
+ Finalizer_Decls := New_List;
+ Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
if Nkind (Typ_Def) = N_Derived_Type_Definition then
Rec_Def := Record_Extension_Part (Typ_Def);
projects / platform / upstream / linaro-gcc.git / commitdiff