mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-03 18:30:49 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2013-10-10  Robert Dewar  <dewar@adacore.com>

	* exp_ch3.adb (Expand_N_Variant_Part): Expand statically
	predicated subtype which appears in Discrete_Choices list.
	* exp_ch5.adb (Expand_N_Case_Statement): Expand statically
	predicated subtype which appears in Discrete_Choices list of
	case statement alternative.
	* exp_util.ads, exp_util.adb (Expand_Static_Predicates_In_Choices): New
	procedure.
	* sem_case.adb: Minor reformatting (Analyze_Choices): Don't
	expand out Discrete_Choices that are names of subtypes with
	static predicates. This is now done in the analyzer so that the
	-gnatct tree is properly formed for ASIS.
	* sem_case.ads (Generic_Choices_Processing): Does not apply
	to aggregates any more, so change doc accordingly, and remove
	unneeded Get_Choices argument.
	* sem_ch3.adb (Analyze_Variant_Part): Remove no
	longer used Get_Choices argument in instantiation of
	Generic_Choices_Processing.
	* sem_ch4.adb (Analyze_Case_Expression): Remove no
	longer used Get_Choices argument in instantiation of
	Generic_Choices_Processing.
	* sem_ch5.adb (Analyze_Case_Statement): Remove no
	longer used Get_Choices argument in instantiation of
	Generic_Choices_Processing.
	* sinfo.ads: For N_Variant_Part, and N_Case_Statement_Alternative,
	document that choices that are names of statically predicated
	subtypes are expanded in the code generation tree passed to the
	back end, but not in the ASIS tree generated for -gnatct.

2013-10-10  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch7.adb: Revert previous change.

2013-10-10  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): In the case where
	the Storage_Pool aspect is specified by an aspect clause and a
	renaming is used to capture the evaluation of the pool name,
	insert the renaming in front of the aspect's associated entity
	declaration rather than in front of the corresponding attribute
	definition (which hasn't been appended to the declaration
	list yet).

2013-10-10  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Is_Interface_Conformant): The controlling type
	of the interface operation is obtained from the ultimate alias
	of the interface primitive parameter, because that may be in
	fact an implicit inherited operation whose signature involves
	the type extension and not the desired interface.

2013-10-10  Ed Schonberg  <schonberg@adacore.com>

	* par-ch13.adb (Aspect_Specifications_Present): In Ada 2012,
	recognize an aspect specification with a misspelled name if it
	is followed by a a comma or semicolon.

2013-10-10  Vadim Godunko  <godunko@adacore.com>

	* s-atocou.adb, s-atocou.ads, s-atocou-x86.adb, s-atocou-builtin.adb:
	Fix copyright notice.

2013-10-10  Yannick Moy  <moy@adacore.com>

	* lib-xref-spark_specific.adb (Enclosing_Subprogram_Or_Package): Get
	enclosing subprogram for precondition/postcondition/contract cases.

From-SVN: r203350
This commit is contained in:
Arnaud Charlet 2013-10-10 13:07:30 +02:00
parent 11d59a8683
commit 9e92ad4973
20 changed files with 275 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
gcc/ada/ChangeLog
View File

