OSDN Git Service

* parser.c (cp_parser_class_specifier): Set class location to that
[pf3gnuchains/gcc-fork.git] / gcc / ada / prj-conf.adb
index b29082d..dfebd9a 100644 (file)
 --                                                                          --
 -- 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,  51  Franklin  Street,  Fifth  Floor, --
--- Boston, MA 02110-1301, 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.      --
@@ -30,6 +29,8 @@ with Makeutl;          use Makeutl;
 with MLib.Tgt;
 with Opt;              use Opt;
 with Output;           use Output;
+with Prj.Env;
+with Prj.Err;
 with Prj.Part;
 with Prj.PP;
 with Prj.Proc;         use Prj.Proc;
@@ -351,7 +352,7 @@ package body Prj.Conf is
       end if;
 
       if Target = "" then
-         OK := not Autoconf_Specified or Tgt_Name = No_Name;
+         OK := not Autoconf_Specified or else Tgt_Name = No_Name;
       else
          OK := Tgt_Name /= No_Name
                  and then Target = Get_Name_String (Tgt_Name);
@@ -515,6 +516,8 @@ package body Prj.Conf is
          Count    : Natural;
          Result   : Argument_List_Access;
 
+         Check_Default : Boolean;
+
       begin
          Prj_Iter := Project_Tree.Projects;
          while Prj_Iter /= null loop
@@ -529,9 +532,23 @@ package body Prj.Conf is
                  or else Variable.Default
                then
                   --  Languages is not declared. If it is not an extending
-                  --  project, check for Default_Language
+                  --  project, or if it extends a project with no Languages,
+                  --  check for Default_Language.
+
+                  Check_Default := Prj_Iter.Project.Extends = No_Project;
 
-                  if Prj_Iter.Project.Extends = No_Project then
+                  if not Check_Default then
+                     Variable :=
+                       Value_Of
+                         (Name_Languages,
+                          Prj_Iter.Project.Extends.Decl.Attributes,
+                          Project_Tree);
+                     Check_Default :=
+                       Variable /= Nil_Variable_Value
+                         and then Variable.Values = Nil_String;
+                  end if;
+
+                  if Check_Default then
                      Variable :=
                        Value_Of
                          (Name_Default_Language,
@@ -547,7 +564,7 @@ package body Prj.Conf is
                         Language_Htable.Set (Lang, Lang);
 
                      else
-                        --  If no language is declared, default to Ada
+                        --  If no default language is declared, default to Ada
 
                         Language_Htable.Set (Name_Ada, Name_Ada);
                      end if;
@@ -676,7 +693,6 @@ package body Prj.Conf is
                Name_Len := 0;
                Add_Str_To_Name_Buffer
                  (Get_Name_String (Project.Directory.Name));
-               Add_Char_To_Name_Buffer (Directory_Separator);
                Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
             end if;
          end if;
@@ -698,6 +714,8 @@ package body Prj.Conf is
             Args     : Argument_List (1 .. 5);
             Arg_Last : Positive;
 
+            Obj_Dir_Exists : Boolean := True;
+
          begin
             --  Check if the object directory exists. If Setup_Projects is True
             --  (-p) and directory does not exist, attempt to create it.
@@ -705,7 +723,7 @@ package body Prj.Conf is
             --  gprconfig.
 
             if not Is_Directory (Obj_Dir)
-              and then (Setup_Projects or Subdirs /= null)
+              and then (Setup_Projects or else Subdirs /= null)
             then
                begin
                   Create_Path (Obj_Dir);
@@ -724,8 +742,18 @@ package body Prj.Conf is
             end if;
 
             if not Is_Directory (Obj_Dir) then
-               raise Invalid_Config
-                 with "object directory " & Obj_Dir & " does not exist";
+               case Flags.Require_Obj_Dirs is
+                  when Error =>
+                     raise Invalid_Config
+                       with "object directory " & Obj_Dir & " does not exist";
+                  when Warning =>
+                     Prj.Err.Error_Msg
+                       (Flags,
+                        "?object directory " & Obj_Dir & " does not exist");
+                     Obj_Dir_Exists := False;
+                  when Silent =>
+                     null;
+               end case;
             end if;
 
             --  Invoke gprconfig
@@ -736,8 +764,35 @@ package body Prj.Conf is
             --  If no config file was specified, set the auto.cgpr one
 
             if Config_File_Name = "" then
-               Args (3) := new String'
-                 (Obj_Dir & Directory_Separator & Auto_Cgpr);
+               if Obj_Dir_Exists then
+                  Args (3) :=
+                    new String'(Obj_Dir & Directory_Separator & Auto_Cgpr);
+
+               else
+                  declare
+                     Path_FD   : File_Descriptor;
+                     Path_Name : Path_Name_Type;
+
+                  begin
+                     Prj.Env.Create_Temp_File
+                       (In_Tree   => Project_Tree,
+                        Path_FD   => Path_FD,
+                        Path_Name => Path_Name,
+                        File_Use  => "configuration file");
+
+                     if Path_FD /= Invalid_FD then
+                        Args (3) := new String'(Get_Name_String (Path_Name));
+                        GNAT.OS_Lib.Close (Path_FD);
+
+                     else
+                        --  We'll have an error message later on
+
+                        Args (3) :=
+                          new String'
+                            (Obj_Dir & Directory_Separator & Auto_Cgpr);
+                     end if;
+                  end;
+               end if;
             else
                Args (3) := new String'(Config_File_Name);
             end if;
@@ -775,9 +830,16 @@ package body Prj.Conf is
                Write_Eol;
 
             elsif not Quiet_Output then
-               Write_Str ("creating ");
-               Write_Str (Simple_Name (Args (3).all));
-               Write_Eol;
+               --  Display no message if we are creating auto.cgpr, unless in
+               --  verbose mode
+
+               if Config_File_Name /= ""
+                 or else Verbose_Mode
+               then
+                  Write_Str ("creating ");
+                  Write_Str (Simple_Name (Args (3).all));
+                  Write_Eol;
+               end if;
             end if;
 
             Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) & Switches.all,
