mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-19 15:11:08 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2015-01-06  Robert Dewar  <dewar@adacore.com>

	* exp_util.adb: Change name Name_Table_Boolean to
	Name_Table_Boolean1.
	* namet.adb: Change name Name_Table_Boolean to Name_Table_Boolean1
	Introduce Name_Table_Boolean2/3.
	* namet.ads: Change name Name_Table_Boolean to Name_Table_Boolean1
	Introduce Name_Table_Boolean2/3.
	* par-ch13.adb: Change name Name_Table_Boolean to
	Name_Table_Boolean1.

2015-01-06  Bob Duff  <duff@adacore.com>

	* gnat_rm.texi: Improve documentation regarding No_Task_Termination.

2015-01-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb (Resolve_Record_Aggregte, Get_Value): For an
	others choice that covers multiple components, analyze each
	copy with the type of the component even in compile-only mode,
	to detect potential accessibility errors.

2015-01-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_res.adb (Is_Assignment_Or_Object_Expression): New routine.
	(Resolve_Actuals): An effectively volatile out
	parameter cannot act as an in or in out actual in a call.
	(Resolve_Entity_Name): An effectively volatile out parameter
	cannot be read.

2015-01-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): If the body is
	the expansion of an expression function it may be pre-analyzed
	if a 'access attribute is applied to the function, in which case
	last_entity may have been assigned already.

2015-01-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Analyze_One_Call): If formal has an incomplete
	type and actual has the corresponding full view, there is no
	error, but a case of use of incomplete type in a predicate or
	invariant expression.

2015-01-06  Vincent Celier  <celier@adacore.com>

	* makeutl.adb (Insert_No_Roots): Make sure that the same source
	in two different project tree is checked in both trees, if they
	are sources of two different projects, extended or not.

2015-01-06  Arnaud Charlet  <charlet@adacore.com>

	* gnat1drv.adb: Minor code clean up.
	(Adjust_Global_Switches): Ignore gnatprove_mode in codepeer_mode.

2015-01-06  Bob Duff  <duff@adacore.com>

	* osint.adb (Read_Source_File): Don't print out
	file name unless T = Source.

2015-01-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Is_Variable, Is_OK_Variable_For_Out_Formal):
	recognize improper uses of constant_reference types as actuals
	for in-out parameters.
	(Check_Function_Call): Do not collect identifiers if function
	name is missing because of previous error.

From-SVN: r219231
This commit is contained in:
Arnaud Charlet 2015-01-06 10:18:13 +01:00
parent ac16e74cdf
commit a921e83c12
14 changed files with 343 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
gcc/ada/ChangeLog
View File

@ -1,3 +1,71 @@
2015-01-06 Robert Dewar <dewar@adacore.com>
* exp_util.adb: Change name Name_Table_Boolean to
Name_Table_Boolean1.
* namet.adb: Change name Name_Table_Boolean to Name_Table_Boolean1
Introduce Name_Table_Boolean2/3.
* namet.ads: Change name Name_Table_Boolean to Name_Table_Boolean1
Introduce Name_Table_Boolean2/3.
* par-ch13.adb: Change name Name_Table_Boolean to
Name_Table_Boolean1.
2015-01-06 Bob Duff <duff@adacore.com>
* gnat_rm.texi: Improve documentation regarding No_Task_Termination.
2015-01-06 Ed Schonberg <schonberg@adacore.com>
* sem_aggr.adb (Resolve_Record_Aggregte, Get_Value): For an
others choice that covers multiple components, analyze each
copy with the type of the component even in compile-only mode,
to detect potential accessibility errors.
2015-01-06 Hristian Kirtchev <kirtchev@adacore.com>
* sem_res.adb (Is_Assignment_Or_Object_Expression): New routine.
(Resolve_Actuals): An effectively volatile out
parameter cannot act as an in or in out actual in a call.
(Resolve_Entity_Name): An effectively volatile out parameter
cannot be read.
2015-01-06 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): If the body is
the expansion of an expression function it may be pre-analyzed
if a 'access attribute is applied to the function, in which case
last_entity may have been assigned already.
2015-01-06 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Analyze_One_Call): If formal has an incomplete
type and actual has the corresponding full view, there is no
error, but a case of use of incomplete type in a predicate or
invariant expression.
2015-01-06 Vincent Celier <celier@adacore.com>
* makeutl.adb (Insert_No_Roots): Make sure that the same source
in two different project tree is checked in both trees, if they
are sources of two different projects, extended or not.
2015-01-06 Arnaud Charlet <charlet@adacore.com>
* gnat1drv.adb: Minor code clean up.
(Adjust_Global_Switches): Ignore gnatprove_mode in codepeer_mode.
2015-01-06 Bob Duff <duff@adacore.com>
* osint.adb (Read_Source_File): Don't print out
file name unless T = Source.
2015-01-06 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb (Is_Variable, Is_OK_Variable_For_Out_Formal):
recognize improper uses of constant_reference types as actuals
for in-out parameters.
(Check_Function_Call): Do not collect identifiers if function
name is missing because of previous error.
2015-01-06 Robert Dewar <dewar@adacore.com>
* ali-util.adb, sem_prag.adb, rtsfind.adb, sem_util.adb, sem_res.adb,

