mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-06 02:20:34 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2017-09-08  Ed Schonberg  <schonberg@adacore.com>

	* style.adb: Fix typo.

2017-09-08  Javier Miranda  <miranda@adacore.com>

	* einfo.adb (Underlying_Type): Add missing support for class-wide
	types that come from the limited view.
	* exp_attr.adb (Attribute_Address): Check class-wide type
	interfaces using the underlying type to handle limited-withed
	types.
	(Attribute_Tag): Check class-wide type interfaces using
	the underlying type to handle limited-withed types.

2017-09-08  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_Predicated_Loop): Handle properly a loop
	over a subtype of a type with a static predicate, taking into
	account the predicate function of the parent type and the bounds
	given in the loop specification.
	* sem_ch3.adb (Inherit_Predicate_Flags): For qn Itype created for
	a loop specification that is a subtype indication whose type mark
	is a type with a static predicate, inherit predicate function,
	used to build case statement for rewritten loop.

2017-09-08  Justin Squirek  <squirek@adacore.com>

	* lib-load.adb: Modify printing of error message to exclude file
	line number.

2017-09-08  Arnaud Charlet  <charlet@adacore.com>

	* inline.adb (Can_Be_Inlined_In_GNATprove_Mode):
	don't inline subprograms declared in both visible and private
	parts of a package.
	(In_Package_Spec): previously In_Package_Visible_Spec; now
	detects subprograms declared both in visible and private parts
	of a package spec.

2017-09-08  Ed Schonberg  <schonberg@adacore.com>

	* exp_util.adb (Build_Invariant_Procedure_Declaration): If
	the type is an anonymous array in an object declaration, whose
	component type has an invariant, use the object declaration
	as the insertion point for the invariant procedure, given that
	there is no explicit type declaration for an anonymous array type.

2017-09-08  Bob Duff  <duff@adacore.com>

	* a-cbprqu.ads, a-cbdlli.adb: Suppress warnings.

From-SVN: r251876
This commit is contained in:
Arnaud Charlet 2017-09-08 11:44:30 +02:00
parent 3815f967f9
commit 63a5b3dc89
11 changed files with 186 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
gcc/ada/ChangeLog
View File

@ -1,3 +1,63 @@
2017-09-08 Ed Schonberg <schonberg@adacore.com>
* style.adb: Fix typo.
2017-09-08 Javier Miranda <miranda@adacore.com>
* einfo.adb (Underlying_Type): Add missing support for class-wide
types that come from the limited view.
* exp_attr.adb (Attribute_Address): Check class-wide type
interfaces using the underlying type to handle limited-withed
types.
(Attribute_Tag): Check class-wide type interfaces using
the underlying type to handle limited-withed types.
2017-09-08 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Expand_Predicated_Loop): Handle properly a loop
over a subtype of a type with a static predicate, taking into
account the predicate function of the parent type and the bounds
given in the loop specification.
* sem_ch3.adb (Inherit_Predicate_Flags): For qn Itype created for
a loop specification that is a subtype indication whose type mark
is a type with a static predicate, inherit predicate function,
used to build case statement for rewritten loop.
2017-09-08 Justin Squirek <squirek@adacore.com>
* lib-load.adb: Modify printing of error message to exclude file
line number.
2017-09-08 Arnaud Charlet <charlet@adacore.com>
* inline.adb (Can_Be_Inlined_In_GNATprove_Mode):
don't inline subprograms declared in both visible and private
parts of a package.
(In_Package_Spec): previously In_Package_Visible_Spec; now
detects subprograms declared both in visible and private parts
of a package spec.
2017-09-08 Ed Schonberg <schonberg@adacore.com>
* exp_util.adb (Build_Invariant_Procedure_Declaration): If
the type is an anonymous array in an object declaration, whose
component type has an invariant, use the object declaration
as the insertion point for the invariant procedure, given that
there is no explicit type declaration for an anonymous array type.
2017-09-08 Bob Duff <duff@adacore.com>
* a-cbprqu.ads, a-cbdlli.adb: Suppress warnings.
2017-09-08 Bob Duff <duff@adacore.com>
* a-strfix.adb (Trim): Compute Low and High only if needed.
2017-09-08 Justin Squirek <squirek@adacore.com>
* lib-load.adb (Load_Main_Source): Add error output in the case a
source file is missing.
2017-09-08 Bob Duff <duff@adacore.com>
PR ada/80888

6
gcc/ada/a-cbdlli.adb
View File

@ -1015,9 +1015,10 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
Position : out Cursor;
Count : Count_Type := 1)
is
pragma Warnings (Off);
New_Item : Element_Type;
pragma Unmodified (New_Item);
-- OK to reference, see below. Needed to suppress front end warning.
-- OK to reference, see below. Note that we need to suppress both the
-- front end warning and the back end warning.
begin
-- There is no explicit element provided, but in an instance the element
@ -1026,7 +1027,6 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
-- initialization, so insert the specified number of possibly
-- initialized elements at the given position.
pragma Warnings (Off); -- Needed to suppress back end warning
Insert (Container, Before, New_Item, Position, Count);
pragma Warnings (On);
end Insert;

6
gcc/ada/a-cbprqu.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2011-2015, Free Software Foundation, Inc. --
-- Copyright (C) 2011-2017, 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 --
@ -88,9 +88,13 @@ package Ada.Containers.Bounded_Priority_Queues is
-- We need a better data structure here, such as a proper heap. ???
pragma Warnings (Off);
-- Otherwise, we get warnings for the uninitialized variable in Insert
-- in Ada.Containers.Bounded_Doubly_Linked_Lists.
package List_Types is new Bounded_Doubly_Linked_Lists
(Element_Type => Queue_Interfaces.Element_Type,
"=" => Queue_Interfaces."=");
pragma Warnings (On);
type List_Type (Capacity : Count_Type) is tagged limited record
Container : List_Types.List (Capacity);

14
gcc/ada/einfo.adb
View File

@ -9300,6 +9300,15 @@ package body Einfo is
if Ekind (Id) = E_Record_Type_With_Private then
return Full_View (Id);
-- If we have a class-wide type that comes from the limited view then
-- we return the Underlying_Type of its nonlimited view.
elsif Ekind (Id) = E_Class_Wide_Type
and then From_Limited_With (Id)
and then Present (Non_Limited_View (Id))
then
return Underlying_Type (Non_Limited_View (Id));
elsif Ekind (Id) in Incomplete_Or_Private_Kind then
-- If we have an incomplete or private type with a full view,
@ -9324,9 +9333,8 @@ package body Einfo is
then
return Underlying_Type (Underlying_Full_View (Id));
-- If we have an incomplete entity that comes from the limited
-- view then we return the Underlying_Type of its non-limited
-- view.
-- If we have an incomplete entity that comes from the limited view
-- then we return the Underlying_Type of its nonlimited view.
elsif From_Limited_With (Id)
and then Present (Non_Limited_View (Id))

4
gcc/ada/exp_attr.adb
View File

@ -2235,7 +2235,7 @@ package body Exp_Attr is
-- issues are taken care of by the virtual machine.
elsif Is_Class_Wide_Type (Ptyp)
and then Is_Interface (Ptyp)
and then Is_Interface (Underlying_Type (Ptyp))
and then Tagged_Type_Expansion
and then not (Nkind (Pref) in N_Has_Entity
and then Is_Subprogram (Entity (Pref)))
@ -6241,7 +6241,7 @@ package body Exp_Attr is
elsif Comes_From_Source (N)
and then Is_Class_Wide_Type (Etype (Prefix (N)))
and then Is_Interface (Etype (Prefix (N)))
and then Is_Interface (Underlying_Type (Etype (Prefix (N))))
then
-- Generate:
-- (To_Tag_Ptr (Prefix'Address)).all

73
gcc/ada/exp_ch5.adb
View File

@ -4698,6 +4698,10 @@ package body Exp_Ch5 is
-- end loop;
-- end;
-- In addition, if the loop specification is given by a subtype
-- indication that constrains a predicated type, the bounds of
-- iteration are given by those of the subtype indication.
else
Static_Predicate : declare
S : Node_Id;
@ -4706,6 +4710,11 @@ package body Exp_Ch5 is
Alts : List_Id;
Cstm : Node_Id;
-- If the domain is an itype, note the bounds of its range.
L_Hi : Node_Id;
L_Lo : Node_Id;
function Lo_Val (N : Node_Id) return Node_Id;
-- Given static expression or static range, returns an identifier
-- whose value is the low bound of the expression value or range.
@ -4760,6 +4769,11 @@ package body Exp_Ch5 is
Set_Warnings_Off (Loop_Id);
if Is_Itype (Ltype) then
L_Hi := High_Bound (Scalar_Range (Ltype));
L_Lo := Low_Bound (Scalar_Range (Ltype));
end if;
-- Loop to create branches of case statement
Alts := New_List;
@ -4768,11 +4782,20 @@ package body Exp_Ch5 is
-- Initial value is largest value in predicate.
D :=
Make_Object_Declaration (Loc,
Defining_Identifier => Loop_Id,
Object_Definition => New_Occurrence_Of (Ltype, Loc),
Expression => Hi_Val (Last (Stat)));
if Is_Itype (Ltype) then
D :=
Make_Object_Declaration (Loc,
Defining_Identifier => Loop_Id,
Object_Definition => New_Occurrence_Of (Ltype, Loc),
Expression => L_Hi);
else
D :=
Make_Object_Declaration (Loc,
Defining_Identifier => Loop_Id,
Object_Definition => New_Occurrence_Of (Ltype, Loc),
Expression => Hi_Val (Last (Stat)));
end if;
P := Last (Stat);
while Present (P) loop
@ -4794,15 +4817,34 @@ package body Exp_Ch5 is
Prev (P);
end loop;
if Is_Itype (Ltype)
and then Is_OK_Static_Expression (L_Lo)
and then
Expr_Value (L_Lo) /= Expr_Value (Lo_Val (First (Stat)))
then
Append_To (Alts,
Make_Case_Statement_Alternative (Loc,
Statements => New_List (Make_Exit_Statement (Loc)),
Discrete_Choices => New_List (L_Lo)));
end if;
else
-- Initial value is smallest value in predicate.
D :=
Make_Object_Declaration (Loc,
Defining_Identifier => Loop_Id,
Object_Definition => New_Occurrence_Of (Ltype, Loc),
Expression => Lo_Val (First (Stat)));
if Is_Itype (Ltype) then
D :=
Make_Object_Declaration (Loc,
Defining_Identifier => Loop_Id,
Object_Definition => New_Occurrence_Of (Ltype, Loc),
Expression => L_Lo);
else
D :=
Make_Object_Declaration (Loc,
Defining_Identifier => Loop_Id,
Object_Definition => New_Occurrence_Of (Ltype, Loc),
Expression => Lo_Val (First (Stat)));
end if;
P := First (Stat);
while Present (P) loop
@ -4823,6 +4865,17 @@ package body Exp_Ch5 is
Next (P);
end loop;
if Is_Itype (Ltype)
and then Is_OK_Static_Expression (L_Hi)
and then
Expr_Value (L_Hi) /= Expr_Value (Lo_Val (Last (Stat)))
then
Append_To (Alts,
Make_Case_Statement_Alternative (Loc,
Statements => New_List (Make_Exit_Statement (Loc)),
Discrete_Choices => New_List (L_Hi)));
end if;
end if;
-- Add others choice

5
gcc/ada/exp_util.adb
View File

@ -3408,6 +3408,11 @@ package body Exp_Util is
-- Derived types with the full view as parent do not have a partial
-- view. Insert the invariant procedure after the derived type.
-- Anonymous arrays in object declarations have no explicit declaration
-- so use the related object declaration as the insertion point.
elsif Is_Itype (Work_Typ) and then Is_Array_Type (Work_Typ) then
Typ_Decl := Associated_Node_For_Itype (Work_Typ);
else
Typ_Decl := Declaration_Node (Full_Typ);

35
gcc/ada/inline.adb
View File

@ -1187,9 +1187,9 @@ package body Inline is
-- Returns True if subprogram Id defines a compilation unit
-- Shouldn't this be in Sem_Aux???
function In_Package_Visible_Spec (Id : Node_Id) return Boolean;
-- Returns True if subprogram Id is defined in the visible part of a
-- package specification.
function In_Package_Spec (Id : Node_Id) return Boolean;
-- Returns True if subprogram Id is defined in the package
-- specification, either its visible or private part.
---------------------------------------------------
-- Has_Formal_With_Discriminant_Dependent_Fields --
@ -1288,24 +1288,17 @@ package body Inline is
return False;
end Has_Some_Contract;
-----------------------------
-- In_Package_Visible_Spec --
-----------------------------
---------------------
-- In_Package_Spec --
---------------------
function In_Package_Visible_Spec (Id : Node_Id) return Boolean is
Decl : Node_Id := Parent (Parent (Id));
P : Node_Id;
function In_Package_Spec (Id : Node_Id) return Boolean is
P : constant Node_Id := Parent (Subprogram_Spec (Id));
-- Parent of the subprogram's declaration
begin
if Nkind (Parent (Id)) = N_Defining_Program_Unit_Name then
Decl := Parent (Decl);
end if;
P := Parent (Decl);
return Nkind (P) = N_Package_Specification
and then List_Containing (Decl) = Visible_Declarations (P);
end In_Package_Visible_Spec;
return Nkind (Enclosing_Declaration (P)) = N_Package_Declaration;
end In_Package_Spec;
------------------------
-- Is_Unit_Subprogram --
@ -1351,9 +1344,11 @@ package body Inline is
if Is_Unit_Subprogram (Id) then
return False;
-- Do not inline subprograms declared in the visible part of a package
-- Do not inline subprograms declared in package specs, because they are
-- not local, i.e. can be called either from anywhere (if declared in
-- visible part) or from the child units (if declared in private part).
elsif In_Package_Visible_Spec (Id) then
elsif In_Package_Spec (Id) then
return False;
-- Do not inline subprograms declared in other units. This is important

10
gcc/ada/lib-load.adb
View File

@ -329,8 +329,14 @@ package body Lib.Load is
if Main_Source_File /= No_Source_File then
Version := Source_Checksum (Main_Source_File);
else
Error_Msg_File_1 := Fname;
Error_Msg ("file{ not found", Load_Msg_Sloc);
-- To avoid emitting a source location (since there is no file),
-- we write a custom error message instead of using the machinery
-- in errout.adb.
Set_Standard_Error;
Write_Str ("file """ & Get_Name_String (Fname) & """ not found");
Write_Eol;
Set_Standard_Output;
end if;
Units.Table (Main_Unit) :=

13
gcc/ada/sem_ch3.adb
View File

@ -18449,6 +18449,19 @@ package body Sem_Ch3 is
(Subt, Has_Static_Predicate_Aspect (Par));
Set_Has_Dynamic_Predicate_Aspect
(Subt, Has_Dynamic_Predicate_Aspect (Par));
-- A named subtype does not inherit the predicate function of its
-- parent but an itype declared for a loop index needs the discrete
-- predicate information of its parent to execute the loop properly.
if Is_Itype (Subt) and then Present (Predicate_Function (Par)) then
Set_Subprograms_For_Type (Subt, Subprograms_For_Type (Par));
if Has_Static_Predicate (Par) then
Set_Static_Discrete_Predicate
(Subt, Static_Discrete_Predicate (Par));
end if;
end if;
end Inherit_Predicate_Flags;
----------------------

2
gcc/ada/style.adb
View File

@ -291,7 +291,7 @@ package body Style is
elsif Nkind (N) = N_Abstract_Subprogram_Declaration then
Error_Msg_NE -- CODEFIX
("(style) missing OVERRIDING indicator in deckaration of&",
("(style) missing OVERRIDING indicator in declaration of&",
Specification (N), E);
else