From ba08ba8412fb405d32184021400e1eda7b38b9a5 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 6 Feb 2013 11:19:04 +0100 Subject: [PATCH] [multiple changes] 2013-02-06 Hristian Kirtchev * 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 * s-os_lib.adb (Normalize_Arguments): Arguments containing tabs should be quoted 2013-02-06 Vincent Celier * 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 * 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 * 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 * sem_ch12.adb: Code clean up. From-SVN: r195792 --- gcc/ada/ChangeLog | 40 ++++++++++++++++++++++++++++++ gcc/ada/exp_ch5.adb | 13 +++++++--- gcc/ada/prj-conf.adb | 59 +++++++++++++++++++++++++++++++++++++++++--- gcc/ada/prj-conf.ads | 9 ++++--- gcc/ada/s-os_lib.adb | 2 +- gcc/ada/sem_attr.adb | 14 ++++++++++- gcc/ada/sem_ch12.adb | 14 +++-------- gcc/ada/sem_res.adb | 41 +++++++++++++++++++++++++++++- 8 files changed, 168 insertions(+), 24 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e7b259a0afc..31af157165d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,43 @@ +2013-02-06 Hristian Kirtchev + + * 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 + + * s-os_lib.adb (Normalize_Arguments): Arguments containing tabs should + be quoted + +2013-02-06 Vincent Celier + + * 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 + + * 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 + + * 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 + + * sem_ch12.adb: Code clean up. + 2013-02-06 Ed Schonberg * checks.adb (Apply_Discriminant_Check): Look for discriminant diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 2bdb82797ab..66a795964f6 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -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); diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 42b91570b5e..c5f0381f57b 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -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, diff --git a/gcc/ada/prj-conf.ads b/gcc/ada/prj-conf.ads index f283c6ed2b3..7154e55d23a 100644 --- a/gcc/ada/prj-conf.ads +++ b/gcc/ada/prj-conf.ads @@ -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; diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index fbd3813355e..f893c8acf55 100644 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -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; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 6247952843e..c2a298bbdf8 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -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 -- -------------------- diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index fad6ae0b004..39ac6a90192 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -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 diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 9a4084b05f1..9dd29188192 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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; -- 2.30.2