Commit 983a3d80 by Robert Dewar Committed by Arnaud Charlet

sem_res.adb: Minor code reorganization and comment fixes.

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* sem_res.adb: Minor code reorganization and comment fixes.
	* sem_type.adb: Minor reformatting.

From-SVN: r197768
parent 1486a00e
2013-04-11 Robert Dewar <dewar@adacore.com>
* sem_res.adb: Minor code reorganization and comment fixes.
* sem_type.adb: Minor reformatting.
2013-04-11 Hristian Kirtchev <kirtchev@adacore.com> 2013-04-11 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch4.adb (Process_Transient_Object): Add new * exp_ch4.adb (Process_Transient_Object): Add new
......
...@@ -4032,7 +4032,7 @@ earlier versions of the package body. ...@@ -4032,7 +4032,7 @@ earlier versions of the package body.
Syntax: Syntax:
@smallexample @c ada @smallexample @c ada
pragma No_Inline (NAME {, NAME}); pragma No_Inline (NAME @{, NAME@});
@end smallexample @end smallexample
@noindent @noindent
......
...@@ -2060,16 +2060,17 @@ package body Sem_Res is ...@@ -2060,16 +2060,17 @@ package body Sem_Res is
Analyze_Dimension (N); Analyze_Dimension (N);
return; return;
-- A Raise_Expression takes its type from context. The expression -- A Raise_Expression takes its type from context. The Etype was set
-- itself does not specify any possible interpretation. -- to Any_Type, reflecting the fact that the expression itself does
-- not specify any possible interpretation. So we set the type to the
-- Seems confusing to set the Etype to Typ here, only to be overwritten -- resolution type here and now. We need to do this before Resolve sees
-- and set to Ctx_Type in the big case statement??? -- the Any_Type value.
elsif Nkind (N) = N_Raise_Expression then elsif Nkind (N) = N_Raise_Expression then
Set_Etype (N, Typ); Set_Etype (N, Typ);
-- Return if type = Any_Type (previous error encountered). -- Any other case of Any_Type as the Etype value means that we had
-- a previous error.
elsif Etype (N) = Any_Type then elsif Etype (N) = Any_Type then
Debug_A_Exit ("resolving ", N, " (done, Etype = Any_Type)"); Debug_A_Exit ("resolving ", N, " (done, Etype = Any_Type)");
...@@ -2815,10 +2816,14 @@ package body Sem_Res is ...@@ -2815,10 +2816,14 @@ package body Sem_Res is
-- Why is the following null, needs a comment ??? -- Why is the following null, needs a comment ???
when N_Quantified_Expression => null; when N_Quantified_Expression
=> null;
-- Nothing to do for Raise_Expression, since we took care of
-- setting the Etype earlier, and no other processing is needed.
when N_Raise_Expression when N_Raise_Expression
=> Set_Etype (N, Ctx_Type); => null;
when N_Raise_xxx_Error when N_Raise_xxx_Error
=> Set_Etype (N, Ctx_Type); => Set_Etype (N, Ctx_Type);
...@@ -4480,7 +4485,7 @@ package body Sem_Res is ...@@ -4480,7 +4485,7 @@ package body Sem_Res is
if In_Instance_Body then if In_Instance_Body then
Error_Msg_N Error_Msg_N
("??type in allocator has deeper level than " ("??type in allocator has deeper level than "
& " designated class-wide type", E); & "designated class-wide type", E);
Error_Msg_N Error_Msg_N
("\??Program_Error will be raised at run time", E); ("\??Program_Error will be raised at run time", E);
Rewrite (N, Rewrite (N,
...@@ -10662,7 +10667,7 @@ package body Sem_Res is ...@@ -10662,7 +10667,7 @@ package body Sem_Res is
then then
if In_Instance_Body then if In_Instance_Body then
Conversion_Error_N Conversion_Error_N
("??source array type has deeper accesibility " ("??source array type has deeper accessibility "
& "level than target", Operand); & "level than target", Operand);
Conversion_Error_N Conversion_Error_N
("\??Program_Error will be raised at run time", ("\??Program_Error will be raised at run time",
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -780,7 +780,7 @@ package body Sem_Type is ...@@ -780,7 +780,7 @@ package body Sem_Type is
RA : Entity_Id; RA : Entity_Id;
begin begin
-- Retrieve parent subtype from subtype declaration for actual. -- Retrieve parent subtype from subtype declaration for actual
if Nkind (Par) = N_Subtype_Declaration if Nkind (Par) = N_Subtype_Declaration
and then not Comes_From_Source (Par) and then not Comes_From_Source (Par)
...@@ -793,7 +793,7 @@ package body Sem_Type is ...@@ -793,7 +793,7 @@ package body Sem_Type is
end if; end if;
end if; end if;
-- Otherwise actual is not the actual of an enclosing instance. -- Otherwise actual is not the actual of an enclosing instance
return T; return T;
end Real_Actual; end Real_Actual;
...@@ -1313,7 +1313,7 @@ package body Sem_Type is ...@@ -1313,7 +1313,7 @@ package body Sem_Type is
-- Determine whether a subprogram is an actual in an enclosing instance. -- Determine whether a subprogram is an actual in an enclosing instance.
-- An overloading between such a subprogram and one declared outside the -- An overloading between such a subprogram and one declared outside the
-- instance is resolved in favor of the first, because it resolved in -- instance is resolved in favor of the first, because it resolved in
-- the generic. Within the instance the eactual is represented by a -- the generic. Within the instance the actual is represented by a
-- constructed subprogram renaming. -- constructed subprogram renaming.
function Matches (Actual, Formal : Node_Id) return Boolean; function Matches (Actual, Formal : Node_Id) return Boolean;
......
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