@ -1,3 +1,71 @@
2013-10-10 Robert Dewar <dewar@adacore.com>
* exp_ch3.adb (Expand_N_Variant_Part): Expand statically
predicated subtype which appears in Discrete_Choices list.
* exp_ch5.adb (Expand_N_Case_Statement): Expand statically
predicated subtype which appears in Discrete_Choices list of
case statement alternative.
* exp_util.ads, exp_util.adb (Expand_Static_Predicates_In_Choices): New
procedure.
* sem_case.adb: Minor reformatting (Analyze_Choices): Don't
expand out Discrete_Choices that are names of subtypes with
static predicates. This is now done in the analyzer so that the
-gnatct tree is properly formed for ASIS.
* sem_case.ads (Generic_Choices_Processing): Does not apply
to aggregates any more, so change doc accordingly, and remove
unneeded Get_Choices argument.
* sem_ch3.adb (Analyze_Variant_Part): Remove no
longer used Get_Choices argument in instantiation of
Generic_Choices_Processing.
* sem_ch4.adb (Analyze_Case_Expression): Remove no
longer used Get_Choices argument in instantiation of
Generic_Choices_Processing.
* sem_ch5.adb (Analyze_Case_Statement): Remove no
longer used Get_Choices argument in instantiation of
Generic_Choices_Processing.
* sinfo.ads: For N_Variant_Part, and N_Case_Statement_Alternative,
document that choices that are names of statically predicated
subtypes are expanded in the code generation tree passed to the
back end, but not in the ASIS tree generated for -gnatct.
2013-10-10 Ed Schonberg <schonberg@adacore.com>
* sem_ch7.adb: Revert previous change.
2013-10-10 Gary Dismukes <dismukes@adacore.com>
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): In the case where
the Storage_Pool aspect is specified by an aspect clause and a
renaming is used to capture the evaluation of the pool name,
insert the renaming in front of the aspect's associated entity
declaration rather than in front of the corresponding attribute
definition (which hasn't been appended to the declaration
list yet).
2013-10-10 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Is_Interface_Conformant): The controlling type
of the interface operation is obtained from the ultimate alias
of the interface primitive parameter, because that may be in
fact an implicit inherited operation whose signature involves
the type extension and not the desired interface.
2013-10-10 Ed Schonberg <schonberg@adacore.com>
* par-ch13.adb (Aspect_Specifications_Present): In Ada 2012,
recognize an aspect specification with a misspelled name if it
is followed by a a comma or semicolon.
2013-10-10 Vadim Godunko <godunko@adacore.com>
* s-atocou.adb, s-atocou.ads, s-atocou-x86.adb, s-atocou-builtin.adb:
Fix copyright notice.
2013-10-10 Yannick Moy <moy@adacore.com>
* lib-xref-spark_specific.adb (Enclosing_Subprogram_Or_Package): Get
enclosing subprogram for precondition/postcondition/contract cases.
2013-10-10 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Minor fix.

26
gcc/ada/exp_ch3.adb
View File

@ -5846,23 +5846,35 @@ package body Exp_Ch3 is
-- Expand_N_Variant_Part --
---------------------------
-- If the last variant does not contain the Others choice, replace it with
-- an N_Others_Choice node since Gigi always wants an Others. Note that we
-- do not bother to call Analyze on the modified variant part, since its
-- only effect would be to compute the Others_Discrete_Choices node
-- laboriously, and of course we already know the list of choices that
-- corresponds to the others choice (it's the list we are replacing!)
procedure Expand_N_Variant_Part (N : Node_Id) is
Last_Var : constant Node_Id := Last_Non_Pragma (Variants (N));
Others_Node : Node_Id;
Variant : Node_Id;
begin
-- If the last variant does not contain the Others choice, replace it
-- with an N_Others_Choice node since Gigi always wants an Others. Note
-- that we do not bother to call Analyze on the modified variant part,
-- since its only effect would be to compute the Others_Discrete_Choices
-- node laboriously, and of course we already know the list of choices
-- corresponding to the others choice (it's the list we're replacing!)
if Nkind (First (Discrete_Choices (Last_Var))) /= N_Others_Choice then
Others_Node := Make_Others_Choice (Sloc (Last_Var));
Set_Others_Discrete_Choices
(Others_Node, Discrete_Choices (Last_Var));
Set_Discrete_Choices (Last_Var, New_List (Others_Node));
end if;
-- Deal with any static predicates in the variant choices. Note that we
-- don't have to look at the last variant, since we know it is an others
-- choice, because we just rewrote it that way if necessary.
Variant := First_Non_Pragma (Variants (N));
while Variant /= Last_Var loop
Expand_Static_Predicates_In_Choices (Variant);
Next_Non_Pragma (Variant);
end loop;
end Expand_N_Variant_Part;
---------------------------------

18
gcc/ada/exp_ch5.adb
View File

@ -2537,7 +2537,11 @@ package body Exp_Ch5 is
-- if statement, since this can result in subsequent optimizations.
-- This helps not only with case statements in the source of a
-- simple form, but also with generated code (discriminant check
-- functions in particular)
-- functions in particular).
-- Note: it is OK to do this before expanding out choices for any
-- static predicates, since the if statement processing will handle
-- the static predicate case fine.
elsif Len = 2 then
Chlist := Discrete_Choices (First (Alternatives (N)));
@ -2617,12 +2621,14 @@ package body Exp_Ch5 is
Set_Discrete_Choices (Last_Alt, New_List (Others_Node));
end if;
Alt := First (Alternatives (N));
while Present (Alt)
and then Nkind (Alt) = N_Case_Statement_Alternative
loop
-- Deal with possible declarations of controlled objects, and also
-- with rewriting choice sequences for static predicate references.
Alt := First_Non_Pragma (Alternatives (N));
while Present (Alt) loop
Process_Statements_For_Controlled_Objects (Alt);
Next (Alt);
Expand_Static_Predicates_In_Choices (Alt);
Next_Non_Pragma (Alt);
end loop;
end;
end Expand_N_Case_Statement;

