CbC/CbC_gcc: gcc/ada/lib-writ.adb comparison

comparison gcc/ada/lib-writ.adb @ 131:84e7813d76e9

gcc-8.2

author	mir3636
date	Thu, 25 Oct 2018 07:37:49 +0900
parents	04ced10e8804
children	1830386684a0

comparison

equal deleted inserted replaced

-:04ced10e8804
+:84e7813d76e9
 --                                                                          --
 --                             L I B . W R I T                              --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2018, 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- --
 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
 Elab_All_Des_Flags : array (Units.First .. Last_Unit) of Boolean;
 --  Array of flags to show which units have Elaborate_All_Desirable set
 type Yes_No is (Unknown, Yes, No);
-Implicit_With : array (Units.First .. Last_Unit) of Yes_No;
+Has_Implicit_With : array (Units.First .. Last_Unit) of Yes_No;
 --  Indicates if an implicit with has been given for the unit. Yes if
---  certainly present, no if certainly absent, unkonwn if not known.
+--  certainly present, No if certainly absent, Unknown if not known.
 Sdep_Table : Unit_Ref_Table (1 .. Pos (Last_Unit - Units.First + 2));
 --  Sorted table of source dependencies. One extra entry in case we
 --  have to add a dummy entry for System.
 Num_Sdep : Nat := 0;
 --  Number of active entries in Sdep_Table
-flag_compare_debug : Int;
-pragma Import (C, flag_compare_debug);
---  Import from toplev.c
 -----------------------
 -- Local Subprograms --
 -----------------------
 procedure Collect_Withs (Cunit : Node_Id);
---  Collect with lines for entries in the context clause of the
+--  Collect with lines for entries in the context clause of the given
---  given compilation unit, Cunit.
+--  compilation unit, Cunit.
 procedure Update_Tables_From_ALI_File;
 --  Given an up to date ALI file (see Up_To_Date_ALI_file_Exists
 --  function), update tables from the ALI information, including
 --  specifically the Compilation_Switches table.
 -------------------
 -- Collect_Withs --
 -------------------
 procedure Collect_Withs (Cunit : Node_Id) is
+function Is_Implicit_With_Clause (Clause : Node_Id) return Boolean;
+pragma Inline (Is_Implicit_With_Clause);
+--  Determine whether a with clause denoted by Clause is implicit
+-----------------------------
+-- Is_Implicit_With_Clause --
+-----------------------------
+function Is_Implicit_With_Clause (Clause : Node_Id) return Boolean is
+begin
+--  With clauses created for ancestor units are marked as internal,
+--  however, they emulate the semantics in Ada RM 10.1.2 (6/2),
+--  where
+--
+--    with A.B;
+--
+--  is almost equivalent to
+--
+--    with A;
+--    with A.B;
+--
+--  For ALI encoding purposes, they are considered to be explicit.
+--  Note that the clauses cannot be marked as explicit because they
+--  will be subjected to various checks related to with clauses and
+--  possibly cause false positives.
+if Parent_With (Clause) then
+return False;
+else
+return Implicit_With (Clause);
+end if;
+end Is_Implicit_With_Clause;
+--  Local variables
 Item : Node_Id;
 Unum : Unit_Number_Type;
+--  Start of processing for Collect_Withs
 begin
 Item := First (Context_Items (Cunit));
 while Present (Item) loop
 else
 Set_From_Limited_With (Cunit_Entity (Unum));
 end if;
-if Implicit_With (Unum) /= Yes then
+if Is_Implicit_With_Clause (Item) then
-if Implicit_With_From_Instantiation (Item) then
-Implicit_With (Unum) := Yes;
+--  A previous explicit with clause withs the unit. Retain
+--  this classification, as it reflects the source relations
+--  between units.
+if Has_Implicit_With (Unum) = No then
+null;
+--  Otherwise this is either the first time any clause withs
+--  the unit, or the unit is already implicitly withed.
 else
-Implicit_With (Unum) := No;
+Has_Implicit_With (Unum) := Yes;
 end if;
+--  Otherwise the current with clause is explicit. Such clauses
+--  take precedence over existing implicit clauses because they
+--  reflect the source relations between unit.
+else
+Has_Implicit_With (Unum) := No;
 end if;
 end if;
 Next (Item);
 end loop;
 With_Flags         (J) := False;
 Elab_Flags         (J) := False;
 Elab_All_Flags     (J) := False;
 Elab_Des_Flags     (J) := False;
 Elab_All_Des_Flags (J) := False;
-Implicit_With      (J) := Unknown;
+Has_Implicit_With  (J) := Unknown;
 end loop;
 Collect_Withs (Unode);
 --  For a body, we must also check for any subunits which belong to
 Note_Unit := Main_Unit;
 else
 Note_Unit := U;
 end if;
-if Note_Unit = Unit_Num then
+--  No action needed for pragmas removed by the expander (for
+--  example, pragmas of ignored ghost entities).
+if Nkind (N) = N_Null_Statement then
+pragma Assert (Nkind (Original_Node (N)) = N_Pragma);
+null;
+elsif Note_Unit = Unit_Num then
 Write_Info_Initiate ('N');
 Write_Info_Char (' ');
-case Pragma_Name_Unmapped (N) is
+case Pragma_Name (N) is
 when Name_Annotate =>
 C := 'A';
 when Name_Comment =>
 C := 'C';
 when Name_Ident =>
 (Nam : in out File_Name_Type;
 Idx : Nat);
 --  Write source file name Nam and ALI file name for unit index Idx.
 --  Possibly change Nam to lowercase (generating a new file name).
---------------------------
+---------------------------
--- Write_With_File_Name --
+-- Write_With_File_Names --
---------------------------
+---------------------------
 procedure Write_With_File_Names
 (Nam : in out File_Name_Type;
 Idx : Nat)
 is
 Cunit := Units.Table (Unum).Cunit;
 Uname := Units.Table (Unum).Unit_Name;
 Fname := Units.Table (Unum).Unit_File_Name;
-if Implicit_With (Unum) = Yes then
+--  Limited with clauses must be processed first because they are
-Write_Info_Initiate ('Z');
+--  the most specific among the three kinds.
-elsif Ekind (Cunit_Entity (Unum)) = E_Package
+if Ekind (Cunit_Entity (Unum)) = E_Package
 and then From_Limited_With (Cunit_Entity (Unum))
 then
 Write_Info_Initiate ('Y');
+elsif Has_Implicit_With (Unum) = Yes then
+Write_Info_Initiate ('Z');
 else
 Write_Info_Initiate ('W');
 end if;
 or else GNATprove_Mode
 then
 Write_Info_Tab (25);
 if Is_Spec_Name (Uname) then
-Body_Fname :=
-Get_File_Name
+--  In GNATprove mode we must write the spec of a unit which
-(Get_Body_Name (Uname),
+--  requires a body if that body is not found. This will
-Subunit => False, May_Fail => True);
+--  allow partial analysis on incomplete sources. Also, in
+--  the case of a unit that is a remote call interface, the
-Body_Index :=
+--  bodies of packages may not exist but still may form a
-Get_Unit_Index
+--  valid program - so we handle that here as well.
-(Get_Body_Name (Uname));
+if GNATprove_Mode
-if Body_Fname = No_File then
+or else Is_Remote_Call_Interface (Cunit_Entity (Unum))
-Body_Fname := Get_File_Name (Uname, Subunit => False);
+then
-Body_Index := Get_Unit_Index (Uname);
+Body_Fname :=
+Get_File_Name
+(Uname    => Get_Body_Name (Uname),
+Subunit  => False,
+May_Fail => True);
+Body_Index := Get_Unit_Index (Get_Body_Name (Uname));
+if Body_Fname = No_File then
+Body_Fname := Get_File_Name (Uname, Subunit => False);
+Body_Index := Get_Unit_Index (Uname);
+end if;
+--  In the normal path we don't allow failure in fetching the
+--  name of the desired body unit so that it may be properly
+--  referenced in the output ali - even if it is missing.
+else
+Body_Fname :=
+Get_File_Name
+(Uname    => Get_Body_Name (Uname),
+Subunit  => False,
+May_Fail => False);
+Body_Index := Get_Unit_Index (Get_Body_Name (Uname));
 end if;
 else
 Body_Fname := Get_File_Name (Uname, Subunit => False);
 Body_Index := Get_Unit_Index (Uname);
 end if;
 begin
 --  We never write an ALI file if the original operating mode was
 --  syntax-only (-gnats switch used in compiler invocation line)
-if Original_Operating_Mode = Check_Syntax
+if Original_Operating_Mode = Check_Syntax then
-or flag_compare_debug /= 0
-then
 return;
 end if;
 --  Generation of ALI files may be disabled, e.g. for formal verification
 --  back-end.
 Write_Info_Char (' ');
 --  Normal case of a unit entry with a source index
 if Sind > No_Source_File then
-Fname := File_Name (Sind);
+--  We never want directory information in ALI files
+--  ???But back out this change temporarily until
---  Ensure that on platforms where the file names are not case
+--  gprbuild is fixed.
---  sensitive, the recorded file name is in lower case.
+if False then
+Fname := Strip_Directory (File_Name (Sind));
+else
+Fname := File_Name (Sind);
+end if;
+--  Ensure that on platforms where the file names are not
+--  case sensitive, the recorded file name is in lower case.
 if not File_Names_Case_Sensitive then
 Get_Name_String (Fname);
 To_Lower (Name_Buffer (1 .. Name_Len));
 Fname := Name_Find;
 if Generate_SCO then
 SCO_Record_Filtered;
 SCO_Output;
 end if;
---  Output SPARK cross-reference information if needed
-if Opt.Xref_Active and then GNATprove_Mode then
-SPARK_Specific.Collect_SPARK_Xrefs (Sdep_Table => Sdep_Table,
-Num_Sdep   => Num_Sdep);
-SPARK_Specific.Output_SPARK_Xrefs;
-end if;
 --  Output final blank line and we are done. This final blank line is
 --  probably junk, but we don't feel like making an incompatible change.
 Write_Info_Terminate;
 Close_Output_Library_Info;

Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/lib-writ.adb @ 131:84e7813d76e9