From 0df5ae93e08e17fbe36bfcd1bda8ea24af968a64 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 21 May 2014 15:01:59 +0200 Subject: [PATCH] [multiple changes] 2014-05-21 Robert Dewar * 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 * 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 * 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 From-SVN: r210702 --- gcc/ada/ChangeLog | 19 ++++++++ gcc/ada/makeutl.adb | 59 +++++++++++++++++++----- gcc/ada/prj.adb | 104 ++++++++++++++++++++++++++++++++++++++++++- gcc/ada/prj.ads | 20 ++++++++- gcc/ada/sem_ch12.adb | 40 +++++++++++------ gcc/ada/sem_ch13.adb | 11 ++++- gcc/ada/sem_prag.adb | 9 ++-- 7 files changed, 229 insertions(+), 33 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9e207fc3747..1ddf41cc177 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2014-05-21 Robert Dewar + + * 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 + + * 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 + + * 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 * sem_ch13.adb: Minor reformatting. diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index a220cbec0e2..d9772510cac 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -1732,7 +1732,7 @@ package body Makeutl is -- 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; @@ -1798,16 +1798,53 @@ package body Makeutl is -- 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 @@ -1883,8 +1920,8 @@ package body Makeutl is 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 diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 6a0a830fe10..a50823eec03 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -889,6 +889,104 @@ package body Prj is 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 -- ---------- @@ -896,6 +994,10 @@ package body Prj is 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)); diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 519e8740161..d0af1a2fda6 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -1525,6 +1525,24 @@ package Prj is -- 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 -- ----------------------- diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 5aa090446b6..c7d16692355 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -3588,7 +3588,6 @@ package body Sem_Ch12 is 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 @@ -8171,8 +8170,8 @@ package body Sem_Ch12 is 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 @@ -8182,23 +8181,39 @@ package body Sem_Ch12 is -- 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 -- @@ -8255,8 +8270,7 @@ package body Sem_Ch12 is 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, diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 8964bac6110..bf42b0eebc4 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1161,7 +1161,8 @@ package body Sem_Ch13 is 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 -- @@ -1463,7 +1464,7 @@ package body Sem_Ch13 is 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); @@ -1678,6 +1679,12 @@ package body Sem_Ch13 is 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 | diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 6764612175e..416eb047f84 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -4552,7 +4552,7 @@ package body Sem_Prag is -- 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)) @@ -6387,12 +6387,11 @@ package body Sem_Prag is 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)). -- 2.30.2