FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2016-04-21  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch3.adb: Code cleanup.
	* sem_ch6.adb: Code cleanup.
	(Is_Matching_Limited_View): New routine.
	(Matches_Limited_With_View): Reimplemented.
	* sem_ch10.adb (Decorate_Type): Code cleanup.

2016-04-21  Doug Rupp  <rupp@adacore.com>

	* tracebak.c (PPC ELF): Add macro defs for lynxos178e.

2016-04-21  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Try_Container_Indexing): If there are overloaded
	indexing functions, collect all overloadings of the call firts,
	and then transfer them to indexing node, to prevent interleaving
	of the set of interpretations of the nodes involved.
	* sem_res.adb (Resolve): Suppress cascaded errors that report
	ambiguities when one of the actuals in an overloaded generatlized
	indexing operation is illegal and has type Any_Type, as is done
	for similar cascaded errors in subprogram calls.
	(Valid_Tagged_Conversion): Cleanup conversion checks when one
	of the types involved is a class-wide subtype.

2016-04-21  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Load_Parent_Of_Generic): When looking for the
	subprogram declaration within a wrapper package, skip pragmas
	that may have been generated by aspect specifications on the
	generic instance.

2016-04-21  Javier Miranda  <miranda@adacore.com>

	* exp_aggr.adb (Component_Not_OK_For_Backend): Generating C
	code return True for array identifiers since the backend needs
	to initialize such component by means of memcpy().

From-SVN: r235330
This commit is contained in:
Arnaud Charlet 2016-04-21 12:25:59 +02:00
parent 150346bd8d
commit 0310af44bb
9 changed files with 259 additions and 87 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
gcc/ada/ChangeLog
View file

@ -1,3 +1,41 @@
2016-04-21 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch3.adb: Code cleanup.
* sem_ch6.adb: Code cleanup.
(Is_Matching_Limited_View): New routine.
(Matches_Limited_With_View): Reimplemented.
* sem_ch10.adb (Decorate_Type): Code cleanup.
2016-04-21 Doug Rupp <rupp@adacore.com>
* tracebak.c (PPC ELF): Add macro defs for lynxos178e.
2016-04-21 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Try_Container_Indexing): If there are overloaded
indexing functions, collect all overloadings of the call firts,
and then transfer them to indexing node, to prevent interleaving
of the set of interpretations of the nodes involved.
* sem_res.adb (Resolve): Suppress cascaded errors that report
ambiguities when one of the actuals in an overloaded generatlized
indexing operation is illegal and has type Any_Type, as is done
for similar cascaded errors in subprogram calls.
(Valid_Tagged_Conversion): Cleanup conversion checks when one
of the types involved is a class-wide subtype.
2016-04-21 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Load_Parent_Of_Generic): When looking for the
subprogram declaration within a wrapper package, skip pragmas
that may have been generated by aspect specifications on the
generic instance.
2016-04-21 Javier Miranda <miranda@adacore.com>
* exp_aggr.adb (Component_Not_OK_For_Backend): Generating C
code return True for array identifiers since the backend needs
to initialize such component by means of memcpy().
2016-04-21 Arnaud Charlet <charlet@adacore.com>
* a-tasatt.adb, a-tasatt.ads (Fast_Path): Rewritten to avoid reading

7
gcc/ada/exp_aggr.adb
View file

@ -6061,6 +6061,13 @@ package body Exp_Aggr is
then
Static_Components := False;
return True;
elsif Modify_Tree_For_C
and then Nkind (Expr_Q) = N_Identifier
and then Is_Array_Type (Etype (Expr_Q))
then
Static_Components := False;
return True;
end if;
if Is_Elementary_Type (Etype (Expr_Q)) then

18
gcc/ada/sem_ch10.adb
View file

