[multiple changes]

2010-10-18  Tristan Gingold  <gingold@adacore.com>

	* init.c: Indentation, and minor changes to more closely follow GNU
	style rules.  Make more variable statics.

2010-10-18  Vincent Celier  <celier@adacore.com>

	* prj.adb (Is_Compilable): On first call for a source, cache value in
	component Compilable.
	* prj.ads (Source_Data): New component Compilable, to cache the value
	returned by function Is_Compilable.

2010-10-18  Vincent Celier  <celier@adacore.com>

	* prj-attr.adb: New project level attribute Ignore_Source_Sub_Dirs.
	* prj-nmsc.adb (Expand_Subdirectory_Pattern): New string list parameter
	Ignore.
	(Recursive_Find_Dirs): Do not consider subdirectories listed in Ignore.
	(Get_Directories): Call Find_Source_Dirs with the string list
	indicated by attribute Ignore_Source_Sub_Dirs.
	* snames.ads-tmpl: New standard name Ignore_Source_Sub_Dirs.

From-SVN: r165619

gcc/ada/ChangeLog

+2010-10-18  Tristan Gingold  <gingold@adacore.com>
+
+	* init.c: Indentation, and minor changes to more closely follow GNU
+	style rules.  Make more variable statics.
+
+2010-10-18  Vincent Celier  <celier@adacore.com>
+
+	* prj.adb (Is_Compilable): On first call for a source, cache value in
+	component Compilable.
+	* prj.ads (Source_Data): New component Compilable, to cache the value
+	returned by function Is_Compilable.
+
+2010-10-18  Vincent Celier  <celier@adacore.com>
+
+	* prj-attr.adb: New project level attribute Ignore_Source_Sub_Dirs.
+	* prj-nmsc.adb (Expand_Subdirectory_Pattern): New string list parameter
+	Ignore.
+	(Recursive_Find_Dirs): Do not consider subdirectories listed in Ignore.
+	(Get_Directories): Call Find_Source_Dirs with the string list
+	indicated by attribute Ignore_Source_Sub_Dirs.
+	* snames.ads-tmpl: New standard name Ignore_Source_Sub_Dirs.
+
 2010-10-18  Javier Miranda  <miranda@adacore.com>
 
 	* einfo.ads, einfo.adb (Primitive_Operations): New synthesized

gcc/ada/init.c

