Commit fc53fe76 by Arnaud Charlet

[multiple changes]

2009-07-27  Sergey Rybin  <rybin@adacore.com>

	* gnat_ugn.texi: gnatcheck Unconstrained_Array_Returns rule: Add to the
	rule definition the paragraph that explains that generic functions and
	functions from generic packages are not checked.

2009-07-27  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch6.adb (New_Overloaded_Entity): Add test for an expanded null
	procedure when determining whether to set the Overridden_Operation
	field of a subprogram overriding an inherited subprogram.
	
2009-07-27  Robert Dewar  <dewar@adacore.com>

	* a-except.adb, a-except-2005.ads: Minor reformatting

From-SVN: r150120
parent cff7cd9b
2009-07-27 Sergey Rybin <rybin@adacore.com>
* gnat_ugn.texi: gnatcheck Unconstrained_Array_Returns rule: Add to the
rule definition the paragraph that explains that generic functions and
functions from generic packages are not checked.
2009-07-27 Gary Dismukes <dismukes@adacore.com>
* sem_ch6.adb (New_Overloaded_Entity): Add test for an expanded null
procedure when determining whether to set the Overridden_Operation
field of a subprogram overriding an inherited subprogram.
2009-07-27 Robert Dewar <dewar@adacore.com>
* a-except.adb, a-except-2005.ads: Minor reformatting
2009-07-27 Robert Dewar <dewar@adacore.com> 2009-07-27 Robert Dewar <dewar@adacore.com>
* sem_util.adb, sem_util.ads (Kill_Current_Values): Reset Is_Known_Valid * sem_util.adb, sem_util.ads (Kill_Current_Values): Reset Is_Known_Valid
......
...@@ -115,7 +115,9 @@ package Ada.Exceptions is ...@@ -115,7 +115,9 @@ package Ada.Exceptions is
-- 0xyyyyyyyy 0xyyyyyyyy ... -- 0xyyyyyyyy 0xyyyyyyyy ...
-- --
-- The lines are separated by a ASCII.LF character -- The lines are separated by a ASCII.LF character
-- The nnnn is the partition Id given as decimal digits. --
-- The nnnn is the partition Id given as decimal digits
--
-- The 0x... line represents traceback program counter locations, -- The 0x... line represents traceback program counter locations,
-- in order with the first one being the exception location. -- in order with the first one being the exception location.
...@@ -184,13 +186,13 @@ private ...@@ -184,13 +186,13 @@ private
pragma Export pragma Export
(Ada, Current_Target_Exception, (Ada, Current_Target_Exception,
"__gnat_current_target_exception"); "__gnat_current_target_exception");
-- This routine should return the current raised exception on targets -- This routine should return the current raised exception on targets which
-- which have built-in exception handling such as the Java Virtual -- have built-in exception handling such as the Java Virtual Machine. For
-- Machine. For other targets this routine is simply ignored. Currently, -- other targets this routine is simply ignored. Currently, only JGNAT
-- only JGNAT uses this. See 4jexcept.ads for details. The pragma Export -- uses this. See 4jexcept.ads for details. The pragma Export allows this
-- allows this routine to be accessed elsewhere in the run-time, even -- routine to be accessed elsewhere in the run-time, even though it is in
-- though it is in the private part of this package (it is not allowed -- the private part of this package (it is not allowed to be in the visible
-- to be in the visible part, since this is set by the reference manual). -- part, since this is set by the reference manual).
function Exception_Name_Simple (X : Exception_Occurrence) return String; function Exception_Name_Simple (X : Exception_Occurrence) return String;
-- Like Exception_Name, but returns the simple non-qualified name of the -- Like Exception_Name, but returns the simple non-qualified name of the
...@@ -230,8 +232,8 @@ private ...@@ -230,8 +232,8 @@ private
procedure Raise_From_Controlled_Operation procedure Raise_From_Controlled_Operation
(X : Ada.Exceptions.Exception_Occurrence); (X : Ada.Exceptions.Exception_Occurrence);
pragma No_Return (Raise_From_Controlled_Operation); pragma No_Return (Raise_From_Controlled_Operation);
-- Raise Program_Error, providing information about X (an exception -- Raise Program_Error, providing information about X (an exception raised
-- raised during a controlled operation) in the exception message. -- during a controlled operation) in the exception message.
procedure Reraise_Occurrence_Always (X : Exception_Occurrence); procedure Reraise_Occurrence_Always (X : Exception_Occurrence);
pragma No_Return (Reraise_Occurrence_Always); pragma No_Return (Reraise_Occurrence_Always);
...@@ -244,8 +246,8 @@ private ...@@ -244,8 +246,8 @@ private
pragma No_Return (Reraise_Occurrence_No_Defer); pragma No_Return (Reraise_Occurrence_No_Defer);
-- Exactly like Reraise_Occurrence, except that abort is not deferred -- Exactly like Reraise_Occurrence, except that abort is not deferred
-- before the call and the parameter X is known not to be the null -- before the call and the parameter X is known not to be the null
-- occurrence. This is used in generated code when it is known that -- occurrence. This is used in generated code when it is known that abort
-- abort is already deferred. -- is already deferred.
----------------------- -----------------------
-- Polling Interface -- -- Polling Interface --
...@@ -287,6 +289,7 @@ private ...@@ -287,6 +289,7 @@ private
type Exception_Occurrence is record type Exception_Occurrence is record
Id : Exception_Id; Id : Exception_Id;
-- Exception_Identity for this exception occurrence -- Exception_Identity for this exception occurrence
--
-- WARNING System.System.Finalization_Implementation.Finalize_List -- WARNING System.System.Finalization_Implementation.Finalize_List
-- relies on the fact that this field is always first in the exception -- relies on the fact that this field is always first in the exception
-- occurrence -- occurrence
......
...@@ -57,9 +57,9 @@ with System.Soft_Links; use System.Soft_Links; ...@@ -57,9 +57,9 @@ with System.Soft_Links; use System.Soft_Links;
package body Ada.Exceptions is package body Ada.Exceptions is
pragma Suppress (All_Checks); pragma Suppress (All_Checks);
-- We definitely do not want exceptions occurring within this unit, or -- We definitely do not want exceptions occurring within this unit, or we
-- we are in big trouble. If an exceptional situation does occur, better -- are in big trouble. If an exceptional situation does occur, better that
-- that it not be raised, since raising it can cause confusing chaos. -- it not be raised, since raising it can cause confusing chaos.
----------------------- -----------------------
-- Local Subprograms -- -- Local Subprograms --
...@@ -77,14 +77,14 @@ package body Ada.Exceptions is ...@@ -77,14 +77,14 @@ package body Ada.Exceptions is
procedure To_Stderr (S : String); procedure To_Stderr (S : String);
pragma Export (Ada, To_Stderr, "__gnat_to_stderr"); pragma Export (Ada, To_Stderr, "__gnat_to_stderr");
-- Little routine to output string to stderr that is also used -- Little routine to output string to stderr that is also used in the
-- in the tasking run time. -- tasking run time.
procedure To_Stderr (C : Character); procedure To_Stderr (C : Character);
pragma Inline (To_Stderr); pragma Inline (To_Stderr);
pragma Export (Ada, To_Stderr, "__gnat_to_stderr_char"); pragma Export (Ada, To_Stderr, "__gnat_to_stderr_char");
-- Little routine to output a character to stderr, used by some of -- Little routine to output a character to stderr, used by some of the
-- the separate units below. -- separate units below.
package Exception_Data is package Exception_Data is
...@@ -109,9 +109,9 @@ package body Ada.Exceptions is ...@@ -109,9 +109,9 @@ package body Ada.Exceptions is
(Id : Exception_Id; (Id : Exception_Id;
Message : String); Message : String);
-- This routine is called to setup the exception referenced by the -- This routine is called to setup the exception referenced by the
-- Current_Excep field in the TSD to contain the indicated Id value -- Current_Excep field in the TSD to contain the indicated Id value and
-- and message. Message is a string which is generated as the -- message. Message is a string which is generated as the exception
-- exception message. -- message.
-------------------------------------- --------------------------------------
-- Exception information subprogram -- -- Exception information subprogram --
...@@ -126,18 +126,20 @@ package body Ada.Exceptions is ...@@ -126,18 +126,20 @@ package body Ada.Exceptions is
-- Call stack traceback locations: (only if at least one location) -- Call stack traceback locations: (only if at least one location)
-- <0xyyyyyyyy 0xyyyyyyyy ...> (is recorded) -- <0xyyyyyyyy 0xyyyyyyyy ...> (is recorded)
-- --
-- The lines are separated by a ASCII.LF character. -- The lines are separated by a ASCII.LF character
-- The nnnn is the partition Id given as decimal digits. --
-- The nnnn is the partition Id given as decimal digits
--
-- The 0x... line represents traceback program counter locations, in -- The 0x... line represents traceback program counter locations, in
-- execution order with the first one being the exception location. It -- execution order with the first one being the exception location. It
-- is present only -- is present only
-- --
-- The Exception_Name and Message lines are omitted in the abort -- The Exception_Name and Message lines are omitted in the abort signal
-- signal case, since this is not really an exception. -- case, since this is not really an exception.
-- !! If the format of the generated string is changed, please note -- Note: If the format of the generated string is changed, please note
-- !! that an equivalent modification to the routine String_To_EO must -- that an equivalent modification to the routine String_To_EO must be
-- !! be made to preserve proper functioning of the stream attributes. -- made to preserve proper functioning of the stream attributes.
--------------------------------------- ---------------------------------------
-- Exception backtracing subprograms -- -- Exception backtracing subprograms --
...@@ -198,11 +200,11 @@ package body Ada.Exceptions is ...@@ -198,11 +200,11 @@ package body Ada.Exceptions is
procedure Unhandled_Exception_Terminate; procedure Unhandled_Exception_Terminate;
pragma No_Return (Unhandled_Exception_Terminate); pragma No_Return (Unhandled_Exception_Terminate);
-- This procedure is called to terminate execution following an -- This procedure is called to terminate program execution following an
-- unhandled exception. The exception information, including -- unhandled exception. The exception information, including traceback
-- traceback if available is output, and execution is then -- if available is output, and execution is then terminated. Note that
-- terminated. Note that at the point where this routine is -- at the point where this routine is called, the stack has typically
-- called, the stack has typically been destroyed. -- been destroyed.
end Exception_Traces; end Exception_Traces;
...@@ -253,10 +255,10 @@ package body Ada.Exceptions is ...@@ -253,10 +255,10 @@ package body Ada.Exceptions is
procedure Raise_With_Msg (E : Exception_Id); procedure Raise_With_Msg (E : Exception_Id);
pragma No_Return (Raise_With_Msg); pragma No_Return (Raise_With_Msg);
pragma Export (C, Raise_With_Msg, "__gnat_raise_with_msg"); pragma Export (C, Raise_With_Msg, "__gnat_raise_with_msg");
-- Raises an exception with given exception id value. A message -- Raises an exception with given exception id value. A message is
-- is associated with the raise, and has already been stored in the -- associated with the raise, and has already been stored in the exception
-- exception occurrence referenced by the Current_Excep in the TSD. -- occurrence referenced by the Current_Excep in the TSD. Abort is deferred
-- Abort is deferred before the raise call. -- before the raise call.
procedure Raise_With_Location_And_Msg procedure Raise_With_Location_And_Msg
(E : Exception_Id; (E : Exception_Id;
...@@ -266,8 +268,8 @@ package body Ada.Exceptions is ...@@ -266,8 +268,8 @@ package body Ada.Exceptions is
pragma No_Return (Raise_With_Location_And_Msg); pragma No_Return (Raise_With_Location_And_Msg);
-- Raise an exception with given exception id value. A filename and line -- Raise an exception with given exception id value. A filename and line
-- number is associated with the raise and is stored in the exception -- number is associated with the raise and is stored in the exception
-- occurrence and in addition a string message M is appended to -- occurrence and in addition a string message M is appended to this
-- this (if M is not null). -- if M is not null.
procedure Raise_Constraint_Error procedure Raise_Constraint_Error
(File : System.Address; (File : System.Address;
...@@ -344,9 +346,9 @@ package body Ada.Exceptions is ...@@ -344,9 +346,9 @@ package body Ada.Exceptions is
procedure Reraise; procedure Reraise;
pragma No_Return (Reraise); pragma No_Return (Reraise);
pragma Export (C, Reraise, "__gnat_reraise"); pragma Export (C, Reraise, "__gnat_reraise");
-- Reraises the exception referenced by the Current_Excep field of -- Reraises the exception referenced by the Current_Excep field of the TSD
-- the TSD (all fields of this exception occurrence are set). Abort -- (all fields of this exception occurrence are set). Abort is deferred
-- is deferred before the reraise operation. -- before the reraise operation.
-- Save_Occurrence variations: As the management of the private data -- Save_Occurrence variations: As the management of the private data
-- attached to occurrences is delicate, whether or not pointers to such -- attached to occurrences is delicate, whether or not pointers to such
...@@ -373,11 +375,10 @@ package body Ada.Exceptions is ...@@ -373,11 +375,10 @@ package body Ada.Exceptions is
-- Run-Time Check Routines -- -- Run-Time Check Routines --
----------------------------- -----------------------------
-- These routines raise a specific exception with a reason message -- Routines to a specific exception with a reason message attached. The
-- attached. The parameters are the file name and line number in each -- parameters are the file name and line number in each case. The names are
-- case. The names are keyed to the codes defined in types.ads and -- keyed to the codes defined in types.ads and a-types.h (for example, the
-- a-types.h (for example, the name Rcheck_05 refers to the Reason -- name Rcheck_05 refers to the Reason RT_Exception_Code'Val (5)).
-- RT_Exception_Code'Val (5)).
procedure Rcheck_00 (File : System.Address; Line : Integer); procedure Rcheck_00 (File : System.Address; Line : Integer);
procedure Rcheck_01 (File : System.Address; Line : Integer); procedure Rcheck_01 (File : System.Address; Line : Integer);
...@@ -546,8 +547,8 @@ package body Ada.Exceptions is ...@@ -546,8 +547,8 @@ package body Ada.Exceptions is
-- perform periodic but not systematic operations. -- perform periodic but not systematic operations.
procedure Poll is separate; procedure Poll is separate;
-- The actual polling routine is separate, so that it can easily -- The actual polling routine is separate, so that it can easily be
-- be replaced with a target dependent version. -- replaced with a target dependent version.
------------------------------ ------------------------------
-- Current_Target_Exception -- -- Current_Target_Exception --
...@@ -569,8 +570,8 @@ package body Ada.Exceptions is ...@@ -569,8 +570,8 @@ package body Ada.Exceptions is
-- EO_To_String -- -- EO_To_String --
------------------ ------------------
-- We use the null string to represent the null occurrence, otherwise -- We use the null string to represent the null occurrence, otherwise we
-- we output the Exception_Information string for the occurrence. -- output the Exception_Information string for the occurrence.
function EO_To_String (X : Exception_Occurrence) return String function EO_To_String (X : Exception_Occurrence) return String
renames Stream_Attributes.EO_To_String; renames Stream_Attributes.EO_To_String;
...@@ -583,9 +584,9 @@ package body Ada.Exceptions is ...@@ -583,9 +584,9 @@ package body Ada.Exceptions is
(X : Exception_Occurrence) return Exception_Id (X : Exception_Occurrence) return Exception_Id
is is
begin begin
-- Note that the following test used to be here for the original -- Note that the following test used to be here for the original Ada 95
-- Ada 95 semantics, but these were modified by AI-241 to require -- semantics, but these were modified by AI-241 to require returning
-- returning Null_Id instead of raising Constraint_Error. -- Null_Id instead of raising Constraint_Error.
-- if X.Id = Null_Id then -- if X.Id = Null_Id then
-- raise Constraint_Error; -- raise Constraint_Error;
...@@ -667,8 +668,8 @@ package body Ada.Exceptions is ...@@ -667,8 +668,8 @@ package body Ada.Exceptions is
-------------------- --------------------
package body Exception_Data is separate; package body Exception_Data is separate;
-- This package can be easily dummied out if we do not want the -- This package can be easily dummied out if we do not want the basic
-- basic support for exception messages (such as in Ada 83). -- support for exception messages (such as in Ada 83).
package body Exception_Propagation is package body Exception_Propagation is
...@@ -691,10 +692,10 @@ package body Ada.Exceptions is ...@@ -691,10 +692,10 @@ package body Ada.Exceptions is
---------------------- ----------------------
package body Exception_Traces is separate; package body Exception_Traces is separate;
-- Depending on the underlying support for IO the implementation -- Depending on the underlying support for IO the implementation will
-- will differ. Moreover we would like to dummy out this package -- differ. Moreover we would like to dummy out this package in case we do
-- in case we do not want any exception tracing support. This is -- not want any exception tracing support. This is why this package is
-- why this package is separated. -- separated.
----------------------- -----------------------
-- Stream Attributes -- -- Stream Attributes --
...@@ -720,17 +721,17 @@ package body Ada.Exceptions is ...@@ -720,17 +721,17 @@ package body Ada.Exceptions is
pragma Import (C, builtin_longjmp, "_gnat_builtin_longjmp"); pragma Import (C, builtin_longjmp, "_gnat_builtin_longjmp");
begin begin
-- WARNING: There should be no exception handler for this body -- WARNING: There should be no exception handler for this body because
-- because this would cause gigi to prepend a setup for a new -- this would cause gigi to prepend a setup for a new jmpbuf to the
-- jmpbuf to the sequence of statements in case of built-in sjljl. -- sequence of statements in case of built-in sjljl. We would then
-- We would then always get this new buf in Jumpbuf_Ptr instead of the -- always get this new buf in Jumpbuf_Ptr instead of the one for the
-- one for the exception we are handling, which would completely break -- exception we are handling, which would completely break the whole
-- the whole design of this procedure. -- design of this procedure.
-- If the jump buffer pointer is non-null, transfer control using -- If the jump buffer pointer is non-null, transfer control using it.
-- it. Otherwise announce an unhandled exception (note that this -- Otherwise announce an unhandled exception (note that this means that
-- means that we have no finalizations to do other than at the outer -- we have no finalizations to do other than at the outer level).
-- level). Perform the necessary notification tasks in both cases. -- Perform the necessary notification tasks in both cases.
if Jumpbuf_Ptr /= Null_Address then if Jumpbuf_Ptr /= Null_Address then
if not Excep.Exception_Raised then if not Excep.Exception_Raised then
...@@ -1251,9 +1252,9 @@ package body Ada.Exceptions is ...@@ -1251,9 +1252,9 @@ package body Ada.Exceptions is
begin begin
-- Setup Target as an exception to be propagated in the calling task -- Setup Target as an exception to be propagated in the calling task
-- (rendezvous-wise), taking care not to clobber the associated private -- (rendezvous-wise), taking care not to clobber the associated private
-- data. Target is expected to be a pointer to the calling task's -- data. Target is expected to be a pointer to the calling task's fixed
-- fixed TSD occurrence, which is very different from Get_Current_Excep -- TSD occurrence, which is very different from Get_Current_Excep here
-- here because this subprogram is called from the called task. -- because this subprogram is called from the called task.
Save_Occurrence_No_Private (Target.all, Source); Save_Occurrence_No_Private (Target.all, Source);
end Transfer_Occurrence; end Transfer_Occurrence;
...@@ -1293,7 +1294,6 @@ package body Ada.Exceptions is ...@@ -1293,7 +1294,6 @@ package body Ada.Exceptions is
--------------- ---------------
procedure To_Stderr (C : Character) is procedure To_Stderr (C : Character) is
type int is new Integer; type int is new Integer;
procedure put_char_stderr (C : int); procedure put_char_stderr (C : int);
......
...@@ -22690,9 +22690,14 @@ This rule has no parameters. ...@@ -22690,9 +22690,14 @@ This rule has no parameters.
Flag each function returning an unconstrained array. Function declarations, Flag each function returning an unconstrained array. Function declarations,
function bodies (and body stubs) having no separate specifications, function bodies (and body stubs) having no separate specifications,
and generic function instantiations are checked. and generic function instantiations are checked.
Generic function declarations, function calls and function renamings are Function calls and function renamings are
not checked. not checked.
Generic function declarations, and function declarations in generic
packages are not checked, instead this rule checks the results of
generic instantiations (that is, expanded specification and expanded
body corresponding to an instantiation).
This rule has no parameters. This rule has no parameters.
@node Universal_Ranges @node Universal_Ranges
...@@ -7678,10 +7678,22 @@ package body Sem_Ch6 is ...@@ -7678,10 +7678,22 @@ package body Sem_Ch6 is
Set_Is_Overriding_Operation (S); Set_Is_Overriding_Operation (S);
Check_Overriding_Indicator (S, E, Is_Primitive => True); Check_Overriding_Indicator (S, E, Is_Primitive => True);
-- Indicate that S overrides the operation from which -- If S is a user-defined subprogram or a null procedure
-- E is inherited. -- expanded to override an inherited null procedure, then
-- indicate that E overrides the operation from which S
if Comes_From_Source (S) then -- is inherited. It seems odd that Overridden_Operation
-- isn't set in all cases where Is_Overriding_Operation
-- is true, but doing so causes infinite loops in the
-- compiler for implicit overriding subprograms. ???
if Comes_From_Source (S)
or else
(Present (Parent (S))
and then
Nkind (Parent (S)) = N_Procedure_Specification
and then
Null_Present (Parent (S)))
then
if Present (Alias (E)) then if Present (Alias (E)) then
Set_Overridden_Operation (S, Alias (E)); Set_Overridden_Operation (S, Alias (E));
else else
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment