Commit dbe36d67 by Arnaud Charlet

[multiple changes]

2011-09-01  Pascal Obry  <obry@adacore.com>

	* prj-proc.adb, prj.ads, sinput-p.adb: Minor reformatting.

2011-09-01  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Generate references to
	the formals of a subprogram stub that acts as a spec.

2011-09-01  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch6.adb (Expand_Inlined_Call): If an actual is a by_reference
	type, declare a renaming for it, not an object declaration.

From-SVN: r178407
parent f5037886
2011-09-01 Pascal Obry <obry@adacore.com>
* prj-proc.adb, prj.ads, sinput-p.adb: Minor reformatting.
2011-09-01 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Generate references to
the formals of a subprogram stub that acts as a spec.
2011-09-01 Ed Schonberg <schonberg@adacore.com>
* exp_ch6.adb (Expand_Inlined_Call): If an actual is a by_reference
type, declare a renaming for it, not an object declaration.
2011-09-01 Yannick Moy <moy@adacore.com> 2011-09-01 Yannick Moy <moy@adacore.com>
* ali-util.adb, ali-util.ads (Read_Withed_ALIs): Add parameter * ali-util.adb, ali-util.ads (Read_Withed_ALIs): Add parameter
......
...@@ -4188,6 +4188,7 @@ package body Exp_Ch6 is ...@@ -4188,6 +4188,7 @@ package body Exp_Ch6 is
if Ekind (F) = E_In_Parameter if Ekind (F) = E_In_Parameter
and then not Is_Limited_Type (Etype (A)) and then not Is_Limited_Type (Etype (A))
and then not Is_Tagged_Type (Etype (A)) and then not Is_Tagged_Type (Etype (A))
and then not Is_By_Reference_Type (Etype (A))
and then and then
(not Is_Array_Type (Etype (A)) (not Is_Array_Type (Etype (A))
or else not Is_Object_Reference (A) or else not Is_Object_Reference (A)
......
...@@ -1992,7 +1992,7 @@ package body Prj.Proc is ...@@ -1992,7 +1992,7 @@ package body Prj.Proc is
Var : Variable_Id := No_Variable; Var : Variable_Id := No_Variable;
begin begin
-- First, find the list where to find the variable or attribute. -- First, find the list where to find the variable or attribute
if Is_Attribute then if Is_Attribute then
if Pkg /= No_Package then if Pkg /= No_Package then
...@@ -2009,7 +2009,7 @@ package body Prj.Proc is ...@@ -2009,7 +2009,7 @@ package body Prj.Proc is
end if; end if;
end if; end if;
-- Loop through the list, to find if it has already been declared. -- Loop through the list, to find if it has already been declared
while Var /= No_Variable while Var /= No_Variable
and then Shared.Variable_Elements.Table (Var).Name /= Name and then Shared.Variable_Elements.Table (Var).Name /= Name
...@@ -2496,7 +2496,7 @@ package body Prj.Proc is ...@@ -2496,7 +2496,7 @@ package body Prj.Proc is
Extended_By : Project_Id) Extended_By : Project_Id)
is is
Shared : constant Shared_Project_Tree_Data_Access := Shared : constant Shared_Project_Tree_Data_Access :=
In_Tree.Shared; In_Tree.Shared;
Child_Env : Prj.Tree.Environment; Child_Env : Prj.Tree.Environment;
-- Only used for the root aggregate project (if any). This is left -- Only used for the root aggregate project (if any). This is left
...@@ -2765,7 +2765,6 @@ package body Prj.Proc is ...@@ -2765,7 +2765,6 @@ package body Prj.Proc is
Project := Processed_Projects.Get (Name); Project := Processed_Projects.Get (Name);
if Project /= No_Project then if Project /= No_Project then
-- Make sure that, when a project is extended, the project id -- Make sure that, when a project is extended, the project id
-- of the project extending it is recorded in its data, even -- of the project extending it is recorded in its data, even
-- when it has already been processed as an imported project. -- when it has already been processed as an imported project.
......
...@@ -235,10 +235,10 @@ package Prj is ...@@ -235,10 +235,10 @@ package Prj is
-- packages) for a project or a package in a project. -- packages) for a project or a package in a project.
No_Declarations : constant Declarations := No_Declarations : constant Declarations :=
(Variables => No_Variable, (Variables => No_Variable,
Attributes => No_Variable, Attributes => No_Variable,
Arrays => No_Array, Arrays => No_Array,
Packages => No_Package); Packages => No_Package);
-- Default value of Declarations: indicates that there is no declarations -- Default value of Declarations: indicates that there is no declarations
type Package_Element is record type Package_Element is record
...@@ -1861,39 +1861,39 @@ private ...@@ -1861,39 +1861,39 @@ private
end record; end record;
Gprbuild_Flags : constant Processing_Flags := Gprbuild_Flags : constant Processing_Flags :=
(Report_Error => null, (Report_Error => null,
When_No_Sources => Warning, When_No_Sources => Warning,
Require_Sources_Other_Lang => True, Require_Sources_Other_Lang => True,
Allow_Duplicate_Basenames => False, Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => True, Compiler_Driver_Mandatory => True,
Error_On_Unknown_Language => True, Error_On_Unknown_Language => True,
Require_Obj_Dirs => Error, Require_Obj_Dirs => Error,
Allow_Invalid_External => Error, Allow_Invalid_External => Error,
Missing_Source_Files => Error, Missing_Source_Files => Error,
Ignore_Missing_With => False); Ignore_Missing_With => False);
Gprclean_Flags : constant Processing_Flags := Gprclean_Flags : constant Processing_Flags :=
(Report_Error => null, (Report_Error => null,
When_No_Sources => Warning, When_No_Sources => Warning,
Require_Sources_Other_Lang => True, Require_Sources_Other_Lang => True,
Allow_Duplicate_Basenames => False, Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => True, Compiler_Driver_Mandatory => True,
Error_On_Unknown_Language => True, Error_On_Unknown_Language => True,
Require_Obj_Dirs => Warning, Require_Obj_Dirs => Warning,
Allow_Invalid_External => Error, Allow_Invalid_External => Error,
Missing_Source_Files => Error, Missing_Source_Files => Error,
Ignore_Missing_With => False); Ignore_Missing_With => False);
Gnatmake_Flags : constant Processing_Flags := Gnatmake_Flags : constant Processing_Flags :=
(Report_Error => null, (Report_Error => null,
When_No_Sources => Error, When_No_Sources => Error,
Require_Sources_Other_Lang => False, Require_Sources_Other_Lang => False,
Allow_Duplicate_Basenames => False, Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => False, Compiler_Driver_Mandatory => False,
Error_On_Unknown_Language => False, Error_On_Unknown_Language => False,
Require_Obj_Dirs => Error, Require_Obj_Dirs => Error,
Allow_Invalid_External => Error, Allow_Invalid_External => Error,
Missing_Source_Files => Error, Missing_Source_Files => Error,
Ignore_Missing_With => False); Ignore_Missing_With => False);
end Prj; end Prj;
...@@ -2565,10 +2565,14 @@ package body Sem_Ch6 is ...@@ -2565,10 +2565,14 @@ package body Sem_Ch6 is
Set_Contract (Body_Id, Make_Contract (Sloc (Body_Id))); Set_Contract (Body_Id, Make_Contract (Sloc (Body_Id)));
Generate_Reference Generate_Reference
(Body_Id, Body_Id, 'b', Set_Ref => False, Force => True); (Body_Id, Body_Id, 'b', Set_Ref => False, Force => True);
Generate_Reference_To_Formals (Body_Id);
Install_Formals (Body_Id); Install_Formals (Body_Id);
Push_Scope (Body_Id); Push_Scope (Body_Id);
end if; end if;
-- For stubs and bodies with no previous spec, generate references to
-- formals.
Generate_Reference_To_Formals (Body_Id);
end if; end if;
-- If the return type is an anonymous access type whose designated type -- If the return type is an anonymous access type whose designated type
...@@ -2600,7 +2604,7 @@ package body Sem_Ch6 is ...@@ -2600,7 +2604,7 @@ package body Sem_Ch6 is
-- If this is the proper body of a stub, we must verify that the stub -- If this is the proper body of a stub, we must verify that the stub
-- conforms to the body, and to the previous spec if one was present. -- conforms to the body, and to the previous spec if one was present.
-- we know already that the body conforms to that spec. This test is -- We know already that the body conforms to that spec. This test is
-- only required for subprograms that come from source. -- only required for subprograms that come from source.
if Nkind (Parent (N)) = N_Subunit if Nkind (Parent (N)) = N_Subunit
...@@ -2626,8 +2630,8 @@ package body Sem_Ch6 is ...@@ -2626,8 +2630,8 @@ package body Sem_Ch6 is
if not Conformant then if not Conformant then
-- The stub was taken to be a new declaration. Indicate -- The stub was taken to be a new declaration. Indicate that
-- that it lacks a body. -- it lacks a body.
Set_Has_Completion (Old_Id, False); Set_Has_Completion (Old_Id, False);
end if; end if;
...@@ -2651,7 +2655,7 @@ package body Sem_Ch6 is ...@@ -2651,7 +2655,7 @@ package body Sem_Ch6 is
end if; end if;
-- Ada 2005 (AI-262): In library subprogram bodies, after the analysis -- Ada 2005 (AI-262): In library subprogram bodies, after the analysis
-- if its specification we have to install the private withed units. -- of the specification we have to install the private withed units.
-- This holds for child units as well. -- This holds for child units as well.
if Is_Compilation_Unit (Body_Id) if Is_Compilation_Unit (Body_Id)
...@@ -2763,8 +2767,8 @@ package body Sem_Ch6 is ...@@ -2763,8 +2767,8 @@ package body Sem_Ch6 is
if Present (Last_Real_Spec_Entity) then if Present (Last_Real_Spec_Entity) then
-- No body entities (happens when the only real spec entities -- No body entities (happens when the only real spec entities come
-- come from precondition and postcondition pragmas) -- from precondition and postcondition pragmas).
if No (Last_Entity (Body_Id)) then if No (Last_Entity (Body_Id)) then
Set_First_Entity Set_First_Entity
...@@ -2781,8 +2785,8 @@ package body Sem_Ch6 is ...@@ -2781,8 +2785,8 @@ package body Sem_Ch6 is
Set_Last_Entity (Body_Id, Last_Entity (Spec_Id)); Set_Last_Entity (Body_Id, Last_Entity (Spec_Id));
Set_Last_Entity (Spec_Id, Last_Real_Spec_Entity); Set_Last_Entity (Spec_Id, Last_Real_Spec_Entity);
-- Case where there are no spec entities, in this case there can -- Case where there are no spec entities, in this case there can be
-- be no body entities either, so just move everything. -- no body entities either, so just move everything.
else else
pragma Assert (No (Last_Entity (Body_Id))); pragma Assert (No (Last_Entity (Body_Id)));
...@@ -2804,7 +2808,7 @@ package body Sem_Ch6 is ...@@ -2804,7 +2808,7 @@ package body Sem_Ch6 is
-- might be the following common idiom for a stubbed function: -- might be the following common idiom for a stubbed function:
-- statement of the procedure raises an exception. In particular this -- statement of the procedure raises an exception. In particular this
-- deals with the common idiom of a stubbed function, which might -- deals with the common idiom of a stubbed function, which might
-- appear as something like -- appear as something like:
-- function F (A : Integer) return Some_Type; -- function F (A : Integer) return Some_Type;
-- X : Some_Type; -- X : Some_Type;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2011, 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- --
...@@ -97,7 +97,7 @@ package body Sinput.P is ...@@ -97,7 +97,7 @@ package body Sinput.P is
----------------------- -----------------------
function Load_Project_File (Path : String) return Source_File_Index is function Load_Project_File (Path : String) return Source_File_Index is
X : Source_File_Index; X : Source_File_Index;
begin begin
X := Sinput.C.Load_File (Path); X := Sinput.C.Load_File (Path);
......
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