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

[multiple changes]

Browse source 
2013-02-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch5.adb (Expand_Loop_Entry_Attributes): When
	dealing with a for loop that iterates over a subtype indication
	with a range, use the low and high bounds of the subtype.

2013-02-06  Nicolas Roche  <roche@adacore.com>

	* s-os_lib.adb (Normalize_Arguments): Arguments containing tabs should
	be quoted

2013-02-06  Vincent Celier  <celier@adacore.com>

	* prj-conf.adb (Process_Project_And_Apply_Config): New variable
	Conf_Project.  New recursive procedure Check_Project to find a non
	aggregate project and put its Project_Id in Conf_Project. Fails if
	no such project can be found.
	(Get_Or_Create_Configuration_File): New parameter Conf_Project.
	 (Do_Autoconf): Use project directory of project Conf_Project to store
	the generated configuration project file.
	* prj-conf.ads (Get_Or_Create_Configuration_File): New parameter
	Conf_Project.

2013-02-06  Javier Miranda  <miranda@adacore.com>

	* sem_res.adb (Resolve_Actuals): Generate a read
	reference for out-mode parameters in the cases specified by
	RM 6.4.1(12).

2013-02-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_attr.adb (Resolve_Attribute): Do not resolve the prefix of
	Loop_Entry, instead wait until the attribute has been expanded. The
	delay ensures that any generated checks or temporaries are inserted
	before the relocated prefix.

2013-02-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb: Code clean up.

From-SVN: r195792
This commit is contained in:
Arnaud Charlet 2013-02-06 11:19:04 +01:00
parent d2a6bd6bb5
commit ba08ba8412
8 changed files with 168 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
gcc/ada/ChangeLog
View file

@ -1,3 +1,43 @@
2013-02-06 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch5.adb (Expand_Loop_Entry_Attributes): When
dealing with a for loop that iterates over a subtype indication
with a range, use the low and high bounds of the subtype.
2013-02-06 Nicolas Roche <roche@adacore.com>
* s-os_lib.adb (Normalize_Arguments): Arguments containing tabs should
be quoted
2013-02-06 Vincent Celier <celier@adacore.com>
* prj-conf.adb (Process_Project_And_Apply_Config): New variable
Conf_Project. New recursive procedure Check_Project to find a non
aggregate project and put its Project_Id in Conf_Project. Fails if
no such project can be found.
(Get_Or_Create_Configuration_File): New parameter Conf_Project.
(Do_Autoconf): Use project directory of project Conf_Project to store
the generated configuration project file.
* prj-conf.ads (Get_Or_Create_Configuration_File): New parameter
Conf_Project.
2013-02-06 Javier Miranda <miranda@adacore.com>
* sem_res.adb (Resolve_Actuals): Generate a read
reference for out-mode parameters in the cases specified by
RM 6.4.1(12).
2013-02-06 Hristian Kirtchev <kirtchev@adacore.com>
* sem_attr.adb (Resolve_Attribute): Do not resolve the prefix of
Loop_Entry, instead wait until the attribute has been expanded. The
delay ensures that any generated checks or temporaries are inserted
before the relocated prefix.
2013-02-06 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb: Code clean up.
2013-02-06 Ed Schonberg <schonberg@adacore.com>
* checks.adb (Apply_Discriminant_Check): Look for discriminant

13
gcc/ada/exp_ch5.adb
View file

@ -1754,13 +1754,18 @@ package body Exp_Ch5 is
declare
Loop_Spec : constant Node_Id :=
Loop_Parameter_Specification (Scheme);
Subt_Def : constant Node_Id :=
Discrete_Subtype_Definition (Loop_Spec);
Cond : Node_Id;
Subt_Def : Node_Id;
begin
-- At this point in the expansion all discrete subtype definitions
-- should be transformed into ranges.
Subt_Def := Discrete_Subtype_Definition (Loop_Spec);
-- When the loop iterates over a subtype indication with a range,
-- use the low and high bounds of the subtype itself.
if Nkind (Subt_Def) = N_Subtype_Indication then
Subt_Def := Scalar_Range (Etype (Subt_Def));
end if;
pragma Assert (Nkind (Subt_Def) = N_Range);