2
gcc/ada/exp_util.adb
View File

@ -2963,7 +2963,7 @@ package body Exp_Util is
-- If parser detected no address clause for the identifier in question,
-- then the answer is a quick NO, without the need for a search.
if not Get_Name_Table_Boolean (Chars (Id)) then
if not Get_Name_Table_Boolean1 (Chars (Id)) then
return Empty;
end if;

5
gcc/ada/gnat1drv.adb
View File

@ -182,6 +182,11 @@ procedure Gnat1drv is
if CodePeer_Mode then
-- Turn off gnatprove mode (if set via e.g. -gnatd.F), not compatible
-- with CodePeer mode.
GNATprove_Mode := False;
-- Turn off inlining, confuses CodePeer output and gains nothing
Front_End_Inlining := False;

12
gcc/ada/gnat_rm.texi
View File

@ -10972,7 +10972,7 @@ directly on the environment task of the partition.
@node No_Task_Termination
@unnumberedsubsec No_Task_Termination
@findex No_Task_Termination
[RM D.7] Tasks which terminate are erroneous.
[RM D.7] Tasks that terminate are erroneous.
@node No_Tasking
@unnumberedsubsec No_Tasking
@ -14315,6 +14315,16 @@ allocation. See D.7(8).
The only operation that implicitly requires heap storage allocation is
task creation.
@sp 1
@item
@cartouche
@noindent
What happens when a task terminates in the presence of
pragma @code{No_Task_Termination}. See D.7(15).
@end cartouche
@noindent
Execution is erroneous in that case.
@sp 1
@item
@cartouche

7
gcc/ada/makeutl.adb
View File

@ -2557,8 +2557,11 @@ package body Makeutl is
for J in 1 .. Q.Last loop
if Source.Id.Path.Name = Q.Table (J).Info.Id.Path.Name
and then Source.Id.Index = Q.Table (J).Info.Id.Index
and then Source.Id.Project.Path.Name =
Q.Table (J).Info.Id.Project.Path.Name
and then
Ultimate_Extending_Project_Of (Source.Id.Project).Path.Name
=
Ultimate_Extending_Project_Of (Q.Table (J).Info.Id.Project).
Path.Name
then
-- No need to insert this source in the queue, but still
-- return True as we may need to insert its roots.

76
gcc/ada/namet.adb
View File

