Skip to content

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

[multiple changes] 

2014-02-19  Yannick Moy  <moy@adacore.com>

	* sem_ch10.adb (Analyze_Proper_Body): Issue error on missing
	subunit in GNATprove_Mode.
	* sinfo.ads (GNATprove_Mode): Document error issued in GNATprove_Mode.

2014-02-19  Hristian Kirtchev  <kirtchev@adacore.com>

	* lib-xref.ads Alphabetize the contents of table
	Xref_Entity_Letters. Add an entry in table Xref_Entity_Letters
	for E_Abstract_State. List all letters and symbols in use.
	* sem_prag.adb (Analyze_Abstract_State): Update all calls
	to Create_Abstract_State to reflect the new signature.
	(Create_Abstract_State): Change subprogram profile and update
	the comment on usage. Use the proper location of the state
	declaration when creating a new abstract state entity. Do not
	generate an external name, but simply reuse the name coming from
	the state declaration.

From-SVN: r207884
parent 3a845e07
Showing with 127 additions and 109 deletions
gcc/ada/ChangeLog
2014-02-19 Yannick Moy <moy@adacore.com>
* sem_ch10.adb (Analyze_Proper_Body): Issue error on missing
subunit in GNATprove_Mode.
* sinfo.ads (GNATprove_Mode): Document error issued in GNATprove_Mode.
2014-02-19 Hristian Kirtchev <kirtchev@adacore.com>
* lib-xref.ads Alphabetize the contents of table
Xref_Entity_Letters. Add an entry in table Xref_Entity_Letters
for E_Abstract_State. List all letters and symbols in use.
* sem_prag.adb (Analyze_Abstract_State): Update all calls
to Create_Abstract_State to reflect the new signature.
(Create_Abstract_State): Change subprogram profile and update
the comment on usage. Use the proper location of the state
declaration when creating a new abstract state entity. Do not
generate an external name, but simply reuse the name coming from
the state declaration.
2014-02-19 Robert Dewar <dewar@adacore.com> 2014-02-19 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Expand_N_Expression_With_Actions): Make sure * exp_ch4.adb (Expand_N_Expression_With_Actions): Make sure
......
gcc/ada/lib-xref.ads
...@@ -433,95 +433,87 @@ package Lib.Xref is ...@@ -433,95 +433,87 @@ package Lib.Xref is
-- indicating procedures and functions. If the operation is abstract, -- indicating procedures and functions. If the operation is abstract,
-- these letters are replaced in the xref by 'x' and 'y' respectively. -- these letters are replaced in the xref by 'x' and 'y' respectively.
Xref_Entity_Letters : array (Entity_Kind) of Character := -- The following letters and symbols are currently in use:
(E_Void => ' ', -- A B C D E F I K L M N O P R S T U V W X Y
E_Variable => '*', -- a b c d e f i k l m n o p q r s t u v w x y
E_Component => '*', -- @ * + space
E_Constant => '*',
E_Discriminant => '*',
E_Loop_Parameter => '*',
E_In_Parameter => '*',
E_Out_Parameter => '*',
E_In_Out_Parameter => '*',
E_Generic_In_Out_Parameter => '*',
E_Generic_In_Parameter => '*',
E_Named_Integer => 'N',
E_Named_Real => 'N',
E_Enumeration_Type => 'E', -- B for boolean
E_Enumeration_Subtype => 'E', -- B for boolean
E_Signed_Integer_Type => 'I', Xref_Entity_Letters : array (Entity_Kind) of Character :=
E_Signed_Integer_Subtype => 'I', (E_Abstract_State => '@',
E_Modular_Integer_Type => 'M',
E_Modular_Integer_Subtype => 'M',
E_Ordinary_Fixed_Point_Type => 'O',
E_Ordinary_Fixed_Point_Subtype => 'O',
E_Decimal_Fixed_Point_Type => 'D',
E_Decimal_Fixed_Point_Subtype => 'D',
E_Floating_Point_Type => 'F',
E_Floating_Point_Subtype => 'F',
E_Access_Type => 'P',
E_Access_Subtype => 'P',
E_Access_Attribute_Type => 'P', E_Access_Attribute_Type => 'P',
E_Allocator_Type => ' ',
E_General_Access_Type => 'P',
E_Access_Subprogram_Type => 'P',
E_Access_Protected_Subprogram_Type => 'P', E_Access_Protected_Subprogram_Type => 'P',
E_Anonymous_Access_Subprogram_Type => ' ', E_Access_Subprogram_Type => 'P',
E_Access_Subtype => 'P',
E_Access_Type => 'P',
E_Allocator_Type => ' ',
E_Anonymous_Access_Protected_Subprogram_Type => ' ', E_Anonymous_Access_Protected_Subprogram_Type => ' ',
E_Anonymous_Access_Subprogram_Type => ' ',
E_Anonymous_Access_Type => ' ', E_Anonymous_Access_Type => ' ',
E_Array_Type => 'A',
E_Array_Subtype => 'A', E_Array_Subtype => 'A',
E_String_Type => 'S', E_Array_Type => 'A',
E_String_Subtype => 'S', E_Block => 'q',
E_String_Literal_Subtype => ' ',
E_Class_Wide_Type => 'C',
E_Class_Wide_Subtype => 'C', E_Class_Wide_Subtype => 'C',
E_Record_Type => 'R', E_Class_Wide_Type => 'C',
E_Record_Subtype => 'R', E_Component => '*',
E_Record_Type_With_Private => 'R', E_Constant => '*',
E_Decimal_Fixed_Point_Subtype => 'D',
E_Record_Subtype_With_Private => 'R', E_Decimal_Fixed_Point_Type => 'D',
E_Private_Type => '+', E_Discriminant => '*',
E_Private_Subtype => '+',
E_Limited_Private_Type => '+',
E_Limited_Private_Subtype => '+',
E_Incomplete_Type => '+',
E_Incomplete_Subtype => '+',
E_Task_Type => 'T',
E_Task_Subtype => 'T',
E_Protected_Type => 'W',
E_Protected_Subtype => 'W',
E_Exception_Type => ' ',
E_Subprogram_Type => ' ',
E_Enumeration_Literal => 'n',
E_Function => 'V',
E_Operator => 'V',
E_Procedure => 'U',
E_Entry => 'Y', E_Entry => 'Y',
E_Entry_Family => 'Y', E_Entry_Family => 'Y',
E_Block => 'q',
E_Entry_Index_Parameter => '*', E_Entry_Index_Parameter => '*',
E_Enumeration_Literal => 'n',
E_Enumeration_Subtype => 'E', -- B for boolean
E_Enumeration_Type => 'E', -- B for boolean
E_Exception => 'X', E_Exception => 'X',
E_Exception_Type => ' ',
E_Floating_Point_Subtype => 'F',
E_Floating_Point_Type => 'F',
E_Function => 'V',
E_General_Access_Type => 'P',
E_Generic_Function => 'v', E_Generic_Function => 'v',
E_Generic_In_Out_Parameter => '*',
E_Generic_In_Parameter => '*',
E_Generic_Package => 'k', E_Generic_Package => 'k',
E_Generic_Procedure => 'u', E_Generic_Procedure => 'u',
E_Label => 'L', E_Label => 'L',
E_Limited_Private_Subtype => '+',
E_Limited_Private_Type => '+',
E_Loop => 'l', E_Loop => 'l',
E_Return_Statement => ' ', E_Loop_Parameter => '*',
E_In_Out_Parameter => '*',
E_In_Parameter => '*',
E_Incomplete_Subtype => '+',
E_Incomplete_Type => '+',
E_Modular_Integer_Subtype => 'M',
E_Modular_Integer_Type => 'M',
E_Named_Integer => 'N',
E_Named_Real => 'N',
E_Operator => 'V',
E_Ordinary_Fixed_Point_Subtype => 'O',
E_Ordinary_Fixed_Point_Type => 'O',
E_Out_Parameter => '*',
E_Package => 'K', E_Package => 'K',
E_Private_Subtype => '+',
E_Private_Type => '+',
E_Procedure => 'U',
E_Protected_Subtype => 'W',
E_Protected_Type => 'W',
E_Record_Subtype => 'R',
E_Record_Subtype_With_Private => 'R',
E_Record_Type => 'R',
E_Record_Type_With_Private => 'R',
E_Return_Statement => ' ',
E_Signed_Integer_Subtype => 'I',
E_Signed_Integer_Type => 'I',
E_String_Literal_Subtype => ' ',
E_String_Subtype => 'S',
E_String_Type => 'S',
E_Subprogram_Type => ' ',
E_Task_Subtype => 'T',
E_Task_Type => 'T',
E_Variable => '*',
E_Void => ' ',
-- The following entities are not ones to which we gather the cross- -- The following entities are not ones to which we gather the cross-
-- references, since it does not make sense to do so (e.g. references to -- references, since it does not make sense to do so (e.g. references to
...@@ -529,15 +521,10 @@ package Lib.Xref is ...@@ -529,15 +521,10 @@ package Lib.Xref is
-- body entity is considered to be a reference to the spec entity. -- body entity is considered to be a reference to the spec entity.
E_Package_Body => ' ', E_Package_Body => ' ',
E_Protected_Object => ' ',
E_Protected_Body => ' ', E_Protected_Body => ' ',
E_Task_Body => ' ', E_Protected_Object => ' ',
E_Subprogram_Body => ' ', E_Subprogram_Body => ' ',
E_Task_Body => ' ');
-- ??? The following letter is added for completion, proper design and
-- implementation of abstract state cross-referencing to follow.
E_Abstract_State => ' ');
-- The following table is for information purposes. It shows the use of -- The following table is for information purposes. It shows the use of
-- each character appearing as an entity type. -- each character appearing as an entity type.
......
gcc/ada/sem_ch10.adb
...@@ -1563,8 +1563,9 @@ package body Sem_Ch10 is ...@@ -1563,8 +1563,9 @@ package body Sem_Ch10 is
procedure Optional_Subunit; procedure Optional_Subunit;
-- This procedure is called when the main unit is a stub, or when we -- This procedure is called when the main unit is a stub, or when we
-- are not generating code. In such a case, we analyze the subunit if -- are not generating code. In such a case, we analyze the subunit if
-- present, which is user-friendly and in fact required for ASIS, but -- present, which is user-friendly and in fact required for ASIS, but we
-- we don't complain if the subunit is missing. -- don't complain if the subunit is missing. In GNATprove_Mode, we issue
-- an error to avoid formal verification of a partial unit.
---------------------- ----------------------
-- Optional_Subunit -- -- Optional_Subunit --
...@@ -1579,18 +1580,18 @@ package body Sem_Ch10 is ...@@ -1579,18 +1580,18 @@ package body Sem_Ch10 is
-- ignore all errors. Note that Fatal_Error will still be set, so we -- ignore all errors. Note that Fatal_Error will still be set, so we
-- will be able to check for this case below. -- will be able to check for this case below.
if not ASIS_Mode then if not (ASIS_Mode or GNATprove_Mode) then
Ignore_Errors_Enable := Ignore_Errors_Enable + 1; Ignore_Errors_Enable := Ignore_Errors_Enable + 1;
end if; end if;
Unum := Unum :=
Load_Unit Load_Unit
(Load_Name => Subunit_Name, (Load_Name => Subunit_Name,
Required => False, Required => GNATprove_Mode,
Subunit => True, Subunit => True,
Error_Node => N); Error_Node => N);
if not ASIS_Mode then if not (ASIS_Mode or GNATprove_Mode) then
Ignore_Errors_Enable := Ignore_Errors_Enable - 1; Ignore_Errors_Enable := Ignore_Errors_Enable - 1;
end if; end if;
......
gcc/ada/sem_prag.adb
...@@ -9986,14 +9986,16 @@ package body Sem_Prag is ...@@ -9986,14 +9986,16 @@ package body Sem_Prag is
-- Opt is not a duplicate property and sets the flag Status. -- Opt is not a duplicate property and sets the flag Status.
procedure Create_Abstract_State procedure Create_Abstract_State
(State_Nam : Name_Id; (Nam : Name_Id;
State_Decl : Node_Id; Decl : Node_Id;
Is_Null : Boolean := False); Loc : Source_Ptr;
-- Generate an abstract state entity with name State_Nam and Is_Null : Boolean);
-- enter it into visibility. State_Decl is the "declaration" -- Generate an abstract state entity with name Nam and enter it
-- of the state as it appears in pragma Abstract_State. Flag -- into visibility. Decl is the "declaration" of the state as
-- Is_Null should be set when the associated Abstract_State -- it appears in pragma Abstract_State. Loc is the location of
-- pragma defines a null state. -- the related state "declaration". Flag Is_Null should be set
-- when the associated Abstract_State pragma defines a null
-- state.
----------------------------- -----------------------------
-- Analyze_External_Option -- -- Analyze_External_Option --
...@@ -10243,17 +10245,16 @@ package body Sem_Prag is ...@@ -10243,17 +10245,16 @@ package body Sem_Prag is
--------------------------- ---------------------------
procedure Create_Abstract_State procedure Create_Abstract_State
(State_Nam : Name_Id; (Nam : Name_Id;
State_Decl : Node_Id; Decl : Node_Id;
Is_Null : Boolean := False) Loc : Source_Ptr;
Is_Null : Boolean)
is is
begin begin
-- The generated state abstraction reuses the same chars -- The generated state abstraction reuses the same chars
-- from the original state declaration. Decorate the entity. -- from the original state declaration. Decorate the entity.
State_Id := State_Id := Make_Defining_Identifier (Loc, Nam);
Make_Defining_Identifier (Sloc (State),
Chars => New_External_Name (State_Nam));
-- Null states never come from source -- Null states never come from source
...@@ -10270,15 +10271,16 @@ package body Sem_Prag is ...@@ -10270,15 +10271,16 @@ package body Sem_Prag is
-- N_Null and does not carry any linkages. -- N_Null and does not carry any linkages.
if not Is_Null then if not Is_Null then
if Present (State_Decl) then if Present (Decl) then
Set_Entity (State_Decl, State_Id); Set_Entity (Decl, State_Id);
Set_Etype (State_Decl, Standard_Void_Type); Set_Etype (Decl, Standard_Void_Type);
end if; end if;
-- Every non-null state must be nameable and resolvable -- Every non-null state must be defined, nameable and
-- the same way a constant is. -- resolvable.
Push_Scope (Pack_Id); Push_Scope (Pack_Id);
Generate_Definition (State_Id);
Enter_Name (State_Id); Enter_Name (State_Id);
Pop_Scope; Pop_Scope;
end if; end if;
...@@ -10303,8 +10305,9 @@ package body Sem_Prag is ...@@ -10303,8 +10305,9 @@ package body Sem_Prag is
elsif Nkind (State) = N_Null then elsif Nkind (State) = N_Null then
Create_Abstract_State Create_Abstract_State
(State_Nam => New_Internal_Name ('S'), (Nam => New_Internal_Name ('S'),
State_Decl => Empty, Decl => Empty,
Loc => Sloc (State),
Is_Null => True); Is_Null => True);
Null_Seen := True; Null_Seen := True;
...@@ -10321,8 +10324,10 @@ package body Sem_Prag is ...@@ -10321,8 +10324,10 @@ package body Sem_Prag is
elsif Nkind (State) = N_Identifier then elsif Nkind (State) = N_Identifier then
Create_Abstract_State Create_Abstract_State
(State_Nam => Chars (State), (Nam => Chars (State),
State_Decl => State); Decl => State,
Loc => Sloc (State),
Is_Null => False);
Non_Null_Seen := True; Non_Null_Seen := True;
-- State declaration with various options. This construct -- State declaration with various options. This construct
...@@ -10331,8 +10336,10 @@ package body Sem_Prag is ...@@ -10331,8 +10336,10 @@ package body Sem_Prag is
elsif Nkind (State) = N_Extension_Aggregate then elsif Nkind (State) = N_Extension_Aggregate then
if Nkind (Ancestor_Part (State)) = N_Identifier then if Nkind (Ancestor_Part (State)) = N_Identifier then
Create_Abstract_State Create_Abstract_State
(State_Nam => Chars (Ancestor_Part (State)), (Nam => Chars (Ancestor_Part (State)),
State_Decl => Ancestor_Part (State)); Decl => Ancestor_Part (State),
Loc => Sloc (Ancestor_Part (State)),
Is_Null => False);
Non_Null_Seen := True; Non_Null_Seen := True;
else else
Error_Msg_N Error_Msg_N
......
gcc/ada/sinfo.ads
...@@ -552,6 +552,10 @@ package Sinfo is ...@@ -552,6 +552,10 @@ package Sinfo is
-- In addition pragma Debug statements are removed from the tree (rewritten -- In addition pragma Debug statements are removed from the tree (rewritten
-- to NULL stmt), since they should be taken into account in flow analysis. -- to NULL stmt), since they should be taken into account in flow analysis.
-- An error is also issued for missing subunits, similar to the warning
-- issued when generating code, to avoid formal verification of a partial
-- unit.
----------------------- -----------------------
-- Check Flag Fields -- -- Check Flag Fields --
----------------------- -----------------------
......
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