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

[multiple changes] 

2009-04-09  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Build_Derived_Record_Type): Fix typo.
	(Derive_Progenitor_Subprograms): Handle interfaces in subtypes of
	tagged types.

2009-04-09  Robert Dewar  <dewar@adacore.com>

	* s-direio.adb: Minor reformatting

	* exp_ch4.adb (Expand_Concatenate): Avoid overflow checks for String

From-SVN: r145808
This commit is contained in:
Arnaud Charlet 2009-04-09 10:52:04 +02:00
parent fa9693102a
commit 59262ebb3e
4 changed files with 41 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/ada/ChangeLog
View File

@ -1,3 +1,15 @@
2009-04-09 Javier Miranda <miranda@adacore.com>
* sem_ch3.adb (Build_Derived_Record_Type): Fix typo.
(Derive_Progenitor_Subprograms): Handle interfaces in subtypes of
tagged types.
2009-04-09 Robert Dewar <dewar@adacore.com>
* s-direio.adb: Minor reformatting
* exp_ch4.adb (Expand_Concatenate): Avoid overflow checks for String
2009-04-09 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Expand_Concatenate): Improve handling of overflow cases

23
gcc/ada/exp_ch4.adb
View File

@ -3,7 +3,7 @@
-- GNAT COMPILER COMPONENTS --
-- --
-- E X P _ C H 4 --
-- g --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
@ -2337,6 +2337,16 @@ package body Exp_Ch4 is
if Is_Enumeration_Type (Ityp) then
Artyp := Standard_Integer;
-- If index type is Positive, we use the standard unsigned type, to give
-- more room on the top of the range, obviating the need for an overflow
-- check when creating the upper bound. This is needed to avoid junk
-- overflow checks in the common case of String types.
-- ??? Disabled for now
-- elsif Istyp = Standard_Positive then
-- Artyp := Standard_Unsigned;
-- For modular types, we use a 32-bit modular type for types whose size
-- is in the range 1-31 bits. For 32-bit unsigned types, we use the
-- identity type, and for larger unsigned types we use 64-bits.
@ -2417,7 +2427,7 @@ package body Exp_Ch4 is
Make_Op_Add (Loc,
Left_Opnd =>
New_Copy_Tree (String_Literal_Low_Bound (Opnd_Typ)),
Right_Opnd => Make_Artyp_Literal (1));
Right_Opnd => Make_Integer_Literal (Loc, 1));
end if;
-- Skip null string literal
@ -2729,9 +2739,14 @@ package body Exp_Ch4 is
Left_Opnd => New_Copy (Aggr_Length (NN)),
Right_Opnd => Make_Artyp_Literal (1))));
-- Now force overflow checking on High_Bound
-- Note that calculation of the high bound may cause overflow in some
-- very weird cases, so in the general case we need an overflow check
-- on the high bound. We can avoid this for the common case of string
-- types since we chose a wider range for the arithmetic type.
Activate_Overflow_Check (High_Bound);
if Istyp /= Standard_Positive then
Activate_Overflow_Check (High_Bound);
end if;
-- Handle the exceptional case where the result is null, in which case
-- case the bounds come from the last operand (so that we get the proper

18
gcc/ada/s-direio.adb
View File

@ -63,7 +63,6 @@ package body System.Direct_IO is
function AFCB_Allocate (Control_Block : Direct_AFCB) return FCB.AFCB_Ptr is
pragma Unreferenced (Control_Block);
begin
return new Direct_AFCB;
end AFCB_Allocate;
@ -76,7 +75,6 @@ package body System.Direct_IO is
procedure AFCB_Close (File : not null access Direct_AFCB) is
pragma Unreferenced (File);
begin
null;
end AFCB_Close;
@ -110,8 +108,8 @@ package body System.Direct_IO is
is
Dummy_File_Control_Block : Direct_AFCB;
pragma Warnings (Off, Dummy_File_Control_Block);
-- Yes, we know this is never assigned a value, only the tag
-- is used for dispatching purposes, so that's expected.
-- Yes, we know this is never assigned a value, only the tag is used for
-- dispatching purposes, so that's expected.
begin
FIO.Open (File_Ptr => AP (File),
@ -156,8 +154,8 @@ package body System.Direct_IO is
is
Dummy_File_Control_Block : Direct_AFCB;
pragma Warnings (Off, Dummy_File_Control_Block);
-- Yes, we know this is never assigned a value, only the tag
-- is used for dispatching purposes, so that's expected.
-- Yes, we know this is never assigned a value, only the tag is used for
-- dispatching purposes, so that's expected.
begin
FIO.Open (File_Ptr => AP (File),
@ -254,10 +252,9 @@ package body System.Direct_IO is
pragma Warnings (Off, File);
-- File is actually modified via Unrestricted_Access below, but
-- GNAT will generate a warning anyway.
-- Note that we do not use pragma Unmodified here, since in -gnatc
-- mode, GNAT will complain that File is modified for
-- "File.Index := 1;"
--
-- Note that we do not use pragma Unmodified here, since in -gnatc mode,
-- GNAT will complain that File is modified for "File.Index := 1;"
begin
FIO.Reset (AP (File)'Unrestricted_Access, Mode);
File.Index := 1;
@ -267,7 +264,6 @@ package body System.Direct_IO is
procedure Reset (File : in out File_Type) is
pragma Warnings (Off, File);
-- See above (other Reset procedure) for explanations on this pragma
begin
FIO.Reset (AP (File)'Unrestricted_Access);
File.Index := 1;

6
gcc/ada/sem_ch3.adb
View File

@ -6467,7 +6467,7 @@ package body Sem_Ch3 is
-- could still refer to the full type prior the change to the new
-- subtype and hence would not match the new base type created here.
Derive_Subprograms (Parent_Type, Base_Type (Derived_Type));
Derive_Subprograms (Parent_Type, Derived_Type);
-- For tagged types the Discriminant_Constraint of the new base itype
-- is inherited from the first subtype so that no subtype conformance
@ -11496,8 +11496,8 @@ package body Sem_Ch3 is
-- Step 2: Add primitives of progenitors that are not implemented by
-- parents of Tagged_Type
if Present (Interfaces (Tagged_Type)) then
Iface_Elmt := First_Elmt (Interfaces (Tagged_Type));
if Present (Interfaces (Base_Type (Tagged_Type))) then
Iface_Elmt := First_Elmt (Interfaces (Base_Type (Tagged_Type)));
while Present (Iface_Elmt) loop
Iface := Node (Iface_Elmt);