Skip to content

R
riscv-gcc-1
Commit ca7e6c26 by Arnaud Charlet
Options

[multiple changes] 

2015-10-26  Hristian Kirtchev  <kirtchev@adacore.com>

	* inline.adb: Minor reformatting.

2015-10-26  Yannick Moy  <moy@adacore.com>

	* get_spark_xrefs.adb (get_SPARK_Xrefs): Remove obsolete
	assertion.
	* lib-xref-spark_specific.adb (Traverse_Declaration_Or_Statement):
	New procedure to factor duplicated code and add
	treatment of protected entries.
	(Add_SPARK_Scope, Traverse_Declarations_Or_Statements): Call the new
	procedure Traverse_Declaration_Or_Statement. Use same character used in
	normal xrefs for SPARK xrefs, for a given entity used as scope.
	* spark_xrefs.ads Document character used for entries.
	* sem_prag.adb (Check_Loop_Pragma_Placement): Account for possible
	introduction of declarations and statements by the expansion, between
	two otherwise consecutive loop pragmas.
	* sem_util.ads, sem_util.adb (Is_Suspension_Object): Lifted from nested
	function.
	(Is_Descendant_Of_Suspension_Object): nested function lifted.

2015-10-26  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_attr.adb (Eval_Attribute): Attribute 'Enum_Rep can be folded
	when its prefix denotes a constant, an enumeration literal or
	an enumeration type. Use the expression of the attribute in the
	enumeration type form, otherwise use the prefix to fold.

