OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

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.

From-SVN: r207034
This commit is contained in:
Arnaud Charlet 2014-01-24 15:27:22 +01:00
parent 7610fee82a
commit 08cd7c2fcf
14 changed files with 258 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
gcc/ada/ChangeLog
View File

@ -1,3 +1,65 @@
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.

21
gcc/ada/a-taside.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -83,6 +83,16 @@ package body Ada.Task_Identification is
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 --
-----------------
@ -106,6 +116,15 @@ package body Ada.Task_Identification is
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 --
-----------

7
gcc/ada/a-taside.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
@ -53,6 +53,9 @@ package Ada.Task_Identification is
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
@ -63,6 +66,8 @@ package Ada.Task_Identification is
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;

56
gcc/ada/exp_util.adb
View File

@ -106,6 +106,10 @@ package body Exp_Util is
-- 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;
@ -1835,28 +1839,7 @@ package body Exp_Util is
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.
@ -1878,6 +1861,32 @@ package body Exp_Util is
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 --
---------------------
@ -2067,8 +2076,7 @@ package body Exp_Util is
-- 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

41
gcc/ada/prj-ext.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -66,12 +66,39 @@ package body Prj.Ext is
(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));
@ -87,11 +114,13 @@ package body Prj.Ext is
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;
@ -105,7 +134,7 @@ package body Prj.Ext is
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;

8
gcc/ada/prj-ext.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -68,11 +68,13 @@ package Prj.Ext is
(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;

3
gcc/ada/prj-proc.adb
View File

@ -1969,7 +1969,8 @@ package body Prj.Proc is
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

2
gcc/ada/prj.adb
View File

@ -1838,7 +1838,7 @@ package body Prj is
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);

7
gcc/ada/s-osinte-android.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -354,7 +354,10 @@ package System.OS_Interface is
(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 --

8
gcc/ada/s-taskin.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -615,12 +615,14 @@ package System.Tasking is
-- 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

13
gcc/ada/sem.adb
View File

@ -1312,18 +1312,19 @@ package body Sem is
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.
@ -1393,7 +1394,7 @@ package body Sem is
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

63
gcc/ada/sem_attr.adb
View File

@ -6013,6 +6013,11 @@ package body Sem_Attr is
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;
@ -6086,6 +6091,7 @@ package body Sem_Attr is
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
@ -8826,12 +8832,8 @@ package body Sem_Attr is
-- Attribute Update is never static
------------
-- Update --
------------
when Attribute_Update =>
null;
return;
---------------
-- VADS_Size --
@ -10409,6 +10411,57 @@ package body Sem_Attr is
-- 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 --
---------

8
gcc/ada/sem_ch6.adb
View File

@ -2997,9 +2997,13 @@ package body Sem_Ch6 is
-- 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;

16
gcc/ada/sem_res.adb
View File

@ -10518,6 +10518,8 @@ package body Sem_Res is
Drange : constant Node_Id := Discrete_Range (N);
begin
Index_Type := Base_Type (Etype (Drange));
if Is_Entity_Name (Drange) then
Index_Subtype := Entity (Drange);
@ -10531,9 +10533,19 @@ package body Sem_Res is
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);