@ -705,15 +705,35 @@ package body Namet is
end loop;
end Get_Name_String_And_Append;
----------------------------
-- Get_Name_Table_Boolean --
----------------------------
-----------------------------
-- Get_Name_Table_Boolean1 --
-----------------------------
function Get_Name_Table_Boolean (Id : Name_Id) return Boolean is
function Get_Name_Table_Boolean1 (Id : Name_Id) return Boolean is
begin
pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
return Name_Entries.Table (Id).Boolean_Info;
end Get_Name_Table_Boolean;
return Name_Entries.Table (Id).Boolean1_Info;
end Get_Name_Table_Boolean1;
-----------------------------
-- Get_Name_Table_Boolean2 --
-----------------------------
function Get_Name_Table_Boolean2 (Id : Name_Id) return Boolean is
begin
pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
return Name_Entries.Table (Id).Boolean2_Info;
end Get_Name_Table_Boolean2;
-----------------------------
-- Get_Name_Table_Boolean3 --
-----------------------------
function Get_Name_Table_Boolean3 (Id : Name_Id) return Boolean is
begin
pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
return Name_Entries.Table (Id).Boolean3_Info;
end Get_Name_Table_Boolean3;
-------------------------
-- Get_Name_Table_Byte --
@ -933,7 +953,9 @@ package body Namet is
Name_Len => Short (Name_Len),
Byte_Info => 0,
Int_Info => 0,
Boolean_Info => False,
Boolean1_Info => False,
Boolean2_Info => False,
Boolean3_Info => False,
Name_Has_No_Encodings => False,
Hash_Link => No_Name));
@ -1037,7 +1059,9 @@ package body Namet is
Name_Has_No_Encodings => False,
Int_Info => 0,
Byte_Info => 0,
Boolean_Info => False));
Boolean1_Info => False,
Boolean2_Info => False,
Boolean3_Info => False));
-- Set corresponding string entry in the Name_Chars table
@ -1262,7 +1286,9 @@ package body Namet is
Name_Len => 1,
Byte_Info => 0,
Int_Info => 0,
Boolean_Info => False,
Boolean1_Info => False,
Boolean2_Info => False,
Boolean3_Info => False,
Name_Has_No_Encodings => True,
Hash_Link => No_Name));
@ -1300,15 +1326,35 @@ package body Namet is
Store_Encoded_Character (C);
end Set_Character_Literal_Name;
----------------------------
-- Set_Name_Table_Boolean --
----------------------------
-----------------------------
-- Set_Name_Table_Boolean1 --
-----------------------------
procedure Set_Name_Table_Boolean (Id : Name_Id; Val : Boolean) is
procedure Set_Name_Table_Boolean1 (Id : Name_Id; Val : Boolean) is
begin
pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
Name_Entries.Table (Id).Boolean_Info := Val;
end Set_Name_Table_Boolean;
Name_Entries.Table (Id).Boolean1_Info := Val;
end Set_Name_Table_Boolean1;
-----------------------------
-- Set_Name_Table_Boolean2 --
-----------------------------
procedure Set_Name_Table_Boolean2 (Id : Name_Id; Val : Boolean) is
begin
pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
Name_Entries.Table (Id).Boolean2_Info := Val;
end Set_Name_Table_Boolean2;
-----------------------------
-- Set_Name_Table_Boolean3 --
-----------------------------
procedure Set_Name_Table_Boolean3 (Id : Name_Id; Val : Boolean) is
begin
pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
Name_Entries.Table (Id).Boolean3_Info := Val;
end Set_Name_Table_Boolean3;
-------------------------
-- Set_Name_Table_Byte --

28
gcc/ada/namet.ads
View File

