+2014-01-24 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_attr.adb (Analyze_Attribute, case 'Update): Analyze
+ expressions in each component association, and for records note
+ the entity in each association choice, for subsequent resolution.
+ (Resolve_Attribute, case 'Update): Complete resolution of
+ expressions in each component association.
+
+2014-01-24 Robert Dewar <dewar@adacore.com>
+
+ * sem.adb (Sem): Avoid premature reference to Current_Sem_Unit
+ (this was causing Is_Main_Unit_Or_Main_Unit_Spec to be set wrong,
+ leading to wrong handling of SPARK_Mode for library units).
+
+2014-01-24 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Set SPARK_Mode
+ on generic instances (do not consider them to be internally
+ generated)
+
+2014-01-24 Doug Rupp <rupp@adacore.com>
+
+ * s-osinte-android.ads (pthread_sigmask): Import sigprocmask
+ vice pthread_sigmask.
+
+2014-01-24 Vincent Celier <celier@adacore.com>
+
+ * prj.adb (Debug_Output (Str, Str2)): Output if verbosity is
+ not default.
+
+2014-01-24 Vincent Celier <celier@adacore.com>
+
+ * prj-ext.adb (Add): Do not output anything when Silent is True,
+ whatever the verbosity. When Source is From_External_Attribute,
+ set the corresponding environment variable if it is not already set.
+ * prj-ext.ads (Add): New Boolean parameter Silent, defaulted
+ to False
+ * prj-proc.adb (Process_Expression_For_Associative_Array):
+ For attribute External, call Prj.Ext.Add with Silent set to
+ True for the child environment, to avoid useless output in non
+ default verbosity.
+
+2014-01-24 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_res.adb (Set_Slice_Subtype): Handle properly a discrete
+ range given by a subtype indication, and force evaluation of
+ the bounds, as for a simple range.
+ * exp_util.adb (Evaluate_Slice_Bounds): Utility to force evaluation
+ of bounds of slice for various kinds of discrete ranges.
+ (Evaluate_Name, Evaluate_Subtype_From_Expr): use
+ Evaluate_Slice_Bounds.
+
+2014-01-24 Bob Duff <duff@adacore.com>
+
+ * s-taskin.ads (Activator): Make this Atomic, because
+ Activation_Is_Complete reads it, and that can be called
+ from any task. Previously, this component was only
+ modified by the activator before activation, and by
+ Self after activation.
+ * a-taside.ads, a-taside.adb (Environment_Task,
+ Activation_Is_Complete): Implement these missing functions.
+
2014-01-24 Doug Rupp <rupp@adacore.com>
* init.c: Add a handler section for Android.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, 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- --
end if;
end Abort_Task;
+ ----------------------------
+ -- Activation_Is_Complete --
+ ----------------------------
+
+ function Activation_Is_Complete (T : Task_Id) return Boolean is
+ use type System.Tasking.Task_Id;
+ begin
+ return Convert_Ids (T).Common.Activator = null;
+ end Activation_Is_Complete;
+
-----------------
-- Convert_Ids --
-----------------
return Convert_Ids (System.Task_Primitives.Operations.Self);
end Current_Task;
+ ----------------------
+ -- Environment_Task --
+ ----------------------
+
+ function Environment_Task return Task_Id is
+ begin
+ return Convert_Ids (System.Task_Primitives.Operations.Environment_Task);
+ end Environment_Task;
+
-----------
-- Image --
-----------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
function Current_Task return Task_Id;
pragma Inline (Current_Task);
+ function Environment_Task return Task_Id;
+ pragma Inline (Environment_Task);
+
procedure Abort_Task (T : Task_Id);
pragma Inline (Abort_Task);
-- Note: parameter is mode IN, not IN OUT, per AI-00101
function Is_Callable (T : Task_Id) return Boolean;
pragma Inline (Is_Callable);
+ function Activation_Is_Complete (T : Task_Id) return Boolean;
+
private
type Task_Id is new System.Tasking.Task_Id;
-- record with task components, or for a dynamically created task that is
-- assigned to a selected component.
+ procedure Evaluate_Slice_Bounds (Slice : Node_Id);
+ -- Force evaluation of bounds of a slice, which may be given by a range
+ -- or by a subtype indication with or without a constraint.
+
function Make_CW_Equivalent_Type
(T : Entity_Id;
E : Node_Id) return Entity_Id;
elsif K = N_Slice then
Evaluate_Name (Prefix (Nam));
-
- declare
- DR : constant Node_Id := Discrete_Range (Nam);
- Constr : Node_Id;
- Rexpr : Node_Id;
-
- begin
- if Nkind (DR) = N_Range then
- Force_Evaluation (Low_Bound (DR));
- Force_Evaluation (High_Bound (DR));
-
- elsif Nkind (DR) = N_Subtype_Indication then
- Constr := Constraint (DR);
-
- if Nkind (Constr) = N_Range_Constraint then
- Rexpr := Range_Expression (Constr);
-
- Force_Evaluation (Low_Bound (Rexpr));
- Force_Evaluation (High_Bound (Rexpr));
- end if;
- end if;
- end;
+ Evaluate_Slice_Bounds (Nam);
-- For a type conversion, the expression of the conversion must be the
-- name of an object, and we simply need to evaluate this name.
end if;
end Evaluate_Name;
+ ---------------------------
+ -- Evaluate_Slice_Bounds --
+ ---------------------------
+
+ procedure Evaluate_Slice_Bounds (Slice : Node_Id) is
+ DR : constant Node_Id := Discrete_Range (Slice);
+ Constr : Node_Id;
+ Rexpr : Node_Id;
+
+ begin
+ if Nkind (DR) = N_Range then
+ Force_Evaluation (Low_Bound (DR));
+ Force_Evaluation (High_Bound (DR));
+
+ elsif Nkind (DR) = N_Subtype_Indication then
+ Constr := Constraint (DR);
+
+ if Nkind (Constr) = N_Range_Constraint then
+ Rexpr := Range_Expression (Constr);
+
+ Force_Evaluation (Low_Bound (Rexpr));
+ Force_Evaluation (High_Bound (Rexpr));
+ end if;
+ end if;
+ end Evaluate_Slice_Bounds;
+
---------------------
-- Evolve_And_Then --
---------------------
-- we better make sure that if a variable was used as a bound of
-- of the original slice, its value is frozen.
- Force_Evaluation (Low_Bound (Scalar_Range (Slice_Type)));
- Force_Evaluation (High_Bound (Scalar_Range (Slice_Type)));
+ Evaluate_Slice_Bounds (Exp);
end;
elsif Ekind (Exp_Typ) = E_String_Literal_Subtype then
-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-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- --
(Self : External_References;
External_Name : String;
Value : String;
- Source : External_Source := External_Source'First)
+ Source : External_Source := External_Source'First;
+ Silent : Boolean := False)
is
Key : Name_Id;
N : Name_To_Name_Ptr;
begin
+ -- For external attribute, set the environment variable
+
+ if Source = From_External_Attribute and then External_Name /= "" then
+ declare
+ Env_Var : String_Access := Getenv (External_Name);
+
+ begin
+ if Env_Var = null or else Env_Var.all = "" then
+ Setenv (Name => External_Name, Value => Value);
+
+ if not Silent then
+ Debug_Output
+ ("Environment variable """ & External_Name
+ & """ = """ & Value & '"');
+ end if;
+
+ elsif not Silent then
+ Debug_Output
+ ("Not overriding existing environment variable """
+ & External_Name & """, value is """ & Env_Var.all & '"');
+ end if;
+
+ Free (Env_Var);
+ end;
+ end if;
+
Name_Len := External_Name'Length;
Name_Buffer (1 .. Name_Len) := External_Name;
Canonical_Case_Env_Var_Name (Name_Buffer (1 .. Name_Len));
if External_Source'Pos (N.Source) <
External_Source'Pos (Source)
then
- if Current_Verbosity = High then
+ if not Silent then
Debug_Output
- ("Not overridding existing variable '" & External_Name
- & "', value was defined in " & N.Source'Img);
+ ("Not overridding existing external reference '"
+ & External_Name & "', value was defined in "
+ & N.Source'Img);
end if;
+
return;
end if;
end if;
Value => Name_Find,
Next => null);
- if Current_Verbosity = High then
+ if not Silent then
Debug_Output ("Add external (" & External_Name & ") is", N.Value);
end if;
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-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- --
(Self : External_References;
External_Name : String;
Value : String;
- Source : External_Source := External_Source'First);
+ Source : External_Source := External_Source'First;
+ Silent : Boolean := False);
-- Add an external reference (or modify an existing one). No overriding is
-- done if the Source's priority is less than the one used to previously
-- set the value of the variable. The default for Source is such that
- -- overriding always occurs.
+ -- overriding always occurs. When Silent is True, nothing is output even
+ -- with non default verbosity.
function Value_Of
(Self : External_References;
Add (Env.External,
External_Name => Get_Name_String (Index_Name),
Value => Get_Name_String (New_Value.Value),
- Source => From_External_Attribute);
+ Source => From_External_Attribute,
+ Silent => True);
else
if Current_Verbosity = High then
Debug_Output
procedure Debug_Output (Str : String; Str2 : Name_Id) is
begin
- if Current_Verbosity = High then
+ if Current_Verbosity > Default then
Debug_Indent;
Set_Standard_Error;
Write_Str (Str);
-- --
-- S p e c --
-- --
--- Copyright (C) 1995-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1995-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- --
(how : int;
set : access sigset_t;
oset : access sigset_t) return int;
- pragma Import (C, pthread_sigmask, "pthread_sigmask");
+ pragma Import (C, pthread_sigmask, "sigprocmask");
+ -- pthread_sigmask maybe be broken due to mismatch between sigset_t and
+ -- kernel_sigset_t, substitute sigprocmask temporarily. ???
+ -- pragma Import (C, pthread_sigmask, "pthread_sigmask");
--------------------------
-- POSIX.1c Section 11 --
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
-- Protection: Only used by Activator
Activator : Task_Id;
+ pragma Atomic (Activator);
-- The task that created this task, either by declaring it as a task
-- object or by executing a task allocator. The value is null iff Self
-- has completed activation.
--
- -- Protection: Set by Activator before Self is activated, and only read
- -- and modified by Self after that.
+ -- Protection: Set by Activator before Self is activated, and
+ -- only modified by Self after that. Can be read by any task via
+ -- Ada.Task_Identification.Activation_Is_Complete; hence Atomic.
Wait_Count : Natural;
-- This count is used by a task that is waiting for other tasks. At all
S_Outer_Gen_Scope : constant Entity_Id := Outer_Generic_Scope;
S_Style_Check : constant Boolean := Style_Check;
+ Curunit : constant Unit_Number_Type := Get_Cunit_Unit_Number (Comp_Unit);
+ -- New value of Current_Sem_Unit
+
Generic_Main : constant Boolean :=
- Nkind (Unit (Cunit (Main_Unit)))
- in N_Generic_Declaration;
+ Nkind (Unit (Cunit (Main_Unit))) in N_Generic_Declaration;
-- If the main unit is generic, every compiled unit, including its
-- context, is compiled with expansion disabled.
Is_Main_Unit_Or_Main_Unit_Spec : constant Boolean :=
- Current_Sem_Unit = Main_Unit
+ Curunit = Main_Unit
or else
(Nkind (Unit (Cunit (Main_Unit))) = N_Package_Body
- and then Library_Unit (Cunit (Main_Unit)) =
- Cunit (Current_Sem_Unit));
+ and then Library_Unit (Cunit (Main_Unit)) = Cunit (Curunit));
-- Configuration flags have special settings when compiling a predefined
-- file as a main unit. This applies to its spec as well.
end if;
Compiler_State := Analyzing;
- Current_Sem_Unit := Get_Cunit_Unit_Number (Comp_Unit);
+ Current_Sem_Unit := Curunit;
-- Compile predefined units with GNAT_Mode set to True, to properly
-- process the categorization stuff. However, do not set GNAT_Mode
Comp_Or_Discr := First_Entity (Typ);
while Present (Comp_Or_Discr) loop
if Chars (Comp_Or_Discr) = Comp_Name then
+
+ -- Record component entity in the given aggregate choice,
+ -- for subsequent resolution.
+
+ Set_Entity (Comp, Comp_Or_Discr);
exit;
end if;
Assoc := First (Component_Associations (E1));
while Present (Assoc) loop
Comp := First (Choices (Assoc));
+ Analyze (Expression (Assoc));
while Present (Comp) loop
if Nkind (Comp) = N_Others_Choice then
Error_Attr
-- Attribute Update is never static
- ------------
- -- Update --
- ------------
-
when Attribute_Update =>
- null;
+ return;
---------------
-- VADS_Size --
-- Processing is shared with Access
+ ------------
+ -- Update --
+ ------------
+
+ -- Resolve aggregate components in component associations
+
+ when Attribute_Update =>
+ declare
+ Aggr : constant Node_Id := First (Expressions (N));
+ Typ : constant Entity_Id := Etype (Prefix (N));
+ Assoc : Node_Id;
+ Comp : Node_Id;
+
+ begin
+ -- Set the Etype of the aggregate to that of the prefix, even
+ -- though the aggregate may not be a proper representation of a
+ -- value of the type (missing or duplicated associations, etc.)
+
+ Set_Etype (Aggr, Typ);
+
+ -- For an array type, resolve expressions with the component
+ -- type of the array.
+
+ if Is_Array_Type (Typ) then
+ Assoc := First (Component_Associations (Aggr));
+ while Present (Assoc) loop
+ Resolve (Expression (Assoc), Component_Type (Typ));
+ Next (Assoc);
+ end loop;
+
+ -- For a record type, use type of each component, which is
+ -- recorded during analysis.
+
+ else
+ Assoc := First (Component_Associations (Aggr));
+ while Present (Assoc) loop
+ Comp := First (Choices (Assoc));
+ if Nkind (Comp) /= N_Others_Choice
+ and then not Error_Posted (Comp)
+ then
+ Resolve (Expression (Assoc), Etype (Entity (Comp)));
+ end if;
+ Next (Assoc);
+ end loop;
+ end if;
+ end;
+
+ -- Premature return requires comment ???
+
+ return;
+
---------
-- Val --
---------
-- Set SPARK_Mode
- -- For internally generated subprogram, always off
+ -- For internally generated subprogram, always off. But generic
+ -- instances are not generated implicitly, so are never considered
+ -- as internal, even though Comes_From_Source is false.
- if not Comes_From_Source (Spec_Id) then
+ if not Comes_From_Source (Spec_Id)
+ and then not Is_Generic_Instance (Spec_Id)
+ then
SPARK_Mode := Off;
SPARK_Mode_Pragma := Empty;
Drange : constant Node_Id := Discrete_Range (N);
begin
+ Index_Type := Base_Type (Etype (Drange));
+
if Is_Entity_Name (Drange) then
Index_Subtype := Entity (Drange);
if Nkind (Drange) = N_Range then
Force_Evaluation (Low_Bound (Drange));
Force_Evaluation (High_Bound (Drange));
- end if;
- Index_Type := Base_Type (Etype (Drange));
+ -- If the discrete range is given by a subtype indication, the
+ -- type of the slice is the base of the subtype mark.
+
+ elsif Nkind (Drange) = N_Subtype_Indication then
+ declare
+ R : constant Node_Id := Range_Expression (Constraint (Drange));
+ begin
+ Index_Type := Base_Type (Entity (Subtype_Mark (Drange)));
+ Force_Evaluation (Low_Bound (R));
+ Force_Evaluation (High_Bound (R));
+ end;
+ end if;
Index_Subtype := Create_Itype (Subtype_Kind (Ekind (Index_Type)), N);
projects / thirdparty / gcc.git / commitdiff
