git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[multiple changes] 

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.

From-SVN: r182619
This commit is contained in:
Arnaud Charlet 2011-12-22 12:52:00 +01:00
parent c7288f61d1
commit 2d1debf816
5 changed files with 88 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
gcc/ada/ChangeLog
View File

@ -1,3 +1,29 @@
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> 2011-12-22 Arnaud Charlet <charlet@adacore.com>
* s-osinte-hpux-dce.ads: Update header to GPLv3 * s-osinte-hpux-dce.ads: Update header to GPLv3

13
gcc/ada/a-ststio.ads
View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
@ -202,18 +202,19 @@ private
type File_Type is access all Stream_AFCB; 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); overriding procedure AFCB_Close (File : not null access Stream_AFCB);
procedure AFCB_Free (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; (File : in out Stream_AFCB;
Item : out Ada.Streams.Stream_Element_Array; Item : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset); Last : out Ada.Streams.Stream_Element_Offset);
-- Read operation used when Stream_IO file is treated directly as Stream -- Read operation used when Stream_IO file is treated directly as Stream
procedure Write overriding procedure Write
(File : in out Stream_AFCB; (File : in out Stream_AFCB;
Item : Ada.Streams.Stream_Element_Array); Item : Ada.Streams.Stream_Element_Array);
-- Write operation used when Stream_IO file is treated directly as Stream -- Write operation used when Stream_IO file is treated directly as Stream

14
gcc/ada/a-stwima.ads
View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
@ -177,9 +177,9 @@ private
-- incorrect attempts to finalize constants that are statically -- incorrect attempts to finalize constants that are statically
-- declared here and in Ada.Strings.Wide_Maps, which is incorrect. -- declared here and in Ada.Strings.Wide_Maps, which is incorrect.
procedure Initialize (Object : in out Wide_Character_Set); overriding procedure Initialize (Object : in out Wide_Character_Set);
procedure Adjust (Object : in out Wide_Character_Set); overriding procedure Adjust (Object : in out Wide_Character_Set);
procedure Finalize (Object : in out Wide_Character_Set); overriding procedure Finalize (Object : in out Wide_Character_Set);
Null_Range : aliased constant Wide_Character_Ranges := Null_Range : aliased constant Wide_Character_Ranges :=
(1 .. 0 => (Low => ' ', High => ' ')); (1 .. 0 => (Low => ' ', High => ' '));
@ -224,9 +224,9 @@ private
-- incorrect attempts to finalize constants that are statically -- incorrect attempts to finalize constants that are statically
-- declared here and in Ada.Strings.Wide_Maps, which is incorrect. -- declared here and in Ada.Strings.Wide_Maps, which is incorrect.
procedure Initialize (Object : in out Wide_Character_Mapping); overriding procedure Initialize (Object : in out Wide_Character_Mapping);
procedure Adjust (Object : in out Wide_Character_Mapping); overriding procedure Adjust (Object : in out Wide_Character_Mapping);
procedure Finalize (Object : in out Wide_Character_Mapping); overriding procedure Finalize (Object : in out Wide_Character_Mapping);
Null_Map : aliased constant Wide_Character_Mapping_Values := Null_Map : aliased constant Wide_Character_Mapping_Values :=
(Length => 0, (Length => 0,

34
gcc/ada/a-tienio.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -94,9 +94,21 @@ package body Ada.Text_IO.Enumeration_IO is
Width : Field := Default_Width; Width : Field := Default_Width;
Set : Type_Set := Default_Setting) Set : Type_Set := Default_Setting)
is is
Image : constant String := Enum'Image (Item);
begin 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; end Put;
procedure Put procedure Put
@ -113,9 +125,21 @@ package body Ada.Text_IO.Enumeration_IO is
Item : Enum; Item : Enum;
Set : Type_Set := Default_Setting) Set : Type_Set := Default_Setting)
is is
Image : constant String := Enum'Image (Item);
begin 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 Put;
end Ada.Text_IO.Enumeration_IO; end Ada.Text_IO.Enumeration_IO;

45
gcc/ada/exp_ch7.adb
View File

@ -1210,10 +1210,8 @@ package body Exp_Ch7 is
Finalizer_Decls := New_List; Finalizer_Decls := New_List;
if Exceptions_OK then Build_Object_Declarations
Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc, For_Package);
(Finalizer_Data, Finalizer_Decls, Loc, For_Package);
end if;
-- Since the total number of controlled objects is always known, -- Since the total number of controlled objects is always known,
-- build a subtype of Natural with precise bounds. This allows -- build a subtype of Natural with precise bounds. This allows
@ -2943,9 +2941,14 @@ package body Exp_Ch7 is
begin begin
pragma Assert (Decls /= No_List); 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 if Restriction_Active (No_Exception_Propagation) then
Data.Abort_Id := Empty; Data.Abort_Id := Empty;
Data.E_Id := Empty; Data.E_Id := Empty;
Data.Raised_Id := Empty; Data.Raised_Id := Empty;
return; return;
end if; end if;
@ -2953,7 +2956,6 @@ package body Exp_Ch7 is
Data.Abort_Id := Make_Temporary (Loc, 'A'); Data.Abort_Id := Make_Temporary (Loc, 'A');
Data.E_Id := Make_Temporary (Loc, 'E'); Data.E_Id := Make_Temporary (Loc, 'E');
Data.Raised_Id := Make_Temporary (Loc, 'R'); Data.Raised_Id := Make_Temporary (Loc, 'R');
Data.Loc := Loc;
-- In certain scenarios, finalization can be triggered by an abort. If -- In certain scenarios, finalization can be triggered by an abort. If
-- the finalization itself fails and raises an exception, the resulting -- the finalization itself fails and raises an exception, the resulting
@ -4893,12 +4895,10 @@ package body Exp_Ch7 is
-- Start of processing for Build_Adjust_Or_Finalize_Statements -- Start of processing for Build_Adjust_Or_Finalize_Statements
begin begin
Build_Indices; Finalizer_Decls := New_List;
if Exceptions_OK then Build_Indices;
Finalizer_Decls := New_List; Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
end if;
Comp_Ref := Comp_Ref :=
Make_Indexed_Component (Loc, Make_Indexed_Component (Loc,
@ -5168,14 +5168,11 @@ package body Exp_Ch7 is
-- Start of processing for Build_Initialize_Statements -- Start of processing for Build_Initialize_Statements
begin begin
Build_Indices;
Counter_Id := Make_Temporary (Loc, 'C'); Counter_Id := Make_Temporary (Loc, 'C');
Finalizer_Decls := New_List;
if Exceptions_OK then Build_Indices;
Finalizer_Decls := New_List; Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
end if;
-- Generate the block which houses the finalization call, the index -- Generate the block which houses the finalization call, the index
-- guard and the handler which triggers Program_Error later on. -- guard and the handler which triggers Program_Error later on.
@ -5881,10 +5878,8 @@ package body Exp_Ch7 is
-- Start of processing for Build_Adjust_Statements -- Start of processing for Build_Adjust_Statements
begin begin
if Exceptions_OK then Finalizer_Decls := New_List;
Finalizer_Decls := New_List; Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
end if;
if Nkind (Typ_Def) = N_Derived_Type_Definition then if Nkind (Typ_Def) = N_Derived_Type_Definition then
Rec_Def := Record_Extension_Part (Typ_Def); Rec_Def := Record_Extension_Part (Typ_Def);
@ -6458,10 +6453,8 @@ package body Exp_Ch7 is
-- Start of processing for Build_Finalize_Statements -- Start of processing for Build_Finalize_Statements
begin begin
if Exceptions_OK then Finalizer_Decls := New_List;
Finalizer_Decls := New_List; Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
end if;
if Nkind (Typ_Def) = N_Derived_Type_Definition then if Nkind (Typ_Def) = N_Derived_Type_Definition then
Rec_Def := Record_Extension_Part (Typ_Def); Rec_Def := Record_Extension_Part (Typ_Def);