+2014-10-20 Vincent Celier <celier@adacore.com>
+
+ * 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 (<language>).
+ (Set_Default_Runtime_For): New procedure to store the default
+ value of a Runtime (<language>) in table Runtime_Defaults.
+ (Expression): Use the value stored in table Runtime_Defaults as
+ the default for Runtime (<language>).
+ * prj-proc.ads (Set_Default_Runtime_For): New procedure.
+ * prj.ads (Attribute_Default_Value): New enumerated value
+ Runtime_Value.
+
+2014-10-20 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <schonberg@adacore.com>
+
+ * gnat_ugn.texi: Minor reformatting.
+
2014-10-20 Tristan Gingold <gingold@adacore.com>
* init.c (__gnat_is_stack_guard): Don't use mach_vm_region_recurse on
@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
"Saobject_generated#" &
"Saobjects_linked#" &
"SVtargetDtarget_value#" &
+ "SaruntimeDruntime_value#" &
-- Configuration - Libraries
-- If Target_Name is empty, get the specified target in the project
-- file, if any.
+ procedure Get_Project_Runtimes;
+ -- Get the various Runtime (<lang>) 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
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 --
-----------------------
Config := No_Project;
Get_Project_Target;
+ Get_Project_Runtimes;
Check_Builder_Switches;
-- Do not attempt to find a configuration project file when
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.
(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 =>
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;
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;
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(<Language>) when Runtime (<language>) is not declared.
end Prj.Proc;
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.
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);
projects / gcc.git / commitdiff