2014-05-21 Robert Dewar <dewar@adacore.com>
+ * sem_ch13.adb (Analyze_Aspect_Specifications):
+ Insert_Delayed_Pragma is now used for the case of Attach_Handler.
+ * sem_prag.adb: Minor comment improvements.
+
+2014-05-21 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch12.adb (Install_Body): When checking whether freezing of
+ instantiation must be delayed, verify that the common enclosing
+ subprogram to generic and instance is in fact an overloadable
+ entity.
+
+2014-05-21 Vincent Celier <celier@adacore.com>
+
+ * makeutl.adb (Mains.Complete_Mains.Do_Complete): Look for all
+ mains with the same name and fail if there is more than one.
+ * prj.ads, prj.adb (Find_All_Sources): New function
+
+2014-05-21 Robert Dewar <dewar@adacore.com>
+
* sem_ch13.adb: Minor reformatting.
* lib-xref-spark_specific.adb, sem_util.adb: Minor reformatting.
* sem_prag.adb: Minor error message improvement.
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2014, 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- --
-- no need to process them in turn.
J := Names.Last;
- loop
+ Main_Loop : loop
declare
File : Main_Info := Names.Table (J);
Main_Id : File_Name_Type := File.File;
-- search for the base name though, and if needed
-- check later that we found the correct file.
- Source := Find_Source
- (In_Tree => File.Tree,
- Project => File.Project,
- Base_Name => Main_Id,
- Index => File.Index,
- In_Imported_Only => True);
+ declare
+ Sources : constant Source_Ids :=
+ Find_All_Sources
+ (In_Tree => File.Tree,
+ Project => File.Project,
+ Base_Name => Main_Id,
+ Index => File.Index,
+ In_Imported_Only => True);
+
+ begin
+ if Is_Absolute then
+ for J in Sources'Range loop
+ if File_Name_Type (Sources (J).Path.Name) =
+ File.File
+ then
+ Source := Sources (J);
+ exit;
+ end if;
+ end loop;
+
+ elsif Sources'Length > 1 then
+
+ -- This is only allowed if the units are from
+ -- the same multi-unit source file.
+
+ Source := Sources (1);
+
+ for J in 2 .. Sources'Last loop
+ if Sources (J).Path /= Source.Path
+ or else Sources (J).Index = Source.Index
+ then
+ Error_Msg_File_1 := Main_Id;
+ Prj.Err.Error_Msg
+ (Flags, "several main sources {",
+ No_Location, File.Project);
+ exit Main_Loop;
+ end if;
+ end loop;
+
+ elsif Sources'Length = 1 then
+ Source := Sources (Sources'First);
+ end if;
+ end;
if Source = No_Source then
Source := Find_File_Add_Extension
- (File.Tree, Get_Name_String (Main_Id));
+ (File.Tree, Get_Name_String (Main_Id));
end if;
if Is_Absolute
end;
J := J - 1;
- exit when J < Names.First;
- end loop;
+ exit Main_Loop when J < Names.First;
+ end loop Main_Loop;
end if;
if Total_Errors_Detected > 0 then
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2014, 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- --
return Result;
end Find_Source;
+ ----------------------
+ -- Find_All_Sources --
+ ----------------------
+
+ function Find_All_Sources
+ (In_Tree : Project_Tree_Ref;
+ Project : Project_Id;
+ In_Imported_Only : Boolean := False;
+ In_Extended_Only : Boolean := False;
+ Base_Name : File_Name_Type;
+ Index : Int := 0) return Source_Ids
+ is
+ Result : Source_Ids (1 .. 1_000);
+ Last : Natural := 0;
+
+ type Empty_State is null record;
+ No_State : Empty_State;
+
+ procedure Look_For_Sources
+ (Proj : Project_Id;
+ Tree : Project_Tree_Ref;
+ State : in out Empty_State);
+ -- Look for Base_Name in the sources of Proj
+
+ ----------------------
+ -- Look_For_Sources --
+ ----------------------
+
+ procedure Look_For_Sources
+ (Proj : Project_Id;
+ Tree : Project_Tree_Ref;
+ State : in out Empty_State)
+ is
+ Iterator : Source_Iterator;
+ Src : Source_Id;
+
+ begin
+ State := No_State;
+
+ Iterator := For_Each_Source (In_Tree => Tree, Project => Proj);
+ while Element (Iterator) /= No_Source loop
+ if Element (Iterator).File = Base_Name
+ and then (Index = 0
+ or else
+ (Element (Iterator).Unit /= No_Unit_Index
+ and then
+ Element (Iterator).Index = Index))
+ then
+ Src := Element (Iterator);
+
+ -- If the source has been excluded, continue looking. We will
+ -- get the excluded source only if there is no other source
+ -- with the same base name that is not locally removed.
+
+ if not Element (Iterator).Locally_Removed then
+ Last := Last + 1;
+ Result (Last) := Src;
+ end if;
+ end if;
+
+ Next (Iterator);
+ end loop;
+ end Look_For_Sources;
+
+ procedure For_Imported_Projects is new For_Every_Project_Imported
+ (State => Empty_State, Action => Look_For_Sources);
+
+ Proj : Project_Id;
+
+ -- Start of processing for Find_All_Sources
+
+ begin
+ if In_Extended_Only then
+ Proj := Project;
+ while Proj /= No_Project loop
+ Look_For_Sources (Proj, In_Tree, No_State);
+ exit when Last > 0;
+ Proj := Proj.Extends;
+ end loop;
+
+ elsif In_Imported_Only then
+ Look_For_Sources (Project, In_Tree, No_State);
+
+ if Last = 0 then
+ For_Imported_Projects
+ (By => Project,
+ Tree => In_Tree,
+ Include_Aggregated => False,
+ With_State => No_State);
+ end if;
+
+ else
+ Look_For_Sources (No_Project, In_Tree, No_State);
+ end if;
+
+ return Result (1 .. Last);
+ end Find_All_Sources;
+
----------
-- Hash --
----------
function Hash is new GNAT.HTable.Hash (Header_Num => Header_Num);
-- Used in implementation of other functions Hash below
+ ----------
+ -- Hash --
+ ----------
+
function Hash (Name : File_Name_Type) return Header_Num is
begin
return Hash (Get_Name_String (Name));
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2014, 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- --
-- Else it searches in the whole tree.
-- If Index is specified, this only search for a source with that index.
+ type Source_Ids is array (Positive range <>) of Source_Id;
+ No_Sources : constant Source_Ids := (1 .. 0 => No_Source);
+
+ function Find_All_Sources
+ (In_Tree : Project_Tree_Ref;
+ Project : Project_Id;
+ In_Imported_Only : Boolean := False;
+ In_Extended_Only : Boolean := False;
+ Base_Name : File_Name_Type;
+ Index : Int := 0) return Source_Ids;
+ -- Find all source files with the given name.
+ -- If In_Extended_Only is True, it will search in project and the project
+ -- it extends, but not in the imported projects.
+ -- Elsif In_Imported_Only is True, it will search in project and the
+ -- projects it imports, but not in the others or in aggregated projects.
+ -- Else it searches in the whole tree.
+ -- If Index is specified, this only search for sources with that index.
+
-----------------------
-- Project_Tree_Data --
-----------------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
Set_Instance_Env (Gen_Unit, Act_Decl_Id);
Set_Defining_Unit_Name (Act_Spec, Act_Decl_Name);
Set_Is_Generic_Instance (Act_Decl_Id);
-
Set_Generic_Parent (Act_Spec, Gen_Unit);
-- References to the generic in its own declaration or its body are
Must_Delay : Boolean;
- function Enclosing_Subp (Id : Entity_Id) return Entity_Id;
- -- Find subprogram (if any) that encloses instance and/or generic body
+ function In_Same_Enclosing_Subp return Boolean;
+ -- Check whether instance and generic body are within same subprogram.
function True_Sloc (N : Node_Id) return Source_Ptr;
-- If the instance is nested inside a generic unit, the Sloc of the
-- origin of a node by finding the maximum sloc of any ancestor node.
-- Why is this not equivalent to Top_Level_Location ???
- --------------------
- -- Enclosing_Subp --
- --------------------
+ ----------------------------
+ -- In_Same_Enclosing_Subp --
+ ----------------------------
- function Enclosing_Subp (Id : Entity_Id) return Entity_Id is
+ function In_Same_Enclosing_Subp return Boolean is
Scop : Entity_Id;
+ Subp : Entity_Id;
begin
- Scop := Scope (Id);
+ Scop := Scope (Act_Id);
while Scop /= Standard_Standard
and then not Is_Overloadable (Scop)
loop
Scop := Scope (Scop);
end loop;
- return Scop;
- end Enclosing_Subp;
+ if Scop = Standard_Standard then
+ return False;
+ else
+ Subp := Scop;
+ end if;
+
+ Scop := Scope (Gen_Id);
+ while Scop /= Standard_Standard loop
+ if Scop = Subp then
+ return True;
+ end if;
+
+ Scop := Scope (Scop);
+ end loop;
+
+ return False;
+ end In_Same_Enclosing_Subp;
---------------
-- True_Sloc --
and then True_Sloc (N) < Sloc (Orig_Body)))
and then Is_In_Main_Unit (Gen_Unit)
and then (Scope (Act_Id) = Scope (Gen_Id)
- or else
- Enclosing_Subp (Act_Id) = Enclosing_Subp (Gen_Id)));
+ or else In_Same_Enclosing_Subp));
-- If this is an early instantiation, the freeze node is placed after
-- the generic body. Otherwise, if the generic appears in an instance,
procedure Insert_Delayed_Pragma (Prag : Node_Id);
-- Insert a postcondition-like pragma into the tree depending on the
-- context. Prag must denote one of the following: Pre, Post, Depends,
- -- Global or Contract_Cases.
+ -- Global or Contract_Cases. This procedure is also used for the case
+ -- of Attach_Handler which has similar requirements for placement.
--------------------------------
-- Decorate_Aspect_And_Pragma --
Check_Restriction_No_Specification_Of_Aspect (Aspect);
- -- Analyze this aspect (actual analysis is delayed till later)
+ -- Mark aspect analyzed (actual analysis is delayed till later)
Set_Analyzed (Aspect);
Set_Entity (Aspect, E);
Expression => Relocate_Node (Expr))),
Pragma_Name => Name_Attach_Handler);
+ -- We need to insert this pragma into the tree to get proper
+ -- processing and to look valid from a placement viewpoint.
+
+ Insert_Delayed_Pragma (Aitem);
+ goto Continue;
+
-- Dynamic_Predicate, Predicate, Static_Predicate
when Aspect_Dynamic_Predicate |
-- For pragma case (as opposed to access case), check placement.
-- We don't need to do that for aspects, because we have the
- -- check that they are apply an appropriate procedure.
+ -- check that they aspect applies an appropriate procedure.
if not From_Aspect_Specification (N)
and then Parent (N) /= Protected_Definition (Parent (Proc_Scope))
Set_Treat_As_Volatile (E);
else
- Error_Pragma_Arg
- ("inappropriate entity for pragma%", Arg1);
+ Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1);
end if;
- -- The following check are only relevant when SPARK_Mode is on as
- -- those are not a standard Ada legality rule. Pragma Volatile can
+ -- The following check is only relevant when SPARK_Mode is on as
+ -- this is not a standard Ada legality rule. Pragma Volatile can
-- only apply to a full type declaration or an object declaration
-- (SPARK RM C.6(1)).
projects / platform / upstream / linaro-gcc.git / commitdiff