From-SVN: r229334
parent f99ff327
Showing with 145 additions and 66 deletions
gcc/ada/ChangeLog
2015-10-26 Hristian Kirtchev <kirtchev@adacore.com> 2015-10-26 Hristian Kirtchev <kirtchev@adacore.com>
* inline.adb: Minor reformatting.
2015-10-26 Yannick Moy <moy@adacore.com>
* get_spark_xrefs.adb (get_SPARK_Xrefs): Remove obsolete
assertion.
* lib-xref-spark_specific.adb (Traverse_Declaration_Or_Statement):
New procedure to factor duplicated code and add
treatment of protected entries.
(Add_SPARK_Scope, Traverse_Declarations_Or_Statements): Call the new
procedure Traverse_Declaration_Or_Statement. Use same character used in
normal xrefs for SPARK xrefs, for a given entity used as scope.
* spark_xrefs.ads Document character used for entries.
* sem_prag.adb (Check_Loop_Pragma_Placement): Account for possible
introduction of declarations and statements by the expansion, between
two otherwise consecutive loop pragmas.
* sem_util.ads, sem_util.adb (Is_Suspension_Object): Lifted from nested
function.
(Is_Descendant_Of_Suspension_Object): nested function lifted.
2015-10-26 Hristian Kirtchev <kirtchev@adacore.com>
* sem_attr.adb (Eval_Attribute): Attribute 'Enum_Rep can be folded
when its prefix denotes a constant, an enumeration literal or
an enumeration type. Use the expression of the attribute in the
enumeration type form, otherwise use the prefix to fold.
2015-10-26 Hristian Kirtchev <kirtchev@adacore.com>
* aspects.adb Add an entry for entry bodies in table * aspects.adb Add an entry for entry bodies in table
Has_Aspect_Specifications_Flag. Has_Aspect_Specifications_Flag.
(Aspects_On_Body_Or_Stub_OK): Entry bodies now allow for certain (Aspects_On_Body_Or_Stub_OK): Entry bodies now allow for certain
......
gcc/ada/get_spark_xrefs.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2011-2013, Free Software Foundation, Inc. -- -- Copyright (C) 2011-2015, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -293,9 +293,6 @@ begin ...@@ -293,9 +293,6 @@ begin
Col := Get_Nat; Col := Get_Nat;
pragma Assert (Scope = Cur_Scope); pragma Assert (Scope = Cur_Scope);
pragma Assert (Typ = 'K'
or else Typ = 'V'
or else Typ = 'U');
-- Scan out scope entity name -- Scan out scope entity name
......
gcc/ada/inline.adb
...@@ -3462,14 +3462,12 @@ package body Inline is ...@@ -3462,14 +3462,12 @@ package body Inline is
if Nkind (D) = N_Package_Declaration then if Nkind (D) = N_Package_Declaration then
Cannot_Inline Cannot_Inline
("cannot inline & (nested package declaration)?", ("cannot inline & (nested package declaration)?", D, Subp);
D, Subp);
return True; return True;
elsif Nkind (D) = N_Package_Instantiation then elsif Nkind (D) = N_Package_Instantiation then
Cannot_Inline Cannot_Inline
("cannot inline & (nested package instantiation)?", ("cannot inline & (nested package instantiation)?", D, Subp);
D, Subp);
return True; return True;
end if; end if;
...@@ -3482,8 +3480,7 @@ package body Inline is ...@@ -3482,8 +3480,7 @@ package body Inline is
or else Nkind (D) = N_Single_Task_Declaration or else Nkind (D) = N_Single_Task_Declaration
then then
Cannot_Inline Cannot_Inline
("cannot inline & (nested task type declaration)?", ("cannot inline & (nested task type declaration)?", D, Subp);
D, Subp);
return True; return True;
elsif Nkind (D) = N_Protected_Type_Declaration elsif Nkind (D) = N_Protected_Type_Declaration
...@@ -3496,22 +3493,19 @@ package body Inline is ...@@ -3496,22 +3493,19 @@ package body Inline is
elsif Nkind (D) = N_Subprogram_Body then elsif Nkind (D) = N_Subprogram_Body then
Cannot_Inline Cannot_Inline
("cannot inline & (nested subprogram)?", ("cannot inline & (nested subprogram)?", D, Subp);
D, Subp);
return True; return True;
elsif Nkind (D) = N_Function_Instantiation elsif Nkind (D) = N_Function_Instantiation
and then not Is_Unchecked_Conversion (D) and then not Is_Unchecked_Conversion (D)
then then
Cannot_Inline Cannot_Inline
("cannot inline & (nested function instantiation)?", ("cannot inline & (nested function instantiation)?", D, Subp);
D, Subp);
return True; return True;
elsif Nkind (D) = N_Procedure_Instantiation then elsif Nkind (D) = N_Procedure_Instantiation then
Cannot_Inline Cannot_Inline
("cannot inline & (nested procedure instantiation)?", ("cannot inline & (nested procedure instantiation)?", D, Subp);
D, Subp);
return True; return True;
-- Subtype declarations with predicates will generate predicate -- Subtype declarations with predicates will generate predicate
...@@ -3535,9 +3529,8 @@ package body Inline is ...@@ -3535,9 +3529,8 @@ package body Inline is
or else A_Id = Aspect_Dynamic_Predicate or else A_Id = Aspect_Dynamic_Predicate
then then
Cannot_Inline Cannot_Inline
("cannot inline & " ("cannot inline & (subtype declaration with "
& "(subtype declaration with predicate)?", & "predicate)?", D, Subp);
D, Subp);
return True; return True;
end if; end if;
......
gcc/ada/sem_attr.adb
...@@ -7265,20 +7265,58 @@ package body Sem_Attr is ...@@ -7265,20 +7265,58 @@ package body Sem_Attr is
return; return;
end if; end if;
-- Special processing for cases where the prefix is an object. For -- Special processing for cases where the prefix is an object. For this
-- this purpose, a string literal counts as an object (attributes -- purpose, a string literal counts as an object (attributes of string
-- of string literals can only appear in generated code). -- literals can only appear in generated code).
if Is_Object_Reference (P) or else Nkind (P) = N_String_Literal then if Is_Object_Reference (P) or else Nkind (P) = N_String_Literal then
-- For Component_Size, the prefix is an array object, and we apply -- For Component_Size, the prefix is an array object, and we apply
-- the attribute to the type of the object. This is allowed for -- the attribute to the type of the object. This is allowed for both
-- both unconstrained and constrained arrays, since the bounds -- unconstrained and constrained arrays, since the bounds have no
-- have no influence on the value of this attribute. -- influence on the value of this attribute.
if Id = Attribute_Component_Size then if Id = Attribute_Component_Size then
P_Entity := Etype (P); P_Entity := Etype (P);
-- For Enum_Rep, evaluation depends on the nature of the prefix and
-- the optional argument.
elsif Id = Attribute_Enum_Rep then
if Is_Entity_Name (P) then
-- The prefix denotes a constant or an enumeration literal, the
-- attribute can be folded.
if Ekind_In (Entity (P), E_Constant, E_Enumeration_Literal) then
P_Entity := Etype (P);
-- The prefix denotes an enumeration type. Folding can occur
-- when the argument is a constant or an enumeration literal.
elsif Is_Enumeration_Type (Entity (P))
and then Present (E1)
and then Is_Entity_Name (E1)
and then Ekind_In (Entity (E1), E_Constant,
E_Enumeration_Literal)
then
P_Entity := Etype (P);
-- Otherwise the attribute must be expanded into a conversion
-- and evaluated at runtime.
else
Check_Expressions;
return;
end if;
-- Otherwise the attribute is illegal, do not attempt to perform
-- any kind of folding.
else
return;
end if;
-- For First and Last, the prefix is an array object, and we apply -- For First and Last, the prefix is an array object, and we apply
-- the attribute to the type of the array, but we need a constrained -- the attribute to the type of the array, but we need a constrained
-- type for this, so we use the actual subtype if available. -- type for this, so we use the actual subtype if available.
...@@ -7971,7 +8009,26 @@ package body Sem_Attr is ...@@ -7971,7 +8009,26 @@ package body Sem_Attr is
-- Enum_Rep -- -- Enum_Rep --
-------------- --------------
when Attribute_Enum_Rep => when Attribute_Enum_Rep => Enum_Rep : declare
Val : Node_Id;
begin
-- The attribute appears in the form
-- Enum_Typ'Enum_Rep (Const)
-- Enum_Typ'Enum_Rep (Enum_Lit)
if Present (E1) then
Val := E1;
-- Otherwise the prefix denotes a constant or enumeration literal
-- Const'Enum_Rep
-- Enum_Lit'Enum_Rep
else
Val := P;
end if;
-- For an enumeration type with a non-standard representation use -- For an enumeration type with a non-standard representation use
-- the Enumeration_Rep field of the proper constant. Note that this -- the Enumeration_Rep field of the proper constant. Note that this
...@@ -7983,15 +8040,16 @@ package body Sem_Attr is ...@@ -7983,15 +8040,16 @@ package body Sem_Attr is
if Is_Enumeration_Type (P_Type) if Is_Enumeration_Type (P_Type)
and then Has_Non_Standard_Rep (P_Type) and then Has_Non_Standard_Rep (P_Type)
then then
Fold_Uint (N, Enumeration_Rep (Expr_Value_E (E1)), Static); Fold_Uint (N, Enumeration_Rep (Expr_Value_E (Val)), Static);
-- For enumeration types with standard representations and all -- For enumeration types with standard representations and all other
-- other cases (i.e. all integer and modular types), Enum_Rep -- cases (i.e. all integer and modular types), Enum_Rep is equivalent
-- is equivalent to Pos. -- to Pos.
else else
Fold_Uint (N, Expr_Value (E1), Static); Fold_Uint (N, Expr_Value (Val), Static);
end if; end if;
end Enum_Rep;
-------------- --------------
-- Enum_Val -- -- Enum_Val --
......
gcc/ada/sem_prag.adb
...@@ -4833,6 +4833,12 @@ package body Sem_Prag is ...@@ -4833,6 +4833,12 @@ package body Sem_Prag is
elsif Is_Loop_Pragma (Stmt) then elsif Is_Loop_Pragma (Stmt) then
Prag := Stmt; Prag := Stmt;
-- Skip declarations and statements generated by
-- the compiler during expansion.
elsif not Comes_From_Source (Stmt) then
null;
-- A non-pragma is separating the group from the -- A non-pragma is separating the group from the
-- current pragma, the placement is illegal. -- current pragma, the placement is illegal.
......
gcc/ada/sem_util.adb
...@@ -11309,40 +11309,9 @@ package body Sem_Util is ...@@ -11309,40 +11309,9 @@ package body Sem_Util is
function Is_Descendant_Of_Suspension_Object function Is_Descendant_Of_Suspension_Object
(Typ : Entity_Id) return Boolean (Typ : Entity_Id) return Boolean
is is
function Is_Suspension_Object (Id : Entity_Id) return Boolean;
-- Determine whether arbitrary entity Id denotes Suspension_Object
-- defined in Ada.Synchronous_Task_Control.
--------------------------
-- Is_Suspension_Object --
--------------------------
function Is_Suspension_Object (Id : Entity_Id) return Boolean is
begin
-- This approach does an exact name match rather than to rely on
-- RTSfind. Routine Is_Effectively_Volatile is used by clients of
-- the front end at point where all auxiliary tables are locked
-- and any modifications to them are treated as violations. Do not
-- tamper with the tables, instead examine the Chars fields of all
-- the scopes of Id.
return
Chars (Id) = Name_Suspension_Object
and then Present (Scope (Id))
and then Chars (Scope (Id)) = Name_Synchronous_Task_Control
and then Present (Scope (Scope (Id)))
and then Chars (Scope (Scope (Id))) = Name_Ada
and then Present (Scope (Scope (Scope (Id))))
and then Scope (Scope (Scope (Id))) = Standard_Standard;
end Is_Suspension_Object;
-- Local variables
Cur_Typ : Entity_Id; Cur_Typ : Entity_Id;
Par_Typ : Entity_Id; Par_Typ : Entity_Id;
-- Start of processing for Is_Descendant_Of_Suspension_Object
begin begin
-- Climb the type derivation chain checking each parent type against -- Climb the type derivation chain checking each parent type against
-- Suspension_Object. -- Suspension_Object.
...@@ -13161,6 +13130,28 @@ package body Sem_Util is ...@@ -13161,6 +13130,28 @@ package body Sem_Util is
and then Ekind (Defining_Entity (N)) /= E_Subprogram_Body; and then Ekind (Defining_Entity (N)) /= E_Subprogram_Body;
end Is_Subprogram_Stub_Without_Prior_Declaration; end Is_Subprogram_Stub_Without_Prior_Declaration;
--------------------------
-- Is_Suspension_Object --
--------------------------
function Is_Suspension_Object (Id : Entity_Id) return Boolean is
begin
-- This approach does an exact name match rather than to rely on
-- RTSfind. Routine Is_Effectively_Volatile is used by clients of the
-- front end at point where all auxiliary tables are locked and any
-- modifications to them are treated as violations. Do not tamper with
-- the tables, instead examine the Chars fields of all the scopes of Id.
return
Chars (Id) = Name_Suspension_Object
and then Present (Scope (Id))
and then Chars (Scope (Id)) = Name_Synchronous_Task_Control
and then Present (Scope (Scope (Id)))
and then Chars (Scope (Scope (Id))) = Name_Ada
and then Present (Scope (Scope (Scope (Id))))
and then Scope (Scope (Scope (Id))) = Standard_Standard;
end Is_Suspension_Object;
--------------------------------- ---------------------------------
-- Is_Synchronized_Tagged_Type -- -- Is_Synchronized_Tagged_Type --
--------------------------------- ---------------------------------
......
gcc/ada/sem_util.ads
...@@ -1503,6 +1503,10 @@ package Sem_Util is ...@@ -1503,6 +1503,10 @@ package Sem_Util is
-- Return True if N is a subprogram stub with no prior subprogram -- Return True if N is a subprogram stub with no prior subprogram
-- declaration. -- declaration.
function Is_Suspension_Object (Id : Entity_Id) return Boolean;
-- Determine whether arbitrary entity Id denotes Suspension_Object defined
-- in Ada.Synchronous_Task_Control.
function Is_Synchronized_Tagged_Type (E : Entity_Id) return Boolean; function Is_Synchronized_Tagged_Type (E : Entity_Id) return Boolean;
-- Returns True if E is a synchronized tagged type (AARM 3.9.4 (6/2)) -- Returns True if E is a synchronized tagged type (AARM 3.9.4 (6/2))
......
gcc/ada/spark_xrefs.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2011-2014, Free Software Foundation, Inc. -- -- Copyright (C) 2011-2015, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -111,9 +111,10 @@ package SPARK_Xrefs is ...@@ -111,9 +111,10 @@ package SPARK_Xrefs is
-- type is a single letter identifying the type of the entity, using -- type is a single letter identifying the type of the entity, using
-- the same code as in cross-references: -- the same code as in cross-references:
-- K = package -- K = package (k = generic package)
-- V = function -- V = function (v = generic function)
-- U = procedure -- U = procedure (u = generic procedure)
-- Y = entry
-- col is the column number of the scope entity -- col is the column number of the scope entity
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment