+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,
-- 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;
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;
@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
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
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.
end loop;
end Get_Name_String_And_Append;
- ----------------------------
- -- Get_Name_Table_Boolean --
- ----------------------------
+ -----------------------------
+ -- Get_Name_Table_Boolean1 --
+ -----------------------------
+
+ 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).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_Boolean (Id : Name_Id) return Boolean is
+ 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).Boolean_Info;
- end Get_Name_Table_Boolean;
+ return Name_Entries.Table (Id).Boolean3_Info;
+ end Get_Name_Table_Boolean3;
-------------------------
-- Get_Name_Table_Byte --
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));
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
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));
Store_Encoded_Character (C);
end Set_Character_Literal_Name;
- ----------------------------
- -- Set_Name_Table_Boolean --
- ----------------------------
+ -----------------------------
+ -- Set_Name_Table_Boolean1 --
+ -----------------------------
+
+ 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).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_Boolean (Id : Name_Id; Val : Boolean) is
+ 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).Boolean_Info := Val;
- end Set_Name_Table_Boolean;
+ Name_Entries.Table (Id).Boolean3_Info := Val;
+ end Set_Name_Table_Boolean3;
-------------------------
-- Set_Name_Table_Byte --
-- 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:
-- 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,
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
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);
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
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;
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;
-
- begin
- if Debug.Debug_Flag_Dot_N then
- Write_Line (Name);
- end if;
+ if T = Source then
+ declare
+ Name : String renames Name_Buffer (1 .. Name_Len);
+ Inc : String renames Include_Dir_Default_Prefix.all;
- if Inc /= ""
- and then Inc'Length < Name_Len
- and then Name_Buffer (1 .. Inc'Length) = Inc
- then
- -- Part of runtimes, so ignore it
+ Part_Of_Runtimes : constant Boolean :=
+ Inc /= ""
+ and then Inc'Length < Name_Len
+ and then Name_Buffer (1 .. Inc'Length) = Inc;
- null;
+ begin
+ if Debug.Debug_Flag_Dot_N then
+ Write_Line (Name);
+ end if;
- 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
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;
-- 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)
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;
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 ");
-- 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);
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;
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
-- 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;
-- (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 --
----------------------------
-- in a non-interfering context.
elsif Nkind_In (Context, N_Attribute_Reference,
+ N_Explicit_Dereference,
N_Indexed_Component,
N_Selected_Component,
N_Slice)
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
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
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
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
projects / gcc.git / commitdiff