snames.adb, snames.ads: Add new standard name runtime_library_dir
authorVincent Celier <celier@adacore.com>
Mon, 15 Oct 2007 13:55:54 +0000 (15:55 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Mon, 15 Oct 2007 13:55:54 +0000 (15:55 +0200)
2007-10-15  Vincent Celier  <celier@adacore.com>

* snames.adb, snames.ads: Add new standard name runtime_library_dir

* prj.ads (Language_Config): Add new component Runtime_Library_Dir

* prj-attr.adb: Add project level attribute Runtime_Library_Dir

* prj-env.adb (Create_Mapping_File): Do not put an entry if the path of
the source is unknown.

* prj-ext.adb: Spelling error fix

* prj-nmsc.adb (Check_Ada_Name): Reject any unit that includes an Ada
95 reserved word in its name.
(Process_Project_Level_Array_Attributes): Process new attribute
Runtime_Library_Dir.

* prj-part.adb (Parse_Single_Project): Do not check the name of the
config project against the user project names.

* prj-proc.adb (Expression): In multi-language mode, indexes that do
not include a dot are always case insensitive.
(Process_Declarative_Items): Ditto
(Process_Project_Tree_Phase_1): Set Success to False in case an error is
detected.

* prj-util.adb (Value_Of (In_Array)): When Force_Lower_Case_Index is
True, compare both indexes in lower case.

From-SVN: r129329

gcc/ada/prj-attr.adb
gcc/ada/prj-env.adb
gcc/ada/prj-ext.adb
gcc/ada/prj-nmsc.adb
gcc/ada/prj-part.adb
gcc/ada/prj-proc.adb
gcc/ada/prj-util.adb
gcc/ada/prj.ads
gcc/ada/snames.adb
gcc/ada/snames.ads

index a833de6..41bd6c4 100644 (file)
@@ -127,6 +127,7 @@ package body Prj.Attr is
    "SVlibrary_auto_init_supported#" &
    "LVshared_library_minimum_switches#" &
    "LVlibrary_version_switches#" &
+   "Saruntime_library_dir#" &
 
    --  package Naming
 
index 1d97d80..f5259b1 100644 (file)
@@ -1333,7 +1333,8 @@ package body Prj.Env is
 
                if Src_Data.Language_Name = Language and then
                  (not Src_Data.Locally_Removed) and then
-                 Src_Data.Replaced_By = No_Source
+                 Src_Data.Replaced_By = No_Source and then
+                 Src_Data.Path /= No_Path
                then
                   if Src_Data.Unit /= No_Name then
                      Get_Name_String (Src_Data.Unit);
@@ -1404,6 +1405,7 @@ package body Prj.Env is
 
    procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref) is
       Disregard : Boolean := True;
+      pragma Warnings (Off, Disregard);
 
    begin
       for Index in Path_File_Table.First ..
index 0e9641a..37c8fc1 100644 (file)
@@ -217,7 +217,7 @@ package body Prj.Ext is
             Name_Len := Name_Len - No_Project_Default_Dir'Length - 1;
 
             --  After removing the '-', go back one character to get the next
-            --  directory corectly.
+            --  directory correctly.
 
             Last := Last - 1;
 
index 67d3975..0574cb2 100644 (file)
@@ -668,6 +668,48 @@ package body Prj.Nmsc is
       Need_Letter     : Boolean := True;
       Last_Underscore : Boolean := False;
       OK              : Boolean := The_Name'Length > 0;
+      First           : Positive;
+
+      function Is_Reserved (S : String) return Boolean;
+      --  Check that the given name is not an Ada 95 reserved word. The
+      --  reason for the Ada 95 here is that we do not want to exclude the case
+      --  of an Ada 95 unit called Interface (for example). In Ada 2005, such
+      --  a unit name would be rejected anyway by the compiler, so there is no
+      --  requirement that the project file parser reject this.
+
+      -----------------
+      -- Is_Reserved --
+      -----------------
+
+      function Is_Reserved (S : String) return Boolean is
+         Name : Name_Id;
+
+      begin
+         Name_Len := 0;
+         Add_Str_To_Name_Buffer (S);
+         Name := Name_Find;
+
+         if Get_Name_Table_Byte (Name) /= 0
+           and then Name /= Name_Project
+           and then Name /= Name_Extends
+           and then Name /= Name_External
+           and then Name not in Ada_2005_Reserved_Words
+         then
+            Unit := No_Name;
+
+            if Current_Verbosity = High then
+               Write_Str (The_Name);
+               Write_Line (" is an Ada reserved word.");
+            end if;
+
+            return True;
+
+         else
+            return False;
+         end if;
+      end Is_Reserved;
+
+   --  Start of processing for Check_Ada_Name
 
    begin
       To_Lower (The_Name);
@@ -677,11 +719,14 @@ package body Prj.Nmsc is
 
       --  Special cases of children of packages A, G, I and S on VMS
 
-      if OpenVMS_On_Target and then
-        Name_Len > 3 and then
-        Name_Buffer (2 .. 3) = "__" and then
-        ((Name_Buffer (1) = 'a') or else (Name_Buffer (1) = 'g') or else
-         (Name_Buffer (1) = 'i') or else (Name_Buffer (1) = 's'))
+      if OpenVMS_On_Target
+        and then Name_Len > 3
+        and then Name_Buffer (2 .. 3) = "__"
+        and then
+          ((Name_Buffer (1) = 'a') or else
+           (Name_Buffer (1) = 'g') or else
+           (Name_Buffer (1) = 'i') or else
+           (Name_Buffer (1) = 's'))
       then
          Name_Buffer (2) := '.';
          Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
@@ -690,28 +735,12 @@ package body Prj.Nmsc is
 
       Real_Name := Name_Find;
 
-      --  Check first that the given name is not an Ada 95 reserved word. The
-      --  reason for the Ada 95 here is that we do not want to exclude the case
-      --  of an Ada 95 unit called Interface (for example). In Ada 2005, such
-      --  a unit name would be rejected anyway by the compiler, so there is no
-      --  requirement that the project file parser reject this.
-
-      if Get_Name_Table_Byte (Real_Name) /= 0
-        and then Real_Name /= Name_Project
-        and then Real_Name /= Name_Extends
-        and then Real_Name /= Name_External
-        and then Real_Name not in Ada_2005_Reserved_Words
-      then
-         Unit := No_Name;
-
-         if Current_Verbosity = High then
-            Write_Str (The_Name);
-            Write_Line (" is an Ada reserved word.");
-         end if;
-
+      if Is_Reserved (Name_Buffer (1 .. Name_Len)) then
          return;
       end if;
 
+      First := The_Name'First;
+
       for Index in The_Name'Range loop
          if Need_Letter then
 
@@ -753,6 +782,13 @@ package body Prj.Nmsc is
 
          elsif The_Name (Index) = '.' then
 
+            --  First, check if the name before the dot is not a reserved word
+            if Is_Reserved (The_Name (First .. Index - 1)) then
+               return;
+            end if;
+
+            First := Index + 1;
+
             --  We need a letter after a dot
 
             Need_Letter := True;
@@ -785,6 +821,12 @@ package body Prj.Nmsc is
       OK := OK and then not Need_Letter and then not Last_Underscore;
 
       if OK then