@@ -846,7 +908,8 @@ package body Prj.Conf is
             Always_Errout_Finalize => False,
             Packages_To_Check      => Packages_To_Check,
             Current_Directory      => Current_Directory,
-            Is_Config_File         => True);
+            Is_Config_File         => True,
+            Flags                  => Flags);
       else
          --  Maybe the user will want to create his own configuration file
          Config_Project_Node := Empty_Node;
@@ -882,8 +945,8 @@ package body Prj.Conf is
       --  auto-conf mode, since the appropriate target was passed to gprconfig.
 
       if not Automatically_Generated
-        and not Check_Target
-          (Config, Autoconf_Specified, Project_Tree, Target_Name)
+        and then not
+          Check_Target (Config, Autoconf_Specified, Project_Tree, Target_Name)
       then
          Automatically_Generated := True;
          goto Process_Config_File;
@@ -991,7 +1054,6 @@ package body Prj.Conf is
    begin
       --  Parse the user project tree
 
-      Prj.Tree.Initialize (Project_Node_Tree);
       Prj.Initialize (Project_Tree);
 
       Main_Project      := No_Project;
@@ -1004,7 +1066,8 @@ package body Prj.Conf is
          Always_Errout_Finalize => False,
          Packages_To_Check      => Packages_To_Check,
          Current_Directory      => Current_Directory,
-         Is_Config_File         => False);
+         Is_Config_File         => False,
+         Flags                  => Flags);
 
       if User_Project_Node = Empty_Node then
          User_Project_Node := Empty_Node;
@@ -1141,8 +1204,11 @@ package body Prj.Conf is
          Index : String := "";
          Pkg   : Project_Node_Id := Empty_Node)
       is
-         Attr : Project_Node_Id;
-         Val  : Name_Id := No_Name;
+         Attr       : Project_Node_Id;
+         pragma Unreferenced (Attr);
+
+         Expr   : Name_Id         := No_Name;
+         Val    : Name_Id         := No_Name;
          Parent : Project_Node_Id := Config_File;
       begin
          if Index /= "" then
@@ -1155,24 +1221,21 @@ package body Prj.Conf is
             Parent := Pkg;
          end if;
 
+         Name_Len := Value'Length;
+         Name_Buffer (1 .. Name_Len) := Value;
+         Expr := Name_Find;
+
          Attr := Create_Attribute
            (Tree       => Project_Tree,
             Prj_Or_Pkg => Parent,
             Name       => Name,
             Index_Name => Val,
-            Kind       => Prj.Single);
-
-         Name_Len := Value'Length;
-         Name_Buffer (1 .. Name_Len) := Value;
-         Val := Name_Find;
-
-         Set_Expression_Of
-           (Attr, Project_Tree,
-            Enclose_In_Expression
-              (Create_Literal_String (Val, Project_Tree),
-               Project_Tree));
+            Kind       => Prj.Single,
+            Value      => Create_Literal_String (Expr, Project_Tree));
       end Create_Attribute;
 
+      --  Local variables
+
       Name   : Name_Id;
       Naming : Project_Node_Id;