+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
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)
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
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
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
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.
-- 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
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;
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
-- 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
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;
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)
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
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)));
-- 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;
-- --
-- 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- --
-----------------------
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);