59
gcc/ada/prj-conf.adb
View file

@ -599,6 +599,7 @@ package body Prj.Conf is
procedure Get_Or_Create_Configuration_File
(Project : Project_Id;
Conf_Project : Project_Id;
Project_Tree : Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
@ -860,7 +861,7 @@ package body Prj.Conf is
Obj_Dir : constant Variable_Value :=
Value_Of
(Name_Object_Dir,
Project.Decl.Attributes,
Conf_Project.Decl.Attributes,
Shared);
Gprconfig_Path : String_Access;
@ -874,10 +875,10 @@ package body Prj.Conf is
("could not locate gprconfig for auto-configuration");
end if;
-- First, find the object directory of the user's project
-- First, find the object directory of the Conf_Project
if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
Get_Name_String (Project.Directory.Display_Name);
Get_Name_String (Conf_Project.Directory.Display_Name);
else
if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
@ -886,7 +887,7 @@ package body Prj.Conf is
else
Name_Len := 0;
Add_Str_To_Name_Buffer
(Get_Name_String (Project.Directory.Display_Name));
(Get_Name_String (Conf_Project.Directory.Display_Name));
Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
end if;
end if;
@ -1627,6 +1628,42 @@ package body Prj.Conf is
Main_Config_Project : Project_Id;
Success : Boolean;
Conf_Project : Project_Id := No_Project;
-- The object directory of this project will be used to store the config
-- project file in auto-configuration. Set by procedure Check_Project
-- below.
procedure Check_Project (Project : Project_Id);
-- Look for a non aggregate project. If one is found, put its project Id
-- in Conf_Project.
-------------------
-- Check_Project --
-------------------
procedure Check_Project (Project : Project_Id) is
begin
if Project.Qualifier = Aggregate
or else Project.Qualifier = Aggregate_Library
then
declare
List : Aggregated_Project_List :=
Project.Aggregated_Projects;
begin
-- Look for a non aggregate project until one is found
while Conf_Project = No_Project and then List /= null loop
Check_Project (List.Project);
List := List.Next;
end loop;
end;
else
Conf_Project := Project;
end if;
end Check_Project;
begin
Main_Project := No_Project;
Automatically_Generated := False;
@ -1682,11 +1719,25 @@ package body Prj.Conf is
Read_Source_Info_File (Project_Tree);
end if;
-- Get the first project that is not an aggregate project or an
-- aggregate library project. The object directory of this project will
-- be used to store the config project file in auto-configuration.
Check_Project (Main_Project);
-- Fail if there is only aggregate projects and aggregate library
-- projects in the project tree.
if Conf_Project = No_Project then
Raise_Invalid_Config ("there are no non-aggregate projects");
end if;
-- Find configuration file
Get_Or_Create_Configuration_File
(Config => Main_Config_Project,
Project => Main_Project,
Conf_Project => Conf_Project,
Project_Tree => Project_Tree,
Project_Node_Tree => Project_Node_Tree,
Env => Env,

9
gcc/ada/prj-conf.ads
View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2006-2012, Free Software Foundation, Inc. --
-- Copyright (C) 2006-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- --
@ -119,6 +119,7 @@ package Prj.Conf is
procedure Get_Or_Create_Configuration_File
(Project : Prj.Project_Id;
Conf_Project : Project_Id;
Project_Tree : Prj.Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
@ -134,7 +135,9 @@ package Prj.Conf is
On_Load_Config : Config_File_Hook := null);
-- Compute the name of the configuration file that should be used. If no
-- default configuration file is found, a new one will be automatically
-- generated if Allow_Automatic_Generation is true.
-- generated if Allow_Automatic_Generation is true. This configuration
-- project file will be generated in the object directory of project
-- Conf_Project.
--
-- Any error in generating or parsing the config file is reported via the
-- Invalid_Config exception, with an appropriate message.
@ -160,7 +163,7 @@ package Prj.Conf is
--
-- If a project file could be found, it is automatically parsed and
-- processed (and Packages_To_Check is used to indicate which packages
-- should be processed)
-- should be processed).
procedure Add_Default_GNAT_Naming_Scheme
(Config_File : in out Prj.Tree.Project_Node_Id;

2
gcc/ada/s-os_lib.adb
View file

@ -1688,7 +1688,7 @@ package body System.OS_Lib is
Res (J) := '"';
Quote_Needed := True;
elsif Arg (K) = ' ' then
elsif Arg (K) = ' ' or else Arg (K) = ASCII.HT then
Res (J) := Arg (K);
Quote_Needed := True;

14
gcc/ada/sem_attr.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -9821,6 +9821,18 @@ package body Sem_Attr is
when Attribute_Enabled =>
null;
----------------
-- Loop_Entry --
----------------
-- Do not resolve the prefix of Loop_Entry, instead wait until the
-- attribute has been expanded (see Expand_Loop_Entry_Attributes).
-- The delay ensures that any generated checks or temporaries are
-- inserted before the relocated prefix.
when Attribute_Loop_Entry =>
null;
--------------------
-- Mechanism_Code --
--------------------

14
gcc/ada/sem_ch12.adb
View file

@ -10452,7 +10452,8 @@ package body Sem_Ch12 is
T : constant Entity_Id := Get_Instance_Of (Gen_T);
begin
return (Base_Type (T) = Base_Type (Act_T)
return ((Base_Type (T) = Act_T
or else Base_Type (T) = Base_Type (Act_T))
and then Subtypes_Statically_Match (T, Act_T))
or else (Is_Class_Wide_Type (Gen_T)
@ -10701,21 +10702,14 @@ package body Sem_Ch12 is
-- the test to handle this special case only after a direct check
-- for static matching has failed. The case where both the component
-- type and the array type are separate formals, and the component
-- type is a private view may also require special checking.
-- type is a private view may also require special checking in
-- Subtypes_Match.
if Subtypes_Match
(Component_Type (A_Gen_T), Component_Type (Act_T))
or else Subtypes_Match
(Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T),
Component_Type (Act_T))
or else
(Is_Private_Type (Component_Type (A_Gen_T))
and then not Has_Discriminants (Component_Type (A_Gen_T))
and then
Subtypes_Match
(Base_Type
(Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T)),
Component_Type (Act_T)))
then
null;
else

41
gcc/ada/sem_res.adb
View file

@ -3409,7 +3409,46 @@ package body Sem_Res is
Generate_Reference (Orig_A, A, 'm');
elsif not Is_Overloaded (A) then
Generate_Reference (Orig_A, A);
if Ekind (F) /= E_Out_Parameter then
Generate_Reference (Orig_A, A);
-- RM 6.4.1(12): For an out parameter that is passed by
-- copy, the formal parameter object is created, and:
-- * For an access type, the formal parameter is initialized
-- from the value of the actual, without checking that the
-- value satisfies any constraint, any predicate, or any
-- exclusion of the null value.
-- * For a scalar type that has the Default_Value aspect
-- specified, the formal parameter is initialized from the
-- value of the actual, without checking that the value
-- satisfies any constraint or any predicate;
-- * For a composite type with discriminants or that has
-- implicit initial values for any subcomponents, the
-- behavior is as for an in out parameter passed by copy.
-- Hence for these cases we generate the read reference now
-- (the write reference will be generated later by
-- Note_Possible_Modification).
elsif Is_By_Copy_Type (Etype (F))
and then
(Is_Access_Type (Etype (F))
or else
(Is_Scalar_Type (Etype (F))
and then
Present (Default_Aspect_Value (Etype (F))))
or else
(Is_Composite_Type (Etype (F))
and then
(Has_Discriminants (Etype (F))
or else
Is_Partially_Initialized_Type (Etype (F)))))
then
Generate_Reference (Orig_A, A);
end if;
end if;
end if;
end if;