From patchwork Thu Jan 12 13:26:46 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 714459 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3tzmkz5755z9vFX for ; Fri, 13 Jan 2017 00:27:07 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="Y2A+QVdx"; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=hdBXsySbbvpalQs3z8s+ikcEVUEWznkKZMndMAFENnfV969jdA voo2R5GF1g8cRikJmAdmjgLPuuBwX4H728+e0Xbam8LO+bjtt3NVQ5KIUicLjCXH C1gek5eYvuJjFvTsgKSy7xZlgWfjBOOv9bIRz1uIhBlbrez6Skm1zSurE= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=R7ugpT5L9A5WOJ6bzEgY2XqczR4=; b=Y2A+QVdx5WRXa9bfh0Un l998woZwcT7AOo9bYMsTF3ywiY0I9XlfHqucV4fu2LHVd2ZaF4PVtjRUNEwQysF3 n0x3CTcMWK5G/QcJ9Yg02nl7piBzOJz23eLGGJzSVox1f21CiiO9U0YkZLt8TTT9 W4M4T/ts6xbvX6bou5MaN6A= Received: (qmail 123194 invoked by alias); 12 Jan 2017 13:26:58 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 123175 invoked by uid 89); 12 Jan 2017 13:26:57 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-0.8 required=5.0 tests=AWL, BAYES_00, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS, WEIRD_QUOTING autolearn=no version=3.3.2 spammy=Natural, bob, Processing, Called X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 12 Jan 2017 13:26:47 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 5208C1172A0; Thu, 12 Jan 2017 08:26:46 -0500 (EST) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id uwg+fD+jf33b; Thu, 12 Jan 2017 08:26:46 -0500 (EST) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 3D7D711724F; Thu, 12 Jan 2017 08:26:46 -0500 (EST) Received: by tron.gnat.com (Postfix, from userid 4192) id 397CB4A4; Thu, 12 Jan 2017 08:26:46 -0500 (EST) Date: Thu, 12 Jan 2017 08:26:46 -0500 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Bob Duff Subject: [Ada] Allow user-specified elaboration order constraints Message-ID: <20170112132646.GA137572@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This patch adds a new feature that allows the user to specify a particular elaboration order for some or all library items in the program. The following test should produce the following output: Command line: gprbuild -q -f -gnatE -g p-main.adb -bargs -l -felab-order.txt elab-order.txt file: -- This is the elaboration order: p (spec) -- Spec of p comes first. -- Then the spec of q, and so on: q (spec) r (spec) p (body) r (body) q (body) p.main (body) ada.exceptions (spec) -- Predefined unit should be ignored. no_such_thing (body) -- Nonexistent unit should be ignored. Test output: p (spec) <-- q (spec) q (spec) <-- r (spec) r (spec) <-- p (body) p (body) <-- r (body) r (body) <-- q (body) q (body) <-- p.main (body) "ada.exceptions%s": predefined unit ignored "no_such_thing%b": not present; ignored ELABORATION ORDER ada (spec) ada.characters (spec) ada.characters.handling (spec) ada.characters.latin_1 (spec) interfaces (spec) system (spec) system.address_operations (spec) system.address_operations (body) system.case_util (spec) system.case_util (body) system.img_int (spec) system.io (spec) system.io (body) system.parameters (spec) system.parameters (body) system.crtl (spec) interfaces.c_streams (spec) interfaces.c_streams (body) system.standard_library (spec) system.exceptions_debug (spec) system.exceptions_debug (body) system.storage_elements (spec) system.storage_elements (body) system.stack_checking (spec) system.stack_checking (body) system.traceback_entries (spec) system.traceback_entries (body) ada.exceptions (spec) system.soft_links (spec) system.unsigned_types (spec) system.img_uns (spec) system.val_lli (spec) system.val_llu (spec) system.val_util (spec) system.val_llu (body) system.val_lli (body) system.wch_con (spec) system.wch_con (body) system.wch_cnv (spec) system.wch_jis (spec) system.wch_jis (body) system.wch_cnv (body) system.wch_stw (spec) ada.exceptions.last_chance_handler (spec) ada.exceptions.last_chance_handler (body) ada.exceptions.traceback (spec) system.address_image (spec) system.bit_ops (spec) system.bit_ops (body) system.concat_2 (spec) system.concat_2 (body) system.concat_3 (spec) system.val_util (body) system.concat_3 (body) system.concat_4 (spec) system.concat_4 (body) system.concat_5 (spec) system.concat_5 (body) system.exception_table (spec) system.exception_table (body) ada.strings (spec) ada.strings.maps (spec) ada.strings.maps.constants (spec) interfaces.c (spec) system.exceptions (spec) system.exceptions (body) system.exceptions.machine (spec) system.assertions (spec) system.wch_stw (body) system.img_uns (body) system.img_int (body) system.assertions (body) system.exception_traces (spec) system.exception_traces (body) system.memory (spec) system.memory (body) system.standard_library (body) system.object_reader (spec) system.dwarf_lines (spec) system.secondary_stack (spec) interfaces.c (body) ada.strings.maps (body) system.soft_links (body) ada.characters.handling (body) system.secondary_stack (body) system.dwarf_lines (body) system.object_reader (body) system.address_image (body) ada.exceptions.traceback (body) system.traceback (spec) system.traceback (body) system.traceback.symbolic (spec) system.traceback.symbolic (body) ada.exceptions (body) p (spec) q (spec) r (spec) p (body) r (body) q (body) p.main (body) Ada code: with Q, R; package body P is procedure P_Proc is begin null; end P_Proc; end P; package P is procedure P_Proc; end P; procedure P.Main is begin null; end P.Main; with P; package body Q is procedure Q_Proc is begin null; end Q_Proc; end Q; with P; package Q is procedure Q_Proc; end Q; with P; package body R is procedure R_Proc is begin null; end R_Proc; end R; with P; package R is procedure R_Proc; end R; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-01-12 Bob Duff * binde.adb (Forced): New reason for a dependence. (Force_Elab_Order): Implementation of the new switch. * binde.ads: Minor comment fixes. * bindusg.adb: Add -f switch. Apparently, there was an -f switch long ago that is no longer supported; removed comment about that. * opt.ads (Force_Elab_Order_File): Name of file specified for -f switch. * switch-b.adb: Parse -f switch. Index: bindusg.adb =================================================================== --- bindusg.adb (revision 244350) +++ bindusg.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -113,8 +113,10 @@ Write_Line (" and enable symbolic tracebacks"); Write_Line (" -E Same as -Ea"); - -- The -f switch is voluntarily omitted, because it is obsolete + -- Line for -f switch + Write_Line (" -felab-order Force elaboration order"); + -- Line for -F switch Write_Line (" -F Force checking of elaboration Flags"); Index: switch-b.adb =================================================================== --- switch-b.adb (revision 244350) +++ switch-b.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2016, 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- -- @@ -28,6 +28,7 @@ with Osint; use Osint; with Opt; use Opt; +with System.OS_Lib; use System.OS_Lib; with System.WCh_Con; use System.WCh_Con; package body Switch.B is @@ -252,6 +253,22 @@ Ptr := Ptr + 1; end if; + -- Processing for f switch + + when 'f' => + if Ptr = Max then + Bad_Switch (Switch_Chars); + end if; + + Force_Elab_Order_File := + new String'(Switch_Chars (Ptr + 1 .. Max)); + + Ptr := Max + 1; + + if not Is_Read_Accessible_File (Force_Elab_Order_File.all) then + Osint.Fail (Force_Elab_Order_File.all & ": file not found"); + end if; + -- Processing for F switch when 'F' => Index: binde.adb =================================================================== --- binde.adb (revision 244350) +++ binde.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -33,6 +33,7 @@ with Output; use Output; with System.Case_Util; use System.Case_Util; +with System.OS_Lib; package body Binde is @@ -62,9 +63,13 @@ -- After directly with's Before, so the spec of Before must be -- elaborated before After is elaborated. + Forced, + -- Before and After come from a pair of lines in the forced elaboration + -- order file. + Elab, -- After directly mentions Before in a pragma Elaborate, so the - -- body of Before must be elaborate before After is elaborated. + -- body of Before must be elaborated before After is elaborated. Elab_All, -- After either mentions Before directly in a pragma Elaborate_All, @@ -73,12 +78,12 @@ -- traces the dependencies in the latter case. Elab_All_Desirable, - -- This is just like Elab_All, except that the elaborate all was not + -- This is just like Elab_All, except that the Elaborate_All was not -- explicitly present in the source, but rather was created by the -- front end, which decided that it was "desirable". Elab_Desirable, - -- This is just like Elab, except that the elaborate was not + -- This is just like Elab, except that the Elaborate was not -- explicitly present in the source, but rather was created by the -- front end, which decided that it was "desirable". @@ -111,19 +116,19 @@ Elab_All_Link : Elab_All_Id; -- If Reason = Elab_All or Elab_Desirable, then this points to the -- first elment in a list of Elab_All entries that record the with - -- chain leading resulting in this particular dependency. + -- chain resulting in this particular dependency. end record; -- Note on handling of Elaborate_Body. Basically, if we have a pragma - -- Elaborate_Body in a unit, it means that the spec and body have to - -- be handled as a single entity from the point of view of determining - -- an elaboration order. What we do is to essentially remove the body - -- from consideration completely, and transfer all its links (other - -- than the spec link) to the spec. Then when then the spec gets chosen, - -- we choose the body right afterwards. We mark the links that get moved - -- from the body to the spec by setting their Elab_Body flag True, so - -- that we can understand what is going on. + -- Elaborate_Body in a unit, it means that the spec and body have to be + -- handled as a single entity from the point of view of determining an + -- elaboration order. What we do is to essentially remove the body from + -- consideration completely, and transfer all its links (other than the + -- spec link) to the spec. Then when the spec gets chosen, we choose the + -- body right afterwards. We mark the links that get moved from the body to + -- the spec by setting their Elab_Body flag True, so that we can understand + -- what is going on. Succ_First : constant := 1; @@ -175,7 +180,7 @@ -- Position in elaboration order (zero = not placed yet) Visited : Boolean; - -- Used in computing transitive closure for elaborate all and + -- Used in computing transitive closure for Elaborate_All and -- also in locating cycles and paths in the diagnose routines. Elab_Position : Natural; @@ -233,15 +238,15 @@ function Corresponding_Body (U : Unit_Id) return Unit_Id; pragma Inline (Corresponding_Body); - -- Given a unit which is a spec for which there is a separate body, return + -- Given a unit that is a spec for which there is a separate body, return -- the unit id of the body. It is an error to call this routine with a unit - -- that is not a spec, or which does not have a separate body. + -- that is not a spec, or that does not have a separate body. function Corresponding_Spec (U : Unit_Id) return Unit_Id; pragma Inline (Corresponding_Spec); - -- Given a unit which is a body for which there is a separate spec, return + -- Given a unit that is a body for which there is a separate spec, return -- the unit id of the spec. It is an error to call this routine with a unit - -- that is not a body, or which does not have a separate spec. + -- that is not a body, or that does not have a separate spec. procedure Diagnose_Elaboration_Problem; -- Called when no elaboration order can be found. Outputs an appropriate @@ -254,20 +259,23 @@ Link : Elab_All_Id); -- Used to compute the transitive closure of elaboration links for an -- Elaborate_All pragma (Reason = Elab_All) or for an indication of - -- Elaborate_All_Desirable (Reason = Elab_All_Desirable). Unit After has - -- a pragma Elaborate_All or the front end has determined that a reference - -- probably requires Elaborate_All is required, and unit Before must be - -- previously elaborated. First a link is built making sure that unit - -- Before is elaborated before After, then a recursive call ensures that - -- we also build links for any units needed by Before (i.e. these units - -- must/should also be elaborated before After). Link is used to build - -- a chain of Elab_All_Entries to explain the reason for a link. The - -- value passed is the chain so far. + -- Elaborate_All_Desirable (Reason = Elab_All_Desirable). Unit After has a + -- pragma Elaborate_All or the front end has determined that a reference + -- probably requires Elaborate_All, and unit Before must be previously + -- elaborated. First a link is built making sure that unit Before is + -- elaborated before After, then a recursive call ensures that we also + -- build links for any units needed by Before (i.e. these units must/should + -- also be elaborated before After). Link is used to build a chain of + -- Elab_All_Entries to explain the reason for a link. The value passed is + -- the chain so far. procedure Elab_Error_Msg (S : Successor_Id); -- Given a successor link, outputs an error message of the form -- "$ must be elaborated before $ ..." where ... is the reason. + procedure Force_Elab_Order; + -- Gather dependencies from the forced elaboration order file (-f switch) + procedure Gather_Dependencies; -- Compute dependencies, building the Succ and UNR tables @@ -281,10 +289,10 @@ function Is_Waiting_Body (U : Unit_Id) return Boolean; pragma Inline (Is_Waiting_Body); - -- Determines if U is a waiting body, defined as a body which has + -- Determines if U is a waiting body, defined as a body that has -- not been elaborated, but whose spec has been elaborated. - function Make_Elab_Entry + function Make_Elab_All_Entry (Unam : Unit_Name_Type; Link : Elab_All_Id) return Elab_All_Id; -- Make an Elab_All_Entries table entry with the given Unam and Link @@ -419,7 +427,7 @@ -- body of A or B? -- The normal waiting body preference would have placed the body of - -- A before the spec of B if it could. Since it could not, there it + -- A before the spec of B if it could. Since it could not, then it -- must be the case that A depends on B. It is therefore a good idea -- to put the body of B first. @@ -445,7 +453,7 @@ if not Debug_Flag_O then - -- The following deal with the case of specs which have been marked + -- The following deal with the case of specs that have been marked -- as Elaborate_Body_Desirable. We generally want to delay these -- specs as long as possible, so that the bodies have a better chance -- of being elaborated closer to the specs. @@ -521,13 +529,15 @@ Cspec : Unit_Id; begin - Succ.Increment_Last; - Succ.Table (Succ.Last).Before := Before; - Succ.Table (Succ.Last).Next := UNR.Table (Before).Successors; - UNR.Table (Before).Successors := Succ.Last; - Succ.Table (Succ.Last).Reason := R; - Succ.Table (Succ.Last).Reason_Unit := Cur_Unit; - Succ.Table (Succ.Last).Elab_All_Link := Ea_Id; + Succ.Append + ((Before => Before, + After => No_Unit_Id, -- filled in below + Next => UNR.Table (Before).Successors, + Reason => R, + Elab_Body => False, -- set correctly below + Reason_Unit => Cur_Unit, + Elab_All_Link => Ea_Id)); + UNR.Table (Before).Successors := Succ.Last; -- Deal with special Elab_Body case. If the After of this link is -- a body whose spec has Elaborate_All set, and this is not the link @@ -721,7 +731,7 @@ Choose (U); return True; - -- All done if already visited, otherwise mark as visited + -- All done if already visited elsif UNR.Table (U).Visited then return False; @@ -751,7 +761,7 @@ -- Start of processing for Find_Path begin - -- Initialize all non-chosen nodes to not visisted yet + -- Initialize all non-chosen nodes to not visited yet for U in Units.First .. Units.Last loop UNR.Table (U).Visited := UNR.Table (U).Elab_Position /= 0; @@ -762,7 +772,7 @@ return Find_Link (Ufrom, 0); end Find_Path; - -- Start of processing for Diagnose_Elaboration_Error + -- Start of processing for Diagnose_Elaboration_Problem begin Set_Standard_Error; @@ -951,7 +961,7 @@ (Unit_Id_Of (Withs.Table (W).Uname), After, Reason, - Make_Elab_Entry (Withs.Table (W).Uname, Link)); + Make_Elab_All_Entry (Withs.Table (W).Uname, Link)); end; end if; end loop; @@ -962,7 +972,7 @@ Elab_All_Links (Corresponding_Body (Before), After, Reason, - Make_Elab_Entry + Make_Elab_All_Entry (Units.Table (Corresponding_Body (Before)).Uname, Link)); end if; end Elab_All_Links; @@ -1006,6 +1016,11 @@ (" reason: with clause", Info => True); + when Forced => + Error_Msg_Output + (" reason: forced by -f switch", + Info => True); + when Elab => Error_Msg_Output (" reason: pragma Elaborate in unit $", @@ -1075,12 +1090,13 @@ -- Initialize unit table for elaboration control for U in Units.First .. Units.Last loop - UNR.Increment_Last; - UNR.Table (UNR.Last).Successors := No_Successor; - UNR.Table (UNR.Last).Num_Pred := 0; - UNR.Table (UNR.Last).Nextnp := No_Unit_Id; - UNR.Table (UNR.Last).Elab_Order := 0; - UNR.Table (UNR.Last).Elab_Position := 0; + UNR.Append + ((Successors => No_Successor, + Num_Pred => 0, + Nextnp => No_Unit_Id, + Elab_Order => 0, + Visited => False, + Elab_Position => 0)); end loop; -- Output warning if -p used with no -gnatE units @@ -1186,6 +1202,193 @@ end loop Outer; end Find_Elab_Order; + ---------------------- + -- Force_Elab_Order -- + ---------------------- + + procedure Force_Elab_Order is + use System.OS_Lib; + -- There is a lot of fiddly string manipulation below, because we don't + -- want to depend on misc utility packages like Ada.Characters.Handling. + + function Read_File (Name : String) return String_Ptr; + -- Read the entire contents of the named file + + function Get_Line return String; + -- Read the next line from the file content read by Read_File. Strip + -- leading and trailing blanks. Convert "(spec)" or "(body)" to + -- "%s"/"%b". Remove comments (Ada style; "--" to end of line). + + function Read_File (Name : String) return String_Ptr is + -- All of the following calls should succeed, because we checked the + -- file in Switch.B, but we double check and raise Program_Error on + -- failure, just in case. + + F : constant File_Descriptor := Open_Read (Name, Binary); + + begin + if F = Invalid_FD then + raise Program_Error; + end if; + + declare + Len : constant Natural := Natural (File_Length (F)); + Result : constant String_Ptr := new String (1 .. Len); + Len_Read : constant Natural := Read (F, Result (1)'Address, Len); + Status : Boolean; + + begin + if Len_Read /= Len then + raise Program_Error; + end if; + + Close (F, Status); + + if not Status then + raise Program_Error; + end if; + + return Result; + end; + end Read_File; + + S : String_Ptr := Read_File (Force_Elab_Order_File.all); + Cur : Positive := 1; + + function Get_Line return String is + First : Positive := Cur; + Last : Natural; + begin + -- Skip to end of line + + while Cur <= S'Last + and then S (Cur) /= ASCII.LF + and then S (Cur) /= ASCII.CR + loop + Cur := Cur + 1; + end loop; + + -- Strip leading blanks + + while First <= S'Last and then S (First) = ' ' loop + First := First + 1; + end loop; + + -- Strip trailing blanks and comment + + Last := Cur - 1; + + for J in First .. Last - 1 loop + if S (J .. J + 1) = "--" then + Last := J - 1; + exit; + end if; + end loop; + + while Last >= First and then S (Last) = ' ' loop + Last := Last - 1; + end loop; + + -- Convert "(spec)" or "(body)" to "%s"/"%b", strip trailing blanks + -- again. + + declare + Line : String renames S (First .. Last); + Spec_String : constant String := "(spec)"; + SL : constant Positive := Spec_String'Length; + Body_String : constant String := "(body)"; + BL : constant Positive := Body_String'Length; + Is_Spec, Is_Body : Boolean := False; + begin + if Line'Length >= SL + and then Line (Last - SL + 1 .. Last) = Spec_String + then + Is_Spec := True; + Last := Last - SL; + elsif Line'Length >= BL + and then Line (Last - BL + 1 .. Last) = Body_String + then + Is_Body := True; + Last := Last - BL; + end if; + + while Last >= First and then S (Last) = ' ' loop + Last := Last - 1; + end loop; + + -- Skip past LF or CR/LF + + if Cur <= S'Last and then S (Cur) = ASCII.CR then + Cur := Cur + 1; + end if; + + if Cur <= S'Last and then S (Cur) = ASCII.LF then + Cur := Cur + 1; + end if; + + if Is_Spec then + return Line (First .. Last) & "%s"; + elsif Is_Body then + return Line (First .. Last) & "%b"; + else + return Line; + end if; + end; + end Get_Line; + + Empty_Name : constant Unit_Name_Type := Name_Find (""); + Prev_Unit : Unit_Id := No_Unit_Id; + + begin + -- Loop through the file content, and build a dependency link for each + -- pair of lines. Ignore lines that should be ignored. + + while Cur <= S'Last loop + declare + Uname : constant Unit_Name_Type := Name_Find (Get_Line); + begin + if Uname = Empty_Name then + null; -- silently skip blank lines + + elsif Get_Name_Table_Int (Uname) = 0 + or else Unit_Id (Get_Name_Table_Int (Uname)) = No_Unit_Id + then + Write_Line + ("""" & Get_Name_String (Uname) & + """: not present; ignored"); + + else + declare + Cur_Unit : constant Unit_Id := Unit_Id_Of (Uname); + begin + if Is_Internal_File_Name (Units.Table (Cur_Unit).Sfile) then + Write_Line + ("""" & Get_Name_String (Uname) & + """: predefined unit ignored"); + + else + if Prev_Unit /= No_Unit_Id then + Write_Unit_Name (Units.Table (Prev_Unit).Uname); + Write_Str (" <-- "); + Write_Unit_Name (Units.Table (Cur_Unit).Uname); + Write_Eol; + + Build_Link + (Before => Prev_Unit, + After => Cur_Unit, + R => Forced); + end if; + + Prev_Unit := Cur_Unit; + end if; + end; + end if; + end; + end loop; + + Free (S); + end Force_Elab_Order; + ------------------------- -- Gather_Dependencies -- ------------------------- @@ -1250,7 +1453,7 @@ Elab_All_Links (Withed_Unit, U, Elab_All, - Make_Elab_Entry + Make_Elab_All_Entry (Withs.Table (W).Uname, No_Elab_All_Link)); -- Elaborate_All_Desirable case, for this we establish the @@ -1269,7 +1472,7 @@ Elab_All_Links (Withed_Unit, U, Elab_All_Desirable, - Make_Elab_Entry + Make_Elab_All_Entry (Withs.Table (W).Uname, No_Elab_All_Link)); -- Pragma Elaborate case. We must build a link for the @@ -1305,7 +1508,7 @@ end if; -- A limited_with does not establish an elaboration - -- dependence (that's the whole point).. + -- dependence (that's the whole point). elsif Withs.Table (W).Limited_With then null; @@ -1323,6 +1526,13 @@ end loop; end if; end loop; + + -- If -f switch was given, take into account dependences + -- specified in the file . + + if Force_Elab_Order_File /= null then + Force_Elab_Order; + end if; end Gather_Dependencies; ------------------ @@ -1344,9 +1554,9 @@ -- If we have a body with separate spec, test flags on the spec if Units.Table (U).Utype = Is_Body then - return Units.Table (U + 1).Preelab + return Units.Table (Corresponding_Spec (U)).Preelab or else - Units.Table (U + 1).Pure; + Units.Table (Corresponding_Spec (U)).Pure; -- Otherwise we have a spec or body acting as spec, test flags on unit @@ -1367,11 +1577,11 @@ and then UNR.Table (Corresponding_Spec (U)).Elab_Position /= 0; end Is_Waiting_Body; - --------------------- - -- Make_Elab_Entry -- - --------------------- + ------------------------- + -- Make_Elab_All_Entry -- + ------------------------- - function Make_Elab_Entry + function Make_Elab_All_Entry (Unam : Unit_Name_Type; Link : Elab_All_Id) return Elab_All_Id is @@ -1380,7 +1590,7 @@ Elab_All_Entries.Table (Elab_All_Entries.Last).Needed_By := Unam; Elab_All_Entries.Table (Elab_All_Entries.Last).Next_Elab := Link; return Elab_All_Entries.Last; - end Make_Elab_Entry; + end Make_Elab_All_Entry; ------------------------------- -- Pessimistic_Better_Choice -- @@ -1501,7 +1711,7 @@ -- body of A or B? -- The normal waiting body preference would have placed the body of - -- A before the spec of B if it could. Since it could not, there it + -- A before the spec of B if it could. Since it could not, then it -- must be the case that A depends on B. It is therefore a good idea -- to put the body of B last so that if there is an elaboration order -- problem, we will find it (that's what pessimistic order is about) @@ -1528,7 +1738,7 @@ if not Debug_Flag_O then - -- The following deal with the case of specs which have been marked + -- The following deal with the case of specs that have been marked -- as Elaborate_Body_Desirable. In the normal case, we generally want -- to delay the elaboration of these specs as long as possible, so -- that bodies have better chance of being elaborated closer to the Index: binde.ads =================================================================== --- binde.ads (revision 244350) +++ binde.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -32,10 +32,10 @@ package Binde is -- The following table records the chosen elaboration order. It is used - -- by Gen_Elab_Call to generate the sequence of elaboration calls. Note + -- by Gen_Elab_Calls to generate the sequence of elaboration calls. Note -- that units are included in this table even if they have no elaboration -- routine, since the table is also used to drive the generation of object - -- files in the binder output. Gen_Elab_Call skips any units that have no + -- files in the binder output. Gen_Elab_Calls skips any units that have no -- elaboration routine. package Elab_Order is new Table.Table ( Index: opt.ads =================================================================== --- opt.ads (revision 244350) +++ opt.ads (working copy) @@ -702,6 +702,10 @@ -- GNATMAKE, GPRBUILD -- Set to force recompilations even when the objects are up-to-date. + Force_Elab_Order_File : String_Ptr := null; + -- GNATBIND + -- File name specified for -f switch (the forced elaboration order file) + Front_End_Inlining : Boolean := False; -- GNAT -- Set True to activate inlining by front-end expansion (even on GCC