mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-25 01:20:52 +08:00
Code Issues Packages Projects Releases Wiki Activity

g-expect-vms.adb, [...]: Minor reformatting.

Browse Source 
2010-06-22  Robert Dewar  <dewar@adacore.com>

	* g-expect-vms.adb, sem_res.adb: Minor reformatting.
	* exp_aggr.adb: Minor comment changes and reformatting.
	* sem_eval.adb (Find_Universal_Operator_Type): Put in proper alpha order
	* sem_util.ads: Add some missing pragma Inline's (efficiency issue only)

From-SVN: r161139
This commit is contained in:
Robert Dewar 2010-06-22 07:26:02 +00:00 committed by Arnaud Charlet
parent cf49bd3232
commit 74e7891f8d
6 changed files with 155 additions and 142 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/ada/ChangeLog
View File

@ -1,3 +1,10 @@
2010-06-22 Robert Dewar <dewar@adacore.com>
* g-expect-vms.adb, sem_res.adb: Minor reformatting.
* exp_aggr.adb: Minor comment changes and reformatting.
* sem_eval.adb (Find_Universal_Operator_Type): Put in proper alpha order
* sem_util.ads: Add some missing pragma Inline's (efficiency issue only)
2010-06-22 Thomas Quinot <quinot@adacore.com>
* sem_util.adb (Build_Actual_Subtype): Record original expression in

5
gcc/ada/exp_aggr.adb
View File

@ -176,8 +176,9 @@ package body Exp_Aggr is
-- Very large static aggregates present problems to the back-end, and are
-- transformed into assignments and loops. This function verifies that the
-- total number of components of an aggregate is acceptable for rewriting
-- into a purely positional static form. It is called prior to calling
-- Flatten.
-- into a purely positional static form. Aggr_Size_OK must be called before
-- calling Flatten.
--
-- This function also detects and warns about one-component aggregates that
-- appear in a non-static context. Even if the component value is static,
-- such an aggregate must be expanded into an assignment.

4
gcc/ada/g-expect-vms.adb
View File

@ -524,6 +524,7 @@ package body GNAT.Expect is
for J in Descriptors'Range loop
Descriptors (J) := Regexps (J).Descriptor;
if Descriptors (J) /= null then
Reinitialize_Buffer (Regexps (J).Descriptor.all);
end if;
@ -775,7 +776,8 @@ package body GNAT.Expect is
------------------------
function First_Dead_Process
(Regexp : Multiprocess_Regexp_Array) return Natural is
(Regexp : Multiprocess_Regexp_Array) return Natural
is
begin
for R in Regexp'Range loop
if Regexp (R).Descriptor /= null

270
gcc/ada/sem_eval.adb
View File

@ -3763,6 +3763,141 @@ package body Sem_Eval is
end if;
end Expr_Value_S;
----------------------------------
-- Find_Universal_Operator_Type --
----------------------------------
function Find_Universal_Operator_Type (N : Node_Id) return Entity_Id is
PN : constant Node_Id := Parent (N);
Call : constant Node_Id := Original_Node (N);
Is_Int : constant Boolean := Is_Integer_Type (Etype (N));
Is_Fix : constant Boolean :=
Nkind (N) in N_Binary_Op
and then Nkind (Right_Opnd (N)) /= Nkind (Left_Opnd (N));
-- A mixed-mode operation in this context indicates the presence of
-- fixed-point type in the designated package.
Is_Relational : constant Boolean := Etype (N) = Standard_Boolean;
-- Case where N is a relational (or membership) operator (else it is an
-- arithmetic one).
In_Membership : constant Boolean :=
Nkind (PN) in N_Membership_Test
and then
Nkind (Right_Opnd (PN)) = N_Range
and then
Is_Universal_Numeric_Type (Etype (Left_Opnd (PN)))
and then
Is_Universal_Numeric_Type
(Etype (Low_Bound (Right_Opnd (PN))))
and then
Is_Universal_Numeric_Type
(Etype (High_Bound (Right_Opnd (PN))));
-- Case where N is part of a membership test with a universal range
E : Entity_Id;
Pack : Entity_Id;
Typ1 : Entity_Id := Empty;
Priv_E : Entity_Id;
function Is_Mixed_Mode_Operand (Op : Node_Id) return Boolean;
-- Check whether one operand is a mixed-mode operation that requires
-- the presence of a fixed-point type. Given that all operands are
-- universal and have been constant-folded, retrieve the original
-- function call.
---------------------------
-- Is_Mixed_Mode_Operand --
---------------------------
function Is_Mixed_Mode_Operand (Op : Node_Id) return Boolean is
begin
return Nkind (Original_Node (Op)) = N_Function_Call
and then Present (Next_Actual (First_Actual (Original_Node (Op))))
and then Etype (First_Actual (Original_Node (Op))) /=
Etype (Next_Actual (First_Actual (Original_Node (Op))));
end Is_Mixed_Mode_Operand;
begin
if Nkind (Call) /= N_Function_Call
or else Nkind (Name (Call)) /= N_Expanded_Name
then
return Empty;
-- There are two cases where the context does not imply the type of the
-- operands: either the universal expression appears in a type
-- type conversion, or we are in the case of a predefined relational
-- operator, where the context type is always Boolean.
elsif Nkind (Parent (N)) = N_Type_Conversion
or else
Is_Relational
or else
In_Membership
then
Pack := Entity (Prefix (Name (Call)));
-- If the prefix is a package declared elsewhere, iterate over
-- its visible entities, otherwise iterate over all declarations
-- in the designated scope.
if Ekind (Pack) = E_Package
and then not In_Open_Scopes (Pack)
then
Priv_E := First_Private_Entity (Pack);
else
Priv_E := Empty;
end if;
Typ1 := Empty;
E := First_Entity (Pack);
while Present (E) and then E /= Priv_E loop
if Is_Numeric_Type (E)
and then Nkind (Parent (E)) /= N_Subtype_Declaration
and then Comes_From_Source (E)
and then Is_Integer_Type (E) = Is_Int
and then
(Nkind (N) in N_Unary_Op
or else Is_Relational
or else Is_Fixed_Point_Type (E) = Is_Fix)
then
if No (Typ1) then
Typ1 := E;
-- Before emitting an error, check for the presence of a
-- mixed-mode operation that specifies a fixed point type.
elsif Is_Relational
and then
(Is_Mixed_Mode_Operand (Left_Opnd (N))
or else Is_Mixed_Mode_Operand (Right_Opnd (N)))
and then Is_Fixed_Point_Type (E) /= Is_Fixed_Point_Type (Typ1)
then
if Is_Fixed_Point_Type (E) then
Typ1 := E;
end if;
else
-- More than one type of the proper class declared in P
Error_Msg_N ("ambiguous operation", N);
Error_Msg_Sloc := Sloc (Typ1);
Error_Msg_N ("\possible interpretation (inherited)#", N);
Error_Msg_Sloc := Sloc (E);
Error_Msg_N ("\possible interpretation (inherited)#", N);
return Empty;
end if;
end if;
Next_Entity (E);
end loop;
end if;
return Typ1;
end Find_Universal_Operator_Type;
--------------------------
-- Flag_Non_Static_Expr --
--------------------------
@ -4761,141 +4896,6 @@ package body Sem_Eval is
end if;
end Test;
----------------------------------
-- Find_Universal_Operator_Type --
----------------------------------
function Find_Universal_Operator_Type (N : Node_Id) return Entity_Id is
PN : constant Node_Id := Parent (N);
Call : constant Node_Id := Original_Node (N);
Is_Int : constant Boolean := Is_Integer_Type (Etype (N));
Is_Fix : constant Boolean :=
Nkind (N) in N_Binary_Op
and then Nkind (Right_Opnd (N)) /= Nkind (Left_Opnd (N));
-- A mixed-mode operation in this context indicates the presence of
-- fixed-point type in the designated package.
Is_Relational : constant Boolean := Etype (N) = Standard_Boolean;
-- Case where N is a relational (or membership) operator (else it is an
-- arithmetic one).
In_Membership : constant Boolean :=
Nkind (PN) in N_Membership_Test
and then
Nkind (Right_Opnd (PN)) = N_Range
and then
Is_Universal_Numeric_Type (Etype (Left_Opnd (PN)))
and then
Is_Universal_Numeric_Type
(Etype (Low_Bound (Right_Opnd (PN))))
and then
Is_Universal_Numeric_Type
(Etype (High_Bound (Right_Opnd (PN))));
-- Case where N is part of a membership test with a universal range
E : Entity_Id;
Pack : Entity_Id;
Typ1 : Entity_Id := Empty;
Priv_E : Entity_Id;
function Is_Mixed_Mode_Operand (Op : Node_Id) return Boolean;
-- Check whether one operand is a mixed-mode operation that requires
-- the presence of a fixed-point type. Given that all operands are
-- universal and have been constant-folded, retrieve the original
-- function call.
---------------------------
-- Is_Mixed_Mode_Operand --
---------------------------
function Is_Mixed_Mode_Operand (Op : Node_Id) return Boolean is
begin
return Nkind (Original_Node (Op)) = N_Function_Call
and then Present (Next_Actual (First_Actual (Original_Node (Op))))
and then Etype (First_Actual (Original_Node (Op))) /=
Etype (Next_Actual (First_Actual (Original_Node (Op))));
end Is_Mixed_Mode_Operand;
begin
if Nkind (Call) /= N_Function_Call
or else Nkind (Name (Call)) /= N_Expanded_Name
then
return Empty;
-- There are two cases where the context does not imply the type of the
-- operands: either the universal expression appears in a type
-- type conversion, or we are in the case of a predefined relational
-- operator, where the context type is always Boolean.
elsif Nkind (Parent (N)) = N_Type_Conversion
or else
Is_Relational
or else
In_Membership
then
Pack := Entity (Prefix (Name (Call)));
-- If the prefix is a package declared elsewhere, iterate over
-- its visible entities, otherwise iterate over all declarations
-- in the designated scope.
if Ekind (Pack) = E_Package
and then not In_Open_Scopes (Pack)
then
Priv_E := First_Private_Entity (Pack);
else
Priv_E := Empty;
end if;
Typ1 := Empty;
E := First_Entity (Pack);
while Present (E) and then E /= Priv_E loop
if Is_Numeric_Type (E)
and then Nkind (Parent (E)) /= N_Subtype_Declaration
and then Comes_From_Source (E)
and then Is_Integer_Type (E) = Is_Int
and then
(Nkind (N) in N_Unary_Op
or else Is_Relational
or else Is_Fixed_Point_Type (E) = Is_Fix)
then
if No (Typ1) then
Typ1 := E;
-- Before emitting an error, check for the presence of a
-- mixed-mode operation that specifies a fixed point type.
elsif Is_Relational
and then
(Is_Mixed_Mode_Operand (Left_Opnd (N))
or else Is_Mixed_Mode_Operand (Right_Opnd (N)))
and then Is_Fixed_Point_Type (E) /= Is_Fixed_Point_Type (Typ1)
then
if Is_Fixed_Point_Type (E) then
Typ1 := E;
end if;
else
-- More than one type of the proper class declared in P
Error_Msg_N ("ambiguous operation", N);
Error_Msg_Sloc := Sloc (Typ1);
Error_Msg_N ("\possible interpretation (inherited)#", N);
Error_Msg_Sloc := Sloc (E);
Error_Msg_N ("\possible interpretation (inherited)#", N);
return Empty;
end if;
end if;
Next_Entity (E);
end loop;
end if;
return Typ1;
end Find_Universal_Operator_Type;
---------------------------------
-- Test_Expression_Is_Foldable --
---------------------------------

10
gcc/ada/sem_res.adb
View File

@ -5083,13 +5083,15 @@ package body Sem_Res is
Expressions => Parameter_Associations (N));
end if;
-- Since we are correcting a node classification error made
-- by the parser, we call Replace rather than Rewrite.
-- Preserve the parenthesis count of the node, for use by
-- tools.
-- Preserve the parenthesis count of the node
Set_Paren_Count (Index_Node, Paren_Count (N));
-- Since we are correcting a node classification error made
-- by the parser, we call Replace rather than Rewrite.
Replace (N, Index_Node);
Set_Etype (Prefix (N), Ret_Type);
Set_Etype (N, Typ);
Resolve_Indexed_Component (N, Typ);

1
gcc/ada/sem_util.ads
View File

@ -801,6 +801,7 @@ package Sem_Util is
-- function simply tests if it is True (i.e. non-zero)
function Is_Universal_Numeric_Type (T : Entity_Id) return Boolean;
pragma Inline (Is_Universal_Numeric_Type);
-- True if T is Universal_Integer or Universal_Real
function Is_Value_Type (T : Entity_Id) return Boolean;