@ -115,7 +115,7 @@ package Namet is
-- character lower case letters in the range a-z, and these names are created
-- and initialized by the Initialize procedure.
-- Three values, one of type Int, one of type Byte, and one of type Boolean,
-- Five values, one of type Int, one of type Byte, and three of type Boolean,
-- are stored with each names table entry and subprograms are provided for
-- setting and retrieving these associated values. The usage of these values
-- is up to the client:
@ -128,9 +128,11 @@ package Namet is
-- The Byte field is used to hold the Token_Type value for reserved words
-- (see Sem for details).
-- The Boolean field is used to mark address clauses to optimize the
-- The Boolean1 field is used to mark address clauses to optimize the
-- performance of the Exp_Util.Following_Address_Clause function.
-- The Boolean2/Boolean3 fields are not used
-- In the binder, we have the following uses:
-- The Int field is used in various ways depending on the name involved,
@ -367,8 +369,10 @@ package Namet is
pragma Inline (Get_Name_Table_Int);
-- Fetches the Int value associated with the given name
function Get_Name_Table_Boolean (Id : Name_Id) return Boolean;
-- Fetches the Boolean value associated with the given name
function Get_Name_Table_Boolean1 (Id : Name_Id) return Boolean;
function Get_Name_Table_Boolean2 (Id : Name_Id) return Boolean;
function Get_Name_Table_Boolean3 (Id : Name_Id) return Boolean;
-- Fetches the Boolean values associated with the given name
function Is_Operator_Name (Id : Name_Id) return Boolean;
-- Returns True if name given is of the form of an operator (that
@ -504,7 +508,9 @@ package Namet is
pragma Inline (Set_Name_Table_Byte);
-- Sets the Byte value associated with the given name
procedure Set_Name_Table_Boolean (Id : Name_Id; Val : Boolean);
procedure Set_Name_Table_Boolean1 (Id : Name_Id; Val : Boolean);
procedure Set_Name_Table_Boolean2 (Id : Name_Id; Val : Boolean);
procedure Set_Name_Table_Boolean3 (Id : Name_Id; Val : Boolean);
-- Sets the Boolean value associated with the given name
procedure Store_Encoded_Character (C : Char_Code);
@ -644,8 +650,10 @@ private
Byte_Info : Byte;
-- Byte value associated with this name
Boolean_Info : Boolean;
-- Boolean value associated with the name
Boolean1_Info : Boolean;
Boolean2_Info : Boolean;
Boolean3_Info : Boolean;
-- Boolean values associated with the name
Name_Has_No_Encodings : Boolean;
-- This flag is set True if the name entry is known not to contain any
@ -665,8 +673,10 @@ private
Name_Chars_Index at 0 range 0 .. 31;
Name_Len at 4 range 0 .. 15;
Byte_Info at 6 range 0 .. 7;
Boolean_Info at 7 range 0 .. 0;
Name_Has_No_Encodings at 7 range 1 .. 7;
Boolean1_Info at 7 range 0 .. 0;
Boolean2_Info at 7 range 1 .. 1;
Boolean3_Info at 7 range 2 .. 2;
Name_Has_No_Encodings at 7 range 3 .. 7;
Hash_Link at 8 range 0 .. 31;
Int_Info at 12 range 0 .. 31;
end record;

44
gcc/ada/osint.adb
View File

@ -2642,31 +2642,33 @@ package body Osint is
return;
end if;
-- Print out the file name, if requested, and if it's not part of the
-- runtimes, store it in File_Name_Chars.
-- If it's a Source file, print out the file name, if requested, and if
-- it's not part of the runtimes, store it in File_Name_Chars. We don't
-- want to print non-Source files, like GNAT-TEMP-000001.TMP used to
-- pass information from gprbuild to gcc. We don't want to save runtime
-- file names, because we don't want users to send them in bug reports.
declare
Name : String renames Name_Buffer (1 .. Name_Len);
Inc : String renames Include_Dir_Default_Prefix.all;
if T = Source then
declare
Name : String renames Name_Buffer (1 .. Name_Len);
Inc : String renames Include_Dir_Default_Prefix.all;
begin
if Debug.Debug_Flag_Dot_N then
Write_Line (Name);
end if;
Part_Of_Runtimes : constant Boolean :=
Inc /= ""
and then Inc'Length < Name_Len
and then Name_Buffer (1 .. Inc'Length) = Inc;
if Inc /= ""
and then Inc'Length < Name_Len
and then Name_Buffer (1 .. Inc'Length) = Inc
then
-- Part of runtimes, so ignore it
begin
if Debug.Debug_Flag_Dot_N then
Write_Line (Name);
end if;
null;
else
File_Name_Chars.Append_All (File_Name_Chars.Table_Type (Name));
File_Name_Chars.Append (ASCII.LF);
end if;
end;
if not Part_Of_Runtimes then
File_Name_Chars.Append_All (File_Name_Chars.Table_Type (Name));
File_Name_Chars.Append (ASCII.LF);
end if;
end;
end if;
-- Prepare to read data from the file

4
gcc/ada/par-ch13.adb
View File

@ -741,7 +741,7 @@ package body Ch13 is
if Attr_Name = Name_Address
and then Nkind (Prefix_Node) = N_Identifier
then
Set_Name_Table_Boolean (Chars (Prefix_Node), True);
Set_Name_Table_Boolean1 (Chars (Prefix_Node), True);
end if;
end loop;
@ -771,7 +771,7 @@ package body Ch13 is
-- Mark occurrence of address clause (used to optimize performance
-- of Exp_Util.Following_Address_Clause).
Set_Name_Table_Boolean (Chars (Identifier_Node), True);
Set_Name_Table_Boolean1 (Chars (Identifier_Node), True);
-- RECORD follows USE (Record Representation Clause)

27
gcc/ada/sem_aggr.adb
View File

@ -3227,17 +3227,36 @@ package body Sem_Aggr is
if Present (Others_Etype)
and then Base_Type (Others_Etype) /= Base_Type (Typ)
then
Error_Msg_N
("components in OTHERS choice must "
& "have same type", Selector_Name);
-- If the components are of an anonymous access
-- type they are distinct, but this is legal in
-- Ada 2012 as long as designated types match.
if (Ekind (Typ) = E_Anonymous_Access_Type
or else Ekind (Typ) =
E_Anonymous_Access_Subprogram_Type)
and then Designated_Type (Typ) =
Designated_Type (Others_Etype)
then
null;
else
Error_Msg_N
("components in OTHERS choice must "
& "have same type", Selector_Name);
end if;
end if;
Others_Etype := Typ;
if Expander_Active then
-- Copy expression so that it is resolved
-- independently for each component, This is needed
-- for accessibility checks on compoents of anonymous
-- access types, even in compile_only mode.
if not Inside_A_Generic then
return
New_Copy_Tree_And_Copy_Dimensions
(Expression (Assoc));
else
return Expression (Assoc);
end if;

12
gcc/ada/sem_ch4.adb
View File

@ -3195,6 +3195,18 @@ package body Sem_Ch4 is
Next_Actual (Actual);
Next_Formal (Formal);
-- For an Ada 2012 predicate or invariant, a call may mention
-- an incomplete type, while resolution of the corresponding
-- predicate function may see the full view, as a consequence
-- of the delayed resolution of the corresponding expressions.
elsif Ekind (Etype (Formal)) = E_Incomplete_Type
and then Full_View (Etype (Formal)) = Etype (Actual)
then
Set_Etype (Formal, Etype (Actual));
Next_Actual (Actual);
Next_Formal (Formal);
else
if Debug_Flag_E then
Write_Str (" type checking fails in call ");

11
gcc/ada/sem_ch6.adb
View File

@ -3950,8 +3950,17 @@ package body Sem_Ch6 is
-- Case where there are no spec entities, in this case there can be
-- no body entities either, so just move everything.
-- If the body is generated for an expression function, it may have
-- been preanalyzed already, if 'access was applied to it.
else
pragma Assert (No (Last_Entity (Body_Id)));
if Nkind (Original_Node (Unit_Declaration_Node (Spec_Id))) /=
N_Expression_Function
then
pragma Assert (No (Last_Entity (Body_Id)));
null;
end if;
Set_First_Entity (Body_Id, First_Entity (Spec_Id));
Set_Last_Entity (Body_Id, Last_Entity (Spec_Id));
Set_First_Entity (Spec_Id, Empty);

96
gcc/ada/sem_res.adb
View File

@ -4250,14 +4250,25 @@ package body Sem_Res is
end if;
-- In Ada 83 we cannot pass an OUT parameter as an IN or IN OUT
-- actual to a nested call, since this is case of reading an
-- out parameter, which is not allowed.
-- actual to a nested call, since this constitutes a reading of
-- the parameter, which is not allowed.
if Ada_Version = Ada_83
and then Is_Entity_Name (A)
if Is_Entity_Name (A)
and then Ekind (Entity (A)) = E_Out_Parameter
then
Error_Msg_N ("(Ada 83) illegal reading of out parameter", A);
if Ada_Version = Ada_83 then
Error_Msg_N
("(Ada 83) illegal reading of out parameter", A);
-- An effectively volatile OUT parameter cannot act as IN or
-- IN OUT actual in a call (SPARK RM 7.1.3(11)).
elsif SPARK_Mode = On
and then Is_Effectively_Volatile (Entity (A))
then
Error_Msg_N
("illegal reading of volatile OUT parameter", A);
end if;
end if;
end if;
@ -5444,8 +5455,8 @@ package body Sem_Res is
N_Unchecked_Type_Conversion)
then
Error_Msg_N
("(Ada 83) fixed-point operation "
& "needs explicit conversion", N);
("(Ada 83) fixed-point operation needs explicit "
& "conversion", N);
end if;
-- The expected type is "any real type" in contexts like
@ -6886,6 +6897,12 @@ package body Sem_Res is
-- Used to resolve identifiers and expanded names
procedure Resolve_Entity_Name (N : Node_Id; Typ : Entity_Id) is
function Is_Assignment_Or_Object_Expression
(Context : Node_Id;
Expr : Node_Id) return Boolean;
-- Determine whether node Context denotes an assignment statement or an
-- object declaration whose expression is node Expr.
function Is_OK_Volatile_Context
(Context : Node_Id;
Obj_Ref : Node_Id) return Boolean;
@ -6893,6 +6910,48 @@ package body Sem_Res is
-- (as defined in SPARK RM 7.1.3(13)) where volatile reference Obj_Ref
-- can safely reside.
----------------------------------------
-- Is_Assignment_Or_Object_Expression --
----------------------------------------
function Is_Assignment_Or_Object_Expression
(Context : Node_Id;
Expr : Node_Id) return Boolean
is
begin
if Nkind_In (Context, N_Assignment_Statement,
N_Object_Declaration)
and then Expression (Context) = Expr
then
return True;
-- Check whether a construct that yields a name is the expression of
-- an assignment statement or an object declaration.
elsif (Nkind_In (Context, N_Attribute_Reference,
N_Explicit_Dereference,
N_Indexed_Component,
N_Selected_Component,
N_Slice)
and then Prefix (Context) = Expr)
or else
(Nkind_In (Context, N_Type_Conversion,
N_Unchecked_Type_Conversion)
and then Expression (Context) = Expr)
then
return
Is_Assignment_Or_Object_Expression
(Context => Parent (Context),
Expr => Context);
-- Otherwise the context is not an assignment statement or an object
-- declaration.
else
return False;
end if;
end Is_Assignment_Or_Object_Expression;
----------------------------
-- Is_OK_Volatile_Context --
----------------------------
@ -6992,6 +7051,7 @@ package body Sem_Res is
-- in a non-interfering context.
elsif Nkind_In (Context, N_Attribute_Reference,
N_Explicit_Dereference,
N_Indexed_Component,
N_Selected_Component,
N_Slice)
@ -7107,14 +7167,26 @@ package body Sem_Res is
elsif Ekind (E) = E_Generic_Function then
Error_Msg_N ("illegal use of generic function", N);
-- In Ada 83 an OUT parameter cannot be read
elsif Ekind (E) = E_Out_Parameter
and then Ada_Version = Ada_83
and then (Nkind (Parent (N)) in N_Op
or else (Nkind (Parent (N)) = N_Assignment_Statement
and then N = Expression (Parent (N)))
or else Nkind (Parent (N)) = N_Explicit_Dereference)
or else Nkind (Parent (N)) = N_Explicit_Dereference
or else Is_Assignment_Or_Object_Expression
(Context => Parent (N),
Expr => N))
then
Error_Msg_N ("(Ada 83) illegal reading of out parameter", N);
if Ada_Version = Ada_83 then
Error_Msg_N ("(Ada 83) illegal reading of out parameter", N);
-- An effectively volatile OUT parameter cannot be read
-- (SPARK RM 7.1.3(11)).
elsif SPARK_Mode = On
and then Is_Effectively_Volatile (E)
then
Error_Msg_N ("illegal reading of volatile OUT parameter", N);
end if;
-- In all other cases, just do the possible static evaluation

21
gcc/ada/sem_util.adb
View File

@ -2133,6 +2133,12 @@ package body Sem_Util is
begin
Id := Get_Function_Id (Call);
-- In case of previous error, no check is posible.
if No (Id) then
return Abandon;
end if;
Formal := First_Formal (Id);
Actual := First_Actual (Call);
while Present (Actual) and then Present (Formal) loop
@ -11621,6 +11627,18 @@ package body Sem_Util is
elsif Is_Variable (AV) then
return True;
-- Generalized indexing operations are rewritten as explicit
-- dereferences, and it is only during resolution that we can
-- check whether the context requires an access_to_variable type.
elsif Nkind (AV) = N_Explicit_Dereference
and then Ada_Version >= Ada_2012
and then Nkind (Original_Node (AV)) = N_Indexed_Component
and then Present (Etype (Original_Node (AV)))
and then Has_Implicit_Dereference (Etype (Original_Node (AV)))
then
return not Is_Access_Constant (Etype (Prefix (AV)));
-- Unchecked conversions are allowed only if they come from the
-- generated code, which sometimes uses unchecked conversions for out
-- parameters in cases where code generation is unaffected. We tell
@ -12857,9 +12875,8 @@ package body Sem_Util is
and then Present (Etype (Orig_Node))
and then Ada_Version >= Ada_2012
and then Has_Implicit_Dereference (Etype (Orig_Node))
and then not Is_Access_Constant (Etype (Prefix (N)))
then
return True;
return not Is_Access_Constant (Etype (Prefix (N)));
-- A function call is never a variable