diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2013-02-06 11:19:04 +0100 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2013-02-06 11:19:04 +0100 |
commit | ba08ba8412fb405d32184021400e1eda7b38b9a5 (patch) | |
tree | 01734c0c31a488eec661db595718216b48859072 /gcc/ada | |
parent | d2a6bd6bb570c3ece919323e9a01fe3c2beec08d (diff) | |
download | gcc-ba08ba8412fb405d32184021400e1eda7b38b9a5.zip gcc-ba08ba8412fb405d32184021400e1eda7b38b9a5.tar.gz gcc-ba08ba8412fb405d32184021400e1eda7b38b9a5.tar.bz2 |
[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
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/ChangeLog | 40 | ||||
-rw-r--r-- | gcc/ada/exp_ch5.adb | 13 | ||||
-rw-r--r-- | gcc/ada/prj-conf.adb | 59 | ||||
-rw-r--r-- | gcc/ada/prj-conf.ads | 9 | ||||
-rw-r--r-- | gcc/ada/s-os_lib.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_attr.adb | 14 | ||||
-rw-r--r-- | gcc/ada/sem_ch12.adb | 14 | ||||
-rw-r--r-- | gcc/ada/sem_res.adb | 41 |
8 files changed, 168 insertions, 24 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e7b259a..31af157 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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 diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 2bdb827..66a7959 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 42b9157..c5f0381 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 f283c6e..7154e55 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 fbd3813..f893c8a 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 6247952..c2a298b 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 fad6ae0..39ac6a9 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 9a4084b..9dd2918 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; |