Skip to content

R
riscv-gcc-1
Commit f197d2f2 by Arnaud Charlet
Options

[multiple changes] 

2013-04-25  Arnaud Charlet  <charlet@adacore.com>

	* par-prag.adb: Fix typo.

2013-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.adb (Apply_Predicate_Check): If the type has a static
	predicate and the expression is also static, check whether the
	expression satisfies the predicate.
	* sem_ch3.adb (Analyze_Object_Declaration): If the type has a
	static predicate and the expression is also static, see if the
	expression satisfies the predicate.
	* sem_util.adb: Alphabetize several routines.
	(Check_Expression_Against_Static_Predicate): New routine.
	* sem_util.ads (Check_Expression_Against_Static_Predicate): New routine.

From-SVN: r198296
parent bbee5cc4
Showing with 149 additions and 102 deletions
gcc/ada/ChangeLog
2013-04-25 Arnaud Charlet <charlet@adacore.com>
* par-prag.adb: Fix typo.
2013-04-25 Hristian Kirtchev <kirtchev@adacore.com>
* checks.adb (Apply_Predicate_Check): If the type has a static
predicate and the expression is also static, check whether the
expression satisfies the predicate.
* sem_ch3.adb (Analyze_Object_Declaration): If the type has a
static predicate and the expression is also static, see if the
expression satisfies the predicate.
* sem_util.adb: Alphabetize several routines.
(Check_Expression_Against_Static_Predicate): New routine.
* sem_util.ads (Check_Expression_Against_Static_Predicate): New routine.
2013-04-25 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Document Reason argument for pragma Warnings.
......
gcc/ada/checks.adb
......@@ -2502,29 +2502,10 @@ package body Checks is
-- Here for normal case of predicate active
else
-- If the predicate is a static predicate and the operand is
-- static, the predicate must be evaluated statically. If the
-- evaluation fails this is a static constraint error. This check
-- is disabled in -gnatc mode, because the compiler is incapable
-- of evaluating static expressions in that case. Note that when
-- inherited predicates are involved, a type may have both static
-- and dynamic forms. Check the presence of a dynamic predicate
-- aspect.
if Is_OK_Static_Expression (N)
and then Present (Static_Predicate (Typ))
and then not Has_Dynamic_Predicate_Aspect (Typ)
then
if Operating_Mode < Generate_Code
or else Eval_Static_Predicate_Check (N, Typ)
then
return;
else
Error_Msg_NE
("static expression fails static predicate check on&",
N, Typ);
end if;
end if;
-- If the type has a static predicate and the expression is also
-- static, see if the expression satisfies the predicate.
Check_Expression_Against_Static_Predicate (N, Typ);
Insert_Action (N,
Make_Predicate_Check (Typ, Duplicate_Subexpr (N)));
......
gcc/ada/par-prag.adb
......@@ -17,7 +17,7 @@
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- War --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
......
gcc/ada/sem_ch3.adb
......@@ -3260,11 +3260,11 @@ package body Sem_Ch3 is
end if;
end if;
-- Deal with predicate check before we start to do major rewriting.
-- it is OK to initialize and then check the initialized value, since
-- the object goes out of scope if we get a predicate failure. Note
-- that we do this in the analyzer and not the expander because the
-- analyzer does some substantial rewriting in some cases.
-- Deal with predicate check before we start to do major rewriting. It
-- is OK to initialize and then check the initialized value, since the
-- object goes out of scope if we get a predicate failure. Note that we
-- do this in the analyzer and not the expander because the analyzer
-- does some substantial rewriting in some cases.
-- We need a predicate check if the type has predicates, and if either
-- there is an initializing expression, or for default initialization
......@@ -3277,6 +3277,13 @@ package body Sem_Ch3 is
or else
Is_Partially_Initialized_Type (T, Include_Implicit => False))
then
-- If the type has a static predicate and the expression is also
-- static, see if the expression satisfies the predicate.
if Present (E) then
Check_Expression_Against_Static_Predicate (E, T);
end if;
Insert_After (N,
Make_Predicate_Check (T, New_Occurrence_Of (Id, Loc)));
end if;
......
gcc/ada/sem_util.adb
......@@ -1265,6 +1265,114 @@ package body Sem_Util is
end if;
end Cannot_Raise_Constraint_Error;
-----------------------------------------
-- Check_Dynamically_Tagged_Expression --
-----------------------------------------
procedure Check_Dynamically_Tagged_Expression
(Expr : Node_Id;
Typ : Entity_Id;
Related_Nod : Node_Id)
is
begin
pragma Assert (Is_Tagged_Type (Typ));
-- In order to avoid spurious errors when analyzing the expanded code,
-- this check is done only for nodes that come from source and for
-- actuals of generic instantiations.
if (Comes_From_Source (Related_Nod)
or else In_Generic_Actual (Expr))
and then (Is_Class_Wide_Type (Etype (Expr))
or else Is_Dynamically_Tagged (Expr))
and then Is_Tagged_Type (Typ)
and then not Is_Class_Wide_Type (Typ)
then
Error_Msg_N ("dynamically tagged expression not allowed!", Expr);
end if;
end Check_Dynamically_Tagged_Expression;
-----------------------------------------------
-- Check_Expression_Against_Static_Predicate --
-----------------------------------------------
procedure Check_Expression_Against_Static_Predicate
(Expr : Node_Id;
Typ : Entity_Id)
is
begin
-- When both the predicate and the expression are static, evaluate the
-- check at compile time. A type becomes non-static when it has aspect
-- Dynamic_Predicate.
if Is_OK_Static_Expression (Expr)
and then Has_Predicates (Typ)
and then Present (Static_Predicate (Typ))
and then not Has_Dynamic_Predicate_Aspect (Typ)
then
-- Either -gnatc is enabled or the expression is ok
if Operating_Mode < Generate_Code
or else Eval_Static_Predicate_Check (Expr, Typ)
then
null;
-- The expression is prohibited by the static predicate
else
Error_Msg_NE
("?static expression fails static predicate check on &",
Expr, Typ);
end if;
end if;
end Check_Expression_Against_Static_Predicate;
--------------------------
-- Check_Fully_Declared --
--------------------------
procedure Check_Fully_Declared (T : Entity_Id; N : Node_Id) is
begin
if Ekind (T) = E_Incomplete_Type then
-- Ada 2005 (AI-50217): If the type is available through a limited
-- with_clause, verify that its full view has been analyzed.
if From_With_Type (T)
and then Present (Non_Limited_View (T))
and then Ekind (Non_Limited_View (T)) /= E_Incomplete_Type
then
-- The non-limited view is fully declared
null;
else
Error_Msg_NE
("premature usage of incomplete}", N, First_Subtype (T));
end if;
-- Need comments for these tests ???
elsif Has_Private_Component (T)
and then not Is_Generic_Type (Root_Type (T))
and then not In_Spec_Expression
then
-- Special case: if T is the anonymous type created for a single
-- task or protected object, use the name of the source object.
if Is_Concurrent_Type (T)
and then not Comes_From_Source (T)
and then Nkind (N) = N_Object_Declaration
then
Error_Msg_NE ("type of& has incomplete component", N,
Defining_Identifier (N));
else
Error_Msg_NE
("premature usage of incomplete}", N, First_Subtype (T));
end if;
end if;
end Check_Fully_Declared;
-------------------------------------
-- Check_Function_Writable_Actuals --
-------------------------------------
......@@ -2016,79 +2124,6 @@ package body Sem_Util is
end loop Outer;
end Check_Later_Vs_Basic_Declarations;
-----------------------------------------
-- Check_Dynamically_Tagged_Expression --
-----------------------------------------
procedure Check_Dynamically_Tagged_Expression
(Expr : Node_Id;
Typ : Entity_Id;
Related_Nod : Node_Id)
is
begin
pragma Assert (Is_Tagged_Type (Typ));
-- In order to avoid spurious errors when analyzing the expanded code,
-- this check is done only for nodes that come from source and for
-- actuals of generic instantiations.
if (Comes_From_Source (Related_Nod)
or else In_Generic_Actual (Expr))
and then (Is_Class_Wide_Type (Etype (Expr))
or else Is_Dynamically_Tagged (Expr))
and then Is_Tagged_Type (Typ)
and then not Is_Class_Wide_Type (Typ)
then
Error_Msg_N ("dynamically tagged expression not allowed!", Expr);
end if;
end Check_Dynamically_Tagged_Expression;
--------------------------
-- Check_Fully_Declared --
--------------------------
procedure Check_Fully_Declared (T : Entity_Id; N : Node_Id) is
begin
if Ekind (T) = E_Incomplete_Type then
-- Ada 2005 (AI-50217): If the type is available through a limited
-- with_clause, verify that its full view has been analyzed.
if From_With_Type (T)
and then Present (Non_Limited_View (T))
and then Ekind (Non_Limited_View (T)) /= E_Incomplete_Type
then
-- The non-limited view is fully declared
null;
else
Error_Msg_NE
("premature usage of incomplete}", N, First_Subtype (T));
end if;
-- Need comments for these tests ???
elsif Has_Private_Component (T)
and then not Is_Generic_Type (Root_Type (T))
and then not In_Spec_Expression
then
-- Special case: if T is the anonymous type created for a single
-- task or protected object, use the name of the source object.
if Is_Concurrent_Type (T)
and then not Comes_From_Source (T)
and then Nkind (N) = N_Object_Declaration
then
Error_Msg_NE ("type of& has incomplete component", N,
Defining_Identifier (N));
else
Error_Msg_NE
("premature usage of incomplete}", N, First_Subtype (T));
end if;
end if;
end Check_Fully_Declared;
-------------------------
-- Check_Nested_Access --
-------------------------
......
gcc/ada/sem_util.ads
......@@ -191,6 +191,14 @@ package Sem_Util is
Related_Nod : Node_Id);
-- Check wrong use of dynamically tagged expression
procedure Check_Expression_Against_Static_Predicate
(Expr : Node_Id;
Typ : Entity_Id);
-- Determine whether an arbitrary expression satisfies the static predicate
-- of a type. The routine does nothing if Expr is non-static or Typ lacks a
-- static predicate, otherwise it may emit a warning if the expression is
-- prohibited by the predicate.
procedure Check_Fully_Declared (T : Entity_Id; N : Node_Id);
-- Verify that the full declaration of type T has been seen. If not, place
-- error message on node N. Used in object declarations, type conversions
......
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