Skip to content

R
riscv-gcc-1
Commit ba08ba84 by Arnaud Charlet
Options

[multiple changes] 

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
parent d2a6bd6b
Showing with 168 additions and 24 deletions
gcc/ada/ChangeLog
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> 2013-02-06 Ed Schonberg <schonberg@adacore.com>
* checks.adb (Apply_Discriminant_Check): Look for discriminant * checks.adb (Apply_Discriminant_Check): Look for discriminant
......
gcc/ada/exp_ch5.adb
...@@ -1754,13 +1754,18 @@ package body Exp_Ch5 is ...@@ -1754,13 +1754,18 @@ package body Exp_Ch5 is
declare declare
Loop_Spec : constant Node_Id := Loop_Spec : constant Node_Id :=
Loop_Parameter_Specification (Scheme); Loop_Parameter_Specification (Scheme);
Subt_Def : constant Node_Id :=
Discrete_Subtype_Definition (Loop_Spec);
Cond : Node_Id; Cond : Node_Id;
Subt_Def : Node_Id;
begin begin
-- At this point in the expansion all discrete subtype definitions Subt_Def := Discrete_Subtype_Definition (Loop_Spec);
-- should be transformed into ranges.
-- 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); pragma Assert (Nkind (Subt_Def) = N_Range);
......
gcc/ada/prj-conf.adb
...@@ -599,6 +599,7 @@ package body Prj.Conf is ...@@ -599,6 +599,7 @@ package body Prj.Conf is
procedure Get_Or_Create_Configuration_File procedure Get_Or_Create_Configuration_File
(Project : Project_Id; (Project : Project_Id;
Conf_Project : Project_Id;
Project_Tree : Project_Tree_Ref; Project_Tree : Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref; Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment; Env : in out Prj.Tree.Environment;
...@@ -860,7 +861,7 @@ package body Prj.Conf is ...@@ -860,7 +861,7 @@ package body Prj.Conf is
Obj_Dir : constant Variable_Value := Obj_Dir : constant Variable_Value :=
Value_Of Value_Of
(Name_Object_Dir, (Name_Object_Dir,
Project.Decl.Attributes, Conf_Project.Decl.Attributes,
Shared); Shared);
Gprconfig_Path : String_Access; Gprconfig_Path : String_Access;
...@@ -874,10 +875,10 @@ package body Prj.Conf is ...@@ -874,10 +875,10 @@ package body Prj.Conf is
("could not locate gprconfig for auto-configuration"); ("could not locate gprconfig for auto-configuration");
end if; 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 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 else
if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
...@@ -886,7 +887,7 @@ package body Prj.Conf is ...@@ -886,7 +887,7 @@ package body Prj.Conf is
else else
Name_Len := 0; Name_Len := 0;
Add_Str_To_Name_Buffer 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)); Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
end if; end if;
end if; end if;
...@@ -1627,6 +1628,42 @@ package body Prj.Conf is ...@@ -1627,6 +1628,42 @@ package body Prj.Conf is
Main_Config_Project : Project_Id; Main_Config_Project : Project_Id;
Success : Boolean; 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 begin
Main_Project := No_Project; Main_Project := No_Project;
Automatically_Generated := False; Automatically_Generated := False;
...@@ -1682,11 +1719,25 @@ package body Prj.Conf is ...@@ -1682,11 +1719,25 @@ package body Prj.Conf is
Read_Source_Info_File (Project_Tree); Read_Source_Info_File (Project_Tree);
end if; 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 -- Find configuration file
Get_Or_Create_Configuration_File Get_Or_Create_Configuration_File
(Config => Main_Config_Project, (Config => Main_Config_Project,
Project => Main_Project, Project => Main_Project,
Conf_Project => Conf_Project,
Project_Tree => Project_Tree, Project_Tree => Project_Tree,
Project_Node_Tree => Project_Node_Tree, Project_Node_Tree => Project_Node_Tree,
Env => Env, Env => Env,
......
gcc/ada/prj-conf.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -119,6 +119,7 @@ package Prj.Conf is ...@@ -119,6 +119,7 @@ package Prj.Conf is
procedure Get_Or_Create_Configuration_File procedure Get_Or_Create_Configuration_File
(Project : Prj.Project_Id; (Project : Prj.Project_Id;
Conf_Project : Project_Id;
Project_Tree : Prj.Project_Tree_Ref; Project_Tree : Prj.Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref; Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment; Env : in out Prj.Tree.Environment;
...@@ -134,7 +135,9 @@ package Prj.Conf is ...@@ -134,7 +135,9 @@ package Prj.Conf is
On_Load_Config : Config_File_Hook := null); On_Load_Config : Config_File_Hook := null);
-- Compute the name of the configuration file that should be used. If no -- Compute the name of the configuration file that should be used. If no
-- default configuration file is found, a new one will be automatically -- 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 -- Any error in generating or parsing the config file is reported via the
-- Invalid_Config exception, with an appropriate message. -- Invalid_Config exception, with an appropriate message.
...@@ -160,7 +163,7 @@ package Prj.Conf is ...@@ -160,7 +163,7 @@ package Prj.Conf is
-- --
-- If a project file could be found, it is automatically parsed and -- If a project file could be found, it is automatically parsed and
-- processed (and Packages_To_Check is used to indicate which packages -- processed (and Packages_To_Check is used to indicate which packages
-- should be processed) -- should be processed).
procedure Add_Default_GNAT_Naming_Scheme procedure Add_Default_GNAT_Naming_Scheme
(Config_File : in out Prj.Tree.Project_Node_Id; (Config_File : in out Prj.Tree.Project_Node_Id;
......
gcc/ada/s-os_lib.adb
...@@ -1688,7 +1688,7 @@ package body System.OS_Lib is ...@@ -1688,7 +1688,7 @@ package body System.OS_Lib is
Res (J) := '"'; Res (J) := '"';
Quote_Needed := True; Quote_Needed := True;
elsif Arg (K) = ' ' then elsif Arg (K) = ' ' or else Arg (K) = ASCII.HT then
Res (J) := Arg (K); Res (J) := Arg (K);
Quote_Needed := True; Quote_Needed := True;
......
gcc/ada/sem_attr.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -9821,6 +9821,18 @@ package body Sem_Attr is ...@@ -9821,6 +9821,18 @@ package body Sem_Attr is
when Attribute_Enabled => when Attribute_Enabled =>
null; 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 -- -- Mechanism_Code --
-------------------- --------------------
......
gcc/ada/sem_ch12.adb
...@@ -10452,7 +10452,8 @@ package body Sem_Ch12 is ...@@ -10452,7 +10452,8 @@ package body Sem_Ch12 is
T : constant Entity_Id := Get_Instance_Of (Gen_T); T : constant Entity_Id := Get_Instance_Of (Gen_T);
begin 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)) and then Subtypes_Statically_Match (T, Act_T))
or else (Is_Class_Wide_Type (Gen_T) or else (Is_Class_Wide_Type (Gen_T)
...@@ -10701,21 +10702,14 @@ package body Sem_Ch12 is ...@@ -10701,21 +10702,14 @@ package body Sem_Ch12 is
-- the test to handle this special case only after a direct check -- the test to handle this special case only after a direct check
-- for static matching has failed. The case where both the component -- for static matching has failed. The case where both the component
-- type and the array type are separate formals, and 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 if Subtypes_Match
(Component_Type (A_Gen_T), Component_Type (Act_T)) (Component_Type (A_Gen_T), Component_Type (Act_T))
or else Subtypes_Match or else Subtypes_Match
(Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T), (Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T),
Component_Type (Act_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 then
null; null;
else else
......
gcc/ada/sem_res.adb
...@@ -3409,7 +3409,46 @@ package body Sem_Res is ...@@ -3409,7 +3409,46 @@ package body Sem_Res is
Generate_Reference (Orig_A, A, 'm'); Generate_Reference (Orig_A, A, 'm');
elsif not Is_Overloaded (A) then 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; end if;
end if; end if;
......
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