From bdafba6f354d0f34b464a9168c7eb152adbc2445 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 20 Oct 2014 16:32:17 +0200 Subject: [PATCH] [multiple changes] 2014-10-20 Vincent Celier * prj-attr.adb: New project level attribute Runtime. * prj-conf.adb (Get_Project_Runtimes): New procedure to get the attributes Runtime declared in the main project, to use in auto-configuration. (Get_Or_Create_Configuration_File): Call Get_Project_Runtimes. * prj-proc.adb (Runtime_Defaults): New table to store the default values of attributes Runtime (). (Set_Default_Runtime_For): New procedure to store the default value of a Runtime () in table Runtime_Defaults. (Expression): Use the value stored in table Runtime_Defaults as the default for Runtime (). * prj-proc.ads (Set_Default_Runtime_For): New procedure. * prj.ads (Attribute_Default_Value): New enumerated value Runtime_Value. 2014-10-20 Ed Schonberg * sem_ch3.adb (Analyze_Object_Declaration): If the type is an unconstrained unchecked_union type, rewrite declaration as a renaming to prevent attempt to retrieve non- existent discriminants from expression. 2014-10-20 Ed Schonberg * gnat_ugn.texi: Minor reformatting. From-SVN: r216479 --- gcc/ada/ChangeLog | 28 ++++++++++++++++++++++++++++ gcc/ada/gnat_ugn.texi | 2 +- gcc/ada/prj-attr.adb | 1 + gcc/ada/prj-conf.adb | 37 +++++++++++++++++++++++++++++++++++++ gcc/ada/prj-proc.adb | 33 ++++++++++++++++++++++++++++++++- gcc/ada/prj-proc.ads | 3 +++ gcc/ada/prj.ads | 3 ++- gcc/ada/sem_ch3.adb | 26 ++++++++++++++++++++++++++ 8 files changed, 130 insertions(+), 3 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1665487ea47..a27cae15192 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,31 @@ +2014-10-20 Vincent Celier + + * prj-attr.adb: New project level attribute Runtime. + * prj-conf.adb (Get_Project_Runtimes): New procedure to get + the attributes Runtime declared in the main project, to use + in auto-configuration. + (Get_Or_Create_Configuration_File): Call Get_Project_Runtimes. + * prj-proc.adb (Runtime_Defaults): New table to store + the default values of attributes Runtime (). + (Set_Default_Runtime_For): New procedure to store the default + value of a Runtime () in table Runtime_Defaults. + (Expression): Use the value stored in table Runtime_Defaults as + the default for Runtime (). + * prj-proc.ads (Set_Default_Runtime_For): New procedure. + * prj.ads (Attribute_Default_Value): New enumerated value + Runtime_Value. + +2014-10-20 Ed Schonberg + + * sem_ch3.adb (Analyze_Object_Declaration): If the type is + an unconstrained unchecked_union type, rewrite declaration + as a renaming to prevent attempt to retrieve non- existent + discriminants from expression. + +2014-10-20 Ed Schonberg + + * gnat_ugn.texi: Minor reformatting. + 2014-10-20 Tristan Gingold * init.c (__gnat_is_stack_guard): Don't use mach_vm_region_recurse on diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index f586f87b17b..d38f0d799fb 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -8127,7 +8127,7 @@ Generate binder file suitable for CodePeer. @item -R @cindex @option{-R} (@command{gnatbind}) -Output closure source list, which includes all non-time-units that are +Output closure source list, which includes all non-runtime-units that are included in the bind. @item -Ra diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index d515c01a1b2..06777bb9e7a 100644 --- a/gcc/ada/prj-attr.adb +++ b/gcc/ada/prj-attr.adb @@ -136,6 +136,7 @@ package body Prj.Attr is "Saobject_generated#" & "Saobjects_linked#" & "SVtargetDtarget_value#" & + "SaruntimeDruntime_value#" & -- Configuration - Libraries diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 206fa4c7228..0be49a079fb 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -660,6 +660,10 @@ package body Prj.Conf is -- If Target_Name is empty, get the specified target in the project -- file, if any. + procedure Get_Project_Runtimes; + -- Get the various Runtime () in the project file or any project + -- it extends, if any are specified. + function Get_Config_Switches return Argument_List_Access; -- Return the --config switches to use for gprconfig @@ -833,6 +837,38 @@ package body Prj.Conf is end if; end Get_Project_Target; + -------------------------- + -- Get_Project_Runtimes -- + -------------------------- + + procedure Get_Project_Runtimes is + Element : Array_Element; + Id : Array_Element_Id; + Lang : Name_Id; + Proj : Project_Id; + + begin + Proj := Project; + + while Proj /= No_Project loop + Id := Value_Of (Name_Runtime, Proj.Decl.Arrays, Shared); + + while Id /= No_Array_Element loop + Element := Shared.Array_Elements.Table (Id); + Lang := Element.Index; + + if not Runtime_Name_Set_For (Lang) then + Set_Runtime_For + (Lang, RTS_Name => Get_Name_String (Element.Value.Value)); + end if; + + Id := Element.Next; + end loop; + + Proj := Proj.Extends; + end loop; + end Get_Project_Runtimes; + ----------------------- -- Default_File_Name -- ----------------------- @@ -1384,6 +1420,7 @@ package body Prj.Conf is Config := No_Project; Get_Project_Target; + Get_Project_Runtimes; Check_Builder_Switches; -- Do not attempt to find a configuration project file when diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 2b865a27fd7..dbb77144104 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -63,6 +63,15 @@ package body Prj.Proc is Equal => "="); -- This hash table contains all processed projects + package Runtime_Defaults is new GNAT.HTable.Simple_HTable + (Header_Num => Prj.Header_Num, + Element => Name_Id, + No_Element => No_Name, + Key => Name_Id, + Hash => Prj.Hash, + Equal => "="); + -- Stores the default values of 'Runtime names for the various languages + procedure Add (To_Exp : in out Name_Id; Str : Name_Id); -- Concatenate two strings and returns another string if both -- arguments are not null string. @@ -943,6 +952,16 @@ package body Prj.Proc is (Opt.Target_Value.all); The_Variable.Value := Name_Find; end if; + + when Runtime_Value => + Get_Name_String (Index); + To_Lower (Name_Buffer (1 .. Name_Len)); + The_Variable.Value := + Runtime_Defaults.Get (Name_Find); + if The_Variable.Value = No_Name then + The_Variable.Value := Empty_String; + end if; + end case; when List => @@ -957,7 +976,9 @@ package body Prj.Proc is The_Variable.Values := Shared.Dot_String_List; - when Object_Dir_Value | Target_Value => + when Object_Dir_Value | + Target_Value | + Runtime_Value => null; end case; end case; @@ -3126,4 +3147,14 @@ package body Prj.Proc is end if; end Recursive_Process; + ----------------------------- + -- Set_Default_Runtime_For -- + ----------------------------- + + procedure Set_Default_Runtime_For (Language : Name_Id; Value : String) is + begin + Name_Len := Value'Length; + Name_Buffer (1 .. Name_Len) := Value; + Runtime_Defaults.Set (Language, Name_Find); + end Set_Default_Runtime_For; end Prj.Proc; diff --git a/gcc/ada/prj-proc.ads b/gcc/ada/prj-proc.ads index 2b0680ebe52..0156df87f44 100644 --- a/gcc/ada/prj-proc.ads +++ b/gcc/ada/prj-proc.ads @@ -90,4 +90,7 @@ package Prj.Proc is On_New_Tree_Loaded : Tree_Loaded_Callback := null); -- Performs the two phases of the processing + procedure Set_Default_Runtime_For (Language : Name_Id; Value : String); + -- Set the default value for the runtime of Language. To be used for the + -- value of 'Runtime() when Runtime () is not declared. end Prj.Proc; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 1beff66a9da..804d88aa210 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -77,7 +77,8 @@ package Prj is Empty_Value, -- Empty string or empty string list Dot_Value, -- "." or (".") Object_Dir_Value, -- 'Object_Dir - Target_Value); -- 'Target (special rules) + Target_Value, -- 'Target (special rules) + Runtime_Value); -- 'Runtime (special rules) -- Describe the default values of attributes that are referenced but not -- declared. diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index b81d3636433..9294eb81fc7 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3839,6 +3839,32 @@ package body Sem_Ch3 is elsif GNATprove_Mode then null; + -- If the type is an unchecked union, no subtype can be built from + -- the expression. Rewrite declaration as a renaming, which the + -- back-end can handle properly. This is a rather unusual case, + -- because most unchecked_union declarations have default values + -- for discriminants and are thus unconstrained. + + elsif Is_Unchecked_Union (T) then + if Constant_Present (N) + or else Nkind (E) = N_Function_Call + then + Set_Ekind (Id, E_Constant); + else + Set_Ekind (Id, E_Variable); + end if; + + Rewrite (N, + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => Id, + Subtype_Mark => New_Occurrence_Of (T, Loc), + Name => E)); + + Set_Renamed_Object (Id, E); + Freeze_Before (N, T); + Set_Is_Frozen (Id); + return; + else Expand_Subtype_From_Expr (N, T, Object_Definition (N), E); Act_T := Find_Type_Of_Object (Object_Definition (N), N); -- 2.30.2