@@ -1262,7 +1262,7 @@ static const struct cond_except cond_except_table [] = {
 typedef int
 resignal_predicate (int code);
 
-const int *cond_resignal_table [] = {
+static const int * const cond_resignal_table [] = {
   &C$_SIGKILL,
   &CMA$_EXIT_THREAD,
   &SS$_DEBUG,
@@ -1273,7 +1273,7 @@ const int *cond_resignal_table [] = {
   0
 };
 
-const int facility_resignal_table [] = {
+static const int facility_resignal_table [] = {
   0x1380000, /* RDB */
   0x2220000, /* SQL */
   0
@@ -1301,15 +1301,15 @@ __gnat_default_resignal_p (int code)
 /* Static pointer to predicate that the __gnat_error_handler exception
    vector invokes to determine if it should resignal a condition.  */
 
-static resignal_predicate * __gnat_resignal_p = __gnat_default_resignal_p;
+static resignal_predicate *__gnat_resignal_p = __gnat_default_resignal_p;
 
 /* User interface to change the predicate pointer to PREDICATE. Reset to
    the default if PREDICATE is null.  */
 
 void
-__gnat_set_resignal_predicate (resignal_predicate * predicate)
+__gnat_set_resignal_predicate (resignal_predicate *predicate)
 {
-  if (predicate == 0)
+  if (predicate == NULL)
     __gnat_resignal_p = __gnat_default_resignal_p;
   else
     __gnat_resignal_p = predicate;
@@ -1323,9 +1323,7 @@ __gnat_set_resignal_predicate (resignal_predicate * predicate)
    and separated by line termination.  */
 
 static int
-copy_msg (msgdesc, message)
-     struct descriptor_s *msgdesc;
-     char *message;
+copy_msg (struct descriptor_s *msgdesc, char *message)
 {
   int len = strlen (message);
   int copy_len;
@@ -1352,7 +1350,7 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs)
 {
   struct Exception_Data *exception = 0;
   Exception_Code base_code;
-  struct descriptor_s gnat_facility = {4,0,"GNAT"};
+  struct descriptor_s gnat_facility = {4, 0, "GNAT"};
   char message [Default_Exception_Msg_Max_Length];
 
   const char *msg = "";
@@ -1365,17 +1363,17 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs)
 #ifdef IN_RTS
   /* See if it's an imported exception.  Beware that registered exceptions
      are bound to their base code, with the severity bits masked off.  */
-  base_code = Base_Code_In ((Exception_Code) sigargs [1]);
+  base_code = Base_Code_In ((Exception_Code) sigargs[1]);
   exception = Coded_Exception (base_code);
 
   if (exception)
     {
-      message [0] = 0;
+      message[0] = 0;
 
       /* Subtract PC & PSL fields which messes with PUTMSG.  */
-      sigargs [0] -= 2;
+      sigargs[0] -= 2;
       SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
-      sigargs [0] += 2;
+      sigargs[0] += 2;
       msg = message;
 
       exception->Name_Length = 19;
@@ -1448,8 +1446,8 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs)
 	      /* Scan the VMS standard condition table for a match and fetch
 		 the associated GNAT exception pointer.  */
 	      for (i = 0;
-		   cond_except_table [i].cond &&
-		   !LIB$MATCH_COND (&sigargs [1], &cond_except_table [i].cond);
+		   cond_except_table[i].cond &&
+		   !LIB$MATCH_COND (&sigargs[1], &cond_except_table[i].cond);
 		   i++);
 	      exception = (struct Exception_Data *)
 		cond_except_table [i].except;
@@ -1463,11 +1461,11 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs)
 #else
 	exception = &program_error;
 #endif
-	message [0] = 0;
+	message[0] = 0;
 	/* Subtract PC & PSL fields which messes with PUTMSG.  */
-	sigargs [0] -= 2;
+	sigargs[0] -= 2;
 	SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
-	sigargs [0] += 2;
+	sigargs[0] += 2;
 	msg = message;
 	break;
       }
@@ -1475,34 +1473,13 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs)
   Raise_From_Signal_Handler (exception, msg);
 }
 
-long
-__gnat_error_handler (int *sigargs, void *mechargs)
-{
-  return __gnat_handle_vms_condition (sigargs, mechargs);
-}
-
 void
 __gnat_install_handler (void)
 {
   long prvhnd ATTRIBUTE_UNUSED;
 
 #if !defined (IN_RTS)
-  SYS$SETEXV (1, __gnat_error_handler, 3, &prvhnd);
-#endif
-
-  /* On alpha-vms, we avoid the global vector annoyance thanks to frame based
-     handlers to turn conditions into exceptions since GCC 3.4.  The global
-     vector is still required for earlier GCC versions.  We're resorting to
-     the __gnat_error_prehandler assembly function in this case.  */
-
-#if defined (IN_RTS) && defined (__alpha__)
-  if ((__GNUC__ * 10 + __GNUC_MINOR__) < 34)
-    {
-      char * c = (char *) xmalloc (2049);
-
-      __gnat_error_prehandler_stack = &c[2048];
-      SYS$SETEXV (1, __gnat_error_prehandler, 3, &prvhnd);
-    }
+  SYS$SETEXV (1, __gnat_handle_vms_condition, 3, &prvhnd);
 #endif
 
   __gnat_handler_installed = 1;
@@ -1572,7 +1549,10 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
    If we ever add another feature logical to this list, the
    feature struct will need to be enhanced to take into account
    possible values for *gl_addr.  */
-struct feature {char *name; int* gl_addr;};
+struct feature {
+  char *name;
+  int *gl_addr;
+};
 
 /* Default values for GNAT features set by environment. */
 int __gl_heap_size = 64;
@@ -1583,21 +1563,21 @@ static struct feature features[] = {
   {0, 0}
 };
 
-void __gnat_set_features ()
+void __gnat_set_features (void)
 {
   struct descriptor_s name_desc, result_desc;
   int i, status;
   unsigned short rlen;
 
 #define MAXEQUIV 10
-  char buff [MAXEQUIV];
+  char buff[MAXEQUIV];
 
   /* Loop through features array and test name for enable/disable */
-  for (i=0; features [i].name; i++)
+  for (i = 0; features[i].name; i++)
     {
-       name_desc.len = strlen (features [i].name);
+       name_desc.len = strlen (features[i].name);
        name_desc.mbz = 0;
-       name_desc.adr = features [i].name;
+       name_desc.adr = features[i].name;
 
        result_desc.len = MAXEQUIV - 1;
        result_desc.mbz = 0;
@@ -1606,18 +1586,18 @@ void __gnat_set_features ()
        status = LIB$GET_LOGICAL (&name_desc, &result_desc, &rlen);
 
        if (((status & 1) == 1) && (rlen < MAXEQUIV))
-         buff [rlen] = 0;
+         buff[rlen] = 0;
        else
          strcpy (buff, "");
 
        if ((strcmp (buff, "ENABLE") == 0) ||
            (strcmp (buff, "TRUE") == 0) ||
            (strcmp (buff, "1") == 0))
-          *features [i].gl_addr = 32;
+          *features[i].gl_addr = 32;
        else if ((strcmp (buff, "DISABLE") == 0) ||
                 (strcmp (buff, "FALSE") == 0) ||
                 (strcmp (buff, "0") == 0))
-          *features [i].gl_addr = 64;
+          *features[i].gl_addr = 64;
     }
 
     __gnat_features_set = 1;

gcc/ada/prj-attr.adb

@@ -81,6 +81,7 @@ package body Prj.Attr is
    "LVsource_dirs#" &
    "Lainherit_source_path#" &
    "LVexcluded_source_dirs#" &
+   "LVignore_source_sub_dirs#" &
 
    --  Source files
 

gcc/ada/prj-nmsc.adb

@@ -223,6 +223,7 @@ package body Prj.Nmsc is
      (Project       : Project_Id;
       Data          : in out Tree_Processing_Data;
       Patterns      : String_List_Id;
+      Ignore        : String_List_Id;
       Search_For    : Search_Type;
       Resolve_Links : Boolean);
    --  Search the subdirectories of Project's directory for files or
@@ -966,6 +967,7 @@ package body Prj.Nmsc is
         (Project       => Project,
          Data          => Data,
          Patterns      => Project_Files.Values,
+         Ignore        => Nil_String,
          Search_For    => Search_Files,
          Resolve_Links => Opt.Follow_Links_For_Files);
 
@@ -4950,6 +4952,12 @@ package body Prj.Nmsc is
                       Util.Value_Of
                         (Name_Source_Dirs, Project.Decl.Attributes, Data.Tree);
 
+      Ignore_Source_Sub_Dirs : constant Variable_Value :=
+                                 Util.Value_Of
+                                   (Name_Ignore_Source_Sub_Dirs,
+                                    Project.Decl.Attributes,
+                                    Data.Tree);
+
       Excluded_Source_Dirs : constant Variable_Value :=
                               Util.Value_Of
                                 (Name_Excluded_Source_Dirs,
@@ -5259,6 +5267,7 @@ package body Prj.Nmsc is
            (Project         => Project,
             Data            => Data,
             Patterns        => Source_Dirs.Values,
+            Ignore          => Ignore_Source_Sub_Dirs.Values,
             Search_For      => Search_Directories,
             Resolve_Links   => Opt.Follow_Links_For_Dirs);
 
@@ -5280,6 +5289,7 @@ package body Prj.Nmsc is
            (Project         => Project,
             Data            => Data,
             Patterns        => Excluded_Source_Dirs.Values,
+            Ignore          => Nil_String,
             Search_For      => Search_Directories,
             Resolve_Links   => Opt.Follow_Links_For_Dirs);
       end if;
@@ -6745,6 +6755,7 @@ package body Prj.Nmsc is
      (Project       : Project_Id;
       Data          : in out Tree_Processing_Data;
       Patterns      : String_List_Id;
+      Ignore        : String_List_Id;
       Search_For    : Search_Type;
       Resolve_Links : Boolean)
    is
@@ -6878,17 +6889,42 @@ package body Prj.Nmsc is
                        Resolve_Links  => Resolve_Links)
                     & Directory_Separator;
                   Path2     : Path_Information;
+                  OK        : Boolean := True;
 
                begin
                   if Is_Directory (Path_Name) then
-                     Name_Len := 0;
-                     Add_Str_To_Name_Buffer (Path_Name);
-                     Path2.Display_Name := Name_Find;
+                     if Ignore /= Nil_String then
+                        declare
+                           Dir_Name : String := Name (1 .. Last);
+                           List : String_List_Id := Ignore;
+                        begin
+                           Canonical_Case_File_Name (Dir_Name);
 
-                     Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
-                     Path2.Name := Name_Find;
+                           while List /= Nil_String loop
+                              Get_Name_String
+                                (Data.Tree.String_Elements.Table
+                                   (List).Value);
+                              Canonical_Case_File_Name
+                                (Name_Buffer (1 .. Name_Len));
+                              OK := Name_Buffer (1 .. Name_Len) /= Dir_Name;
+                              exit when not OK;
+                              List := Data.Tree.String_Elements.Table
+                                                                 (List).Next;
+                           end loop;
+                        end;
+                     end if;
+
+                     if OK then
+                        Name_Len := 0;
+                        Add_Str_To_Name_Buffer (Path_Name);
+                        Path2.Display_Name := Name_Find;
 
-                     Success := Recursive_Find_Dirs (Path2, Rank) or Success;
+                        Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+                        Path2.Name := Name_Find;
+
+                        Success :=
+                          Recursive_Find_Dirs (Path2, Rank) or Success;
+                     end if;
                   end if;
                end;
             end if;

gcc/ada/prj.adb

@@ -1154,12 +1154,29 @@ package body Prj is
 
    function Is_Compilable (Source : Source_Id) return Boolean is
    begin
-      return Source.Language.Config.Compiler_Driver /= No_File
-        and then Length_Of_Name (Source.Language.Config.Compiler_Driver) /= 0
-        and then not Source.Locally_Removed
-        and then (Source.Language.Config.Kind /= File_Based
-                    or else
-                  Source.Kind /= Spec);
+      case Source.Compilable is
+         when Unknown =>
+            if Source.Language.Config.Compiler_Driver /= No_File
+              and then
+                Length_Of_Name (Source.Language.Config.Compiler_Driver) /= 0
+              and then not Source.Locally_Removed
+              and then (Source.Language.Config.Kind /= File_Based
+                        or else
+                          Source.Kind /= Spec)
+            then
+               Source.Compilable := Yes;
+               return True;
+            else
+               Source.Compilable := No;
+               return False;
+            end if;
+
+         when Yes =>
+            return True;
+
+         when No =>
+            return False;
+      end case;
    end Is_Compilable;
 
    ------------------------------

gcc/ada/prj.ads

@@ -706,6 +706,10 @@ package Prj is
       --  file). Index is 0 if there is either no unit or a single one, and
       --  starts at 1 when there are multiple units
 
+      Compilable : Yes_No_Unknown := Unknown;
+      --  Updated at the first call to Is_Compilable. Yes if source file is
+      --  compilable.
+
       Locally_Removed : Boolean := False;
       --  True if the source has been "excluded"
 
@@ -788,6 +792,7 @@ package Prj is
                        Unit                   => No_Unit_Index,
                        Index                  => 0,
                        Locally_Removed        => False,
+                       Compilable             => Unknown,
                        Replaced_By            => No_Source,
                        File                   => No_File,
                        Display_File           => No_File,

gcc/ada/snames.ads-tmpl

@@ -1089,6 +1089,7 @@ package Snames is
    Name_Gnatstub                         : constant Name_Id := N + $;
    Name_Gnu                              : constant Name_Id := N + $;
    Name_Ide                              : constant Name_Id := N + $;
+   Name_Ignore_Source_Sub_Dirs           : constant Name_Id := N + $;
    Name_Implementation                   : constant Name_Id := N + $;
    Name_Implementation_Exceptions        : constant Name_Id := N + $;
    Name_Implementation_Suffix            : constant Name_Id := N + $;