X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Flib-writ.adb;h=7ebfc7d3d5148b016ac484014b759db9b1ac33f0;hb=169337519eece470dd1e178a4356030a6c845b37;hp=254fa7111288f58caf8245f1b5583cfafc1ae26d;hpb=3670c51dfe5b75666de76454dd55944799dc90b5;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 254fa711128..7ebfc7d3d51 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -6,18 +6,17 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2001 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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 2, or (at your option) any later ver- -- +-- 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- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- +-- Public License distributed with GNAT; see file COPYING3. If not, go to -- +-- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- @@ -33,7 +32,6 @@ with Fname; use Fname; with Fname.UF; use Fname.UF; with Lib.Util; use Lib.Util; with Lib.Xref; use Lib.Xref; -with Namet; use Namet; with Nlists; use Nlists; with Gnatvsn; use Gnatvsn; with Opt; use Opt; @@ -41,23 +39,63 @@ with Osint; use Osint; with Osint.C; use Osint.C; with Par; with Restrict; use Restrict; +with Rident; use Rident; with Scn; use Scn; with Sinfo; use Sinfo; with Sinput; use Sinput; +with Snames; use Snames; with Stringt; use Stringt; +with Tbuild; use Tbuild; with Uname; use Uname; -with System.WCh_Con; use System.WCh_Con; +with System.Case_Util; use System.Case_Util; +with System.WCh_Con; use System.WCh_Con; package body Lib.Writ is + ----------------------- + -- Local Subprograms -- + ----------------------- + + procedure Write_Unit_Name (N : Node_Id); + -- Used to write out the unit name for R (pragma Restriction) lines + -- for uses of Restriction (No_Dependence => unit-name). + + ---------------------------------- + -- Add_Preprocessing_Dependency -- + ---------------------------------- + + procedure Add_Preprocessing_Dependency (S : Source_File_Index) is + begin + Units.Increment_Last; + Units.Table (Units.Last) := + (Unit_File_Name => File_Name (S), + Unit_Name => No_Unit_Name, + Expected_Unit => No_Unit_Name, + Source_Index => S, + Cunit => Empty, + Cunit_Entity => Empty, + Dependency_Num => 0, + Dynamic_Elab => False, + Fatal_Error => False, + Generate_Code => False, + Has_RACW => False, + Is_Compiler_Unit => False, + Ident_String => Empty, + Loading => False, + Main_Priority => -1, + Munit_Index => 0, + Serial_Number => 0, + Version => 0, + Error_Location => No_Location, + OA_Setting => 'O'); + end Add_Preprocessing_Dependency; + ------------------------------ -- Ensure_System_Dependency -- ------------------------------ procedure Ensure_System_Dependency is - Discard : List_Id; - System_Uname : Unit_Name_Type; -- Unit name for system spec if needed for dummy entry @@ -86,29 +124,41 @@ package body Lib.Writ is Units.Increment_Last; Units.Table (Units.Last) := ( - Unit_File_Name => System_Fname, - Unit_Name => System_Uname, - Expected_Unit => System_Uname, - Source_Index => System_Source_File_Index, - Cunit => Empty, - Cunit_Entity => Empty, - Dependency_Num => 0, - Dependent_Unit => True, - Dynamic_Elab => False, - Fatal_Error => False, - Generate_Code => False, - Has_RACW => False, - Ident_String => Empty, - Loading => False, - Main_Priority => -1, - Serial_Number => 0, - Version => 0, - Error_Location => No_Location); + Unit_File_Name => System_Fname, + Unit_Name => System_Uname, + Expected_Unit => System_Uname, + Source_Index => System_Source_File_Index, + Cunit => Empty, + Cunit_Entity => Empty, + Dependency_Num => 0, + Dynamic_Elab => False, + Fatal_Error => False, + Generate_Code => False, + Has_RACW => False, + Is_Compiler_Unit => False, + Ident_String => Empty, + Loading => False, + Main_Priority => -1, + Munit_Index => 0, + Serial_Number => 0, + Version => 0, + Error_Location => No_Location, + OA_Setting => 'O'); -- Parse system.ads so that the checksum is set right + -- Style checks are not applied. - Initialize_Scanner (Units.Last, System_Source_File_Index); - Discard := Par (Configuration_Pragmas => False); + declare + Save_Mindex : constant Nat := Multiple_Unit_Index; + Save_Style : constant Boolean := Style_Check; + begin + Multiple_Unit_Index := 0; + Style_Check := False; + Initialize_Scanner (Units.Last, System_Source_File_Index); + Discard_List (Par (Configuration_Pragmas => False)); + Style_Check := Save_Style; + Multiple_Unit_Index := Save_Mindex; + end; end Ensure_System_Dependency; --------------- @@ -135,6 +185,9 @@ package body Lib.Writ is -- Array of flags to show which units have pragma Elaborate All set Elab_Des_Flags : array (Units.First .. Last_Unit) of Boolean; + -- Array of flags to show which units have Elaborate_Desirable set + + Elab_All_Des_Flags : array (Units.First .. Last_Unit) of Boolean; -- Array of flags to show which units have Elaborate_All_Desirable set Sdep_Table : Unit_Ref_Table (1 .. Pos (Last_Unit - Units.First + 2)); @@ -182,20 +235,36 @@ package body Lib.Writ is Item := First (Context_Items (Cunit)); while Present (Item) loop + -- Process with clause + + -- Ada 2005 (AI-50217): limited with_clauses do not create + -- dependencies, but must be recorded as components of the + -- partition, in case there is no regular with_clause for + -- the unit anywhere else. + if Nkind (Item) = N_With_Clause then Unum := Get_Cunit_Unit_Number (Library_Unit (Item)); With_Flags (Unum) := True; - if Elaborate_Present (Item) then - Elab_Flags (Unum) := True; - end if; + if not Limited_Present (Item) then + if Elaborate_Present (Item) then + Elab_Flags (Unum) := True; + end if; - if Elaborate_All_Present (Item) then - Elab_All_Flags (Unum) := True; - end if; + if Elaborate_All_Present (Item) then + Elab_All_Flags (Unum) := True; + end if; - if Elaborate_All_Desirable (Cunit_Entity (Unum)) then - Elab_Des_Flags (Unum) := True; + if Elaborate_All_Desirable (Item) then + Elab_All_Des_Flags (Unum) := True; + end if; + + if Elaborate_Desirable (Item) then + Elab_Des_Flags (Unum) := True; + end if; + + else + Set_From_With_Type (Cunit_Entity (Unum)); end if; end if; @@ -293,15 +362,30 @@ package body Lib.Writ is Write_Info_Tab (49); Write_Info_Str (Version_Get (Unit_Num)); + -- Add BD parameter if Elaborate_Body pragma desirable + + if Ekind (Uent) = E_Package + and then Elaborate_Body_Desirable (Uent) + then + Write_Info_Str (" BD"); + end if; + + -- Add BN parameter if body needed for SAL + + if (Is_Subprogram (Uent) + or else Ekind (Uent) = E_Package + or else Is_Generic_Unit (Uent)) + and then Body_Needed_For_SAL (Uent) + then + Write_Info_Str (" BN"); + end if; + if Dynamic_Elab (Unit_Num) then Write_Info_Str (" DE"); end if; - -- We set the Elaborate_Body indication if either an explicit pragma - -- was present, or if this is an instantiation. RM 12.3(20) requires - -- that the body be immediately elaborated after the spec. We would - -- normally do that anyway, but the EB we generate here ensures that - -- this gets done even when we use the -p gnatbind switch. + -- Set the Elaborate_Body indication if either an explicit pragma + -- was present, or if this is an instantiation. if Has_Pragma_Elaborate_Body (Uent) or else (Ukind = N_Package_Declaration @@ -312,8 +396,8 @@ package body Lib.Writ is end if; -- Now see if we should tell the binder that an elaboration entity - -- is present, which must be reset to true during elaboration. We - -- generate the indication if the following condition is met: + -- is present, which must be set to true during elaboration. + -- We generate the indication if the following condition is met: -- If this is a spec ... @@ -348,13 +432,25 @@ package body Lib.Writ is (Declaration_Node (Body_Entity (Uent)))))) then - Write_Info_Str (" EE"); + if Convention (Uent) = Convention_CIL then + + -- Special case for generic CIL packages which never have + -- elaboration code + + Write_Info_Str (" NE"); + + else + Write_Info_Str (" EE"); + end if; end if; if Has_No_Elaboration_Code (Unode) then Write_Info_Str (" NE"); end if; + Write_Info_Str (" O"); + Write_Info_Char (OA_Setting (Unit_Num)); + if Is_Preelaborated (Uent) then Write_Info_Str (" PR"); end if; @@ -426,7 +522,7 @@ package body Lib.Writ is end case; end if; - if Initialize_Scalars then + if Initialize_Scalars or else Invalid_Value_Used then Write_Info_Str (" IS"); end if; @@ -435,10 +531,11 @@ package body Lib.Writ is -- Generate with lines, first those that are directly with'ed for J in With_Flags'Range loop - With_Flags (J) := False; - Elab_Flags (J) := False; - Elab_All_Flags (J) := False; - Elab_Des_Flags (J) := False; + With_Flags (J) := False; + Elab_Flags (J) := False; + Elab_All_Flags (J) := False; + Elab_Des_Flags (J) := False; + Elab_All_Des_Flags (J) := False; end loop; Collect_Withs (Unode); @@ -450,9 +547,13 @@ package body Lib.Writ is if Nkind (Unit (Unode)) in N_Unit_Body then for S in Units.First .. Last_Unit loop - -- We are only interested in subunits + -- We are only interested in subunits. + -- For preproc. data and def. files, Cunit is Empty, so + -- we need to test that first. - if Nkind (Unit (Cunit (S))) = N_Subunit then + if Cunit (S) /= Empty + and then Nkind (Unit (Cunit (S))) = N_Subunit + then Pnode := Library_Unit (Cunit (S)); -- In gnatc mode, the errors in the subunits will not @@ -509,7 +610,7 @@ package body Lib.Writ is else declare - Hex : array (0 .. 15) of Character := + Hex : constant array (0 .. 15) of Character := "0123456789ABCDEF"; begin @@ -537,18 +638,46 @@ package body Lib.Writ is Num_Withs : Int := 0; Unum : Unit_Number_Type; Cunit : Node_Id; - Cunite : Entity_Id; Uname : Unit_Name_Type; Fname : File_Name_Type; Pname : constant Unit_Name_Type := Get_Parent_Spec_Name (Unit_Name (Main_Unit)); Body_Fname : File_Name_Type; + Body_Index : Nat; + + procedure Write_With_File_Names + (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 -- + -------------------------- + + procedure Write_With_File_Names + (Nam : in out File_Name_Type; + Idx : Nat) + is + begin + if not File_Names_Case_Sensitive then + Get_Name_String (Nam); + To_Lower (Name_Buffer (1 .. Name_Len)); + Nam := Name_Find; + end if; + + Write_Info_Name (Nam); + Write_Info_Tab (49); + Write_Info_Name (Lib_File_Name (Nam, Idx)); + end Write_With_File_Names; + + -- Start of processing for Write_With_Lines begin -- Loop to build the with table. A with on the main unit itself -- is ignored (AARM 10.2(14a)). Such a with-clause can occur if -- the main unit is a subprogram with no spec, and a subunit of - -- it unecessarily withs the parent. + -- it unnecessarily withs the parent. for J in Units.First + 1 .. Last_Unit loop @@ -556,9 +685,11 @@ package body Lib.Writ is -- parent spec of the main unit (case of main unit is a child -- unit). The latter with is not needed for semantic purposes, -- but is required by the binder for elaboration purposes. + -- For preproc. data and def. files, there is no Unit_Name, + -- check for that first. - if (With_Flags (J) or else Unit_Name (J) = Pname) - and then Units.Table (J).Dependent_Unit + if Unit_Name (J) /= No_Unit_Name + and then (With_Flags (J) or else Unit_Name (J) = Pname) then Num_Withs := Num_Withs + 1; With_Table (Num_Withs) := J; @@ -572,58 +703,90 @@ package body Lib.Writ is for J in 1 .. Num_Withs loop Unum := With_Table (J); Cunit := Units.Table (Unum).Cunit; - Cunite := Units.Table (Unum).Cunit_Entity; Uname := Units.Table (Unum).Unit_Name; Fname := Units.Table (Unum).Unit_File_Name; - Write_Info_Initiate ('W'); + if Ekind (Cunit_Entity (Unum)) = E_Package + and then From_With_Type (Cunit_Entity (Unum)) + then + Write_Info_Initiate ('Y'); + else + Write_Info_Initiate ('W'); + end if; + Write_Info_Char (' '); Write_Info_Name (Uname); -- Now we need to figure out the names of the files that contain -- the with'ed unit. These will usually be the files for the body, - -- except in the case of a package that has no body. - - if (Nkind (Unit (Cunit)) not in N_Generic_Declaration - and then - Nkind (Unit (Cunit)) not in N_Generic_Renaming_Declaration) - or else Generic_Separately_Compiled (Cunite) + -- except in the case of a package that has no body. Note that we + -- have a specific exemption here for predefined library generics + -- (see comments for Generic_May_Lack_ALI). We do not generate + -- dependency upon the ALI file for such units. Older compilers + -- used to not support generating code (and ALI) for generics, and + -- we want to avoid having different processing (namely, different + -- lists of files to be compiled) for different stages of the + -- bootstrap. + + if not ((Nkind (Unit (Cunit)) in N_Generic_Declaration + or else + Nkind (Unit (Cunit)) in N_Generic_Renaming_Declaration) + and then Generic_May_Lack_ALI (Fname)) then Write_Info_Tab (25); if Is_Spec_Name (Uname) then Body_Fname := - Get_File_Name (Get_Body_Name (Uname), Subunit => False); + Get_File_Name + (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; + else Body_Fname := Get_File_Name (Uname, Subunit => False); + Body_Index := Get_Unit_Index (Uname); end if; -- A package is considered to have a body if it requires -- a body or if a body is present in Ada 83 mode. if Body_Required (Cunit) - or else (Ada_83 + or else (Ada_Version = Ada_83 and then Full_Source_Name (Body_Fname) /= No_File) then - Write_Info_Name (Body_Fname); - Write_Info_Tab (49); - Write_Info_Name (Lib_File_Name (Body_Fname)); + Write_With_File_Names (Body_Fname, Body_Index); else - Write_Info_Name (Fname); - Write_Info_Tab (49); - Write_Info_Name (Lib_File_Name (Fname)); + Write_With_File_Names (Fname, Munit_Index (Unum)); end if; - if Elab_Flags (Unum) then - Write_Info_Str (" E"); - end if; + if Ekind (Cunit_Entity (Unum)) = E_Package + and then From_With_Type (Cunit_Entity (Unum)) + then + null; + else + if Elab_Flags (Unum) then + Write_Info_Str (" E"); + end if; - if Elab_All_Flags (Unum) then - Write_Info_Str (" EA"); - end if; + if Elab_All_Flags (Unum) then + Write_Info_Str (" EA"); + end if; + + if Elab_Des_Flags (Unum) then + Write_Info_Str (" ED"); + end if; - if Elab_Des_Flags (Unum) then - Write_Info_Str (" ED"); + if Elab_All_Des_Flags (Unum) then + Write_Info_Str (" AD"); + end if; end if; end if; @@ -631,15 +794,26 @@ package body Lib.Writ is end loop; end Write_With_Lines; - -- Start of processing for Writ_ALI + -- Start of processing for Write_ALI 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 then + return; + end if; + -- Build sorted source dependency table. We do this right away, -- because it is referenced by Up_To_Date_ALI_File_Exists. for Unum in Units.First .. Last_Unit loop - Num_Sdep := Num_Sdep + 1; - Sdep_Table (Num_Sdep) := Unum; + if Cunit_Entity (Unum) = Empty + or else not From_With_Type (Cunit_Entity (Unum)) + then + Num_Sdep := Num_Sdep + 1; + Sdep_Table (Num_Sdep) := Unum; + end if; end loop; -- Sort the table so that the D lines are in order @@ -666,20 +840,24 @@ package body Lib.Writ is Write_Info_Initiate ('V'); Write_Info_Str (" """); - Write_Info_Str (Library_Version); + Write_Info_Str (Verbose_Library_Version); Write_Info_Char ('"'); Write_Info_EOL; -- Output main program line if this is acceptable main program - declare + Output_Main_Program_Line : declare U : Node_Id := Unit (Units.Table (Main_Unit).Cunit); S : Node_Id; procedure M_Parameters; -- Output parameters for main program line + ------------------ + -- M_Parameters -- + ------------------ + procedure M_Parameters is begin if Main_Priority (Main_Unit) /= Default_Main_Priority then @@ -699,14 +877,14 @@ package body Lib.Writ is Write_Info_EOL; end M_Parameters; + -- Start of processing for Output_Main_Program_Line + begin if Nkind (U) = N_Subprogram_Body - or else (Nkind (U) = N_Package_Body - and then - (Nkind (Original_Node (U)) = N_Function_Instantiation - or else - Nkind (Original_Node (U)) = - N_Procedure_Instantiation)) + or else + (Nkind (U) = N_Package_Body + and then + Nkind (Original_Node (U)) in N_Subprogram_Instantiation) then -- If the unit is a subprogram instance, the entity for the -- subprogram is the alias of the visible entity, which is the @@ -721,7 +899,7 @@ package body Lib.Writ is S := Specification (U); - if not Present (Parameter_Specifications (S)) then + if No (Parameter_Specifications (S)) then if Nkind (S) = N_Procedure_Specification then Write_Info_Initiate ('M'); Write_Info_Str (" P"); @@ -732,7 +910,7 @@ package body Lib.Writ is Nam : Node_Id := Defining_Unit_Name (S); begin - -- If it is a child unit, get its simple name. + -- If it is a child unit, get its simple name if Nkind (Nam) = N_Defining_Program_Unit_Name then Nam := Defining_Identifier (Nam); @@ -747,9 +925,9 @@ package body Lib.Writ is end if; end if; end if; - end; + end Output_Main_Program_Line; - -- Write command argmument ('A') lines + -- Write command argument ('A') lines for A in 1 .. Compilation_Switches.Last loop Write_Info_Initiate ('A'); @@ -766,6 +944,10 @@ package body Lib.Writ is Write_Info_Str (" CE"); end if; + if Opt.Detect_Blocking then + Write_Info_Str (" DB"); + end if; + if Opt.Float_Format /= ' ' then Write_Info_Str (" F"); @@ -804,7 +986,7 @@ package body Lib.Writ is Write_Info_Str (" NO"); end if; - if No_Run_Time then + if No_Run_Time_Mode then Write_Info_Str (" NR"); end if; @@ -812,37 +994,128 @@ package body Lib.Writ is Write_Info_Str (" NS"); end if; + if Sec_Stack_Used then + Write_Info_Str (" SS"); + end if; + if Unreserve_All_Interrupts then Write_Info_Str (" UA"); end if; - if Exception_Mechanism /= Setjmp_Longjmp then - if Unit_Exception_Table_Present then - Write_Info_Str (" UX"); - end if; - + if Exception_Mechanism = Back_End_Exceptions then Write_Info_Str (" ZX"); end if; Write_Info_EOL; - -- Output restrictions line + -- Before outputting the restrictions line, update the setting of + -- the No_Elaboration_Code flag. Violations of this restriction + -- cannot be detected until after the backend has been called since + -- it is the backend that sets this flag. We have to check all units + -- for which we have generated code + + for Unit in Units.First .. Last_Unit loop + if Units.Table (Unit).Generate_Code + or else Unit = Main_Unit + then + if not Has_No_Elaboration_Code (Cunit (Unit)) then + Main_Restrictions.Violated (No_Elaboration_Code) := True; + end if; + end if; + end loop; + + -- Output first restrictions line Write_Info_Initiate ('R'); Write_Info_Char (' '); - for J in All_Restrictions loop - if Main_Restrictions (J) then + -- First the information for the boolean restrictions + + for R in All_Boolean_Restrictions loop + if Main_Restrictions.Set (R) + and then not Restriction_Warnings (R) + then Write_Info_Char ('r'); - elsif Violations (J) then + elsif Main_Restrictions.Violated (R) then Write_Info_Char ('v'); else Write_Info_Char ('n'); end if; end loop; + -- And now the information for the parameter restrictions + + for RP in All_Parameter_Restrictions loop + if Main_Restrictions.Set (RP) + and then not Restriction_Warnings (RP) + then + Write_Info_Char ('r'); + Write_Info_Nat (Nat (Main_Restrictions.Value (RP))); + else + Write_Info_Char ('n'); + end if; + + if not Main_Restrictions.Violated (RP) + or else RP not in Checked_Parameter_Restrictions + then + Write_Info_Char ('n'); + else + Write_Info_Char ('v'); + Write_Info_Nat (Nat (Main_Restrictions.Count (RP))); + + if Main_Restrictions.Unknown (RP) then + Write_Info_Char ('+'); + end if; + end if; + end loop; + Write_Info_EOL; + -- Output R lines for No_Dependence entries + + for J in No_Dependence.First .. No_Dependence.Last loop + if In_Extended_Main_Source_Unit (No_Dependence.Table (J).Unit) + and then not No_Dependence.Table (J).Warn + then + Write_Info_Initiate ('R'); + Write_Info_Char (' '); + Write_Unit_Name (No_Dependence.Table (J).Unit); + Write_Info_EOL; + end if; + end loop; + + -- Output interrupt state lines + + for J in Interrupt_States.First .. Interrupt_States.Last loop + Write_Info_Initiate ('I'); + Write_Info_Char (' '); + Write_Info_Nat (Interrupt_States.Table (J).Interrupt_Number); + Write_Info_Char (' '); + Write_Info_Char (Interrupt_States.Table (J).Interrupt_State); + Write_Info_Char (' '); + Write_Info_Nat + (Nat (Get_Logical_Line_Number + (Interrupt_States.Table (J).Pragma_Loc))); + Write_Info_EOL; + end loop; + + -- Output priority specific dispatching lines + + for J in Specific_Dispatching.First .. Specific_Dispatching.Last loop + Write_Info_Initiate ('S'); + Write_Info_Char (' '); + Write_Info_Char (Specific_Dispatching.Table (J).Dispatching_Policy); + Write_Info_Char (' '); + Write_Info_Nat (Specific_Dispatching.Table (J).First_Priority); + Write_Info_Char (' '); + Write_Info_Nat (Specific_Dispatching.Table (J).Last_Priority); + Write_Info_Char (' '); + Write_Info_Nat + (Nat (Get_Logical_Line_Number + (Specific_Dispatching.Table (J).Pragma_Loc))); + Write_Info_EOL; + end loop; + -- Loop through file table to output information for all units for which -- we have generated code, as marked by the Generate_Code flag. @@ -879,6 +1152,8 @@ package body Lib.Writ is Sind : Source_File_Index; -- Index of corresponding source file + Fname : File_Name_Type; + begin for J in 1 .. Num_Sdep loop Unum := Sdep_Table (J); @@ -888,12 +1163,21 @@ package body Lib.Writ is Write_Info_Initiate ('D'); Write_Info_Char (' '); - -- Normal case of a dependent unit entry with a source index + -- Normal case of a unit entry with a source index - if Sind /= No_Source_File - and then Units.Table (Unum).Dependent_Unit - then - Write_Info_Name (File_Name (Sind)); + if Sind /= No_Source_File then + Fname := File_Name (Sind); + + -- 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; + end if; + + Write_Info_Name (Fname); Write_Info_Tab (25); Write_Info_Str (String (Time_Stamp (Sind))); Write_Info_Char (' '); @@ -924,8 +1208,8 @@ package body Lib.Writ is Write_Info_Name (Reference_Name (Sind)); end if; - -- Case where there is no source index (happens for missing files) - -- Also come here for non-dependent units. + -- Case where there is no source index (happens for missing + -- files). In this case we write a dummy time stamp. else Write_Info_Name (Unit_File_Name (Unum)); @@ -942,7 +1226,23 @@ package body Lib.Writ is Output_References; Write_Info_Terminate; Close_Output_Library_Info; - end Write_ALI; + --------------------- + -- Write_Unit_Name -- + --------------------- + + procedure Write_Unit_Name (N : Node_Id) is + begin + if Nkind (N) = N_Identifier then + Write_Info_Name (Chars (N)); + + else + pragma Assert (Nkind (N) = N_Selected_Component); + Write_Unit_Name (Prefix (N)); + Write_Info_Char ('.'); + Write_Unit_Name (Selector_Name (N)); + end if; + end Write_Unit_Name; + end Lib.Writ;