@ -5637,10 +5637,10 @@ package body Sem_Ch10 is
Set_Ekind (Ent, E_Incomplete_Type);
Set_Etype (Ent, Ent);
Set_Scope (Ent, Scop);
Set_Is_First_Subtype (Ent);
Set_Stored_Constraint (Ent, No_Elist);
Set_Full_View (Ent, Empty);
Set_Is_First_Subtype (Ent);
Set_Scope (Ent, Scop);
Set_Stored_Constraint (Ent, No_Elist);
Init_Size_Align (Ent);
-- A tagged type and its corresponding shadow entity share one common
@ -5668,16 +5668,16 @@ package body Sem_Ch10 is
Set_Parent (CW_Typ, Parent (Ent));
Set_Ekind (CW_Typ, E_Class_Wide_Type);
Set_Etype (CW_Typ, Ent);
Set_Scope (CW_Typ, Scop);
Set_Is_Tagged_Type (CW_Typ);
Set_Is_First_Subtype (CW_Typ);
Init_Size_Align (CW_Typ);
Set_Has_Unknown_Discriminants (CW_Typ);
Set_Class_Wide_Type (CW_Typ, CW_Typ);
Set_Etype (CW_Typ, Ent);
Set_Equivalent_Type (CW_Typ, Empty);
Set_From_Limited_With (CW_Typ, From_Limited_With (Ent));
Set_Has_Unknown_Discriminants (CW_Typ);
Set_Is_First_Subtype (CW_Typ);
Set_Is_Tagged_Type (CW_Typ);
Set_Materialize_Entity (CW_Typ, Materialize);
Set_Scope (CW_Typ, Scop);
Init_Size_Align (CW_Typ);
end if;
end Decorate_Type;

15
gcc/ada/sem_ch12.adb
View file

@ -13105,18 +13105,23 @@ package body Sem_Ch12 is
-- The instance_spec is in the wrapper package,
-- usually followed by its local renaming
-- declaration. See Build_Subprogram_Renaming
-- for details.
-- for details. If the instance carries aspects,
-- these result in the corresponding pragmas,
-- inserted after the subprogram declaration.
-- They must be skipped as well when retrieving
-- the desired spec. A direct link would be
-- more robust ???
declare
Decl : Node_Id :=
(Last (Visible_Declarations
(Specification (Info.Act_Decl))));
begin
if Nkind (Decl) =
N_Subprogram_Renaming_Declaration
then
while Nkind_In (Decl,
N_Subprogram_Renaming_Declaration, N_Pragma)
loop
Decl := Prev (Decl);
end if;
end loop;
Info.Act_Decl := Decl;
end;

2
gcc/ada/sem_ch3.adb
View file

@ -5074,7 +5074,7 @@ package body Sem_Ch3 is
-- inherit static and dynamic predicates if any.
-- If declaration has no aspect specifications, inherit predicate
-- info as well. Unclear how to handle the case of both specified
-- info as well. Unclear how to handle the case of both specified
-- and inherited predicates ??? Other inherited aspects, such as
-- invariants, should be OK, but the combination with later pragmas
-- may also require special merging.

45
gcc/ada/sem_ch4.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2016, 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- --
@ -7537,27 +7537,54 @@ package body Sem_Ch4 is
Get_First_Interp (Func_Name, I, It);
Set_Etype (Indexing, Any_Type);
-- Analyze eacn candidae function with the given actuals
while Present (It.Nam) loop
Analyze_One_Call (Indexing, It.Nam, False, Success);
Get_Next_Interp (I, It);
end loop;
if Success then
-- If there are several successful candidates, resolution will
-- be by result. Mark the interpretations of the function name
-- itself.
-- Function in current interpretation is a valid candidate.
-- Its result type is also a potential type for the
-- original Indexed_Component node.
if Is_Overloaded (Indexing) then
Get_First_Interp (Indexing, I, It);
while Present (It.Nam) loop
Add_One_Interp (Name (Indexing), It.Nam, It.Typ);
Get_Next_Interp (I, It);
end loop;
else
Set_Etype (Name (Indexing), Etype (Indexing));
end if;
-- Now add the candidate interpretations to the indexing node
-- itself, to be replaced later by the function call.
if Is_Overloaded (Name (Indexing)) then
Get_First_Interp (Name (Indexing), I, It);
while Present (It.Nam) loop
Add_One_Interp (N, It.Nam, It.Typ);
-- Add implicit dereference interpretation to original node
-- Add dereference interpretation if the result type type
-- has implicit reference discriminants.
if Has_Discriminants (Etype (It.Nam)) then
Check_Implicit_Dereference (N, Etype (It.Nam));
end if;
end if;
Get_Next_Interp (I, It);
end loop;
Get_Next_Interp (I, It);
end loop;
else
Set_Etype (N, Etype (Name (Indexing)));
if Has_Discriminants (Etype (N)) then
Check_Implicit_Dereference (N, Etype (N));
end if;
end if;
end;
end if;