+         if First /= Name'First and then
+           Is_Reserved (The_Name (First .. The_Name'Last))
+         then
+            return;
+         end if;
+
          Unit := Real_Name;
 
       else
@@ -824,6 +866,7 @@ package body Prj.Nmsc is
 
          begin
             --  Dot_Replacement cannot
+
             --   - be empty
             --   - start or end with an alphanumeric
             --   - be a single '_'
@@ -1927,6 +1970,14 @@ package body Prj.Nmsc is
                           (Lang_Index).Config.Toolchain_Version :=
                           Element.Value.Value;
 
+                     when Name_Runtime_Library_Dir =>
+
+                        --  Attribute Runtime_Library_Dir (<language>)
+
+                        In_Tree.Languages_Data.Table
+                          (Lang_Index).Config.Runtime_Library_Dir :=
+                          Element.Value.Value;
+
                      when others =>
                         null;
                   end case;
@@ -1941,9 +1992,7 @@ package body Prj.Nmsc is
 
    begin
       Process_Project_Level_Simple_Attributes;
-
       Process_Project_Level_Array_Attributes;
-
       Process_Packages;
 
       --  For unit based languages, set Casing, Dot_Replacement and
@@ -3169,12 +3218,11 @@ package body Prj.Nmsc is
                --  For all unit based languages, if any, set the specified
                --  value of Dot_Replacement, Casing and/or Separate_Suffix.
 
-               if Dot_Replacement /= No_File or else
-                 Casing_Defined or else
-                 Separate_Suffix /= No_File
+               if Dot_Replacement /= No_File
+                 or else Casing_Defined
+                 or else Separate_Suffix /= No_File
                then
                   Lang_Id := Data.First_Language_Processing;
-
                   while Lang_Id /= No_Language_Index loop
                      if In_Tree.Languages_Data.Table
                        (Lang_Id).Config.Kind = Unit_Based
@@ -3206,11 +3254,12 @@ package body Prj.Nmsc is
             --  Next, get the spec and body suffixes
 
             declare
-               Suffix : Variable_Value;
-
-               Lang_Id : Language_Index := Data.First_Language_Processing;
+               Suffix  : Variable_Value;
+               Lang_Id : Language_Index;
                Lang    : Name_Id;
+
             begin
+               Lang_Id := Data.First_Language_Processing;
                while Lang_Id /= No_Language_Index loop
                   Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
 
@@ -3384,18 +3433,20 @@ package body Prj.Nmsc is
          end if;
       end Check_Library;
 
+   --  Start of processing for Check_Library_Attributes
+
    begin
       --  Special case of extending project
 
       if Data.Extends /= No_Project then
          declare
             Extended_Data : constant Project_Data :=
-                           In_Tree.Projects.Table (Data.Extends);
+                              In_Tree.Projects.Table (Data.Extends);
 
          begin
-            --  If the project extended is a library project, we inherit
-            --  the library name, if it is not redefined; we check that
-            --  the library directory is specified.
+            --  If the project extended is a library project, we inherit the
+            --  library name, if it is not redefined; we check that the library
+            --  directory is specified.
 
             if Extended_Data.Library then
                if Lib_Name.Default then
@@ -3606,7 +3657,7 @@ package body Prj.Nmsc is
          else
             if Lib_ALI_Dir.Value = Empty_String then
                if Current_Verbosity = High then
-                  Write_Line ("No library 'A'L'I directory specified");
+                  Write_Line ("No library ALI directory specified");
                end if;
                Data.Library_ALI_Dir := Data.Library_Dir;
                Data.Display_Library_ALI_Dir := Data.Display_Library_Dir;
@@ -3946,10 +3997,11 @@ package body Prj.Nmsc is
          end;
 
          declare
-            Current : Array_Element_Id := Data.Naming.Spec_Suffix;
+            Current : Array_Element_Id;
             Element : Array_Element;
 
          begin
+            Current := Data.Naming.Spec_Suffix;
             while Current /= No_Array_Element loop
                Element := In_Tree.Array_Elements.Table (Current);
                Get_Name_String (Element.Value.Value);
@@ -3970,14 +4022,14 @@ package body Prj.Nmsc is
 
          declare
             Impl_Suffixs : Array_Element_Id :=
-              Util.Value_Of
-                (Name_Body_Suffix,
-                 Naming.Decl.Arrays,
-                 In_Tree);
+                             Util.Value_Of
+                               (Name_Body_Suffix,
+                                Naming.Decl.Arrays,
+                                In_Tree);
 
-            Suffix       : Array_Element_Id;
-            Element      : Array_Element;
-            Suffix2      : Array_Element_Id;
+            Suffix  : Array_Element_Id;
+            Element : Array_Element;
+            Suffix2 : Array_Element_Id;
 
          begin
             --  If some suffixes have been specified, we make sure that
@@ -3987,12 +4039,11 @@ package body Prj.Nmsc is
 
             if Impl_Suffixs /= No_Array_Element then
                Suffix := Data.Naming.Body_Suffix;
-
                while Suffix /= No_Array_Element loop
                   Element :=
                     In_Tree.Array_Elements.Table (Suffix);
-                  Suffix2 := Impl_Suffixs;
 
+                  Suffix2 := Impl_Suffixs;
                   while Suffix2 /= No_Array_Element loop
                      exit when In_Tree.Array_Elements.Table
                                 (Suffix2).Index = Element.Index;
@@ -4001,8 +4052,7 @@ package body Prj.Nmsc is
                   end loop;
 
                   --  There is a registered default suffix, but no suffix was
-                  --  specified in the project file. Add the default to the
-                  --  array.
+                  --  specified in the project file. Add default to the array.
 
                   if Suffix2 = No_Array_Element then
                      Array_Element_Table.Increment_Last
@@ -4029,10 +4079,11 @@ package body Prj.Nmsc is
          end;
 
          declare
-            Current : Array_Element_Id := Data.Naming.Body_Suffix;
+            Current : Array_Element_Id;
             Element : Array_Element;
 
          begin
+            Current := Data.Naming.Body_Suffix;
             while Current /= No_Array_Element loop
                Element := In_Tree.Array_Elements.Table (Current);
                Get_Name_String (Element.Value.Value);
@@ -4070,12 +4121,12 @@ package body Prj.Nmsc is
    ---------------------------------
 
    procedure Check_Programming_Languages
-     (In_Tree       : Project_Tree_Ref;
-      Project       : Project_Id;
-      Data          : in out Project_Data)
+     (In_Tree : Project_Tree_Ref;
+      Project : Project_Id;
+      Data    : in out Project_Data)
    is
-      Languages : Variable_Value := Nil_Variable_Value;
-      Def_Lang  : Variable_Value := Nil_Variable_Value;
+      Languages   : Variable_Value := Nil_Variable_Value;
+      Def_Lang    : Variable_Value := Nil_Variable_Value;
       Def_Lang_Id : Name_Id;
 
    begin
@@ -4170,6 +4221,7 @@ package body Prj.Nmsc is
 
             begin
                if Get_Mode = Ada_Only then
+
                   --  Assume that there is no language specified yet
 
                   Data.Other_Sources_Present := False;
@@ -4356,16 +4408,13 @@ package body Prj.Nmsc is
                                  In_Tree);
 
       Auto_Init_Supported : Boolean;
-
       OK                  : Boolean := True;
-
       Source              : Source_Id;
       Next_Proj           : Project_Id;
 
    begin
       if Get_Mode = Multi_Language then
          Auto_Init_Supported := Data.Config.Auto_Init_Supported;
-
       else
          Auto_Init_Supported :=
            MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported;
@@ -4397,8 +4446,9 @@ package body Prj.Nmsc is
 
                declare
                   ALI         : constant String :=
-                    ALI_File_Name (Name_Buffer (1 .. Name_Len));
+                                  ALI_File_Name (Name_Buffer (1 .. Name_Len));
                   ALI_Name_Id : Name_Id;
+
                begin
                   Name_Len := ALI'Length;
                   Name_Buffer (1 .. Name_Len) := ALI;
@@ -4650,8 +4700,8 @@ package body Prj.Nmsc is
 
             if Lib_Auto_Init.Default then
 
-               --  If no attribute Library_Auto_Init is declared, then
-               --  set auto init only if it is supported.
+               --  If no attribute Library_Auto_Init is declared, then set auto
+               --  init only if it is supported.
 
                Data.Lib_Auto_Init := Auto_Init_Supported;
 
@@ -4667,8 +4717,8 @@ package body Prj.Nmsc is
                      Data.Lib_Auto_Init := True;
 
                   else
-                     --  Library_Auto_Init cannot be "true" if auto init
-                     --  is not supported
+                     --  Library_Auto_Init cannot be "true" if auto init is not
+                     --  supported
 
                      Error_Msg
                        (Project, In_Tree,
@@ -4686,12 +4736,11 @@ package body Prj.Nmsc is
             end if;
          end SAL_Library;
 
-         --  If attribute Library_Src_Dir is defined and not the
-         --  empty string, check if the directory exist and is not
-         --  the object directory or one of the source directories.
-         --  This is the directory where copies of the interface
-         --  sources will be copied. Note that this directory may be
-         --  the library directory.
+         --  If attribute Library_Src_Dir is defined and not the empty string,
+         --  check if the directory exist and is not the object directory or
+         --  one of the source directories. This is the directory where copies
+         --  of the interface sources will be copied. Note that this directory
+         --  may be the library directory.
 
          if Lib_Src_Dir.Value /= Empty_String then
             declare
@@ -4713,12 +4762,12 @@ package body Prj.Nmsc is
 
                if Data.Library_Src_Dir = No_Path then
 
-                  --  Get the absolute name of the library directory
-                  --  that does not exist, to report an error.
+                  --  Get the absolute name of the library directory that does
+                  --  not exist, to report an error.
 
                   declare
                      Dir_Name : constant String :=
-                       Get_Name_String (Dir_Id);
+                                  Get_Name_String (Dir_Id);
 
                   begin
                      if Is_Absolute_Path (Dir_Name) then
@@ -4751,8 +4800,7 @@ package body Prj.Nmsc is
                         Lib_Src_Dir.Location);
                   end;
 
-                  --  Report an error if it is the same as the object
-                  --  directory.
+                  --  Report error if it is the same as the object directory
 
                elsif Data.Library_Src_Dir = Data.Object_Directory then
                   Error_Msg
@@ -4773,8 +4821,7 @@ package body Prj.Nmsc is
 
                      Src_Dirs := Data.Source_Dirs;
                      while Src_Dirs /= Nil_String loop
-                        Src_Dir := In_Tree.String_Elements.Table
-                                                          (Src_Dirs);
+                        Src_Dir := In_Tree.String_Elements.Table (Src_Dirs);
 
                         --  Report error if it is one of the source directories
 
@@ -5105,6 +5152,7 @@ package body Prj.Nmsc is
 
       procedure Add_File is
          File : File_Name_Type;
+
       begin
          Add ('"');
          File_Number := File_Number + 1;
@@ -5131,6 +5179,7 @@ package body Prj.Nmsc is
 
       procedure Add_Name is
          Name : Name_Id;
+
       begin
          Add ('"');
          Name_Number := Name_Number + 1;
@@ -5171,7 +5220,7 @@ package body Prj.Nmsc is
          First := First + 1;
 
          --  Warning character is always the first one in this package
-         --  this is an undocumented kludge!!!
+         --  this is an undocumented kludge???
 
       elsif Msg (First) = '?' then
          First := First + 1;
@@ -5248,7 +5297,7 @@ package body Prj.Nmsc is
                      Write_Line (Source_Directory);
                   end if;
 
-                  --  We look to every entry in the source directory
+                  --  We look at every entry in the source directory
 
                   Open (Dir, Source_Directory
                                (Source_Directory'First .. Dir_Last));
@@ -5318,10 +5367,9 @@ package body Prj.Nmsc is
          Write_Line ("end Looking for sources.");
       end if;
 
-      --  If we have looked for sources and found none, then
-      --  it is an error, except if it is an extending project.
-      --  If a non extending project is not supposed to contain
-      --  any source, then we never call Find_Ada_Sources.
+      --  If we have looked for sources and found none, then it is an error,
+      --  except if it is an extending project. If a non extending project is
+      --  not supposed to contain any source, then never call Find_Ada_Sources.
 
       if Current_Source = Nil_String and then
         Data.Extends = No_Project
@@ -5341,7 +5389,7 @@ package body Prj.Nmsc is
       For_Language : Language_Index;
       Follow_Links : Boolean := False)
    is
-      Source_Dir      : String_List_Id := Data.Source_Dirs;
+      Source_Dir      : String_List_Id;
       Element         : String_Element;
       Dir             : Dir_Type;
       Current_Source  : String_List_Id := Nil_String;
@@ -5352,8 +5400,9 @@ package body Prj.Nmsc is
          Write_Line ("Looking for sources:");
       end if;
 
-      --  For each subdirectory
+      --  Loop through subdirectories
 
+      Source_Dir := Data.Source_Dirs;
       while Source_Dir /= Nil_String loop
          begin
             Source_Recorded := False;
@@ -5367,8 +5416,8 @@ package body Prj.Nmsc is
                                        Name_Buffer (1 .. Name_Len) &
                                          Directory_Separator;
 
-                  Dir_Last  : constant Natural :=
-                                Compute_Directory_Last (Source_Directory);
+                  Dir_Last : constant Natural :=
+                               Compute_Directory_Last (Source_Directory);
 
                begin
                   if Current_Verbosity = High then
@@ -5464,10 +5513,10 @@ package body Prj.Nmsc is
 
       if For_Language = Ada_Language_Index then
 
-         --  If we have looked for sources and found none, then
-         --  it is an error, except if it is an extending project.
-         --  If a non extending project is not supposed to contain
-         --  any source, then we never call Find_Sources.
+         --  If we have looked for sources and found none, then it is an error,
+         --  except if it is an extending project. If a non extending project
+         --  is not supposed to contain any source files, then never call
+         --  Find_Sources.
 
          if Current_Source /= Nil_String then
             Data.Ada_Sources_Present := True;
@@ -5502,9 +5551,9 @@ package body Prj.Nmsc is
                       Util.Value_Of
                         (Name_Object_Dir, Data.Decl.Attributes, In_Tree);
 
-      Exec_Dir    : constant Variable_Value :=
-                      Util.Value_Of
-                        (Name_Exec_Dir, Data.Decl.Attributes, In_Tree);
+      Exec_Dir : constant Variable_Value :=
+                   Util.Value_Of
+                     (Name_Exec_Dir, Data.Decl.Attributes, In_Tree);
 
       Source_Dirs : constant Variable_Value :=
                       Util.Value_Of
@@ -5527,8 +5576,7 @@ package body Prj.Nmsc is
          Location : Source_Ptr;
          Removed  : Boolean := False);
       --  Find one or several source directories, and add (or remove, if
-      --  Removed is True) them to the list of source directories of the
-      --  project.
+      --  Removed is True) them to list of source directories of the project.
 
       ----------------------
       -- Find_Source_Dirs --