63
gcc/ada/exp_util.adb
View File

@ -1946,6 +1946,69 @@ package body Exp_Util is
end if;
end Evolve_Or_Else;
-----------------------------------------
-- Expand_Static_Predicates_In_Choices --
-----------------------------------------
procedure Expand_Static_Predicates_In_Choices (N : Node_Id) is
pragma Assert (Nkind_In (N, N_Case_Statement_Alternative, N_Variant));
Choices : constant List_Id := Discrete_Choices (N);
Choice : Node_Id;
Next_C : Node_Id;
P : Node_Id;
C : Node_Id;
begin
Choice := First (Choices);
while Present (Choice) loop
Next_C := Next (Choice);
-- Check for name of subtype with static predicate
if Is_Entity_Name (Choice)
and then Is_Type (Entity (Choice))
and then Has_Predicates (Entity (Choice))
then
-- Loop through entries in predicate list, converting to choices
-- and inserting in the list before the current choice. Note that
-- if the list is empty, corresponding to a False predicate, then
-- no choices are inserted.
P := First (Static_Predicate (Entity (Choice)));
while Present (P) loop
-- If low bound and high bounds are equal, copy simple choice
if Expr_Value (Low_Bound (P)) = Expr_Value (High_Bound (P)) then
C := New_Copy (Low_Bound (P));
-- Otherwise copy a range
else
C := New_Copy (P);
end if;
-- Change Sloc to referencing choice (rather than the Sloc of
-- the predicate declarationo element itself).
Set_Sloc (C, Sloc (Choice));
Insert_Before (Choice, C);
Next (P);
end loop;
-- Delete the predicated entry
Remove (Choice);
end if;
-- Move to next choice to check
Choice := Next_C;
end loop;
end Expand_Static_Predicates_In_Choices;
------------------------------
-- Expand_Subtype_From_Expr --
------------------------------

6
gcc/ada/exp_util.ads
View File

@ -377,6 +377,12 @@ package Exp_Util is
-- indicating that no checks were required). The Sloc field of the
-- constructed N_Or_Else node is copied from Cond1.
procedure Expand_Static_Predicates_In_Choices (N : Node_Id);
-- N is either a case alternative or a variant. The Discrete_Choices field
-- of N points to a list of choices. If any of these choices is the name
-- of a (statically) predicated subtype, then it is rewritten as the series
-- of choices that correspond to the values allowed for the subtype.
procedure Expand_Subtype_From_Expr
(N : Node_Id;
Unc_Type : Entity_Id;

23
gcc/ada/lib-xref-spark_specific.adb
View File

@ -1020,17 +1020,28 @@ package body SPARK_Specific is
Result := Defining_Unit_Name (Specification (Result));
exit;
-- The enclosing subprogram for a pre- or postconditions should be
-- the subprogram to which the pragma is attached. This is not
-- always the case in the AST, as the pragma may be declared after
-- the declaration of the subprogram. Return Empty in this case.
when N_Pragma =>
-- The enclosing subprogram for a precondition, a
-- postcondition, or a contract case should be the subprogram
-- to which the pragma is attached, which can be found by
-- following previous elements in the list to which the
-- pragma belongs.
if Get_Pragma_Id (Result) = Pragma_Precondition
or else
Get_Pragma_Id (Result) = Pragma_Postcondition
or else
Get_Pragma_Id (Result) = Pragma_Contract_Cases
then
return Empty;
if Is_List_Member (Result)
and then Present (Prev (Result))
then
Result := Prev (Result);
else
Result := Parent (Result);
end if;
else
Result := Parent (Result);
end if;

10
gcc/ada/par-ch13.adb
View File

@ -78,15 +78,19 @@ package body Ch13 is
-- are in Ada 2012 mode, Strict is False, and we consider that we have
-- an aspect specification if the identifier is an aspect name (even if
-- not followed by =>) or the identifier is not an aspect name but is
-- followed by =>. P_Aspect_Specifications will generate messages if the
-- aspect specification is ill-formed.
-- followed by =>, by a comma, or by a semicolon. The last two cases
-- correspond to (misspelled) Boolean aspects with a defaulted value of
-- True. P_Aspect_Specifications will generate messages if the aspect
-- specification is ill-formed.
elsif not Strict then
if Get_Aspect_Id (Token_Name) /= No_Aspect then
Result := True;
else
Scan; -- past identifier
Result := Token = Tok_Arrow;
Result := Token = Tok_Arrow
or else Token = Tok_Comma
or else Token = Tok_Semicolon;
end if;
-- If earlier than Ada 2012, check for valid aspect identifier (possibly

2
gcc/ada/s-atocou-builtin.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2011-2013, AdaCore --
-- Copyright (C) 2011-2013, 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- --

2
gcc/ada/s-atocou-x86.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2011-2013, AdaCore --
-- Copyright (C) 2011-2013, 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- --

2
gcc/ada/s-atocou.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2011-2013, AdaCore --
-- Copyright (C) 2011-2013, 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- --

2
gcc/ada/s-atocou.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2011-2013, AdaCore --
-- Copyright (C) 2011-2013, 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- --

57
gcc/ada/sem_case.adb
View File

@ -57,9 +57,9 @@ package body Sem_Case is
-- to the choice node itself.
type Choice_Table_Type is array (Nat range <>) of Choice_Bounds;
-- Table type used to sort the choices present in a case statement, array
-- aggregate or record variant. The actual entries are stored in 1 .. Last,
-- but we have a 0 entry for convenience in sorting.
-- Table type used to sort the choices present in a case statement or
-- record variant. The actual entries are stored in 1 .. Last, but we
-- have a 0 entry for use in sorting.
-----------------------
-- Local Subprograms --
@ -145,8 +145,7 @@ package body Sem_Case is
procedure Missing_Choices (Pred : Node_Id; Prev_Hi : Uint);
-- Emit an error message for each non-covered static predicate set.
-- Prev_Hi denotes the upper bound of the last choice that covered a
-- set.
-- Prev_Hi denotes the upper bound of the last choice covering a set.
procedure Move_Choice (From : Natural; To : Natural);
-- Move routine for sorting the Choice_Table
@ -263,7 +262,6 @@ package body Sem_Case is
else
Illegal_Range (Loc, Choice_Lo, Choice_Hi);
Error := True;
return;
end if;
@ -443,21 +441,21 @@ package body Sem_Case is
if Nkind (Case_Node) = N_Variant_Part then
Error_Msg_NE
("bounds of & are not static," &
" alternatives must cover base type", Expr, Expr);
("bounds of & are not static, "
& "alternatives must cover base type!", Expr, Expr);
-- If this is a case statement, the expression may be non-static
-- or else the subtype may be at fault.
elsif Is_Entity_Name (Expr) then
Error_Msg_NE
("bounds of & are not static," &
" alternatives must cover base type", Expr, Expr);
("bounds of & are not static, "
& "alternatives must cover base type!", Expr, Expr);
else
Error_Msg_N
("subtype of expression is not static,"
& " alternatives must cover base type!", Expr);
("subtype of expression is not static, "
& "alternatives must cover base type!", Expr);
end if;
-- Otherwise the expression is not static, even if the bounds of the
@ -1220,10 +1218,13 @@ package body Sem_Case is
if Nkind (Alt) = N_Pragma then
Analyze (Alt);
-- Otherwise check each choice against its base type
-- Otherwise we have an alternative. In most cases the semantic
-- processing leaves the list of choices unchanged
-- Check each choice against its base type
else
Choice := First (Get_Choices (Alt));
Choice := First (Discrete_Choices (Alt));
while Present (Choice) loop
Delete_Choice := False;
Analyze (Choice);
@ -1260,33 +1261,29 @@ package body Sem_Case is
then
Bad_Predicated_Subtype_Use
("cannot use subtype& with non-static "
& "predicate as case alternative", Choice, E,
Suggest_Static => True);
& "predicate as case alternative",
Choice, E, Suggest_Static => True);
-- Static predicate case
-- Static predicate case
else
declare
Copy : constant List_Id := Empty_List;
P : Node_Id;
C : Node_Id;
P : Node_Id;
C : Node_Id;
begin
-- Loop through entries in predicate list,
-- converting to choices. Note that if the
-- checking each entry. Note that if the
-- list is empty, corresponding to a False
-- predicate, then no choices are inserted.
-- predicate, then no choices are checked.
P := First (Static_Predicate (E));
while Present (P) loop
C := New_Copy (P);
Set_Sloc (C, Sloc (Choice));
Append_To (Copy, C);
Check (C, Low_Bound (C), High_Bound (C));
Next (P);
end loop;
Insert_List_After (Choice, Copy);
Delete_Choice := True;
end;
end if;
@ -1306,8 +1303,6 @@ package body Sem_Case is
Resolve_Discrete_Subtype_Indication
(Choice, Expected_Type);
-- Here for other than predicated subtype case
if Etype (Choice) /= Any_Type then
declare
C : constant Node_Id := Constraint (Choice);
@ -1351,9 +1346,9 @@ package body Sem_Case is
-- alternative and as its only choice.
elsif Kind = N_Others_Choice then
if not (Choice = First (Get_Choices (Alt))
and then Choice = Last (Get_Choices (Alt))
and then Alt = Last (Get_Alternatives (N)))
if not (Choice = First (Discrete_Choices (Alt))
and then Choice = Last (Discrete_Choices (Alt))
and then Alt = Last (Get_Alternatives (N)))
then
Error_Msg_N
("the choice OTHERS must appear alone and last",

36
gcc/ada/sem_case.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1996-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1996-2013, 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- --
@ -40,28 +40,22 @@ package Sem_Case is
generic
with function Get_Alternatives (N : Node_Id) return List_Id;
-- Function needed to get to the actual list of case statement
-- alternatives, or array aggregate component associations or
-- record variants from which we can then access the actual lists
-- of discrete choices. N is the node for the original construct
-- i.e. a case statement, an array aggregate or a record variant.
with function Get_Choices (A : Node_Id) return List_Id;
-- Given a case statement alternative, array aggregate component
-- association or record variant A we need different access functions
-- to get to the actual list of discrete choices.
-- Function used to get the list of case statement alternatives or
-- record variants, from which we can then access the actual lists of
-- discrete choices. N is the node for the original construct (case
-- statement or a record variant).
with procedure Process_Empty_Choice (Choice : Node_Id);
-- Processing to carry out for an empty Choice
-- Processing to carry out for an empty Choice. Set to No_Op (declared
-- above) if no such processing is required.
with procedure Process_Non_Static_Choice (Choice : Node_Id);
-- Processing to carry out for a non static Choice
with procedure Process_Associated_Node (A : Node_Id);
-- Associated with each case alternative, aggregate component
-- association or record variant A there is a node or list of nodes
-- that need semantic processing. This routine implements that
-- processing.
-- Associated with each case alternative or record variant A there is
-- a node or list of nodes that need semantic processing. This routine
-- implements that processing.
package Generic_Choices_Processing is
@ -70,12 +64,12 @@ package Sem_Case is
Subtyp : Entity_Id;
Raises_CE : out Boolean;
Others_Present : out Boolean);
-- From a case expression, case statement, array aggregate or record
-- variant N, this routine analyzes the corresponding list of discrete
-- choices. Subtyp is the subtype of the discrete choices. The type
-- against which the discrete choices must be resolved is its base type.
-- From a case expression, case statement, or record variant N, this
-- routine analyzes the corresponding list of discrete choices. Subtyp
-- is the subtype of the discrete choices. The type against which the
-- discrete choices must be resolved is its base type.
--
-- In one of the bounds of a discrete choice raises a constraint
-- If one of the bounds of a discrete choice raises a constraint
-- error the flag Raise_CE is set.
--
-- Finally Others_Present is set to True if an Others choice is present

12
gcc/ada/sem_ch13.adb
View File

@ -4381,7 +4381,17 @@ package body Sem_Ch13 is
Name => Expr);
begin
Insert_Before (N, Rnode);
-- If the attribute definition clause comes from an aspect
-- clause, then insert the renaming before the associated
-- entity's declaration, since the attribute clause has
-- not yet been appended to the declaration list.
if From_Aspect_Specification (N) then
Insert_Before (Parent (Entity (N)), Rnode);
else
Insert_Before (N, Rnode);
end if;
Analyze (Rnode);
Set_Associated_Storage_Pool (U_Ent, Pool);
end;

