Commit ae77c68b by Arnaud Charlet

[multiple changes]

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

	* sem_eval.adb: Minor reformatting.

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

	* exp_ch4.adb (Expand_N_Conditional_Expression): Use
	Expression_With_Actions to clean up the code generated when folding
	constant expressions.

2010-06-22  Vincent Celier  <celier@adacore.com>

	* g-expect-vms.adb: Add new subprograms Free, First_Dead_Process and
	Has_Process.

From-SVN: r161132
parent 47edeeab
2010-06-22 Robert Dewar <dewar@adacore.com>
* sem_eval.adb: Minor reformatting.
2010-06-22 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Expand_N_Conditional_Expression): Use
Expression_With_Actions to clean up the code generated when folding
constant expressions.
2010-06-22 Vincent Celier <celier@adacore.com>
* g-expect-vms.adb: Add new subprograms Free, First_Dead_Process and
Has_Process.
2010-06-22 Vincent Celier <celier@adacore.com>
* prj-nmsc.adb (Find_Sources): When a source from a multi-unit file is
......
......@@ -4053,8 +4053,25 @@ package body Exp_Ch4 is
end if;
Remove (Expr);
Insert_Actions (N, Actions);
Rewrite (N, Relocate_Node (Expr));
if Present (Actions) then
-- If we are not allowed to use Expression_With_Actions, just
-- skip the optimization, it is not critical for correctness.
if not Use_Expression_With_Actions then
goto Skip_Optimization;
end if;
Rewrite (N,
Make_Expression_With_Actions (Loc,
Expression => Relocate_Node (Expr),
Actions => Actions));
Analyze_And_Resolve (N, Typ);
else
Rewrite (N, Relocate_Node (Expr));
end if;
-- Note that the result is never static (legitimate cases of static
-- conditional expressions were folded in Sem_Eval).
......@@ -4063,6 +4080,8 @@ package body Exp_Ch4 is
return;
end if;
<<Skip_Optimization>>
-- If the type is limited or unconstrained, we expand as follows to
-- avoid any possibility of improper copies.
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2009, AdaCore --
-- Copyright (C) 2002-2010, AdaCore --
-- --
-- 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- --
......@@ -715,6 +715,24 @@ package body GNAT.Expect is
(Descriptor.Last_Match_Start .. Descriptor.Last_Match_End);
end Expect_Out_Match;
------------------------
-- First_Dead_Process --
------------------------
function First_Dead_Process
(Regexp : Multiprocess_Regexp_Array) return Natural is
begin
for R in Regexp'Range loop
if Regexp (R).Descriptor /= null
and then Regexp (R).Descriptor.Input_Fd = GNAT.OS_Lib.Invalid_FD
then
return R;
end if;
end loop;
return 0;
end First_Dead_Process;
-----------
-- Flush --
-----------
......@@ -770,6 +788,18 @@ package body GNAT.Expect is
end loop;
end Flush;
----------
-- Free --
----------
procedure Free (Regexp : in out Multiprocess_Regexp) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Process_Descriptor'Class, Process_Descriptor_Access);
begin
Unchecked_Free (Regexp.Descriptor);
Free (Regexp.Regexp);
end Free;
------------------------
-- Get_Command_Output --
------------------------
......@@ -897,6 +927,15 @@ package body GNAT.Expect is
return Descriptor.Pid;
end Get_Pid;
-----------------
-- Has_Process --
-----------------
function Has_Process (Regexp : Multiprocess_Regexp_Array) return Boolean is
begin
return Regexp /= (Regexp'Range => (null, null));
end Has_Process;
---------------
-- Interrupt --
---------------
......
......@@ -183,7 +183,7 @@ package body Sem_Eval is
procedure Test_Ambiguous_Operator (N : Node_Id);
-- Check whether an arithmetic operation with universal operands which
-- is a rewritten function call with an explicit scope indication is
-- ambiguous: P."+" (1, 2) will be ambiguous if there is more than one
-- ambiguous: P."+" (1, 2) will be ambiguous if there is more than one
-- visible numeric type declared in P and the context does not impose a
-- type on the result (e.g. in the expression of a type conversion).
......@@ -1466,10 +1466,12 @@ package body Sem_Eval is
end if;
if (Etype (Right) = Universal_Integer
or else Etype (Right) = Universal_Real)
or else
Etype (Right) = Universal_Real)
and then
(Etype (Left) = Universal_Integer
or else Etype (Left) = Universal_Real)
or else
Etype (Left) = Universal_Real)
then
Test_Ambiguous_Operator (N);
end if;
......@@ -3412,7 +3414,8 @@ package body Sem_Eval is
end if;
if Etype (Right) = Universal_Integer
or else Etype (Right) = Universal_Real
or else
Etype (Right) = Universal_Real
then
Test_Ambiguous_Operator (N);
end if;
......@@ -4730,9 +4733,9 @@ package body Sem_Eval is
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
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.
E : Entity_Id;
......@@ -4763,9 +4766,7 @@ package body Sem_Eval is
Typ1 := Empty;
E := First_Entity (Pack);
while Present (E)
and then E /= Priv_E
loop
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)
......
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