Skip to content

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

[multiple changes] 

2014-01-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Pragma): Ensure that
	the sole argument of pragmas Abstract_State, Contract_Cases,
	Depends, Global and Initializes in in aggregate form.
	(Analyze_Refined_Pragma): Ensure that the sole argument of
	pragmas Refined_Depends, Refined_Global and Refined_State is in
	aggregate form.
	(Ensure_Aggregate_Form): New routine.

2014-01-20  Doug Rupp  <rupp@adacore.com>

	* sem_attr.adb (Analyze_Attribute): case
	Attribute_Constrained => treat all prefixes as legal for Declib
	compatibility.

From-SVN: r206836
parent 9559eccf
Showing with 165 additions and 65 deletions
gcc/ada/ChangeLog
2014-01-20 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Pragma): Ensure that
the sole argument of pragmas Abstract_State, Contract_Cases,
Depends, Global and Initializes in in aggregate form.
(Analyze_Refined_Pragma): Ensure that the sole argument of
pragmas Refined_Depends, Refined_Global and Refined_State is in
aggregate form.
(Ensure_Aggregate_Form): New routine.
2014-01-20 Doug Rupp <rupp@adacore.com>
* sem_attr.adb (Analyze_Attribute): case
Attribute_Constrained => treat all prefixes as legal for Declib
compatibility.
2014-01-20 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Check_Mode): Reimplement the routine.
(Find_Mode): New routine.
......
gcc/ada/sem_attr.adb
......@@ -3037,6 +3037,15 @@ package body Sem_Attr is
and then Extensions_Allowed
then
return;
-- For compatibility with Declib code, treat all prefixes as
-- legal, including non-discriminated types.
-- ??? this non-conforming language extension needs documenting
-- ??? anyway it should not depend on Extend_System!
elsif Present (System_Extend_Unit) then
return;
end if;
end if;
......
gcc/ada/sem_prag.adb
-----------------------------------------------------------------------------
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
......@@ -449,39 +449,38 @@ package body Sem_Prag is
Subp_Id := Defining_Entity (Subp_Decl);
All_Cases := Get_Pragma_Arg (First (Pragma_Argument_Associations (N)));
-- Multiple contract cases appear in aggregate form
if Nkind (All_Cases) = N_Aggregate then
if No (Component_Associations (All_Cases)) then
Error_Msg_N ("wrong syntax for aspect Contract_Cases", N);
-- Single and multiple contract cases must appear in aggregate form. If
-- this is not the case, then either the parser of the analysis of the
-- pragma failed to produce an aggregate.
-- Individual contract cases appear as component associations
pragma Assert (Nkind (All_Cases) = N_Aggregate);
else
-- Ensure that the formal parameters are visible when analyzing
-- all clauses. This falls out of the general rule of aspects
-- pertaining to subprogram declarations. Skip the installation
-- for subprogram bodies because the formals are already visible.
if No (Component_Associations (All_Cases)) then
Error_Msg_N ("wrong syntax for aspect Contract_Cases", N);
if not In_Open_Scopes (Subp_Id) then
Restore_Scope := True;
Push_Scope (Subp_Id);
Install_Formals (Subp_Id);
end if;
-- Individual contract cases appear as component associations
CCase := First (Component_Associations (All_Cases));
while Present (CCase) loop
Analyze_Contract_Case (CCase);
Next (CCase);
end loop;
else
-- Ensure that the formal parameters are visible when analyzing all
-- clauses. This falls out of the general rule of aspects pertaining
-- to subprogram declarations. Skip the installation for subprogram
-- bodies because the formals are already visible.
if Restore_Scope then
End_Scope;
end if;
if not In_Open_Scopes (Subp_Id) then
Restore_Scope := True;
Push_Scope (Subp_Id);
Install_Formals (Subp_Id);
end if;
else
Error_Msg_N ("wrong syntax for aspect Contract_Cases", N);
CCase := First (Component_Associations (All_Cases));
while Present (CCase) loop
Analyze_Contract_Case (CCase);
Next (CCase);
end loop;
if Restore_Scope then
End_Scope;
end if;
end if;
end Analyze_Contract_Cases_In_Decl_Part;
......@@ -2577,32 +2576,26 @@ package body Sem_Prag is
Collect_States_And_Variables;
-- Multiple initialization clauses appear as an aggregate
-- Single and multiple initialization clauses must appear as an
-- aggregate. If this is not the case, then either the parser of
-- the analysis of the pragma failed to produce an aggregate.
if Nkind (Inits) = N_Aggregate then
if Present (Expressions (Inits)) then
Init := First (Expressions (Inits));
while Present (Init) loop
Analyze_Initialization_Item (Init);
Next (Init);
end loop;
end if;
pragma Assert (Nkind (Inits) = N_Aggregate);
if Present (Component_Associations (Inits)) then
Init := First (Component_Associations (Inits));
while Present (Init) loop
Analyze_Initialization_Item_With_Inputs (Init);
Next (Init);
end loop;
end if;
-- Various forms of a single initialization clause. Note that these may
-- include malformed initializations.
if Present (Expressions (Inits)) then
Init := First (Expressions (Inits));
while Present (Init) loop
Analyze_Initialization_Item (Init);
Next (Init);
end loop;
end if;
else
Analyze_Initialization_Item (Inits);
if Present (Component_Associations (Inits)) then
Init := First (Component_Associations (Inits));
while Present (Init) loop
Analyze_Initialization_Item_With_Inputs (Init);
Next (Init);
end loop;
end if;
end Analyze_Initializes_In_Decl_Part;
......@@ -2620,8 +2613,8 @@ package body Sem_Prag is
-- name may be different from the pragma name.
Pragma_Exit : exception;
-- This exception is used to exit pragma processing completely. It is
-- used when an error is detected, and no further processing is
-- This exception is used to exit pragma processing completely. It
-- is used when an error is detected, and no further processing is
-- required. It is also used if an earlier error has left the tree in
-- a state where the pragma should not be processed.
......@@ -2656,8 +2649,8 @@ package body Sem_Prag is
-- Subsidiary routine to the analysis of body pragmas Refined_Depends,
-- Refined_Global and Refined_Post. Check the placement and related
-- context of the pragma. Spec_Id is the entity of the related
-- subprogram. Body_Id is the entity of the subprogram body. Flag Legal
-- is set when the pragma is properly placed.
-- subprogram. Body_Id is the entity of the subprogram body. Flag
-- Legal is set when the pragma is properly placed.
procedure Check_Ada_83_Warning;
-- Issues a warning message for the current pragma if operating in Ada
......@@ -2910,6 +2903,12 @@ package body Sem_Prag is
-- presence of at least one component. UU_Typ is the related Unchecked_
-- Union type.
procedure Ensure_Aggregate_Form (Arg : Node_Id);
-- Subsidiary routine to the processing of pragmas Abstract_State,
-- Contract_Cases, Depends, Global, Initializes, Refined_Depends,
-- Refined_Global and Refined_State. Transform argument Arg into an
-- aggregate if not one already. N_Null is never transformed.
procedure Error_Pragma (Msg : String);
pragma No_Return (Error_Pragma);
-- Outputs error message for current pragma. The message contains a %
......@@ -2936,15 +2935,15 @@ package body Sem_Prag is
procedure Error_Pragma_Arg_Ident (Msg : String; Arg : Node_Id);
pragma No_Return (Error_Pragma_Arg_Ident);
-- Outputs error message for current pragma. The message may contain
-- a % that will be replaced with the pragma name. The parameter Arg
-- must be a pragma argument association with a non-empty identifier
-- (i.e. its Chars field must be set), and the error message is placed
-- on the identifier. The message is placed using Error_Msg_N so
-- the message may also contain an & insertion character which will
-- reference the identifier. After placing the message, Pragma_Exit
-- is raised. Note: this routine calls Fix_Error (see spec of that
-- procedure for details).
-- Outputs error message for current pragma. The message may contain a %
-- that will be replaced with the pragma name. The parameter Arg must be
-- a pragma argument association with a non-empty identifier (i.e. its
-- Chars field must be set), and the error message is placed on the
-- identifier. The message is placed using Error_Msg_N so the message
-- may also contain an & insertion character which will reference
-- the identifier. After placing the message, Pragma_Exit is raised.
-- Note: this routine calls Fix_Error (see spec of that procedure for
-- details).
procedure Error_Pragma_Ref (Msg : String; Ref : Entity_Id);
pragma No_Return (Error_Pragma_Ref);
......@@ -3221,6 +3220,13 @@ package body Sem_Prag is
Check_Arg_Count (1);
Check_No_Identifiers;
if Nam_In (Pname, Name_Refined_Depends,
Name_Refined_Global,
Name_Refined_State)
then
Ensure_Aggregate_Form (Arg1);
end if;
-- Verify the placement of the pragma and check for duplicates. The
-- pragma must apply to a subprogram body [stub].
......@@ -5110,6 +5116,70 @@ package body Sem_Prag is
end loop;
end Check_Variant;
---------------------------
-- Ensure_Aggregate_Form --
---------------------------
procedure Ensure_Aggregate_Form (Arg : Node_Id) is
Expr : constant Node_Id := Get_Pragma_Arg (Arg);
Loc : constant Source_Ptr := Sloc (Arg);
Nam : constant Name_Id := Chars (Arg);
Comps : List_Id := No_List;
Exprs : List_Id := No_List;
begin
-- The argument is already in aggregate form, but the presence of a
-- name causes this to be interpreted as a named association which in
-- turn must be converted into an aggregate.
-- pragma Global (In_Out => (A, B, C))
-- ^ ^
-- name aggregate
-- pragma Global ((In_Out => (A, B, C)))
-- ^ ^
-- aggregate aggregate
if Nkind (Expr) = N_Aggregate then
if Nam = No_Name then
return;
end if;
-- Do not transform a null argument into an aggregate as N_Null has
-- special meaning in formal verification pragmas.
elsif Nkind (Expr) = N_Null then
return;
end if;
-- Positional argument is transformed into an aggregate with an
-- Expressions list.
if Nam = No_Name then
Exprs := New_List (Relocate_Node (Expr));
-- An associative argument is transformed into an aggregate with
-- Component_Associations.
else
Comps := New_List (
Make_Component_Association (Loc,
Choices => New_List (Make_Identifier (Loc, Chars (Arg))),
Expression => Relocate_Node (Expr)));
end if;
-- Remove the pragma argument name as this information has been
-- captured in the aggregate.
Set_Chars (Arg, No_Name);
Set_Expression (Arg,
Make_Aggregate (Loc,
Component_Associations => Comps,
Expressions => Exprs));
end Ensure_Aggregate_Form;
------------------
-- Error_Pragma --
------------------
......@@ -9654,6 +9724,7 @@ package body Sem_Prag is
GNAT_Pragma;
S14_Pragma;
Check_Arg_Count (1);
Ensure_Aggregate_Form (Arg1);
-- Ensure the proper placement of the pragma. Abstract states must
-- be associated with a package declaration.
......@@ -9677,7 +9748,7 @@ package body Sem_Prag is
State := Expression (Arg1);
-- Multiple abstract states appear as an aggregate
-- Multiple non-null abstract states appear as an aggregate
if Nkind (State) = N_Aggregate then
State := First (Expressions (State));
......@@ -11305,6 +11376,7 @@ package body Sem_Prag is
begin
GNAT_Pragma;
Check_Arg_Count (1);
Ensure_Aggregate_Form (Arg1);
-- The pragma is analyzed at the end of the declarative part which
-- contains the related subprogram. Reset the analyzed flag.
......@@ -11824,6 +11896,7 @@ package body Sem_Prag is
GNAT_Pragma;
S14_Pragma;
Check_Arg_Count (1);
Ensure_Aggregate_Form (Arg1);
-- Ensure the proper placement of the pragma. Depends must be
-- associated with a subprogram declaration or a body that acts
......@@ -13094,6 +13167,7 @@ package body Sem_Prag is
GNAT_Pragma;
S14_Pragma;
Check_Arg_Count (1);
Ensure_Aggregate_Form (Arg1);
-- Ensure the proper placement of the pragma. Global must be
-- associated with a subprogram declaration or a body that acts
......@@ -13937,6 +14011,7 @@ package body Sem_Prag is
GNAT_Pragma;
S14_Pragma;
Check_Arg_Count (1);
Ensure_Aggregate_Form (Arg1);
-- Ensure the proper placement of the pragma. Initializes must be
-- associated with a package declaration.
......@@ -22116,7 +22191,7 @@ package body Sem_Prag is
Abstr_States := New_Copy_Elist (Abstract_States (Spec_Id));
Collect_Hidden_States;
-- Multiple state refinements appear as an aggregate
-- Multiple non-null state refinements appear as an aggregate
if Nkind (Clauses) = N_Aggregate then
if Present (Expressions (Clauses)) then
......
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