+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
S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
return _trmdir (wpath);
}
+#elif defined (VTHREADS)
+ /* rmdir not available */
+ return -1;
#else
return rmdir (path);
#endif
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
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
-- 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
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;
---------------------
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;
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;
-- --
-- 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- --
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;
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;
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
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
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;
----------------
projects / platform / upstream / gcc.git / commitdiff