[multiple changes]
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. From-SVN: r244355
This commit is contained in:
Arnaud Charlet
parent
84e1361435
commit
10c2c151f1
8 changed files with 349 additions and 97 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 (
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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' =>
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue