Skip to content

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

[multiple changes] 

2013-04-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Dependency_Clause): Update all calls to
	Analyze_Input_Output.
	(Analyze_Input_List): Update all calls to Analyze_Input_Output.
	(Analyze_Input_Output): Add formal parameter Self_Ref along with
	comment on its usage. Update all calls to Analyze_Input_Output.
	(Analyze_Pragma): Add new local variable Self_Ref to capture
	the presence of a self-referential dependency clause. Update
	all calls to Analyze_Input_Output.
	(Check_Mode): Add formal parameter Self_Ref along with comment on its
	usage. Verify the legality of a self-referential output.

2013-04-23  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch6.adb: Add predicate checks on by-copy parameter.

2013-04-23  Vincent Celier  <celier@adacore.com>

	* a-envvar.adb, a-envvar.ads (Value): New.

From-SVN: r198177
parent 08c52234
Showing with 119 additions and 31 deletions
gcc/ada/ChangeLog
2013-04-23 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Dependency_Clause): Update all calls to
Analyze_Input_Output.
(Analyze_Input_List): Update all calls to Analyze_Input_Output.
(Analyze_Input_Output): Add formal parameter Self_Ref along with
comment on its usage. Update all calls to Analyze_Input_Output.
(Analyze_Pragma): Add new local variable Self_Ref to capture
the presence of a self-referential dependency clause. Update
all calls to Analyze_Input_Output.
(Check_Mode): Add formal parameter Self_Ref along with comment on its
usage. Verify the legality of a self-referential output.
2013-04-23 Ed Schonberg <schonberg@adacore.com>
* exp_ch6.adb: Add predicate checks on by-copy parameter.
2013-04-23 Vincent Celier <celier@adacore.com>
* a-envvar.adb, a-envvar.ads (Value): New.
2013-04-22 Yannick Moy <moy@adacore.com> 2013-04-22 Yannick Moy <moy@adacore.com>
* exp_prag.adb (Expand_Pragma_Loop_Variant): Rewrite pragma as * exp_prag.adb (Expand_Pragma_Loop_Variant): Rewrite pragma as
......
gcc/ada/a-envvar.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2009-2012, Free Software Foundation, Inc. -- -- Copyright (C) 2009-2013, 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- --
...@@ -223,4 +223,13 @@ package body Ada.Environment_Variables is ...@@ -223,4 +223,13 @@ package body Ada.Environment_Variables is
end if; end if;
end Value; end Value;
function Value (Name : String; Default : String) return String is
begin
if Exists (Name) then
return Value (Name);
else
return Default;
end if;
end Value;
end Ada.Environment_Variables; end Ada.Environment_Variables;
gcc/ada/a-envvar.ads
...@@ -23,6 +23,11 @@ package Ada.Environment_Variables is ...@@ -23,6 +23,11 @@ package Ada.Environment_Variables is
-- Constraint_Error is propagated. If the execution environment does not -- Constraint_Error is propagated. If the execution environment does not
-- support environment variables, then Program_Error is propagated. -- support environment variables, then Program_Error is propagated.
function Value (Name : String; Default : String) return String;
-- If the external execution environment supports environment variables and
-- an environment variable with the given name currently exists, then Value
-- returns its value; otherwise, it returns Default.
function Exists (Name : String) return Boolean; function Exists (Name : String) return Boolean;
-- If the external execution environment supports environment variables and -- If the external execution environment supports environment variables and
-- an environment variable with the given name currently exists, then -- an environment variable with the given name currently exists, then
......
gcc/ada/exp_ch6.adb
...@@ -23,6 +23,7 @@ ...@@ -23,6 +23,7 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Aspects; use Aspects;
with Atree; use Atree; with Atree; use Atree;
with Checks; use Checks; with Checks; use Checks;
with Debug; use Debug; with Debug; use Debug;
...@@ -1707,8 +1708,22 @@ package body Exp_Ch6 is ...@@ -1707,8 +1708,22 @@ package body Exp_Ch6 is
-- function, so it must be done explicitly after the call. Ditto -- function, so it must be done explicitly after the call. Ditto
-- if the actual is an entity of a predicated subtype. -- if the actual is an entity of a predicated subtype.
if Is_By_Reference_Type (E_Formal) -- The rule refers to by-reference types, but a check is needed
and then Has_Predicates (E_Actual) -- for by-copy types as well. That check is subsumed by the rule
-- for subtype conversion on assignment, but we can generate the
-- required check now.
-- Note that this is needed only if the subtype of the actual has
-- an explicit predicate aspect, not if it inherits them from a
-- base type or ancestor. The check is also superfluous if the
-- subtype is elaborated before the body of the subprogram, but
-- this is harder to verify, and there may be a redundant check.
if (Present (Find_Aspect (E_Actual, Aspect_Predicate))
or else Present
(Find_Aspect (E_Actual, Aspect_Dynamic_Predicate))
or else Present
(Find_Aspect (E_Actual, Aspect_Static_Predicate)))
and then not Is_Init_Proc (Subp) and then not Is_Init_Proc (Subp)
then then
if Is_Derived_Type (E_Actual) if Is_Derived_Type (E_Actual)
......
gcc/ada/sem_prag.adb
...@@ -9346,10 +9346,14 @@ package body Sem_Prag is ...@@ -9346,10 +9346,14 @@ package body Sem_Prag is
procedure Check_Mode procedure Check_Mode
(Item : Node_Id; (Item : Node_Id;
Item_Id : Entity_Id; Item_Id : Entity_Id;
Is_Input : Boolean); Is_Input : Boolean;
Self_Ref : Boolean);
-- Ensure that an item has a proper "in", "in out" or "out" mode -- Ensure that an item has a proper "in", "in out" or "out" mode
-- depending on its function. If this is not the case, emit an -- depending on its function. If this is not the case, emit an
-- error. -- error. Item and Item_Id denote the attributes of an item. Flag
-- Is_Input should be set when item comes from an input list.
-- Flag Self_Ref should be set when the item is an output and the
-- dependency clause has operator "+".
procedure Check_Usage procedure Check_Usage
(Subp_List : Elist_Id; (Subp_List : Elist_Id;
...@@ -9382,16 +9386,19 @@ package body Sem_Prag is ...@@ -9382,16 +9386,19 @@ package body Sem_Prag is
procedure Analyze_Input_Output procedure Analyze_Input_Output
(Item : Node_Id; (Item : Node_Id;
Is_Input : Boolean; Is_Input : Boolean;
Self_Ref : Boolean;
Top_Level : Boolean; Top_Level : Boolean;
Seen : in out Elist_Id; Seen : in out Elist_Id;
Null_Seen : in out Boolean); Null_Seen : in out Boolean);
-- Verify the legality of a single input or output item. Flag -- Verify the legality of a single input or output item. Flag
-- Is_Input should be set whenever Item is an input, False when -- Is_Input should be set whenever Item is an input, False when
-- it denotes an output. Flag Top_Level should be set whenever -- it denotes an output. Flag Self_Ref should be set when the
-- Item appears immediately within an input or output list. -- item is an output and the dependency clause has a "+". Flag
-- Seen is a collection of all abstract states, variables and -- Top_Level should be set whenever Item appears immediately
-- formals processed so far. Flag Null_Seen denotes whether a -- within an input or output list. Seen is a collection of all
-- null input or output has been encountered. -- abstract states, variables and formals processed so far.
-- Flag Null_Seen denotes whether a null input or output has
-- been encountered.
------------------------ ------------------------
-- Analyze_Input_List -- -- Analyze_Input_List --
...@@ -9421,6 +9428,7 @@ package body Sem_Prag is ...@@ -9421,6 +9428,7 @@ package body Sem_Prag is
Analyze_Input_Output Analyze_Input_Output
(Item => Input, (Item => Input,
Is_Input => True, Is_Input => True,
Self_Ref => False,
Top_Level => False, Top_Level => False,
Seen => Inputs_Seen, Seen => Inputs_Seen,
Null_Seen => Null_Input_Seen); Null_Seen => Null_Input_Seen);
...@@ -9439,6 +9447,7 @@ package body Sem_Prag is ...@@ -9439,6 +9447,7 @@ package body Sem_Prag is
Analyze_Input_Output Analyze_Input_Output
(Item => Inputs, (Item => Inputs,
Is_Input => True, Is_Input => True,
Self_Ref => False,
Top_Level => False, Top_Level => False,
Seen => Inputs_Seen, Seen => Inputs_Seen,
Null_Seen => Null_Input_Seen); Null_Seen => Null_Input_Seen);
...@@ -9462,6 +9471,7 @@ package body Sem_Prag is ...@@ -9462,6 +9471,7 @@ package body Sem_Prag is
procedure Analyze_Input_Output procedure Analyze_Input_Output
(Item : Node_Id; (Item : Node_Id;
Is_Input : Boolean; Is_Input : Boolean;
Self_Ref : Boolean;
Top_Level : Boolean; Top_Level : Boolean;
Seen : in out Elist_Id; Seen : in out Elist_Id;
Null_Seen : in out Boolean) Null_Seen : in out Boolean)
...@@ -9490,6 +9500,7 @@ package body Sem_Prag is ...@@ -9490,6 +9500,7 @@ package body Sem_Prag is
Analyze_Input_Output Analyze_Input_Output
(Item => Grouped, (Item => Grouped,
Is_Input => Is_Input, Is_Input => Is_Input,
Self_Ref => Self_Ref,
Top_Level => False, Top_Level => False,
Seen => Seen, Seen => Seen,
Null_Seen => Null_Seen); Null_Seen => Null_Seen);
...@@ -9576,7 +9587,7 @@ package body Sem_Prag is ...@@ -9576,7 +9587,7 @@ package body Sem_Prag is
-- Ensure that the item is of the correct mode -- Ensure that the item is of the correct mode
-- depending on its function. -- depending on its function.
Check_Mode (Item, Item_Id, Is_Input); Check_Mode (Item, Item_Id, Is_Input, Self_Ref);
-- Detect multiple uses of the same state, variable -- Detect multiple uses of the same state, variable
-- or formal parameter. If this is not the case, -- or formal parameter. If this is not the case,
...@@ -9631,12 +9642,24 @@ package body Sem_Prag is ...@@ -9631,12 +9642,24 @@ package body Sem_Prag is
-- Local variables -- Local variables
Inputs : Node_Id; Inputs : Node_Id;
Output : Node_Id; Output : Node_Id;
Self_Ref : Boolean;
-- Start of processing for Analyze_Dependency_Clause -- Start of processing for Analyze_Dependency_Clause
begin begin
Inputs := Expression (Clause);
Self_Ref := False;
-- An input list with a self-dependency appears as operator "+"
-- where the actuals inputs are the right operand.
if Nkind (Inputs) = N_Op_Plus then
Inputs := Right_Opnd (Inputs);
Self_Ref := True;
end if;
-- Process the output_list of a dependency_clause -- Process the output_list of a dependency_clause
Output := First (Choices (Clause)); Output := First (Choices (Clause));
...@@ -9644,6 +9667,7 @@ package body Sem_Prag is ...@@ -9644,6 +9667,7 @@ package body Sem_Prag is
Analyze_Input_Output Analyze_Input_Output
(Item => Output, (Item => Output,
Is_Input => False, Is_Input => False,
Self_Ref => Self_Ref,
Top_Level => True, Top_Level => True,
Seen => Outputs_Seen, Seen => Outputs_Seen,
Null_Seen => Null_Output_Seen); Null_Seen => Null_Output_Seen);
...@@ -9653,15 +9677,6 @@ package body Sem_Prag is ...@@ -9653,15 +9677,6 @@ package body Sem_Prag is
-- Process the input_list of a dependency_clause -- Process the input_list of a dependency_clause
Inputs := Expression (Clause);
-- An input list with a self-dependency appears as operator "+"
-- where the actuals inputs are the right operand.
if Nkind (Inputs) = N_Op_Plus then
Inputs := Right_Opnd (Inputs);
end if;
Analyze_Input_List (Inputs); Analyze_Input_List (Inputs);
end Analyze_Dependency_Clause; end Analyze_Dependency_Clause;
...@@ -9717,9 +9732,12 @@ package body Sem_Prag is ...@@ -9717,9 +9732,12 @@ package body Sem_Prag is
procedure Check_Mode procedure Check_Mode
(Item : Node_Id; (Item : Node_Id;
Item_Id : Entity_Id; Item_Id : Entity_Id;
Is_Input : Boolean) Is_Input : Boolean;
Self_Ref : Boolean)
is is
begin begin
-- Input
if Is_Input then if Is_Input then
if Ekind (Item_Id) = E_Out_Parameter if Ekind (Item_Id) = E_Out_Parameter
or else (Global_Seen or else (Global_Seen
...@@ -9729,17 +9747,37 @@ package body Sem_Prag is ...@@ -9729,17 +9747,37 @@ package body Sem_Prag is
("item & must have mode in or in out", Item, Item_Id); ("item & must have mode in or in out", Item, Item_Id);
end if; end if;
-- Output -- Self-referential output
else elsif Self_Ref then
if Ekind (Item_Id) = E_In_Parameter
or else -- A self-referential state or variable must appear in both
(Global_Seen -- input and output lists of a subprogram.
and then not Appears_In (Subp_Outputs, Item_Id))
then if Ekind_In (Item_Id, E_Abstract_State, E_Variable) then
if Global_Seen
and then not Appears_In (Subp_Inputs, Item_Id)
then
Error_Msg_NE
("item & must have mode in out", Item, Item_Id);
end if;
-- Self-referential parameter
elsif Ekind (Item_Id) /= E_In_Out_Parameter then
Error_Msg_NE Error_Msg_NE
("item & must have mode out or in out", Item, Item_Id); ("item & must have mode in out", Item, Item_Id);
end if; end if;
-- Regular output
elsif Ekind (Item_Id) = E_In_Parameter
or else
(Global_Seen
and then not Appears_In (Subp_Outputs, Item_Id))
then
Error_Msg_NE
("item & must have mode out or in out", Item, Item_Id);
end if; end if;
end Check_Mode; end Check_Mode;
......
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