182
gcc/ada/sem_ch6.adb
View file

@ -6482,45 +6482,48 @@ package body Sem_Ch6 is
Ctype : Conformance_Type;
Get_Inst : Boolean := False) return Boolean
is
Type_1 : Entity_Id := T1;
Type_2 : Entity_Id := T2;
Are_Anonymous_Access_To_Subprogram_Types : Boolean := False;
function Base_Types_Match
(Typ_1 : Entity_Id;
Typ_2 : Entity_Id) return Boolean;
-- If neither Typ_1 nor Typ_2 are generic actual types, or if they are
-- in different scopes (e.g. parent and child instances), then verify
-- that the base types are equal. Otherwise Typ_1 and Typ_2 must be on
-- the same subtype chain. The whole purpose of this procedure is to
-- prevent spurious ambiguities in an instantiation that may arise if
-- two distinct generic types are instantiated with the same actual.
function Base_Types_Match (T1, T2 : Entity_Id) return Boolean;
-- If neither T1 nor T2 are generic actual types, or if they are in
-- different scopes (e.g. parent and child instances), then verify that
-- the base types are equal. Otherwise T1 and T2 must be on the same
-- subtype chain. The whole purpose of this procedure is to prevent
-- spurious ambiguities in an instantiation that may arise if two
-- distinct generic types are instantiated with the same actual.
function Find_Designated_Type (T : Entity_Id) return Entity_Id;
function Find_Designated_Type (Typ : Entity_Id) return Entity_Id;
-- An access parameter can designate an incomplete type. If the
-- incomplete type is the limited view of a type from a limited_
-- with_clause, check whether the non-limited view is available. If
-- it is a (non-limited) incomplete type, get the full view.
-- with_clause, check whether the non-limited view is available.
-- If it is a (non-limited) incomplete type, get the full view.
function Matches_Limited_With_View (T1, T2 : Entity_Id) return Boolean;
-- Returns True if and only if either T1 denotes a limited view of T2
-- or T2 denotes a limited view of T1. This can arise when the limited
-- with view of a type is used in a subprogram declaration and the
-- subprogram body is in the scope of a regular with clause for the
-- same unit. In such a case, the two type entities can be considered
function Matches_Limited_With_View
(Typ_1 : Entity_Id;
Typ_2 : Entity_Id) return Boolean;
-- Returns True if and only if either Typ_1 denotes a limited view of
-- Typ_2 or Typ_2 denotes a limited view of Typ_1. This can arise when
-- the limited with view of a type is used in a subprogram declaration
-- and the subprogram body is in the scope of a regular with clause for
-- the same unit. In such a case, the two type entities are considered
-- identical for purposes of conformance checking.
----------------------
-- Base_Types_Match --
----------------------
function Base_Types_Match (T1, T2 : Entity_Id) return Boolean is
BT1 : constant Entity_Id := Base_Type (T1);
BT2 : constant Entity_Id := Base_Type (T2);
function Base_Types_Match
(Typ_1 : Entity_Id;
Typ_2 : Entity_Id) return Boolean
is
Base_1 : constant Entity_Id := Base_Type (Typ_1);
Base_2 : constant Entity_Id := Base_Type (Typ_2);
begin
if T1 = T2 then
if Typ_1 = Typ_2 then
return True;
elsif BT1 = BT2 then
elsif Base_1 = Base_2 then
-- The following is too permissive. A more precise test should
-- check that the generic actual is an ancestor subtype of the
@ -6529,18 +6532,23 @@ package body Sem_Ch6 is
-- See code in Find_Corresponding_Spec that applies an additional
-- filter to handle accidental amiguities in instances.
return not Is_Generic_Actual_Type (T1)
or else not Is_Generic_Actual_Type (T2)
or else Scope (T1) /= Scope (T2);
return
not Is_Generic_Actual_Type (Typ_1)
or else not Is_Generic_Actual_Type (Typ_2)
or else Scope (Typ_1) /= Scope (Typ_2);
-- If T2 is a generic actual type it is declared as the subtype of
-- If Typ_2 is a generic actual type it is declared as the subtype of
-- the actual. If that actual is itself a subtype we need to use its
-- own base type to check for compatibility.
elsif Ekind (BT2) = Ekind (T2) and then BT1 = Base_Type (BT2) then
elsif Ekind (Base_2) = Ekind (Typ_2)
and then Base_1 = Base_Type (Base_2)
then
return True;
elsif Ekind (BT1) = Ekind (T1) and then BT2 = Base_Type (BT1) then
elsif Ekind (Base_1) = Ekind (Typ_1)
and then Base_2 = Base_Type (Base_1)
then
return True;
else
@ -6552,11 +6560,11 @@ package body Sem_Ch6 is
-- Find_Designated_Type --
--------------------------
function Find_Designated_Type (T : Entity_Id) return Entity_Id is
function Find_Designated_Type (Typ : Entity_Id) return Entity_Id is
Desig : Entity_Id;
begin
Desig := Directly_Designated_Type (T);
Desig := Directly_Designated_Type (Typ);
if Ekind (Desig) = E_Incomplete_Type then
@ -6580,39 +6588,115 @@ package body Sem_Ch6 is
-- Matches_Limited_With_View --
-------------------------------
function Matches_Limited_With_View (T1, T2 : Entity_Id) return Boolean is
function Matches_Limited_With_View
(Typ_1 : Entity_Id;
Typ_2 : Entity_Id) return Boolean
is
function Is_Matching_Limited_View
(Typ : Entity_Id;
View : Entity_Id) return Boolean;
-- Determine whether non-limited view View denotes type Typ in some
-- conformant fashion.
------------------------------
-- Is_Matching_Limited_View --
------------------------------
function Is_Matching_Limited_View
(Typ : Entity_Id;
View : Entity_Id) return Boolean
is
Root_Typ : Entity_Id;
Root_View : Entity_Id;
begin
-- The non-limited view directly denotes the type
if Typ = View then
return True;
-- The type is a subtype of the non-limited view
elsif Is_Subtype_Of (Typ, View) then
return True;
-- Both the non-limited view and the type denote class-wide types
elsif Is_Class_Wide_Type (Typ)
and then Is_Class_Wide_Type (View)
then
Root_Typ := Root_Type (Typ);
Root_View := Root_Type (View);
if Root_Typ = Root_View then
return True;
-- An incomplete tagged type and its full view may receive two
-- distinct class-wide types when the related package has not
-- been analyzed yet.
-- package Pack is
-- type T is tagged; -- CW_1
-- type T is tagged null record; -- CW_2
-- end Pack;
-- This is because the package lacks any semantic information
-- that may eventually link both views of T. As a consequence,
-- a client of the limited view of Pack will see CW_2 while a
-- client of the non-limited view of Pack will see CW_1.
elsif Is_Incomplete_Type (Root_Typ)
and then Present (Full_View (Root_Typ))
and then Full_View (Root_Typ) = Root_View
then
return True;
elsif Is_Incomplete_Type (Root_View)
and then Present (Full_View (Root_View))
and then Full_View (Root_View) = Root_Typ
then
return True;
end if;
end if;
return False;
end Is_Matching_Limited_View;
-- Start of processing for Matches_Limited_With_View
begin
-- In some cases a type imported through a limited_with clause, and
-- its nonlimited view are both visible, for example in an anonymous
-- its non-limited view are both visible, for example in an anonymous
-- access-to-class-wide type in a formal, or when building the body
-- for a subprogram renaming after the subprogram has been frozen.
-- In these cases Both entities designate the same type. In addition,
-- In these cases both entities designate the same type. In addition,
-- if one of them is an actual in an instance, it may be a subtype of
-- the non-limited view of the other.
if From_Limited_With (T1)
and then (T2 = Available_View (T1)
or else Is_Subtype_Of (T2, Available_View (T1)))
if From_Limited_With (Typ_1)
and then From_Limited_With (Typ_2)
and then Available_View (Typ_1) = Available_View (Typ_2)
then
return True;
elsif From_Limited_With (T2)
and then (T1 = Available_View (T2)
or else Is_Subtype_Of (T1, Available_View (T2)))
then
return True;
elsif From_Limited_With (Typ_1) then
return Is_Matching_Limited_View (Typ_2, Available_View (Typ_1));
elsif From_Limited_With (T1)
and then From_Limited_With (T2)
and then Available_View (T1) = Available_View (T2)
then
return True;
elsif From_Limited_With (Typ_2) then
return Is_Matching_Limited_View (Typ_1, Available_View (Typ_2));
else
return False;
end if;
end Matches_Limited_With_View;
-- Local variables
Are_Anonymous_Access_To_Subprogram_Types : Boolean := False;
Type_1 : Entity_Id := T1;
Type_2 : Entity_Id := T2;
-- Start of processing for Conforming_Types
begin

36
gcc/ada/sem_res.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2016, 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- --
@ -2248,17 +2248,25 @@ package body Sem_Res is
end loop;
else
-- Before we issue an ambiguity complaint, check for
-- the case of a subprogram call where at least one
-- of the arguments is Any_Type, and if so, suppress
-- the message, since it is a cascaded error.
-- Before we issue an ambiguity complaint, check for the
-- case of a subprogram call where at least one of the
-- arguments is Any_Type, and if so suppress the message,
-- since it is a cascaded error. This can also happen for
-- a generalized indexing operation.
if Nkind (N) in N_Subprogram_Call then
if Nkind (N) in N_Subprogram_Call
or else (Nkind (N) = N_Indexed_Component
and then Present (Generalized_Indexing (N)))
then
declare
A : Node_Id;
E : Node_Id;
begin
if Nkind (N) = N_Indexed_Component then
Rewrite (N, Generalized_Indexing (N));
end if;
A := First_Actual (N);
while Present (A) loop
E := A;
@ -2292,17 +2300,17 @@ package body Sem_Res is
exit Interp_Loop;
end if;
-- Not that special case, so issue message using the
-- flag Ambiguous to control printing of the header
-- message only at the start of an ambiguous set.
-- Not that special case, so issue message using the flag
-- Ambiguous to control printing of the header message
-- only at the start of an ambiguous set.
if not Ambiguous then
if Nkind (N) = N_Function_Call
and then Nkind (Name (N)) = N_Explicit_Dereference
then
Error_Msg_N
("ambiguous expression "
& "(cannot resolve indirect call)!", N);
("ambiguous expression (cannot resolve indirect "
& "call)!", N);
else
Error_Msg_NE -- CODEFIX
("ambiguous expression (cannot resolve&)!",
@ -11836,9 +11844,11 @@ package body Sem_Res is
"downward conversion of tagged objects not allowed");
-- Ada 2005 (AI-251): The conversion to/from interface types is
-- always valid
-- always valid. The types involved may be class-wide (sub)types.
elsif Is_Interface (Target_Type) or else Is_Interface (Opnd_Type) then
elsif Is_Interface (Etype (Base_Type (Target_Type)))
or else Is_Interface (Etype (Base_Type (Opnd_Type)))
then
return True;
-- If the operand is a class-wide type obtained through a limited_

3
gcc/ada/tracebak.c
View file

@ -354,9 +354,10 @@ extern void __runnit(); /* thread entry point. */
#define BASE_SKIP 1
/*-------------------- PPC ELF (GNU/Linux & VxWorks) ---------------------*/
/*----------- PPC ELF (GNU/Linux & VxWorks & Lynx178e) -------------------*/
#elif (defined (_ARCH_PPC) && defined (__vxworks)) || \
(defined (__powerpc__) && defined (__Lynx__) && defined(__ELF__)) || \
(defined (__linux__) && defined (__powerpc__))
#define USE_GENERIC_UNWINDER