diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 22 | ||||
| -rw-r--r-- | gcc/ada/init.c | 78 | ||||
| -rw-r--r-- | gcc/ada/prj-attr.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 48 | ||||
| -rw-r--r-- | gcc/ada/prj.adb | 29 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 1 |
7 files changed, 123 insertions, 61 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0813f2e1a72..f7bdeb515e4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +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 diff --git a/gcc/ada/init.c b/gcc/ada/init.c index f011668899c..3f2916d9d2d 100644 --- a/gcc/ada/init.c +++ b/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; diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index 91ae42cd41f..6fb2c0a3e5b 100644 --- a/gcc/ada/prj-attr.adb +++ b/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 diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 9284556f29a..5dbf1a7d7d5 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/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; diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index bd929cc5a87..60720920471 100644 --- a/gcc/ada/prj.adb +++ b/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; ------------------------------ diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 95ead562a77..dd3c98156b9 100644 --- a/gcc/ada/prj.ads +++ b/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, diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 18357cc77f4..fa85239ccef 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/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 + $; |