diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2009-04-29 12:12:51 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2009-04-29 12:12:51 +0200 |
commit | 333748297bddb622fad377e66dc26e48e75add69 (patch) | |
tree | db850cccda7e03723bfa6457c9bcc78f290921f5 | |
parent | 91c2cbdb6847c9c1bbf1c0ce9d7e2f9bd7e3e5ab (diff) | |
download | gcc-333748297bddb622fad377e66dc26e48e75add69.zip gcc-333748297bddb622fad377e66dc26e48e75add69.tar.gz gcc-333748297bddb622fad377e66dc26e48e75add69.tar.bz2 |
[multiple changes]
2009-04-29 Ed Schonberg <schonberg@adacore.com>
* sem_elim.adb (Check_Eliminated): Handle new improved eliminate
information: no need for full scope check.
(Eliminate_Error): Do not emit error in a generic context.
2009-04-29 Ed Falis <falis@adacore.com>
* adaint.c (__gnat_rmdir): return error code if VTHREADS is defined.
VxWorks 653 POS does not support rmdir.
2009-04-29 Matteo Bordin <bordin@adacore.com>
* s-stausa.adb, s-stausa.ads: Get_Usage_Range: changing the way
results are printed.
From-SVN: r146943
-rw-r--r-- | gcc/ada/ChangeLog | 16 | ||||
-rw-r--r-- | gcc/ada/adaint.c | 3 | ||||
-rw-r--r-- | gcc/ada/s-stausa.adb | 37 | ||||
-rw-r--r-- | gcc/ada/sem_elim.adb | 75 |
4 files changed, 61 insertions, 70 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c9bd620..421dc7e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2009-04-29 Ed Schonberg <schonberg@adacore.com> + + * sem_elim.adb (Check_Eliminated): Handle new improved eliminate + information: no need for full scope check. + (Eliminate_Error): Do not emit error in a generic context. + +2009-04-29 Ed Falis <falis@adacore.com> + + * adaint.c (__gnat_rmdir): return error code if VTHREADS is defined. + VxWorks 653 POS does not support rmdir. + +2009-04-29 Matteo Bordin <bordin@adacore.com> + + * s-stausa.adb, s-stausa.ads: Get_Usage_Range: changing the way + results are printed. + 2009-04-29 Arnaud Charlet <charlet@adacore.com> * s-taskin.adb (Initialize): Remove pragma Warnings Off and remove diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index e78440a..83da18b 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -747,6 +747,9 @@ __gnat_rmdir (char *path) S2WSC (wpath, path, GNAT_MAX_PATH_LEN); return _trmdir (wpath); } +#elif defined (VTHREADS) + /* rmdir not available */ + return -1; #else return rmdir (path); #endif diff --git a/gcc/ada/s-stausa.adb b/gcc/ada/s-stausa.adb index bf14beb..dfa8a1f 100644 --- a/gcc/ada/s-stausa.adb +++ b/gcc/ada/s-stausa.adb @@ -173,7 +173,7 @@ package body System.Stack_Usage is Index_Str : constant String := "Index"; Task_Name_Str : constant String := "Task Name"; Stack_Size_Str : constant String := "Stack Size"; - Actual_Size_Str : constant String := "Stack usage [Value +/- Variation]"; + Actual_Size_Str : constant String := "Stack usage"; function Get_Usage_Range (Result : Task_Result) return String; -- Return string representing the range of possible result of stack usage @@ -203,10 +203,10 @@ package body System.Stack_Usage is Result_Array := new Result_Array_Type (1 .. Buffer_Size); Result_Array.all := (others => - (Task_Name => (others => ASCII.NUL), + (Task_Name => (others => ASCII.NUL), Variation => 0, - Value => 0, - Max_Size => 0)); + Value => 0, + Max_Size => 0)); -- Set the Is_Enabled flag to true, so that the task wrapper knows that -- it has to handle dynamic stack analysis @@ -327,12 +327,11 @@ package body System.Stack_Usage is -- Initialize the analyzer fields Analyzer.Bottom_Of_Stack := Bottom; - Analyzer.Stack_Size := My_Stack_Size; - Analyzer.Pattern_Size := Max_Pattern_Size; - Analyzer.Pattern := Pattern; - Analyzer.Result_Id := Next_Id; - - Analyzer.Task_Name := (others => ' '); + Analyzer.Stack_Size := My_Stack_Size; + Analyzer.Pattern_Size := Max_Pattern_Size; + Analyzer.Pattern := Pattern; + Analyzer.Result_Id := Next_Id; + Analyzer.Task_Name := (others => ' '); -- Compute the task name, and truncate if bigger than Task_Name_Length @@ -415,10 +414,11 @@ package body System.Stack_Usage is function Get_Usage_Range (Result : Task_Result) return String is Variation_Used_Str : constant String := - Natural'Image (Result.Variation); - Value_Used_Str : constant String := Natural'Image (Result.Value); + Natural'Image (Result.Variation); + Value_Used_Str : constant String := + Natural'Image (Result.Value); begin - return "[" & Value_Used_Str & " +/- " & Variation_Used_Str & "]"; + return Value_Used_Str & " +/- " & Variation_Used_Str; end Get_Usage_Range; --------------------- @@ -488,8 +488,8 @@ package body System.Stack_Usage is for J in Result_Array'Range loop exit when J >= Next_Id; - if Result_Array (J).Value - > Result_Array (Max_Actual_Use_Result_Id).Value + if Result_Array (J).Value > + Result_Array (Max_Actual_Use_Result_Id).Value then Max_Actual_Use_Result_Id := J; end if; @@ -569,15 +569,18 @@ package body System.Stack_Usage is begin if Analyzer.Pattern_Size = 0 then + -- If we have that result, it means that we didn't do any computation -- at all. In other words, we used at least everything (and possibly -- more). Min := Analyzer.Stack_Size - Overflow_Guard; Max := Analyzer.Stack_Size; + else - Min := Stack_Size - (Analyzer.Topmost_Touched_Mark, Analyzer.Bottom_Of_Stack); + Min := + Stack_Size + (Analyzer.Topmost_Touched_Mark, Analyzer.Bottom_Of_Stack); Max := Min + Overflow_Guard; end if; diff --git a/gcc/ada/sem_elim.adb b/gcc/ada/sem_elim.adb index d285e08..33ebfd1 100644 --- a/gcc/ada/sem_elim.adb +++ b/gcc/ada/sem_elim.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1997-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2009, 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- -- @@ -26,6 +26,7 @@ with Atree; use Atree; with Einfo; use Einfo; with Errout; use Errout; +with Lib; use Lib; with Namet; use Namet; with Nlists; use Nlists; with Sem; use Sem; @@ -234,29 +235,6 @@ package body Sem_Elim is Scop : Entity_Id; Form : Entity_Id; - function Original_Chars (S : Entity_Id) return Name_Id; - -- If the candidate subprogram is a protected operation of a single - -- protected object, the scope of the operation is the created - -- protected type, and we have to retrieve the original name of - -- the object. - - -------------------- - -- Original_Chars -- - -------------------- - - function Original_Chars (S : Entity_Id) return Name_Id is - begin - if Ekind (S) /= E_Protected_Type - or else Comes_From_Source (S) - then - return Chars (S); - else - return Chars (Defining_Identifier (Original_Node (Parent (S)))); - end if; - end Original_Chars; - - -- Start of processing for Check_Eliminated - begin if No_Elimination then return; @@ -308,33 +286,9 @@ package body Sem_Elim is goto Continue; end if; - -- Then we need to see if the static scope matches within the - -- compilation unit. - - -- At the moment, gnatelim does not consider block statements as - -- scopes (even if a block is named) + -- Find enclosing unit. - Scop := Scope (E); - while Ekind (Scop) = E_Block loop - Scop := Scope (Scop); - end loop; - - if Elmt.Entity_Scope /= null then - for J in reverse Elmt.Entity_Scope'Range loop - if Elmt.Entity_Scope (J) /= Original_Chars (Scop) then - goto Continue; - end if; - - Scop := Scope (Scop); - while Ekind (Scop) = E_Block loop - Scop := Scope (Scop); - end loop; - - if not Is_Compilation_Unit (Scop) and then J = 1 then - goto Continue; - end if; - end loop; - end if; + Scop := Cunit_Entity (Current_Sem_Unit); -- Now see if compilation unit matches @@ -673,7 +627,10 @@ package body Sem_Elim is Enclosing_Subp : Entity_Id; begin - if Is_Eliminated (Ultimate_Subp) and then not Inside_A_Generic then + if Is_Eliminated (Ultimate_Subp) + and then not Inside_A_Generic + and then not Is_Generic_Unit (Cunit_Entity (Current_Sem_Unit)) + then Enclosing_Subp := Current_Subprogram; while Present (Enclosing_Subp) loop if Is_Eliminated (Enclosing_Subp) then @@ -701,9 +658,21 @@ package body Sem_Elim is end if; end loop; - -- Should never fall through, since entry should be in table + -- If this is an internal operation generated for a protected operation. + -- its name does not match the source name, so just report the error. + + if not Comes_From_Source (E) + and then Present (First_Entity (E)) + and then Is_Concurrent_Record_Type (Etype (First_Entity (E))) + then + Error_Msg_NE + ("cannot reference eliminated protected subprogram", N, E); - raise Program_Error; + -- Otherwise should not fall through, entry should be in table + + else + raise Program_Error; + end if; end Eliminate_Error_Msg; ---------------- |