Skip to content

R
riscv-gcc-1
Commit 2d1debf8 by Arnaud Charlet
Options

[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
parent c7288f61
Showing with 74 additions and 30 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/a-ststio.ads
......@@ -6,7 +6,7 @@
-- --
-- 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 --
......@@ -202,18 +202,19 @@ private
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
......
gcc/ada/a-stwima.ads
......@@ -6,7 +6,7 @@
-- --
-- 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 --
......@@ -177,9 +177,9 @@ private
-- 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 => ' '));
......@@ -224,9 +224,9 @@ private
-- 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,
......
gcc/ada/a-tienio.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -94,9 +94,21 @@ package body Ada.Text_IO.Enumeration_IO is
Width : Field := Default_Width;
Set : Type_Set := Default_Setting)
is
begin
-- 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
......@@ -113,9 +125,21 @@ package body Ada.Text_IO.Enumeration_IO is
Item : Enum;
Set : Type_Set := Default_Setting)
is
begin
-- 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;
gcc/ada/exp_ch7.adb
......@@ -1210,10 +1210,8 @@ package body Exp_Ch7 is
Finalizer_Decls := New_List;
if Exceptions_OK then
Build_Object_Declarations
(Finalizer_Data, Finalizer_Decls, Loc, For_Package);
end if;
-- Since the total number of controlled objects is always known,
-- build a subtype of Natural with precise bounds. This allows
......@@ -2943,6 +2941,11 @@ package body Exp_Ch7 is
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;
......@@ -2953,7 +2956,6 @@ package body Exp_Ch7 is
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
......@@ -4893,12 +4895,10 @@ package body Exp_Ch7 is
-- Start of processing for Build_Adjust_Or_Finalize_Statements
begin
Build_Indices;
if Exceptions_OK then
Finalizer_Decls := New_List;
Build_Indices;
Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
end if;
Comp_Ref :=
Make_Indexed_Component (Loc,
......@@ -5168,14 +5168,11 @@ package body Exp_Ch7 is
-- Start of processing for Build_Initialize_Statements
begin
Build_Indices;
Counter_Id := Make_Temporary (Loc, 'C');
if Exceptions_OK then
Finalizer_Decls := New_List;
Build_Indices;
Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
end if;
-- Generate the block which houses the finalization call, the index
-- 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
begin
if Exceptions_OK then
Finalizer_Decls := New_List;
Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
end if;
if Nkind (Typ_Def) = N_Derived_Type_Definition then
Rec_Def := Record_Extension_Part (Typ_Def);
......@@ -6458,10 +6453,8 @@ package body Exp_Ch7 is
-- 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;
if Nkind (Typ_Def) = N_Derived_Type_Definition then
Rec_Def := Record_Extension_Part (Typ_Def);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment