From: charlet Date: Wed, 29 Apr 2009 10:12:51 +0000 (+0000) Subject: 2009-04-29 Ed Schonberg X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=2db7aef0df900ba7945ffaa6312f11ad261d7c50;p=thirdparty%2Fgcc.git 2009-04-29 Ed Schonberg * 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 * adaint.c (__gnat_rmdir): return error code if VTHREADS is defined. VxWorks 653 POS does not support rmdir. 2009-04-29 Matteo Bordin * s-stausa.adb, s-stausa.ads: Get_Usage_Range: changing the way results are printed. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@146943 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c9bd62054af8..421dc7e0efb2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2009-04-29 Ed Schonberg + + * 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 + + * adaint.c (__gnat_rmdir): return error code if VTHREADS is defined. + VxWorks 653 POS does not support rmdir. + +2009-04-29 Matteo Bordin + + * s-stausa.adb, s-stausa.ads: Get_Usage_Range: changing the way + results are printed. + 2009-04-29 Arnaud Charlet * s-taskin.adb (Initialize): Remove pragma Warnings Off and remove diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index e78440ac0c58..83da18b4e5bb 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 bf14beb468a2..dfa8a1fc6bb6 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 d285e08355c5..33ebfd1f0672 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; ----------------