@@ -5551,13 +5599,13 @@ package body Prj.Nmsc is
          -------------------------
 
          procedure Recursive_Find_Dirs (Path : Name_Id) is
-            Dir      : Dir_Type;
-            Name     : String (1 .. 250);
-            Last     : Natural;
-            List     : String_List_Id := Data.Source_Dirs;
-            Prev     : String_List_Id := Nil_String;
-            Element  : String_Element;
-            Found    : Boolean := False;
+            Dir     : Dir_Type;
+            Name    : String (1 .. 250);
+            Last    : Natural;
+            List    : String_List_Id;
+            Prev    : String_List_Id;
+            Element : String_Element;
+            Found   : Boolean := False;
 
             Non_Canonical_Path : Name_Id := No_Name;
             Canonical_Path     : Name_Id := No_Name;
@@ -5579,9 +5627,9 @@ package body Prj.Nmsc is
             Canonical_Path := Name_Find;
 
             --  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.
+            --  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.
 
             if not Removed then
                if Recursive_Dirs.Get (Canonical_Path) then
@@ -5593,6 +5641,8 @@ package body Prj.Nmsc is
 
             --  Check if directory is already in list
 
+            List := Data.Source_Dirs;
+            Prev := Nil_String;
             while List /= Nil_String loop
                Element := In_Tree.String_Elements.Table (List);
 
@@ -7564,9 +7614,26 @@ package body Prj.Nmsc is
          end if;
       end Search_Directories;
 
+      Excluded_Sources : Variable_Value :=
+                           Util.Value_Of
+                             (Name_Excluded_Source_Files,
+                              Data.Decl.Attributes,
+                              In_Tree);
+
    --  Start of processing for Look_For_Sources
 
    begin
+      --  If Excluded_Source_Files is not declared, check
+      --  Locally_Removed_Files.
+
+      if Excluded_Sources.Default then
+         Excluded_Sources :=
+           Util.Value_Of
+             (Name_Locally_Removed_Files,
+              Data.Decl.Attributes,
+              In_Tree);
+      end if;
+
       if Get_Mode = Ada_Only and then
         Is_A_Language (In_Tree, Data, "ada")
       then
@@ -7583,12 +7650,6 @@ package body Prj.Nmsc is
                                     Data.Decl.Attributes,
                                     In_Tree);
 
-            Excluded_Sources : Variable_Value :=
-                                 Util.Value_Of
-                                   (Name_Excluded_Source_Files,
-                                    Data.Decl.Attributes,
-                                    In_Tree);
-
          begin
             pragma Assert
               (Sources.Kind = List,
@@ -7708,17 +7769,6 @@ package body Prj.Nmsc is
                  (Project, In_Tree, Data, Follow_Links);
             end if;
 
-            --  If Excluded_ource_Files is not declared, check
-            --  Locally_Removed_Files.
-
-            if Excluded_Sources.Default then
-               Excluded_Sources :=
-                 Util.Value_Of
-                   (Name_Locally_Removed_Files,
-                    Data.Decl.Attributes,
-                    In_Tree);
-            end if;
-
             --  If there are sources that are locally removed, mark them as
             --  such in the Units table.
 
@@ -8120,25 +8170,9 @@ package body Prj.Nmsc is
                                     Data.Decl.Attributes,
                                     In_Tree);
 
-            Excluded_Sources : Variable_Value :=
-                                 Util.Value_Of
-                                   (Name_Excluded_Source_Files,
-                                    Data.Decl.Attributes,
-                                    In_Tree);
             Name_Loc         : Name_Location;
 
          begin
-            --  If Excluded_ource_Files is not declared, check
-            --  Locally_Removed_Files.
-
-            if Excluded_Sources.Default then
-               Excluded_Sources :=
-                 Util.Value_Of
-                   (Name_Locally_Removed_Files,
-                    Data.Decl.Attributes,
-                    In_Tree);
-            end if;
-
             if not Sources.Default then
                if not Source_List_File.Default then
                   Error_Msg
@@ -8314,8 +8348,7 @@ package body Prj.Nmsc is
 
    function Path_Name_Of
      (File_Name : File_Name_Type;
-      Directory : Path_Name_Type)
-      return String
+      Directory : Path_Name_Type) return String
    is
       Result : String_Access;
 
index 2fa0973..f576841 100644 (file)
@@ -439,7 +439,9 @@ package body Prj.Part is
       Store_Comments         : Boolean := False)
    is
       Current_Directory : constant String := Get_Current_Dir;
+
       Dummy : Boolean;
+      pragma Warnings (Off, Dummy);
 
       Real_Project_File_Name : String_Access :=
                                  Osint.To_Canonical_File_Spec
@@ -1055,16 +1057,8 @@ package body Prj.Part is
          --  or not following Ada identifier's syntax).
 
          Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name);
-
-         if In_Configuration then
-            Error_Msg ("{ is not a valid path name for a configuration " &
-                       "project file",
-                       Token_Ptr);
-
-         else
-            Error_Msg ("?{ is not a valid path name for a project file",
-                       Token_Ptr);
-         end if;
+         Error_Msg ("?{ is not a valid path name for a project file",
+                    Token_Ptr);
       end if;
 
       if Current_Verbosity >= Medium then
@@ -1234,49 +1228,52 @@ package body Prj.Part is
             Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
          end;
 
-         declare
-            Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
-              Tree_Private_Part.Projects_Htable.Get_First
-                (In_Tree.Projects_HT);
-            Project_Name : Name_Id := Name_And_Node.Name;
-
-         begin
-            --  Check if we already have a project with this name
-
-            while Project_Name /= No_Name
-              and then Project_Name /= Name_Of_Project
-            loop
-               Name_And_Node :=
-                 Tree_Private_Part.Projects_Htable.Get_Next
+         if not In_Configuration then
+            declare
+               Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
+                 Tree_Private_Part.Projects_Htable.Get_First
                    (In_Tree.Projects_HT);
-               Project_Name := Name_And_Node.Name;
-            end loop;
+               Project_Name : Name_Id := Name_And_Node.Name;
 
-            --  Report an error if we already have a project with this name
+            begin
+               --  Check if we already have a project with this name
+
+               while Project_Name /= No_Name
+                 and then Project_Name /= Name_Of_Project
+               loop
+                  Name_And_Node :=
+                    Tree_Private_Part.Projects_Htable.Get_Next
+                      (In_Tree.Projects_HT);
+                  Project_Name := Name_And_Node.Name;
+               end loop;
 
-            if Project_Name /= No_Name then
-               Error_Msg_Name_1 := Project_Name;
-               Error_Msg
-                 ("duplicate project name %%", Location_Of (Project, In_Tree));
-               Error_Msg_Name_1 :=
-                 Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
-               Error_Msg
-                 ("\already in %%", Location_Of (Project, In_Tree));
+               --  Report an error if we already have a project with this name
 
-            else
-               --  Otherwise, add the name of the project to the hash table, so
-               --  that we can check that no other subsequent project will have
-               --  the same name.
-
-               Tree_Private_Part.Projects_Htable.Set
-                 (T => In_Tree.Projects_HT,
-                  K => Name_Of_Project,
-                  E => (Name           => Name_Of_Project,
-                        Node           => Project,
-                        Canonical_Path => Canonical_Path_Name,
-                        Extended       => Extended));
-            end if;
-         end;
+               if Project_Name /= No_Name then
+                  Error_Msg_Name_1 := Project_Name;
+                  Error_Msg
+                    ("duplicate project name %%",
+                     Location_Of (Project, In_Tree));
+                  Error_Msg_Name_1 :=
+                    Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
+                  Error_Msg
+                    ("\already in %%", Location_Of (Project, In_Tree));
+
+               else
+                  --  Otherwise, add the name of the project to the hash table,
+                  --  so that we can check that no other subsequent project
+                  --  will have the same name.
+
+                  Tree_Private_Part.Projects_Htable.Set
+                    (T => In_Tree.Projects_HT,
+                     K => Name_Of_Project,
+                     E => (Name           => Name_Of_Project,
+                           Node           => Project,
+                           Canonical_Path => Canonical_Path_Name,
+                           Extended       => Extended));
+               end if;
+            end;
+         end if;
 
       end if;
 
index f6a1610..c3c321c 100644 (file)
@@ -766,6 +766,7 @@ package body Prj.Proc is
                         The_Array   : Array_Id := No_Array;
                         The_Element : Array_Element_Id := No_Array_Element;
                         Array_Index : Name_Id := No_Name;
+                        Lower       : Boolean;
 
                      begin
                         if The_Package /= No_Package then
@@ -792,9 +793,26 @@ package body Prj.Proc is
 
                            Get_Name_String (Index);
 
-                           if Case_Insensitive
-                                (The_Current_Term, From_Project_Node_Tree)
-                           then
+                           Lower :=
+                             Case_Insensitive
+                               (The_Current_Term, From_Project_Node_Tree);
+
+                           --  In multi-language mode (gprbuild), the index is
+                           --  always case insensitive if it does not include
+                           --  any dot.
+
+                           if Get_Mode = Multi_Language and then not Lower then
+                              Lower := True;
+
+                              for J in 1 .. Name_Len loop
+                                 if Name_Buffer (J) = '.' then
+                                    Lower := False;
+                                    exit;
+                                 end if;
+                              end loop;
+                           end if;
+
+                           if Lower then
                               To_Lower (Name_Buffer (1 .. Name_Len));
                            end if;
 
@@ -1875,12 +1893,32 @@ package body Prj.Proc is
 
                         --  Put in lower case, if necessary
 
-                        if Case_Insensitive
-                             (Current_Item, From_Project_Node_Tree)
-                        then
-                           GNAT.Case_Util.To_Lower
-                                            (Name_Buffer (1 .. Name_Len));
-                        end if;
+                        declare
+                           Lower : Boolean;
+
+                        begin
+                           Lower :=
+                             Case_Insensitive
+                               (Current_Item, From_Project_Node_Tree);
+
+                           --  In multi-language mode (gprbuild), the index is
+                           --  always case insensitive if it does not include
+                           --  any dot.
+
+                           if Get_Mode = Multi_Language and then not Lower then
+                              for J in 1 .. Name_Len loop
+                                 if Name_Buffer (J) = '.' then
+                                    Lower := False;
+                                    exit;
+                                 end if;
+                              end loop;
+                           end if;
+
+                           if Lower then
+                              GNAT.Case_Util.To_Lower
+                                (Name_Buffer (1 .. Name_Len));
+                           end if;
+                        end;
 
                         declare
                            The_Array : Array_Id;
@@ -1895,18 +1933,19 @@ package body Prj.Proc is
                            --  Look for the array in the appropriate list
 
                            if Pkg /= No_Package then
-                              The_Array := In_Tree.Packages.Table
-                                             (Pkg).Decl.Arrays;
+                              The_Array :=
+                                In_Tree.Packages.Table (Pkg).Decl.Arrays;
 
                            else
-                              The_Array := In_Tree.Projects.Table
-                                             (Project).Decl.Arrays;
+                              The_Array :=
+                                In_Tree.Projects.Table (Project).Decl.Arrays;
                            end if;
 
                            while
                              The_Array /= No_Array
-                             and then In_Tree.Arrays.Table
-                                        (The_Array).Name /= Current_Item_Name
+                               and then
+                                 In_Tree.Arrays.Table (The_Array).Name /=
+                                                            Current_Item_Name
                            loop
                               The_Array := In_Tree.Arrays.Table
                                              (The_Array).Next;
@@ -1918,27 +1957,22 @@ package body Prj.Proc is
                            --  created automatically later
 
                            if The_Array = No_Array then
-                              Array_Table.Increment_Last
-                                (In_Tree.Arrays);
-                              The_Array := Array_Table.Last
-                                (In_Tree.Arrays);
+                              Array_Table.Increment_Last (In_Tree.Arrays);
+                              The_Array := Array_Table.Last (In_Tree.Arrays);
 
                               if Pkg /= No_Package then
-                                 In_Tree.Arrays.Table
-                                   (The_Array) :=
+                                 In_Tree.Arrays.Table (The_Array) :=
                                    (Name  => Current_Item_Name,
                                     Value => No_Array_Element,
                                     Next  =>
                                       In_Tree.Packages.Table
                                         (Pkg).Decl.Arrays);
 
-                                 In_Tree.Packages.Table
-                                   (Pkg).Decl.Arrays :=
+                                 In_Tree.Packages.Table (Pkg).Decl.Arrays :=
                                      The_Array;
 
                               else
-                                 In_Tree.Arrays.Table
-                                   (The_Array) :=
+                                 In_Tree.Arrays.Table (The_Array) :=
                                    (Name  => Current_Item_Name,
                                     Value => No_Array_Element,
                                     Next  =>
@@ -1946,8 +1980,7 @@ package body Prj.Proc is
                                         (Project).Decl.Arrays);
 
                                  In_Tree.Projects.Table
-                                   (Project).Decl.Arrays :=
-                                     The_Array;
+                                   (Project).Decl.Arrays := The_Array;
                               end if;
 
                            --  Otherwise initialize The_Array_Element as the
@@ -1955,8 +1988,7 @@ package body Prj.Proc is
 
                            else
                               The_Array_Element :=
-                                In_Tree.Arrays.Table
-                                  (The_Array).Value;
+                                In_Tree.Arrays.Table (The_Array).Value;
                            end if;
 
                            --  Look in the list, if any, to find an element
@@ -1984,16 +2016,16 @@ package body Prj.Proc is
 
                               In_Tree.Array_Elements.Table
                                 (The_Array_Element) :=
-                                (Index  => Index_Name,
-                                 Src_Index =>
-                                   Source_Index_Of
-                                     (Current_Item, From_Project_Node_Tree),
-                                 Index_Case_Sensitive =>
-                                 not Case_Insensitive
-                                   (Current_Item, From_Project_Node_Tree),
-                                 Value  => New_Value,
-                                 Next => In_Tree.Arrays.Table
-                                           (The_Array).Value);
+                                  (Index  => Index_Name,
+                                   Src_Index =>
+                                     Source_Index_Of
+                                       (Current_Item, From_Project_Node_Tree),
+                                   Index_Case_Sensitive =>
+                                     not Case_Insensitive
+                                       (Current_Item, From_Project_Node_Tree),
+                                   Value  => New_Value,
+                                   Next => In_Tree.Arrays.Table
+                                             (The_Array).Value);
                               In_Tree.Arrays.Table
                                 (The_Array).Value := The_Array_Element;
 
@@ -2038,7 +2070,7 @@ package body Prj.Proc is
                      Name   : Name_Id     := No_Name;
 
                   begin
-                     --  If a project were specified for the case variable,
+                     --  If a project was specified for the case variable,
                      --  get its id.
 
                      if Project_Node_Of
@@ -2223,7 +2255,6 @@ package body Prj.Proc is
    is
    begin
       Error_Report := Report_Error;
-      Success := True;
 
       if Reset_Tree then
 
@@ -2244,6 +2275,10 @@ package body Prj.Proc is
          From_Project_Node_Tree => From_Project_Node_Tree,
          Extended_By            => No_Project);
 
+      Success :=
+        Total_Errors_Detected = 0
+          and then
+            (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
    end Process_Project_Tree_Phase_1;
 
    ----------------------------------
index 1917bd2..c41c3da 100644 (file)
@@ -524,9 +524,10 @@ package body Prj.Util is
       In_Tree                : Project_Tree_Ref;
       Force_Lower_Case_Index : Boolean := False) return Variable_Value
    is
-      Current    : Array_Element_Id;
-      Element    : Array_Element;
-      Real_Index : Name_Id;
+      Current      : Array_Element_Id;
+      Element      : Array_Element;
+      Real_Index_1 : Name_Id;
+      Real_Index_2 : Name_Id;
 
    begin
       Current := In_Array;
@@ -537,18 +538,25 @@ package body Prj.Util is
 
       Element := In_Tree.Array_Elements.Table (Current);
 
-      Real_Index := Index;
+      Real_Index_1 := Index;
 
       if not Element.Index_Case_Sensitive or Force_Lower_Case_Index then
          Get_Name_String (Index);
          To_Lower (Name_Buffer (1 .. Name_Len));
-         Real_Index := Name_Find;
+         Real_Index_1 := Name_Find;
       end if;
 
       while Current /= No_Array_Element loop
          Element := In_Tree.Array_Elements.Table (Current);
+         Real_Index_2 := Element.Index;
+
+         if not Element.Index_Case_Sensitive or Force_Lower_Case_Index then
+            Get_Name_String (Element.Index);
+            To_Lower (Name_Buffer (1 .. Name_Len));
+            Real_Index_2 := Name_Find;
+         end if;
 
-         if Real_Index = Element.Index and then
+         if Real_Index_1 = Real_Index_2 and then
            Src_Index = Element.Src_Index
          then
             return Element.Value;
index c0c936e..938b3a0 100644 (file)
@@ -370,6 +370,8 @@ package Prj is
       --  shared libraries. Specified in the configuration. When not specified,
       --  there is no need for such switch.
 
+      Runtime_Library_Dir : Name_Id := No_Name;
+
       Mapping_File_Switches  : Name_List_Index := No_Name_List;
       --  The option(s) to provide a mapping file to the compiler. Specified in
       --  the configuration. When not ???
@@ -417,6 +419,7 @@ package Prj is
                            Compiler_Driver_Path       => null,
                            Compiler_Required_Switches => No_Name_List,
                            Compilation_PIC_Option     => No_Name_List,
+                           Runtime_Library_Dir        => No_Name,
                            Mapping_File_Switches      => No_Name_List,
                            Mapping_Spec_Suffix        => No_File,
                            Mapping_Body_Suffix        => No_File,
index fb456ac..a6693a7 100644 (file)
@@ -776,6 +776,7 @@ package body Snames is
      "symbolic_link_supported#" &
      "toolchain_description#" &
      "toolchain_version#" &
+     "runtime_library_dir#" &
      "unaligned_valid#" &
      "interface#" &
      "overriding#" &
index 2b78213..b7a7ab1 100644 (file)
@@ -1092,25 +1092,26 @@ package Snames is
    Name_Symbolic_Link_Supported        : constant Name_Id := N + 715;
    Name_Toolchain_Description          : constant Name_Id := N + 716;
    Name_Toolchain_Version              : constant Name_Id := N + 717;
+   Name_Runtime_Library_Dir            : constant Name_Id := N + 718;
 
    --  Other miscellaneous names used in front end
 
-   Name_Unaligned_Valid                : constant Name_Id := N + 718;
+   Name_Unaligned_Valid                : constant Name_Id := N + 719;
 
    --  Ada 2005 reserved words
 
-   First_2005_Reserved_Word            : constant Name_Id := N + 719;
-   Name_Interface                      : constant Name_Id := N + 719;
-   Name_Overriding                     : constant Name_Id := N + 720;
-   Name_Synchronized                   : constant Name_Id := N + 721;
-   Last_2005_Reserved_Word             : constant Name_Id := N + 721;
+   First_2005_Reserved_Word            : constant Name_Id := N + 720;
+   Name_Interface                      : constant Name_Id := N + 720;
+   Name_Overriding                     : constant Name_Id := N + 721;
+   Name_Synchronized                   : constant Name_Id := N + 722;
+   Last_2005_Reserved_Word             : constant Name_Id := N + 722;
 
    subtype Ada_2005_Reserved_Words is
      Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
 
    --  Mark last defined name for consistency check in Snames body
 
-   Last_Predefined_Name                : constant Name_Id := N + 721;
+   Last_Predefined_Name                : constant Name_Id := N + 722;
 
    ---------------------------------------
    -- Subtypes Defining Name Categories --