Skip to content

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

[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
Showing with 68 additions and 50 deletions
gcc/ada/ChangeLog
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>
* ali-util.adb, ali-util.ads (Read_Withed_ALIs): Add parameter
......
gcc/ada/exp_ch6.adb
......@@ -4188,6 +4188,7 @@ package body Exp_Ch6 is
if Ekind (F) = E_In_Parameter
and then not Is_Limited_Type (Etype (A))
and then not Is_Tagged_Type (Etype (A))
and then not Is_By_Reference_Type (Etype (A))
and then
(not Is_Array_Type (Etype (A))
or else not Is_Object_Reference (A)
......
gcc/ada/prj-proc.adb
......@@ -1992,7 +1992,7 @@ package body Prj.Proc is
Var : Variable_Id := No_Variable;
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 Pkg /= No_Package then
......@@ -2009,7 +2009,7 @@ package body Prj.Proc is
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
and then Shared.Variable_Elements.Table (Var).Name /= Name
......@@ -2496,7 +2496,7 @@ package body Prj.Proc is
Extended_By : Project_Id)
is
Shared : constant Shared_Project_Tree_Data_Access :=
In_Tree.Shared;
In_Tree.Shared;
Child_Env : Prj.Tree.Environment;
-- Only used for the root aggregate project (if any). This is left
......@@ -2765,7 +2765,6 @@ package body Prj.Proc is
Project := Processed_Projects.Get (Name);
if Project /= No_Project then
-- Make sure that, when a project is extended, the project id
-- of the project extending it is recorded in its data, even
-- when it has already been processed as an imported project.
......
gcc/ada/prj.ads
......@@ -235,10 +235,10 @@ package Prj is
-- packages) for a project or a package in a project.
No_Declarations : constant Declarations :=
(Variables => No_Variable,
Attributes => No_Variable,
Arrays => No_Array,
Packages => No_Package);
(Variables => No_Variable,
Attributes => No_Variable,
Arrays => No_Array,
Packages => No_Package);
-- Default value of Declarations: indicates that there is no declarations
type Package_Element is record
......@@ -1861,39 +1861,39 @@ private
end record;
Gprbuild_Flags : constant Processing_Flags :=
(Report_Error => null,
When_No_Sources => Warning,
Require_Sources_Other_Lang => True,
Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => True,
Error_On_Unknown_Language => True,
Require_Obj_Dirs => Error,
Allow_Invalid_External => Error,
Missing_Source_Files => Error,
Ignore_Missing_With => False);
(Report_Error => null,
When_No_Sources => Warning,
Require_Sources_Other_Lang => True,
Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => True,
Error_On_Unknown_Language => True,
Require_Obj_Dirs => Error,
Allow_Invalid_External => Error,
Missing_Source_Files => Error,
Ignore_Missing_With => False);
Gprclean_Flags : constant Processing_Flags :=
(Report_Error => null,
When_No_Sources => Warning,
Require_Sources_Other_Lang => True,
Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => True,
Error_On_Unknown_Language => True,
Require_Obj_Dirs => Warning,
Allow_Invalid_External => Error,
Missing_Source_Files => Error,
Ignore_Missing_With => False);
(Report_Error => null,
When_No_Sources => Warning,
Require_Sources_Other_Lang => True,
Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => True,
Error_On_Unknown_Language => True,
Require_Obj_Dirs => Warning,
Allow_Invalid_External => Error,
Missing_Source_Files => Error,
Ignore_Missing_With => False);
Gnatmake_Flags : constant Processing_Flags :=
(Report_Error => null,
When_No_Sources => Error,
Require_Sources_Other_Lang => False,
Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => False,
Error_On_Unknown_Language => False,
Require_Obj_Dirs => Error,
Allow_Invalid_External => Error,
Missing_Source_Files => Error,
Ignore_Missing_With => False);
(Report_Error => null,
When_No_Sources => Error,
Require_Sources_Other_Lang => False,
Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => False,
Error_On_Unknown_Language => False,
Require_Obj_Dirs => Error,
Allow_Invalid_External => Error,
Missing_Source_Files => Error,
Ignore_Missing_With => False);
end Prj;
gcc/ada/sem_ch6.adb
......@@ -2565,10 +2565,14 @@ package body Sem_Ch6 is
Set_Contract (Body_Id, Make_Contract (Sloc (Body_Id)));
Generate_Reference
(Body_Id, Body_Id, 'b', Set_Ref => False, Force => True);
Generate_Reference_To_Formals (Body_Id);
Install_Formals (Body_Id);
Push_Scope (Body_Id);
end if;
-- For stubs and bodies with no previous spec, generate references to
-- formals.
Generate_Reference_To_Formals (Body_Id);
end if;
-- If the return type is an anonymous access type whose designated type
......@@ -2600,7 +2604,7 @@ package body Sem_Ch6 is
-- 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.
-- 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.
if Nkind (Parent (N)) = N_Subunit
......@@ -2626,8 +2630,8 @@ package body Sem_Ch6 is
if not Conformant then
-- The stub was taken to be a new declaration. Indicate
-- that it lacks a body.
-- The stub was taken to be a new declaration. Indicate that
-- it lacks a body.
Set_Has_Completion (Old_Id, False);
end if;
......@@ -2651,7 +2655,7 @@ package body Sem_Ch6 is
end if;
-- 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.
if Is_Compilation_Unit (Body_Id)
......@@ -2763,8 +2767,8 @@ package body Sem_Ch6 is
if Present (Last_Real_Spec_Entity) then
-- No body entities (happens when the only real spec entities
-- come from precondition and postcondition pragmas)
-- No body entities (happens when the only real spec entities come
-- from precondition and postcondition pragmas).
if No (Last_Entity (Body_Id)) then
Set_First_Entity
......@@ -2781,8 +2785,8 @@ package body Sem_Ch6 is
Set_Last_Entity (Body_Id, Last_Entity (Spec_Id));
Set_Last_Entity (Spec_Id, Last_Real_Spec_Entity);
-- Case where there are no spec entities, in this case there can
-- be no body entities either, so just move everything.
-- Case where there are no spec entities, in this case there can be
-- no body entities either, so just move everything.
else
pragma Assert (No (Last_Entity (Body_Id)));
......@@ -2804,7 +2808,7 @@ package body Sem_Ch6 is
-- might be the following common idiom for a stubbed function:
-- statement of the procedure raises an exception. In particular this
-- 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;
-- X : Some_Type;
......
gcc/ada/sinput-p.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -97,7 +97,7 @@ package body Sinput.P is
-----------------------
function Load_Project_File (Path : String) return Source_File_Index is
X : Source_File_Index;
X : Source_File_Index;
begin
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