OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2014-08-01  Robert Dewar  <dewar@adacore.com>

	* sem_ch8.adb: Minor reformatting.

2014-08-01  Yannick Moy  <moy@adacore.com>

	* sem_ch13.adb (Insert_Pragma): Add special case for precondition
	pragmas from aspects, which need to be inserted in proper order.

2014-08-01  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Expand_Record_Aggregate, Init_Hidden_Discriminants):
	Handle properly a type extension that constrains a discriminated
	derived type that renames other discriminants of an ancestor.

2014-08-01  Thomas Quinot  <quinot@adacore.com>

	* s-pack06.adb, s-pack10.adb, s-pack03.ads, s-pack12.adb, s-pack14.ads,
	s-pack25.adb: Fix minor inconsistencies and typos.

From-SVN: r213469
This commit is contained in:
Arnaud Charlet 2014-08-01 16:02:43 +02:00
parent fc193526f3
commit 2feb1f84d7
10 changed files with 67 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
gcc/ada/ChangeLog
View File

@ -1,3 +1,23 @@
2014-08-01 Robert Dewar <dewar@adacore.com>
* sem_ch8.adb: Minor reformatting.
2014-08-01 Yannick Moy <moy@adacore.com>
* sem_ch13.adb (Insert_Pragma): Add special case for precondition
pragmas from aspects, which need to be inserted in proper order.
2014-08-01 Ed Schonberg <schonberg@adacore.com>
* exp_aggr.adb (Expand_Record_Aggregate, Init_Hidden_Discriminants):
Handle properly a type extension that constrains a discriminated
derived type that renames other discriminants of an ancestor.
2014-08-01 Thomas Quinot <quinot@adacore.com>
* s-pack06.adb, s-pack10.adb, s-pack03.ads, s-pack12.adb, s-pack14.ads,
s-pack25.adb: Fix minor inconsistencies and typos.
2014-08-01 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch8.adb (Analyze_Subprogram_Renaming): Alphabetize

25
gcc/ada/exp_aggr.adb
View File

@ -1845,7 +1845,9 @@ package body Exp_Aggr is
procedure Init_Hidden_Discriminants (Typ : Entity_Id; List : List_Id);
-- If Typ is derived, and constrains discriminants of the parent type,
-- these discriminants are not components of the aggregate, and must be
-- initialized. The assignments are appended to List.
-- initialized. The assignments are appended to List. The same is done
-- if Typ derives fron an already constrained subtype of a discriminated
-- parent type.
function Get_Explicit_Discriminant_Value (D : Entity_Id) return Node_Id;
-- If the ancestor part is an unconstrained type and further ancestors
@ -2113,13 +2115,30 @@ package body Exp_Aggr is
begin
Btype := Base_Type (Typ);
-- The constraints on the hidden discriminants, if present, are
-- kep in the Stored_Constraint list of the type itself, or in
-- that of the base type.
while Is_Derived_Type (Btype)
and then Present (Stored_Constraint (Btype))
and then (Present (Stored_Constraint (Btype))
or else Present (Stored_Constraint (Typ)))
loop
Parent_Type := Etype (Btype);
if not Has_Discriminants (Parent_Type) then
return;
end if;
Disc := First_Discriminant (Parent_Type);
Discr_Val := First_Elmt (Stored_Constraint (Base_Type (Typ)));
-- We know that one of the stored-constraint lists is present.
if Present (Stored_Constraint (Btype)) then
Discr_Val := First_Elmt (Stored_Constraint (Btype));
else
Discr_Val := First_Elmt (Stored_Constraint (Typ));
end if;
while Present (Discr_Val) loop
-- Only those discriminants of the parent that are not

4
gcc/ada/s-pack03.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -29,7 +29,7 @@
-- --
------------------------------------------------------------------------------
-- Handing of packed arrays with Component_Size = 3
-- Handling of packed arrays with Component_Size = 3
package System.Pack_03 is
pragma Preelaborate;

4
gcc/ada/s-pack06.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -128,7 +128,6 @@ package body System.Pack_06 is
procedure Set_06 (Arr : System.Address; N : Natural; E : Bits_06) is
C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
begin
case N07 (Uns (N) mod 8) is
when 0 => C.E0 := E;
@ -148,7 +147,6 @@ package body System.Pack_06 is
procedure SetU_06 (Arr : System.Address; N : Natural; E : Bits_06) is
C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
begin
case N07 (Uns (N) mod 8) is
when 0 => C.E0 := E;

4
gcc/ada/s-pack10.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -128,7 +128,6 @@ package body System.Pack_10 is
procedure Set_10 (Arr : System.Address; N : Natural; E : Bits_10) is
C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
begin
case N07 (Uns (N) mod 8) is
when 0 => C.E0 := E;
@ -148,7 +147,6 @@ package body System.Pack_10 is
procedure SetU_10 (Arr : System.Address; N : Natural; E : Bits_10) is
C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
begin
case N07 (Uns (N) mod 8) is
when 0 => C.E0 := E;

4
gcc/ada/s-pack12.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -128,7 +128,6 @@ package body System.Pack_12 is
procedure Set_12 (Arr : System.Address; N : Natural; E : Bits_12) is
C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
begin
case N07 (Uns (N) mod 8) is
when 0 => C.E0 := E;
@ -148,7 +147,6 @@ package body System.Pack_12 is
procedure SetU_12 (Arr : System.Address; N : Natural; E : Bits_12) is
C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
begin
case N07 (Uns (N) mod 8) is
when 0 => C.E0 := E;

4
gcc/ada/s-pack14.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -29,7 +29,7 @@
-- --
------------------------------------------------------------------------------
-- Handing of packed arrays with Component_Size = 14
-- Handling of packed arrays with Component_Size = 14
package System.Pack_14 is
pragma Preelaborate;

4
gcc/ada/s-pack25.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -77,7 +77,6 @@ package body System.Pack_25 is
function Get_25 (Arr : System.Address; N : Natural) return Bits_25 is
C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
begin
case N07 (Uns (N) mod 8) is
when 0 => return C.E0;
@ -97,7 +96,6 @@ package body System.Pack_25 is
procedure Set_25 (Arr : System.Address; N : Natural; E : Bits_25) is
C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
begin
case N07 (Uns (N) mod 8) is
when 0 => C.E0 := E;

9
gcc/ada/sem_ch13.adb
View File

@ -1283,10 +1283,19 @@ package body Sem_Ch13 is
-- the proper insertion point. As a result the order of pragmas
-- is the same as the order of aspects.
-- As precondition pragmas generated from conjuncts in the
-- precondition aspect are presented in reverse order to
-- Insert_Pragma, insert them in the correct order here by not
-- skipping previously inserted precondition pragmas when the
-- current pragma is a precondition.
Decl := First (Declarations (N));
while Present (Decl) loop
if Nkind (Decl) = N_Pragma
and then From_Aspect_Specification (Decl)
and then not (Get_Pragma_Id (Decl) = Pragma_Precondition
and then
Get_Pragma_Id (Prag) = Pragma_Precondition)
then
Next (Decl);
else

17
gcc/ada/sem_ch8.adb
View File

@ -1830,28 +1830,28 @@ package body Sem_Ch8 is
-- type with unknown discriminants and a generic primitive operation of
-- the said type with a box require special processing when the actual
-- is a class-wide type:
--
-- generic
-- type Formal_Typ (<>) is private;
-- with procedure Prim_Op (Param : Formal_Typ) is <>;
-- package Gen is ...
--
-- package Inst is new Gen (Actual_Typ'Class);
--
-- In this case the general renaming mechanism used in the prologue of
-- an instance no longer applies:
--
-- procedure Prim_Op (Param : Formal_Typ) renames Prim_Op;
--
-- The above is replaced the following wrapper/renaming combination:
--
-- procedure Prim_Op (Param : Formal_Typ) is -- wrapper
-- begin
-- Prim_Op (Param); -- primitive
-- end Wrapper;
--
-- procedure Dummy (Param : Formal_Typ) renames Prim_Op;
--
-- This transformation applies only if there is no explicit visible
-- class-wide operation at the point of the instantiation. Ren_Id is
-- the entity of the renaming declaration. Wrap_Id is the entity of
@ -1937,7 +1937,6 @@ package body Sem_Ch8 is
while Present (Formal) loop
Append_To (Actuals,
Make_Identifier (Loc, Chars (Defining_Identifier (Formal))));
Next (Formal);
end loop;