+2017-10-19 Bob Duff <duff@adacore.com>
+
+ * exp_util.adb: (Process_Statements_For_Controlled_Objects): Clarify
+ which node kinds can legitimately be ignored, and raise Program_Error
+ for others.
+
+2017-10-19 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_elab.adb (Compilation_Unit): Handle the case of a subprogram
+ instantiation that acts as a compilation unit.
+ (Find_Code_Unit): Reimplemented.
+ (Find_Top_Unit): Reimplemented.
+ (Find_Unit_Entity): New routine.
+ (Process_Instantiation_SPARK): Correct the elaboration requirement a
+ package instantiation imposes on a unit.
+
+2017-10-19 Bob Duff <duff@adacore.com>
+
+ * exp_ch6.adb (Is_Build_In_Place_Result_Type): Enable build-in-place
+ for a narrow set of controlled types.
+
+2017-10-19 Eric Botcazou <ebotcazou@adacore.com>
+
+ * sinput.ads (Line_Start): Add pragma Inline.
+ * widechar.ads (Is_Start_Of_Wide_Char): Likewise.
+
+2017-10-19 Bob Duff <duff@adacore.com>
+
+ * exp_attr.adb (Expand_N_Attribute_Reference): Disable
+ Make_Build_In_Place_Call_... for F(...)'Old, where F(...) is a
+ build-in-place function call so that the temp is declared in the right
+ place.
+
2017-10-18 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/misc.c (gnat_tree_size): Move around.
-- and access to it must be passed to the function.
if Is_Build_In_Place_Function_Call (Pref) then
- Make_Build_In_Place_Call_In_Anonymous_Context (Pref);
+
+ -- If attribute is 'Old, the context is a postcondition, and
+ -- the temporary must go in the corresponding subprogram, not
+ -- the postcondition function or any created blocks, as when
+ -- the attribute appears in a quantified expression. This is
+ -- handled below in the expansion of the attribute.
+
+ if Attribute_Name (Parent (Pref)) = Name_Old then
+ null;
+
+ else
+ Make_Build_In_Place_Call_In_Anonymous_Context (Pref);
+ end if;
-- Ada 2005 (AI-318-02): Specialization of the previous case for prefix
-- containing build-in-place function calls whose returned object covers
if Is_Limited_View (Typ) then
return Ada_Version >= Ada_2005 and then not Debug_Flag_Dot_L;
else
--- if Debug_Flag_Dot_9 then
- if True then
- return False; -- ???disable bip for nonlimited types
- end if;
-
if Has_Interfaces (Typ) then
return False;
end if;
- -- For T'Class, return True if it's True for the corresponding
- -- specific type. This is necessary because a class-wide function
- -- might say "return F (...)", where F returns the corresponding
- -- specific type.
-
- if Is_Class_Wide_Type (Typ) then
- return Is_Build_In_Place_Result_Type (Etype (Typ));
- end if;
-
declare
T : Entity_Id := Typ;
begin
- if Present (Underlying_Type (Typ)) then
+ -- For T'Class, return True if it's True for T. This is necessary
+ -- because a class-wide function might say "return F (...)", where
+ -- F returns the corresponding specific type.
+
+ if Is_Class_Wide_Type (Typ) then
+ T := Etype (Typ);
+ end if;
+
+ -- If this is a generic formal type in an instance, return True if
+ -- it's True for the generic actual type.
+
+ if Nkind (Parent (Typ)) = N_Subtype_Declaration
+ and then Present (Generic_Parent_Type (Parent (Typ)))
+ then
+ T := Entity (Subtype_Indication (Parent (Typ)));
+
+ if Present (Full_View (T)) then
+ T := Full_View (T);
+ end if;
+
+ elsif Present (Underlying_Type (Typ)) then
T := Underlying_Type (Typ);
end if;
declare
- Result : constant Boolean := Is_Controlled (T);
+ Result : Boolean;
begin
+ -- ???For now, enable build-in-place for a very narrow set of
+ -- controlled types. Change "if True" to "if False" to
+ -- experiment more controlled types. Eventually, we would
+ -- like to enable build-in-place for all tagged types, all
+ -- types that need finalization, and all caller-unknown-size
+ -- types. We will eventually use Debug_Flag_Dot_9 to disable
+ -- build-in-place for nonlimited types.
+
+-- if Debug_Flag_Dot_9 then
+ if True then
+ Result := Is_Controlled (T)
+ and then Present (Enclosing_Subprogram (T))
+ and then not Is_Compilation_Unit (Enclosing_Subprogram (T))
+ and then Ekind (Enclosing_Subprogram (T)) = E_Procedure;
+ else
+ Result := Is_Controlled (T);
+ end if;
+
return Result;
end;
end;
Analyze (Block);
end if;
- when others =>
+ -- Could be e.g. a loop that was transformed into a block or null
+ -- statement. Do nothing for terminate alternatives.
+
+ when N_Block_Statement | N_Null_Statement | N_Terminate_Alternative =>
null;
+
+ when others =>
+ raise Program_Error;
end case;
end Process_Statements_For_Controlled_Objects;
--
-- - Instantiations
--
- -- - References to variables
+ -- - Reads of variables
--
-- - Task activation
--
--
-- - For instantiations, the target is the generic template
--
- -- - For references to variables, the target is the variable
+ -- - For reads of variables, the target is the variable
--
-- - For task activation, the target is the task body
--
-- is obtained by logically unwinding instantiations and subunits when N
-- resides within one.
+ function Find_Unit_Entity (N : Node_Id) return Entity_Id;
+ pragma Inline (Find_Unit_Entity);
+ -- Return the entity of unit N
+
function First_Formal_Type (Subp_Id : Entity_Id) return Entity_Id;
pragma Inline (First_Formal_Type);
-- Return the type of subprogram Subp_Id's first formal parameter. If the
Comp_Unit := Parent (Unit_Declaration_Node (Unit_Id));
end if;
- if Nkind (Comp_Unit) = N_Subunit then
+ -- Handle the case where a subprogram instantiation which acts as a
+ -- compilation unit is expanded into an anonymous package that wraps
+ -- the instantiated subprogram.
+
+ if Nkind (Comp_Unit) = N_Package_Specification
+ and then Nkind_In (Original_Node (Parent (Comp_Unit)),
+ N_Function_Instantiation,
+ N_Procedure_Instantiation)
+ then
+ Comp_Unit := Parent (Parent (Comp_Unit));
+
+ -- Handle the case where the compilation unit is a subunit
+
+ elsif Nkind (Comp_Unit) = N_Subunit then
Comp_Unit := Parent (Comp_Unit);
end if;
--------------------
function Find_Code_Unit (N : Node_Or_Entity_Id) return Entity_Id is
- N_Unit : constant Node_Id := Unit (Cunit (Get_Code_Unit (N)));
-
begin
- return Defining_Entity (N_Unit, Concurrent_Subunit => True);
+ return Find_Unit_Entity (Unit (Cunit (Get_Code_Unit (N))));
end Find_Code_Unit;
---------------------------
-------------------
function Find_Top_Unit (N : Node_Or_Entity_Id) return Entity_Id is
- N_Unit : constant Node_Id := Unit (Cunit (Get_Top_Level_Code_Unit (N)));
-
begin
- return Defining_Entity (N_Unit, Concurrent_Subunit => True);
+ return Find_Unit_Entity (Unit (Cunit (Get_Top_Level_Code_Unit (N))));
end Find_Top_Unit;
+ ----------------------
+ -- Find_Unit_Entity --
+ ----------------------
+
+ function Find_Unit_Entity (N : Node_Id) return Entity_Id is
+ Context : constant Node_Id := Parent (N);
+ Orig_N : constant Node_Id := Original_Node (N);
+
+ begin
+ -- The unit denotes a package body of an instantiation which acts as
+ -- a compilation unit. The proper entity is that of the package spec.
+
+ if Nkind (N) = N_Package_Body
+ and then Nkind (Orig_N) = N_Package_Instantiation
+ and then Nkind (Context) = N_Compilation_Unit
+ then
+ return Corresponding_Spec (N);
+
+ -- The unit denotes an anonymous package created to wrap a subprogram
+ -- instantiation which acts as a compilation unit. The proper entity is
+ -- that of the "related instance".
+
+ elsif Nkind (N) = N_Package_Declaration
+ and then Nkind_In (Orig_N, N_Function_Instantiation,
+ N_Procedure_Instantiation)
+ and then Nkind (Context) = N_Compilation_Unit
+ then
+ return
+ Related_Instance (Defining_Entity (N, Concurrent_Subunit => True));
+
+ -- Otherwise the proper entity is the defining entity
+
+ else
+ return Defining_Entity (N, Concurrent_Subunit => True);
+ end if;
+ end Find_Unit_Entity;
+
-----------------------
-- First_Formal_Type --
-----------------------
-- in a great number of contexts. To determine whether a reference is
-- a read, it is more practical to find out whether it is a write.
- -- A reference is a write when appearing immediately on the left-hand
- -- side of an assignment.
+ -- A reference is a write when it appears immediately on the left-
+ -- hand side of an assignment.
if Nkind (Context) = N_Assignment_Statement
and then Name (Context) = Ref
-- ABE ramifications of the instantiation.
if Nkind (Inst) = N_Package_Instantiation then
- Req_Nam := Name_Elaborate;
- else
Req_Nam := Name_Elaborate_All;
+ else
+ Req_Nam := Name_Elaborate;
end if;
Meet_Elaboration_Requirement
-- listed below are not considered. The categories are:
-- 'Access for entries, operators, and subprograms
+ -- Assignments to variables
-- Calls (includes task activation)
-- Instantiations
- -- Variable assignments
- -- Variable references
+ -- Reads of variables
elsif Is_Suitable_Access (N)
or else Is_Suitable_Variable_Assignment (N)
pragma Inline (Num_Source_Files);
pragma Inline (Num_Source_Lines);
+ pragma Inline (Line_Start);
+
No_Instance_Id : constant Instance_Id := 0;
-------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
-- --
-- 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- --
P : Source_Ptr) return Boolean;
-- Determines if S (P) is the start of a wide character sequence
+private
+ pragma Inline (Is_Start_Of_Wide_Char);
+
end Widechar;
projects / platform / upstream / gcc.git / commitdiff