diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 16 | ||||
| -rw-r--r-- | gcc/ada/binde.adb | 332 | ||||
| -rw-r--r-- | gcc/ada/binde.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/bindusg.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 23 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/spark_xrefs.ads | 40 | ||||
| -rw-r--r-- | gcc/ada/switch-b.adb | 19 |
8 files changed, 349 insertions, 97 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4def327..787b324 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2017-01-12 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_ch6.adb: Minor reformatting. + * spark_xrefs.ads: minor cleanup of comments for SPARK xrefs + +2017-01-12 Bob Duff <duff@adacore.com> + + * 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. + 2017-01-12 Justin Squirek <squirek@adacore.com> * exp_ch6.adb (Check_View_Conversion): Created this function diff --git a/gcc/ada/binde.adb b/gcc/ada/binde.adb index 785afa5..7baf685 100644 --- a/gcc/ada/binde.adb +++ b/gcc/ada/binde.adb @@ -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 Osint; with Output; use Output; with System.Case_Util; use System.Case_Util; +with System.OS_Lib; package body Binde is @@ -62,9 +63,13 @@ package body Binde is -- 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 @@ package body Binde is -- 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 @@ package body Binde is 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 @@ package body Binde is -- 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 @@ package body Binde is 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 @@ package body Binde is 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 @@ package body Binde is 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 @@ package body Binde is -- 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 @@ package body Binde is 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 @@ package body Binde is 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 @@ package body Binde is 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 @@ package body Binde is -- 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 @@ package body Binde is 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 @@ package body Binde is (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 @@ package body Binde is 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 @@ package body Binde is (" 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 @@ package body Binde is -- 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 @@ package body Binde is 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 @@ package body Binde is 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 @@ package body Binde is 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 @@ package body Binde is 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 @@ package body Binde is end loop; end if; end loop; + + -- If -f<elab_order> switch was given, take into account dependences + -- specified in the file <elab_order>. + + if Force_Elab_Order_File /= null then + Force_Elab_Order; + end if; end Gather_Dependencies; ------------------ @@ -1344,9 +1554,9 @@ package body Binde is -- 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 @@ package body Binde is 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 @@ package body Binde is 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 @@ package body Binde is -- 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 @@ package body Binde is 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 diff --git a/gcc/ada/binde.ads b/gcc/ada/binde.ads index 7ffa13f..4481ef2 100644 --- a/gcc/ada/binde.ads +++ b/gcc/ada/binde.ads @@ -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 @@ with Types; use Types; 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 ( diff --git a/gcc/ada/bindusg.adb b/gcc/ada/bindusg.adb index f1a6177..ede1c0c 100644 --- a/gcc/ada/bindusg.adb +++ b/gcc/ada/bindusg.adb @@ -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,7 +113,9 @@ package body Bindusg is 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 diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 9b740ca..145ae93 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2265,9 +2265,8 @@ package body Exp_Ch6 is -- extra formal. procedure Check_View_Conversion (Formal : Entity_Id; Actual : Node_Id); - -- Adds Invariant checks for every intermediate type between - -- the range of a view converted argument to its ancestor (from - -- parent to child). + -- Adds invariant checks for every intermediate type between the range + -- of a view converted argument to its ancestor (from parent to child). function Inherited_From_Formal (S : Entity_Id) return Entity_Id; -- Within an instance, a type derived from an untagged formal derived @@ -2361,31 +2360,35 @@ package body Exp_Ch6 is procedure Check_View_Conversion (Formal : Entity_Id; Actual : Node_Id) is Arg : Entity_Id; - Curr_Typ : Entity_Id := Empty; + Curr_Typ : Entity_Id; Inv_Checks : List_Id; Par_Typ : Entity_Id; begin Inv_Checks := No_List; - -- Extract actual object for type conversions + -- Extract the argument from a potentially nested set of view + -- conversions. Arg := Actual; while Nkind (Arg) = N_Type_Conversion loop Arg := Expression (Arg); end loop; - -- Move up the derivation chain starting with the type of the - -- the formal parameter down to the type of the actual object. + -- Move up the derivation chain starting with the type of the formal + -- parameter down to the type of the actual object. - Par_Typ := Etype (Arg); + Curr_Typ := Empty; + Par_Typ := Etype (Arg); while Par_Typ /= Etype (Formal) and Par_Typ /= Curr_Typ loop Curr_Typ := Par_Typ; + if Has_Invariants (Curr_Typ) and then Present (Invariant_Procedure (Curr_Typ)) then -- Verify the invariate of the current type. Generate: - -- Invariant_Check_Curr_Typ (Curr_Typ (Arg)); + + -- <Curr_Typ>Invariant (Curr_Typ (Arg)); Prepend_New_To (Inv_Checks, Make_Procedure_Call_Statement (Loc, @@ -3292,7 +3295,7 @@ package body Exp_Ch6 is -- Invariant checks are performed for every intermediate type between -- the range of a view converted argument to its ancestor (from -- parent to child) if it is passed as an "out" or "in out" parameter - -- after executing the call (RM 7.3.2 (11-14)). + -- after executing the call (RM 7.3.2 (12/3, 13/3, 14/3)). if Ekind (Formal) /= E_In_Parameter and then Nkind (Actual) = N_Type_Conversion diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 4027fab..1a57074 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -702,6 +702,10 @@ package Opt is -- 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 diff --git a/gcc/ada/spark_xrefs.ads b/gcc/ada/spark_xrefs.ads index 704b1ea..f3cbdfd 100644 --- a/gcc/ada/spark_xrefs.ads +++ b/gcc/ada/spark_xrefs.ads @@ -25,9 +25,9 @@ -- This package defines tables used to store information needed for the SPARK -- mode. It is used by procedures in Lib.Xref.SPARK_Specific to build the --- SPARK specific cross-references information before writing it out to the --- ALI file, and by Get_SPARK_Xrefs/Put_SPARK_Xrefs to read and write the text --- form that is used in the ALI file. +-- SPARK-specific cross-reference information before writing it to the ALI +-- file, and by Get_SPARK_Xrefs/Put_SPARK_Xrefs to read/write the textual +-- representation that is stored in the ALI file. with Types; use Types; with GNAT.Table; @@ -128,8 +128,9 @@ package SPARK_Xrefs is -- -- Xref Section -- -- ------------------ - -- A second section defines cross-references useful for computing the set - -- of global variables read/written in each subprogram/package. + -- A second section defines cross-references useful for computing global + -- variables read/written in each subprogram/package/protected_type/ + -- task_type. -- FX dependency-number filename . entity-number entity @@ -197,14 +198,13 @@ package SPARK_Xrefs is -- The Generated Globals section is located at the end of the ALI file - -- All lines introducing information related to the Generated Globals - -- have the string "GG" appearing in the beginning. This string ("GG") - -- should therefore not be used in the beginning of any line that does - -- not relate to Generated Globals. + -- All lines with information related to the Generated Globals begin with + -- string "GG". This string should therefore not be used in the beginning + -- of any line not related to Generated Globals. - -- The processing (reading and writing) of this section happens in - -- package Flow_Generated_Globals (from the SPARK 2014 sources), for - -- further information please refer there. + -- The processing (reading and writing) of this section happens in package + -- Flow_Generated_Globals (from the SPARK 2014 sources), for further + -- information please refer there. ---------------- -- Xref Table -- @@ -235,20 +235,20 @@ package SPARK_Xrefs is -- Column number for the entity referenced File_Num : Nat; - -- Set to the file dependency number for the cross-reference. Note - -- that if no file entry is present explicitly, this is just a copy - -- of the reference for the current cross-reference section. + -- File dependency number for the cross-reference. Note that if no file + -- entry is present explicitly, this is just a copy of the reference for + -- the current cross-reference section. Scope_Num : Nat; - -- Set to the scope number for the cross-reference. Note that if no - -- scope entry is present explicitly, this is just a copy of the - -- reference for the current cross-reference section. + -- Scope number for the cross-reference. Note that if no scope entry is + -- present explicitly, this is just a copy of the reference for the + -- current cross-reference section. Line : Nat; -- Line number for the reference Rtype : Character; - -- Indicates type of reference, using code used in ALI file: + -- Indicates type of the reference, using code used in ALI file: -- r = reference -- c = reference to constant object -- m = modification @@ -348,7 +348,7 @@ package SPARK_Xrefs is Unit_File_Name : String_Ptr; -- Pointer to file name for unit in ALI file, when File_Name refers to a - -- subunit. Otherwise null. + -- subunit; otherwise null. File_Num : Nat; -- Dependency number in ALI file diff --git a/gcc/ada/switch-b.adb b/gcc/ada/switch-b.adb index b26c583..71ee61a 100644 --- a/gcc/ada/switch-b.adb +++ b/gcc/ada/switch-b.adb @@ -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 Debug; use Debug; 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 @@ package body Switch.B is 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' => |