1
gcc/ada/sem_ch3.adb
View File

@ -4602,7 +4602,6 @@ package body Sem_Ch3 is
package Variant_Choices_Processing is new
Generic_Choices_Processing
(Get_Alternatives => Variants,
Get_Choices => Discrete_Choices,
Process_Empty_Choice => No_OP,
Process_Non_Static_Choice => Non_Static_Choice_Error,
Process_Associated_Node => Process_Declarations);

6
gcc/ada/sem_ch4.adb
View File

@ -1318,7 +1318,6 @@ package body Sem_Ch4 is
package Case_Choices_Processing is new
Generic_Choices_Processing
(Get_Alternatives => Alternatives,
Get_Choices => Discrete_Choices,
Process_Empty_Choice => No_OP,
Process_Non_Static_Choice => Non_Static_Choice_Error,
Process_Associated_Node => No_OP);
@ -3962,8 +3961,8 @@ package body Sem_Ch4 is
Next (Param);
end loop;
-- One of the specs has additional formals, there is no match,
-- unless this may be an indexing of a parameterless call.
-- One of the specs has additional formals; there is no match, unless
-- this may be an indexing of a parameterless call.
-- Note that when expansion is disabled, the corresponding record
-- type of synchronized types is not constructed, so that there is
@ -3977,7 +3976,6 @@ package body Sem_Ch4 is
and then not Expander_Active
then
return True;
else
return False;
end if;

1
gcc/ada/sem_ch5.adb
View File

@ -1045,7 +1045,6 @@ package body Sem_Ch5 is
package Case_Choices_Processing is new
Generic_Choices_Processing
(Get_Alternatives => Alternatives,
Get_Choices => Discrete_Choices,
Process_Empty_Choice => No_OP,
Process_Non_Static_Choice => Non_Static_Choice_Error,
Process_Associated_Node => Process_Statements);

9
gcc/ada/sem_ch6.adb
View File

@ -9100,7 +9100,12 @@ package body Sem_Ch6 is
Iface_Prim : Entity_Id;
Prim : Entity_Id) return Boolean
is
Iface : constant Entity_Id := Find_Dispatching_Type (Iface_Prim);
-- The operation may in fact be an inherited (implicit) operation
-- rather than the original interface primitive, so retrieve the
-- ultimate ancestor.
Iface : constant Entity_Id :=
Find_Dispatching_Type (Ultimate_Alias (Iface_Prim));
Typ : constant Entity_Id := Find_Dispatching_Type (Prim);
function Controlling_Formal (Prim : Entity_Id) return Entity_Id;
@ -9185,7 +9190,7 @@ package body Sem_Ch6 is
return False;
else
return
Type_Conformant (Prim, Iface_Prim,
Type_Conformant (Prim, Ultimate_Alias (Iface_Prim),
Skip_Controlling_Formals => True);
end if;

21
gcc/ada/sem_ch7.adb
View File

@ -1170,7 +1170,7 @@ package body Sem_Ch7 is
-- If one of the non-generic parents is itself on the scope
-- stack, do not install its private declarations: they are
-- installed in due time when the private part of that parent
-- is analyzed.
-- is analyzed. This is delicate ???
else
while Present (Inst_Par)
@ -1178,20 +1178,11 @@ package body Sem_Ch7 is
and then (not In_Open_Scopes (Inst_Par)
or else not In_Private_Part (Inst_Par))
loop
if Nkind (Inst_Node) = N_Formal_Package_Declaration
or else
not Is_Ancestor_Package
(Inst_Par, Cunit_Entity (Current_Sem_Unit))
then
Install_Private_Declarations (Inst_Par);
Set_Use (Private_Declarations
(Specification
(Unit_Declaration_Node (Inst_Par))));
Inst_Par := Scope (Inst_Par);
else
exit;
end if;
Install_Private_Declarations (Inst_Par);
Set_Use (Private_Declarations
(Specification
(Unit_Declaration_Node (Inst_Par))));
Inst_Par := Scope (Inst_Par);
end loop;
exit;

12
gcc/ada/sinfo.ads
View File

@ -3084,6 +3084,12 @@ package Sinfo is
-- Present_Expr (Uint3-Sem)
-- Dcheck_Function (Node5-Sem)
-- Note: in the list of Discrete_Choices, the tree passed to the back
-- end does not have choice entries corresponding to names of statically
-- predicated subtypes. Such entries are always expanded out to the list
-- of equivalent values or ranges. The ASIS tree generated in -gnatct
-- mode does not have this expansion, and has the original choices.
---------------------------------
-- 3.8.1 Discrete Choice List --
---------------------------------
@ -4382,6 +4388,12 @@ package Sinfo is
-- Discrete_Choices (List4)
-- Statements (List3)
-- Note: in the list of Discrete_Choices, the tree passed to the back
-- end does not have choice entries corresponding to names of statically
-- predicated subtypes. Such entries are always expanded out to the list
-- of equivalent values or ranges. The ASIS tree generated in -gnatct
-- mode does not have this expansion, and has the original choices.
-------------------------
-- 5.5 Loop Statement --
-------------------------