* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@195792
138bc75d-0d04-0410-961f-
82ee72b054a4
+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
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);
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;
Obj_Dir : constant Variable_Value :=
Value_Of
(Name_Object_Dir,
- Project.Decl.Attributes,
+ Conf_Project.Decl.Attributes,
Shared);
Gprconfig_Path : String_Access;
("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
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;
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;
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,
-- --
-- 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- --
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;
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.
--
-- 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;
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;
-- --
-- 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- --
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 --
--------------------
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)
-- 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
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;
OSDN Git Service
