From f98319dc96d784a6cb010309c645db5b271322ba Mon Sep 17 00:00:00 2001 From: charlet Date: Tue, 2 Mar 2004 13:50:15 +0000 Subject: 2004-03-02 Emmanuel Briot * ali.adb (Read_Instantiation_Instance): Do not modify the current_file_num when reading information about instantiations, since this corrupts files in later references. 2004-03-02 Vincent Celier * bcheck.adb (Check_Consistency): Get the full path of an ALI file before checking if it is read-only. * bld.adb (Recursive_Process): Concatenate .src_dirs in front of SRC_DIRS and eliminate duplicates. * gprcmd.adb: Replace command "path" with command "path_sep" to return the path separator. (Usage): Document path_sep * Makefile.generic: For Ada and GNU C++ cases, link directly with the C++ compiler. No need for a script. Replace use of C*_INCLUDE_PATH env var for GCC compilers with CPATH. Do not call gprcmd to build the C*_INCLUDE_PATHs, do it with function subst. * prj-env.adb (For_All_Source_Dirs): Only add source dirs in project where there are Ada sources. (Set_Ada_Paths): Only add to the include path the source dirs of project with Ada sources. (Add_To_Path): Add the Display_Values of the directories, not their Values. * prj-nmsc.adb (Find_Sources): Set flag Sources_Present in the project data. * prj-nmsc.adb (Add_ALI_For): Make sure that the element Display_Value is not No_Name. (Find_Source_Dirs): Set Display_Value to a non canonicalized value, only Value is canonicalized. (Language_Independent_Check): Do not copy Value to Display_Value when canonicalizing Value. * prj-part.adb (Post_Parse_Context_Clause): Compare canonical cased path to find limited with cycles. (Parse_Single_Project): Use canonical cased path to find the end of a with cycle. 2004-03-02 Ed Schonberg * sem_ch10.adb (Optional_Subunit): Verify that unit contains a subunit and not a child unit. * sinfo.ads, sinfo.adb: Rearrange flags so that Private_Present can appear in a with_clause. * decl.c (gnat_to_gnu_type): If entity is a generic type, which can only happen in type_annotate mode, do not try to elaborate it. * exp_util.adb (Force_Evaluation): If expression is a selected component on the left of an assignment, use a renaming rather than a temporary to remove side effects. * freeze.adb (Freeze_Entity): Do not freeze a global entity within an inlined instance body, which is analyzed before the end of the enclosing scope. 2004-03-02 Robert Dewar * par-ch10.adb, par-ch3.adb, par-ch4.adb, scng.adb, sem_ch4.adb: Use new feature for substitution of keywords in VMS * errout.ads, errout.adb: Implement new circuit for substitution of keywords in VMS. * sem_case.adb (Analyze_Choices): Place message properly when case is a subtype reference rather than an explicit range. * sem_elim.adb, s-tpobop.ads, exp_ch2.adb: Minor reformatting 2004-03-02 Doug Rupp * init.c (__gnat_initialize)[VMS]: Resignal RDB-E-STREAM_EOF. 2004-03-02 Thomas Quinot * s-tporft.adb: Add missing locking around call to Initialize_ATCB. 2004-03-02 Richard Kenner * utils.c (finish_record_type): Do not set DECL_NONADDRESSABLE for a BLKmode bitfield. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@78758 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/prj-nmsc.adb | 210 ++++++++++++++++++++++++--------------------------- 1 file changed, 97 insertions(+), 113 deletions(-) (limited to 'gcc/ada/prj-nmsc.adb') diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 3f3250243a2..5c42d5cea38 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2004 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- -- @@ -758,9 +758,10 @@ package body Prj.Nmsc is -- If a non extending project is not supposed to contain -- any source, then we never call Find_Sources. - if Data.Extends = No_Project - and then Current_Source = Nil_String - then + if Current_Source /= Nil_String then + Data.Sources_Present := True; + + elsif Data.Extends = No_Project then Error_Msg (Project, "there are no Ada sources in this project", @@ -1405,7 +1406,7 @@ package body Prj.Nmsc is String_Elements.Increment_Last; String_Elements.Table (String_Elements.Last) := (Value => ALI_Name_Id, - Display_Value => No_Name, + Display_Value => ALI_Name_Id, Location => String_Elements.Table (Interfaces).Location, Flag => False, @@ -2573,10 +2574,6 @@ package body Prj.Nmsc is Directory : constant String := Get_Name_String (From); Element : String_Element; - Canonical_Directory_Id : Name_Id; - pragma Unreferenced (Canonical_Directory_Id); - -- Is this in fact being used for anything useful ??? - procedure Recursive_Find_Dirs (Path : Name_Id); -- Find all the subdirectories (recursively) of Path and add them -- to the list of source directories of the project. @@ -2593,136 +2590,128 @@ package body Prj.Nmsc is Element : String_Element; Found : Boolean := False; - Canonical_Path : Name_Id := No_Name; + Non_Canonical_Path : Name_Id := No_Name; + Canonical_Path : Name_Id := No_Name; + + The_Path : constant String := + Normalize_Pathname (Get_Name_String (Path)) & + Directory_Separator; + + The_Path_Last : constant Natural := + Compute_Directory_Last (The_Path); begin - Get_Name_String (Path); + Name_Len := The_Path_Last - The_Path'First + 1; + Name_Buffer (1 .. Name_Len) := + The_Path (The_Path'First .. The_Path_Last); + Non_Canonical_Path := Name_Find; + Get_Name_String (Non_Canonical_Path); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); + Canonical_Path := Name_Find; - declare - The_Path : constant String := - Normalize_Pathname - (Name => Name_Buffer (1 .. Name_Len)) & - Directory_Separator; + -- To avoid processing the same directory several times, check + -- if the directory is already in Recursive_Dirs. If it is, + -- then there is nothing to do, just return. If it is not, put + -- it there and continue recursive processing. - The_Path_Last : constant Natural := - Compute_Directory_Last (The_Path); + if Recursive_Dirs.Get (Canonical_Path) then + return; - begin - Name_Len := The_Path_Last - The_Path'First + 1; - Name_Buffer (1 .. Name_Len) := - The_Path (The_Path'First .. The_Path_Last); - Canonical_Path := Name_Find; + else + Recursive_Dirs.Set (Canonical_Path, True); + end if; - -- To avoid processing the same directory several times, check - -- if the directory is already in Recursive_Dirs. If it is, - -- then there is nothing to do, just return. If it is not, put - -- it there and continue recursive processing. + -- Check if directory is already in list - if Recursive_Dirs.Get (Canonical_Path) then - return; + while List /= Nil_String loop + Element := String_Elements.Table (List); - else - Recursive_Dirs.Set (Canonical_Path, True); + if Element.Value /= No_Name then + Found := Element.Value = Canonical_Path; + exit when Found; end if; - -- Check if directory is already in list - - while List /= Nil_String loop - Element := String_Elements.Table (List); - - if Element.Value /= No_Name then - Get_Name_String (Element.Value); - Found := - The_Path (The_Path'First .. The_Path_Last) = - Name_Buffer (1 .. Name_Len); - exit when Found; - end if; - - List := Element.Next; - end loop; - - -- If directory is not already in list, put it there - - if not Found then - if Current_Verbosity = High then - Write_Str (" "); - Write_Line (The_Path (The_Path'First .. The_Path_Last)); - end if; + List := Element.Next; + end loop; - String_Elements.Increment_Last; - Element := - (Value => Canonical_Path, - Display_Value => No_Name, - Location => No_Location, - Flag => False, - Next => Nil_String); + -- If directory is not already in list, put it there - -- Case of first source directory + if not Found then + if Current_Verbosity = High then + Write_Str (" "); + Write_Line (The_Path (The_Path'First .. The_Path_Last)); + end if; - if Last_Source_Dir = Nil_String then - Data.Source_Dirs := String_Elements.Last; + String_Elements.Increment_Last; + Element := + (Value => Canonical_Path, + Display_Value => Non_Canonical_Path, + Location => No_Location, + Flag => False, + Next => Nil_String); - -- Here we already have source directories. + -- Case of first source directory - else - -- Link the previous last to the new one + if Last_Source_Dir = Nil_String then + Data.Source_Dirs := String_Elements.Last; - String_Elements.Table (Last_Source_Dir).Next := - String_Elements.Last; - end if; + -- Here we already have source directories. - -- And register this source directory as the new last + else + -- Link the previous last to the new one - Last_Source_Dir := String_Elements.Last; - String_Elements.Table (Last_Source_Dir) := Element; + String_Elements.Table (Last_Source_Dir).Next := + String_Elements.Last; end if; - -- Now look for subdirectories. We do that even when this - -- directory is already in the list, because some of its - -- subdirectories may not be in the list yet. + -- And register this source directory as the new last - Open (Dir, The_Path (The_Path'First .. The_Path_Last)); + Last_Source_Dir := String_Elements.Last; + String_Elements.Table (Last_Source_Dir) := Element; + end if; - loop - Read (Dir, Name, Last); - exit when Last = 0; + -- Now look for subdirectories. We do that even when this + -- directory is already in the list, because some of its + -- subdirectories may not be in the list yet. - if Name (1 .. Last) /= "." - and then Name (1 .. Last) /= ".." - then - -- Avoid . and .. + Open (Dir, The_Path (The_Path'First .. The_Path_Last)); - if Current_Verbosity = High then - Write_Str (" Checking "); - Write_Line (Name (1 .. Last)); - end if; + loop + Read (Dir, Name, Last); + exit when Last = 0; - declare - Path_Name : String := - Normalize_Pathname - (Name => Name (1 .. Last), - Directory => - The_Path - (The_Path'First .. The_Path_Last)); + if Name (1 .. Last) /= "." + and then Name (1 .. Last) /= ".." + then + -- Avoid . and .. - begin - Canonical_Case_File_Name (Path_Name); + if Current_Verbosity = High then + Write_Str (" Checking "); + Write_Line (Name (1 .. Last)); + end if; - if Is_Directory (Path_Name) then + declare + Path_Name : constant String := + Normalize_Pathname + (Name => Name (1 .. Last), + Directory => + The_Path + (The_Path'First .. The_Path_Last)); - -- We have found a new subdirectory, call self + begin + if Is_Directory (Path_Name) then - Name_Len := Path_Name'Length; - Name_Buffer (1 .. Name_Len) := Path_Name; - Recursive_Find_Dirs (Name_Find); - end if; - end; - end if; - end loop; + -- We have found a new subdirectory, call self - Close (Dir); - end; + Name_Len := Path_Name'Length; + Name_Buffer (1 .. Name_Len) := Path_Name; + Recursive_Find_Dirs (Name_Find); + end if; + end; + end if; + end loop; + + Close (Dir); exception when Directory_Error => @@ -2742,10 +2731,6 @@ package body Prj.Nmsc is -- Directory := Name_Buffer (1 .. Name_Len); -- Why is above line commented out ??? - Canonical_Directory_Id := Name_Find; - -- What is purpose of above assignment ??? - -- Are we sure it is being used ??? - if Current_Verbosity = High then Write_Str (Directory); Write_Line (""")"); @@ -3098,7 +3083,6 @@ package body Prj.Nmsc is while Current /= Nil_String loop Element := String_Elements.Table (Current); if Element.Value /= No_Name then - Element.Display_Value := Element.Value; Get_Name_String (Element.Value); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Element.Value := Name_Find; -- cgit v1.2.1