Skip to content

R
riscv-gcc-1
Commit 9bdc432a by Arnaud Charlet
Options

[multiple changes] 

2015-10-26  Javier Miranda  <miranda@adacore.com>

	* exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Return False when
	generating C code.
	* sem_ch3.adb: Fix typos.

2015-10-26  Bob Duff  <duff@adacore.com>

	* sem_ch13.adb (Build_Predicate_Functions): Change the
	structure of the predicate functions to reflect the requirements
	of AI12-0071.
	(Add_Condition): New procedure to do the "and-then-ing" in Add_Call
	and Add_Predicates.
	* einfo.ads (Static_Real_Or_String_Predicate): Change the
	documentation to reflect the new structure.
	* sem_eval.adb (Real_Or_String_Static_Predicate_Matches):
	Change the walking of the predicate expression to reflect the
	new structure.
	* exp_util.adb: Minor comment fix.

From-SVN: r229352
parent 2f7ae2aa
Showing with 97 additions and 52 deletions
gcc/ada/ChangeLog
2015-10-26 Javier Miranda <miranda@adacore.com>
* exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Return False when
generating C code.
* sem_ch3.adb: Fix typos.
2015-10-26 Bob Duff <duff@adacore.com>
* sem_ch13.adb (Build_Predicate_Functions): Change the
structure of the predicate functions to reflect the requirements
of AI12-0071.
(Add_Condition): New procedure to do the "and-then-ing" in Add_Call
and Add_Predicates.
* einfo.ads (Static_Real_Or_String_Predicate): Change the
documentation to reflect the new structure.
* sem_eval.adb (Real_Or_String_Static_Predicate_Matches):
Change the walking of the predicate expression to reflect the
new structure.
* exp_util.adb: Minor comment fix.
2015-10-26 Bob Duff <duff@adacore.com>
* s-rident.ads (No_Dynamic_Sized_Objects): New restriction name.
......
gcc/ada/einfo.ads
......@@ -4149,7 +4149,7 @@ package Einfo is
-- as Predicate_Function (typ). Also, in the case where a predicate is
-- inherited, the expression is of the form:
--
-- expression AND THEN xxxPredicate (typ2 (ent))
-- xxxPredicate (typ2 (ent)) AND THEN expression
--
-- where typ2 is the type from which the predicate is inherited, ent is
-- the entity for the current predicate function, and xxxPredicate is the
......
gcc/ada/exp_aggr.adb
......@@ -4105,6 +4105,8 @@ package body Exp_Aggr is
-- Backend processing by Gigi/gcc is possible only if all the following
-- conditions are met:
-- 0. We are not generating C code
-- 1. N consists of a single OTHERS choice, possibly recursively
-- 2. The array type is not packed
......@@ -4135,6 +4137,10 @@ package body Exp_Aggr is
Nunits : Nat;
begin
if Generate_C_Code then
return False;
end if;
-- Recurse as far as possible to find the innermost component type
Ctyp := Etype (N);
......
gcc/ada/exp_util.adb
......@@ -3860,10 +3860,10 @@ package body Exp_Util is
-- caller. Note that in the subexpression case, N is always the child we
-- came from.
-- N_Raise_xxx_Error is an annoying special case, it is a statement if
-- it has type Standard_Void_Type, and a subexpression otherwise.
-- otherwise. Procedure calls, and similarly procedure attribute
-- references, are also statements.
-- N_Raise_xxx_Error is an annoying special case, it is a statement
-- if it has type Standard_Void_Type, and a subexpression otherwise.
-- Procedure calls, and similarly procedure attribute references, are
-- also statements.
if Nkind (Assoc_Node) in N_Subexpr
and then (Nkind (Assoc_Node) not in N_Raise_xxx_Error
......
gcc/ada/sem_ch13.adb
......@@ -8340,10 +8340,10 @@ package body Sem_Ch13 is
-- function typPredicate (Ixxx : typ) return Boolean is
-- begin
-- return
-- exp1 and then exp2 and then ...
-- and then typ1Predicate (typ1 (Ixxx))
-- typ1Predicate (typ1 (Ixxx))
-- and then typ2Predicate (typ2 (Ixxx))
-- and then ...;
-- exp1 and then exp2 and then ...
-- end typPredicate;
-- Here exp1, and exp2 are expressions from Predicate pragmas. Note that
......@@ -8352,6 +8352,12 @@ package body Sem_Ch13 is
-- inherited. Note that we do NOT generate Check pragmas, that's because we
-- use this function even if checks are off, e.g. for membership tests.
-- Note that the inherited predicates are evaluated first, as required by
-- AI12-0071-1.
-- Note that Sem_Eval.Real_Or_String_Static_Predicate_Matches depends on
-- the form of this return expression.
-- If the expression has at least one Raise_Expression, then we also build
-- the typPredicateM version of the function, in which any occurrence of a
-- Raise_Expression is converted to "return False".
......@@ -8384,9 +8390,9 @@ package body Sem_Ch13 is
Raise_Expression_Present : Boolean := False;
-- Set True if Expr has at least one Raise_Expression
procedure Add_Call (T : Entity_Id);
-- Includes a call to the predicate function for type T in Expr if T
-- has predicates and Predicate_Function (T) is non-empty.
procedure Add_Condition (Cond : Node_Id);
-- Append Cond to Expr using "and then" (or just copy Cond to Expr if
-- Expr is empty).
procedure Add_Predicates;
-- Appends expressions for any Predicate pragmas in the rep item chain
......@@ -8394,6 +8400,10 @@ package body Sem_Ch13 is
-- Inheritance of predicates for the parent type is done by calling the
-- Predicate_Function of the parent type, using Add_Call above.
procedure Add_Call (T : Entity_Id);
-- Includes a call to the predicate function for type T in Expr if T
-- has predicates and Predicate_Function (T) is non-empty.
function Process_RE (N : Node_Id) return Traverse_Result;
-- Used in Process REs, tests if node N is a raise expression, and if
-- so, marks it to be converted to return False.
......@@ -8425,17 +8435,9 @@ package body Sem_Ch13 is
Make_Predicate_Call
(T, Convert_To (T, Make_Identifier (Loc, Object_Name)));
-- Add call to evolving expression, using AND THEN if needed
-- "and"-in the call to evolving expression
if No (Expr) then
Expr := Exp;
else
Expr :=
Make_And_Then (Sloc (Expr),
Left_Opnd => Relocate_Node (Expr),
Right_Opnd => Exp);
end if;
Add_Condition (Exp);
-- Output info message on inheritance if required. Note we do not
-- give this information for generic actual types, since it is
......@@ -8456,6 +8458,28 @@ package body Sem_Ch13 is
end if;
end Add_Call;
-------------------
-- Add_Condition --
-------------------
procedure Add_Condition (Cond : Node_Id) is
begin
-- This is the first predicate expression
if No (Expr) then
Expr := Cond;
-- Otherwise concatenate to the existing predicate expressions by
-- using "and then".
else
Expr :=
Make_And_Then (Loc,
Left_Opnd => Relocate_Node (Expr),
Right_Opnd => Cond);
end if;
end Add_Condition;
--------------------
-- Add_Predicates --
--------------------
......@@ -8535,24 +8559,12 @@ package body Sem_Ch13 is
-- Check_Aspect_At_xxx routines.
if Present (Asp) then
Set_Entity (Identifier (Asp), New_Copy_Tree (Arg2));
end if;
-- Concatenate to the existing predicate expressions by using
-- "and then".
if Present (Expr) then
Expr :=
Make_And_Then (Loc,
Left_Opnd => Relocate_Node (Expr),
Right_Opnd => Relocate_Node (Arg2));
-- Otherwise this is the first predicate expression
-- "and"-in the Arg2 condition to evolving expression
else
Expr := Relocate_Node (Arg2);
end if;
Add_Condition (Relocate_Node (Arg2));
end if;
end Add_Predicate;
......@@ -8627,11 +8639,8 @@ package body Sem_Ch13 is
Expr := Empty;
-- Add Predicates for the current type
Add_Predicates;
-- Add predicates for ancestor if present
-- Add predicates for ancestor if present. These must come before the
-- ones for the current type, as required by AI12-0071-1.
declare
Atyp : constant Entity_Id := Nearest_Ancestor (Typ);
......@@ -8641,6 +8650,10 @@ package body Sem_Ch13 is
end if;
end;
-- Add Predicates for the current type
Add_Predicates;
-- Case where predicates are present
if Present (Expr) then
......@@ -8955,13 +8968,18 @@ package body Sem_Ch13 is
-- First a little fiddling to get a nice location for the
-- message. If the expression is of the form (A and then B),
-- then use the left operand for the Sloc. This avoids getting
-- confused by a call to a higher-level predicate with a less
-- convenient source location.
-- where A is an inherited predicate, then use the right
-- operand for the Sloc. This avoids getting confused by a call
-- to an inherited predicate with a less convenient source
-- location.
EN := Expr;
while Nkind (EN) = N_And_Then loop
EN := Left_Opnd (EN);
while Nkind (EN) = N_And_Then
and then Nkind (Left_Opnd (EN)) = N_Function_Call
and then Is_Predicate_Function
(Entity (Name (Left_Opnd (EN))))
loop
EN := Right_Opnd (EN);
end loop;
-- Now post appropriate message
......@@ -11688,7 +11706,7 @@ package body Sem_Ch13 is
-- references to inherited predicates, so that the expression we are
-- processing looks like:
-- expression and then xxPredicate (typ (Inns))
-- xxPredicate (typ (Inns)) and then expression
-- Where the call is to a Predicate function for an inherited predicate.
-- We simply ignore such a call, which could be to either a dynamic or
......
gcc/ada/sem_ch3.adb
......@@ -3278,7 +3278,7 @@ package body Sem_Ch3 is
-- task type is declared. Its function is to count the static number of
-- tasks declared within the type (it is only called if Has_Tasks is set
-- for T). As a side effect, if an array of tasks with non-static bounds
-- or a variant record type is encountered, Check_Restrictions is called
-- or a variant record type is encountered, Check_Restriction is called
-- indicating the count is unknown.
function Delayed_Aspect_Present return Boolean;
......
gcc/ada/sem_eval.adb
......@@ -5408,13 +5408,14 @@ package body Sem_Eval is
-- First deal with special case of inherited predicate, where the
-- predicate expression looks like:
-- Expr and then xxPredicate (typ (Ent))
-- xxPredicate (typ (Ent)) and then Expr
-- where Expr is the predicate expression for this level, and the
-- right operand is the call to evaluate the inherited predicate.
-- left operand is the call to evaluate the inherited predicate.
if Nkind (Expr) = N_And_Then
and then Nkind (Right_Opnd (Expr)) = N_Function_Call
and then Nkind (Left_Opnd (Expr)) = N_Function_Call
and then Is_Predicate_Function (Entity (Name (Left_Opnd (Expr))))
then
-- OK we have the inherited case, so make a call to evaluate the
-- inherited predicate. If that fails, so do we!
......@@ -5422,14 +5423,14 @@ package body Sem_Eval is
if not
Real_Or_String_Static_Predicate_Matches
(Val => Val,
Typ => Etype (First_Formal (Entity (Name (Right_Opnd (Expr))))))
Typ => Etype (First_Formal (Entity (Name (Left_Opnd (Expr))))))
then
return False;
end if;
-- Use the left operand for the continued processing
-- Use the right operand for the continued processing
Copy := Copy_Separate_Tree (Left_Opnd (Expr));
Copy := Copy_Separate_Tree (Right_Opnd (Expr));
-- Case where call to predicate function appears on its own (this means
-- that the predicate at this level is just inherited from the parent).
......
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