Skip to content

R
riscv-gcc-1
Commit 2cc7967f by Arnaud Charlet
Options

[multiple changes] 

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

	* sem_ch3.adb, exp_util.adb, sem_ch13.adb, exp_unst.adb: Minor
	reformatting.

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

	* sem_util.adb (Denotes_Iterator): Use root type to determine
	whether the ultimate ancestor is the predefined iterator
	interface pakage.
	* exp_ch5.adb (Expand_Iterator_Over_Container): simplify code
	and avoid reuse of Pack local variable.

2016-04-21  Olivier Hainque  <hainque@adacore.com>

	* system-vxworks-arm.ads, system-vxworks-sparcv9.ads,
	system-vxworks-ppc.ads, system-vxworks-m68k.ads,
	system-vxworks-mips.ads, system-vxworks-x86.ads: Define
	Executable_Extension to ".out".

From-SVN: r235304
parent 29a56f61
Showing with 122 additions and 54 deletions
gcc/ada/ChangeLog
2016-04-21 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch3.adb, exp_util.adb, sem_ch13.adb, exp_unst.adb: Minor
reformatting.
2016-04-21 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb (Denotes_Iterator): Use root type to determine
whether the ultimate ancestor is the predefined iterator
interface pakage.
* exp_ch5.adb (Expand_Iterator_Over_Container): simplify code
and avoid reuse of Pack local variable.
2016-04-21 Olivier Hainque <hainque@adacore.com>
* system-vxworks-arm.ads, system-vxworks-sparcv9.ads,
system-vxworks-ppc.ads, system-vxworks-m68k.ads,
system-vxworks-mips.ads, system-vxworks-x86.ads: Define
Executable_Extension to ".out".
2016-04-21 Javier Miranda <miranda@adacore.com>
* frontend.adb: Update call to Unnest_Subprograms.
......
gcc/ada/exp_ch5.adb
......@@ -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- --
......@@ -3606,24 +3606,30 @@ package body Exp_Ch5 is
Container_Typ : Entity_Id)
is
Id : constant Entity_Id := Defining_Identifier (I_Spec);
Elem_Typ : constant Entity_Id := Etype (Id);
Id_Kind : constant Entity_Kind := Ekind (Id);
Loc : constant Source_Ptr := Sloc (N);
I_Kind : constant Entity_Kind := Ekind (Id);
Cursor : Entity_Id;
Iterator : Entity_Id;
New_Loop : Node_Id;
Stats : constant List_Id := Statements (N);
Element_Type : constant Entity_Id := Etype (Id);
Iter_Type : Entity_Id;
Pack : Entity_Id;
Cursor : Entity_Id;
Decl : Node_Id;
Iter_Type : Entity_Id;
Iterator : Entity_Id;
Name_Init : Name_Id;
Name_Step : Name_Id;
New_Loop : Node_Id;
Fast_Element_Access_Op, Fast_Step_Op : Entity_Id := Empty;
Fast_Element_Access_Op : Entity_Id := Empty;
Fast_Step_Op : Entity_Id := Empty;
-- Only for optimized version of "for ... of"
Iter_Pack : Entity_Id;
-- The package in which the iterator interface is instantiated. This is
-- typically an instance within the container package.
Pack : Entity_Id;
-- The package in which the container type is declared
begin
-- Determine the advancement and initialization steps for the cursor.
-- Analysis of the expanded loop will verify that the container has a
......@@ -3658,8 +3664,6 @@ package body Exp_Ch5 is
Pack := Scope (Container_Typ);
end if;
Iter_Type := Etype (Name (I_Spec));
if Of_Present (I_Spec) then
Handle_Of : declare
Container_Arg : Node_Id;
......@@ -3734,6 +3738,8 @@ package body Exp_Ch5 is
end if;
end Get_Default_Iterator;
-- Local variables
Default_Iter : Entity_Id;
Ent : Entity_Id;
......@@ -3760,6 +3766,12 @@ package body Exp_Ch5 is
Iter_Type := Etype (Default_Iter);
-- The iterator type, which is a class-wide type, may itself be
-- derived locally, so the desired instantiation is the scope of
-- the root type of the iterator type.
Iter_Pack := Scope (Root_Type (Etype (Iter_Type)));
-- Find declarations needed for "for ... of" optimization
Ent := First_Entity (Pack);
......@@ -3798,28 +3810,35 @@ package body Exp_Ch5 is
New_List (New_Copy_Tree (Container_Arg)))));
end if;
-- The iterator type, which is a class-wide type, may itself be
-- derived locally, so the desired instantiation is the scope of
-- the root type of the iterator type. Currently, Pack is the
-- container instance; this overwrites it with the iterator
-- package.
Pack := Scope (Root_Type (Etype (Iter_Type)));
-- Rewrite domain of iteration as a call to the default iterator
-- for the container type.
-- for the container type. The formal may be an access parameter
-- in which case we must build a reference to the container.
declare
Arg : Node_Id;
begin
if Is_Access_Type (Etype (First_Entity (Default_Iter))) then
Arg :=
Make_Attribute_Reference (Loc,
Prefix => Container_Arg,
Attribute_Name => Name_Unrestricted_Access);
else
Arg := Container_Arg;
end if;
Rewrite (Name (I_Spec),
Make_Function_Call (Loc,
Name =>
New_Occurrence_Of (Default_Iter, Loc),
Parameter_Associations => New_List (Container_Arg)));
Parameter_Associations => New_List (Arg)));
end;
Analyze_And_Resolve (Name (I_Spec));
-- Find cursor type in proper iterator package, which is an
-- instantiation of Iterator_Interfaces.
Ent := First_Entity (Pack);
Ent := First_Entity (Iter_Pack);
while Present (Ent) loop
if Chars (Ent) = Name_Cursor then
Set_Etype (Cursor, Etype (Ent));
......@@ -3834,7 +3853,7 @@ package body Exp_Ch5 is
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Id,
Subtype_Mark =>
New_Occurrence_Of (Element_Type, Loc),
New_Occurrence_Of (Elem_Typ, Loc),
Name =>
Make_Explicit_Dereference (Loc,
Prefix =>
......@@ -3849,7 +3868,7 @@ package body Exp_Ch5 is
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Id,
Subtype_Mark =>
New_Occurrence_Of (Element_Type, Loc),
New_Occurrence_Of (Elem_Typ, Loc),
Name =>
Make_Indexed_Component (Loc,
Prefix => Relocate_Node (Container_Arg),
......@@ -3857,8 +3876,8 @@ package body Exp_Ch5 is
New_List (New_Occurrence_Of (Cursor, Loc))));
end if;
-- The defining identifier in the iterator is user-visible
-- and must be visible in the debugger.
-- The defining identifier in the iterator is user-visible and
-- must be visible in the debugger.
Set_Debug_Info_Needed (Id);
......@@ -3878,18 +3897,25 @@ package body Exp_Ch5 is
Prepend_To (Stats, Decl);
end Handle_Of;
-- X in Iterate (S) : type of iterator is type of explicitly
-- given Iterate function, and the loop variable is the cursor.
-- It will be assigned in the loop and must be a variable.
-- X in Iterate (S) : type of iterator is type of explicitly given
-- Iterate function, and the loop variable is the cursor. It will be
-- assigned in the loop and must be a variable.
else
Iter_Type := Etype (Name (I_Spec));
-- The iterator type, which is a class-wide type, may itself be
-- derived locally, so the desired instantiation is the scope of
-- the root type of the iterator type, as in the "of" case.
Iter_Pack := Scope (Root_Type (Etype (Iter_Type)));
Cursor := Id;
end if;
Iterator := Make_Temporary (Loc, 'I');
-- For both iterator forms, add a call to the step operation to
-- advance the cursor. Generate:
-- For both iterator forms, add a call to the step operation to advance
-- the cursor. Generate:
-- Cursor := Iterator.Next (Cursor);
......@@ -3899,8 +3925,9 @@ package body Exp_Ch5 is
if Present (Fast_Element_Access_Op) and then Present (Fast_Step_Op) then
declare
Step_Call : Node_Id;
Curs_Name : constant Node_Id := New_Occurrence_Of (Cursor, Loc);
Step_Call : Node_Id;
begin
Step_Call :=
Make_Procedure_Call_Statement (Loc,
......@@ -3948,16 +3975,16 @@ package body Exp_Ch5 is
Condition =>
Make_Function_Call (Loc,
Name =>
New_Occurrence_Of (
Next_Entity (First_Entity (Pack)), Loc),
Parameter_Associations =>
New_List (New_Occurrence_Of (Cursor, Loc)))),
New_Occurrence_Of
(Next_Entity (First_Entity (Iter_Pack)), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Cursor, Loc)))),
Statements => Stats,
End_Label => Empty);
-- If present, preserve identifier of loop, which can be used in
-- an exit statement in the body.
-- If present, preserve identifier of loop, which can be used in an exit
-- statement in the body.
if Present (Identifier (N)) then
Set_Identifier (New_Loop, Relocate_Node (Identifier (N)));
......@@ -3984,7 +4011,8 @@ package body Exp_Ch5 is
New_Occurrence_Of (Etype (Cursor), Loc),
Expression =>
Make_Selected_Component (Loc,
Prefix => New_Occurrence_Of (Iterator, Loc),
Prefix =>
New_Occurrence_Of (Iterator, Loc),
Selector_Name =>
Make_Identifier (Loc, Name_Init)));
......@@ -3999,7 +4027,7 @@ package body Exp_Ch5 is
Set_Assignment_OK (Cursor_Decl);
Insert_Action (N, Cursor_Decl);
Set_Ekind (Cursor, I_Kind);
Set_Ekind (Cursor, Id_Kind);
end;
-- If the range of iteration is given by a function call that returns
......
gcc/ada/exp_unst.adb
......@@ -1721,7 +1721,6 @@ package body Exp_Unst is
------------------------
procedure Unnest_Subprograms (N : Node_Id) is
function Search_Subprograms (N : Node_Id) return Traverse_Result;
-- Tree visitor that search for outer level procedures with nested
-- subprograms and invokes Unnest_Subprogram()
......@@ -1732,9 +1731,7 @@ package body Exp_Unst is
function Search_Subprograms (N : Node_Id) return Traverse_Result is
begin
if Nkind_In (N, N_Subprogram_Body,
N_Subprogram_Body_Stub)
then
if Nkind_In (N, N_Subprogram_Body, N_Subprogram_Body_Stub) then
declare
Spec_Id : constant Entity_Id := Unique_Defining_Entity (N);
......
gcc/ada/exp_util.adb
......@@ -1728,11 +1728,12 @@ package body Exp_Util is
----------------------------------------
function Containing_Package_With_Ext_Axioms
(E : Entity_Id) return Entity_Id is
(E : Entity_Id) return Entity_Id
is
begin
-- E is the package or generic package which is externally axiomatized
if Ekind_In (E, E_Package, E_Generic_Package)
if Ekind_In (E, E_Generic_Package, E_Package)
and then Has_Annotate_Pragma_For_External_Axiomatization (E)
then
return E;
......@@ -1758,6 +1759,7 @@ package body Exp_Util is
declare
Par : constant Node_Id := Parent (E);
Decl : Node_Id;
begin
if Nkind (Par) = N_Defining_Program_Unit_Name then
Decl := Parent (Par);
......
gcc/ada/sem_ch13.adb
......@@ -8439,10 +8439,10 @@ package body Sem_Ch13 is
-- are present in expression.
FDecl : Node_Id;
-- The function declaration.
-- The function declaration
SId : Entity_Id;
-- Its entity.
-- Its entity
Raise_Expression_Present : Boolean := False;
-- Set True if Expr has at least one Raise_Expression
......@@ -8725,6 +8725,7 @@ package body Sem_Ch13 is
Add_Call (Atyp);
end if;
end;
-- Add Predicates for the current type
Add_Predicates;
......@@ -9065,7 +9066,8 @@ package body Sem_Ch13 is
Loc : constant Source_Ptr := Sloc (Typ);
Object_Entity : constant Entity_Id :=
Make_Defining_Identifier (Loc, Chars => New_Internal_Name ('I'));
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('I'));
-- The formal parameter of the function
......@@ -12613,6 +12615,7 @@ package body Sem_Ch13 is
then
Find_Selected_Component (Parent (N));
end if;
return Skip;
elsif Nkind (N) = N_Identifier and then Chars (N) /= Chars (E) then
......@@ -12625,6 +12628,8 @@ package body Sem_Ch13 is
procedure Resolve_Aspect_Expression is new Traverse_Proc (Resolve_Name);
-- Start of processing for Resolve_Aspect_Expressions
begin
ASN := First_Rep_Item (E);
while Present (ASN) loop
......@@ -12645,7 +12650,7 @@ package body Sem_Ch13 is
when Aspect_Static_Predicate |
Aspect_Dynamic_Predicate =>
-- build predicate function specification and preanalyze
-- Build predicate function specification and preanalyze
-- expression after type replacement.
if No (Predicate_Function (E)) then
......
gcc/ada/sem_ch3.adb
......@@ -11826,6 +11826,7 @@ package body Sem_Ch3 is
if Has_Predicates (Priv) then
Set_Has_Predicates (Full);
if Present (Predicate_Function (Priv))
and then No (Predicate_Function (Full))
then
......
gcc/ada/sem_util.adb
......@@ -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- --
......@@ -12650,11 +12650,14 @@ package body Sem_Util is
function Denotes_Iterator (Iter_Typ : Entity_Id) return Boolean is
begin
-- Check that the name matches, and that the ultimate ancestor is in
-- a predefined unit, i.e the one that declares iterator interfaces.
return
Nam_In (Chars (Iter_Typ), Name_Forward_Iterator,
Name_Reversible_Iterator)
and then Is_Predefined_File_Name
(Unit_File_Name (Get_Source_Unit (Iter_Typ)));
(Unit_File_Name (Get_Source_Unit (Root_Type (Iter_Typ))));
end Denotes_Iterator;
-- Local variables
......
gcc/ada/system-vxworks-arm.ads
......@@ -7,7 +7,7 @@
-- S p e c --
-- (VxWorks Version ARM) --
-- --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2016, 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 --
......@@ -161,4 +161,6 @@ private
Frontend_Exceptions : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Executable_Extension : constant String := ".out";
end System;
gcc/ada/system-vxworks-m68k.ads
......@@ -157,4 +157,6 @@ private
Frontend_Exceptions : constant Boolean := True;
ZCX_By_Default : constant Boolean := False;
Executable_Extension : constant String := ".out";
end System;
gcc/ada/system-vxworks-mips.ads
......@@ -157,4 +157,6 @@ private
Frontend_Exceptions : constant Boolean := True;
ZCX_By_Default : constant Boolean := False;
Executable_Extension : constant String := ".out";
end System;
gcc/ada/system-vxworks-ppc.ads
......@@ -164,4 +164,6 @@ private
Frontend_Exceptions : constant Boolean := True;
ZCX_By_Default : constant Boolean := False;
Executable_Extension : constant String := ".out";
end System;
gcc/ada/system-vxworks-sparcv9.ads
......@@ -159,4 +159,6 @@ private
Frontend_Exceptions : constant Boolean := True;
ZCX_By_Default : constant Boolean := False;
Executable_Extension : constant String := ".out";
end System;
gcc/ada/system-vxworks-x86.ads
......@@ -161,4 +161,6 @@ private
Frontend_Exceptions : constant Boolean := True;
ZCX_By_Default : constant Boolean := False;
Executable_Extension : constant String := ".out";
end System;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment