OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

par_sco.adb, [...]: Change name Conditional_Expression to If_Expression. 

2012-10-02  Robert Dewar  <dewar@adacore.com>

	* par_sco.adb, sem_ch3.adb, layout.adb, exp_ch7.adb, exp_imgv.adb,
	exp_util.adb, exp_util.ads, exp_attr.adb, sinfo.adb, sinfo.ads,
	exp_ch9.adb, style.ads, scos.ads, debug.adb, einfo.ads, scng.adb,
	checks.adb, checks.ads, sem.adb, par-ch4.adb, sem_util.adb, types.h,
	sem_res.adb, expander.adb, scans.ads, par.adb, exp_ch2.adb,
	gnat1drv.adb, stylesw.ads, sem_elab.adb, exp_ch4.adb, exp_ch4.ads,
	exp_ch6.adb, sem_ch4.adb, sem_ch4.ads, sem_ch6.adb,
	opt.ads, sem_eval.adb, sem_eval.ads, exp_intr.adb, sprint.adb,
	sprint.ads, styleg.ads: Change name Conditional_Expression to
	If_Expression.
	* gcc-interface/trans.c (gnat_to_gnu): Replace
	N_Conditional_Expression by N_If_Expression.
	* gcc-interface/Make-lang.in: Update dependencies.

From-SVN: r191967
This commit is contained in:
Robert Dewar 2012-10-02 08:48:27 +00:00 committed by Arnaud Charlet
parent cb42ba5d66
commit 9b16cb57de
46 changed files with 955 additions and 927 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
2012-10-02 Robert Dewar <dewar@adacore.com>
* par_sco.adb, sem_ch3.adb, layout.adb, exp_ch7.adb, exp_imgv.adb,
exp_util.adb, exp_util.ads, exp_attr.adb, sinfo.adb, sinfo.ads,
exp_ch9.adb, style.ads, scos.ads, debug.adb, einfo.ads, scng.adb,
checks.adb, checks.ads, sem.adb, par-ch4.adb, sem_util.adb, types.h,
sem_res.adb, expander.adb, scans.ads, par.adb, exp_ch2.adb,
gnat1drv.adb, stylesw.ads, sem_elab.adb, exp_ch4.adb, exp_ch4.ads,
exp_ch6.adb, sem_ch4.adb, sem_ch4.ads, sem_ch6.adb,
opt.ads, sem_eval.adb, sem_eval.ads, exp_intr.adb, sprint.adb,
sprint.ads, styleg.ads: Change name Conditional_Expression to
If_Expression.
* gcc-interface/trans.c (gnat_to_gnu): Replace
N_Conditional_Expression by N_If_Expression.
* gcc-interface/Make-lang.in: Update dependencies.
2012-10-02 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Expand_N_Op_Expon): Use expression with actions

30
gcc/ada/checks.adb
View File

@ -197,13 +197,14 @@ package body Checks is
-- Used to apply arithmetic overflow checks for all cases except operators
-- on signed arithmetic types in Minimized/Eliminate case (for which we
-- call Apply_Arithmetic_Overflow_Minimized_Eliminated below). N is always
-- a signed integer arithmetic operator (conditional expression excluded).
-- a signed integer arithmetic operator (if and case expressions are not
-- included for this case).
procedure Apply_Arithmetic_Overflow_Minimized_Eliminated (Op : Node_Id);
-- Used to apply arithmetic overflow checks for the case where the overflow
-- checking mode is Minimized or Eliminated (and the Do_Overflow_Check flag
-- is known to be set) and we have an signed integer arithmetic op (which
-- includes the case of conditional expressions).
-- includes the case of if and case expressions).
procedure Apply_Division_Check
(N : Node_Id;
@ -6258,8 +6259,7 @@ package body Checks is
N_Op_Rem | N_Op_Subtract =>
return Is_Signed_Integer_Type (Etype (N));
when N_Conditional_Expression |
N_Case_Expression =>
when N_If_Expression | N_Case_Expression =>
return Is_Signed_Integer_Type (Etype (N));
when N_Case_Expression_Alternative =>
@ -6338,11 +6338,11 @@ package body Checks is
return False;
end if;
-- Similarly, if we are in a conditional expression and not
-- part of the condition, then we return False, since neither
-- the THEN or ELSE expressions will always be elaborated.
-- Similarly, if we are in an if expression and not part of the
-- condition, then we return False, since neither the THEN or
-- ELSE dependent expressions will always be elaborated.
if Nkind (P) = N_Conditional_Expression
if Nkind (P) = N_If_Expression
and then N /= First (Expressions (P))
then
return False;
@ -6350,7 +6350,7 @@ package body Checks is
-- If we are in a case expression, and not part of the
-- expression, then we return False, since a particular
-- branch may not always be elaborated
-- dependent expression may not always be elaborated
if Nkind (P) = N_Case_Expression
and then N /= Expression (P)
@ -6805,7 +6805,7 @@ package body Checks is
-- Processing for if expression
elsif Nkind (N) = N_Conditional_Expression then
elsif Nkind (N) = N_If_Expression then
declare
Then_DE : constant Node_Id := Next (First (Expressions (N)));
Else_DE : constant Node_Id := Next (Then_DE);
@ -6840,7 +6840,7 @@ package body Checks is
if Bignum_Operands then
Rewrite (N,
Make_Conditional_Expression (Loc,
Make_If_Expression (Loc,
Expressions => New_List (
Remove_Head (Expressions (N)),
Convert_To_Bignum (Then_DE),
@ -8021,10 +8021,10 @@ package body Checks is
if Is_Array_Type (T_Typ) and then Is_Array_Type (S_Typ) then
if Is_Constrained (T_Typ) then
-- The checking code to be generated will freeze the
-- corresponding array type. However, we must freeze the
-- type now, so that the freeze node does not appear within
-- the generated conditional expression, but ahead of it.
-- The checking code to be generated will freeze the corresponding
-- array type. However, we must freeze the type now, so that the
-- freeze node does not appear within the generated if expression,
-- but ahead of it.
Freeze_Before (Ck_Node, T_Typ);

2
gcc/ada/checks.ads
View File

@ -138,7 +138,7 @@ package Checks is
-- Handle overflow checking for an arithmetic operator. Also handles the
-- cases of ELIMINATED and MINIMIZED overflow checking mode. If the mode
-- is one of the latter two, then this routine can also be called with
-- a conditional expression node to make sure that we properly handle
-- an if or case expression node to make sure that we properly handle
-- overflow checking for dependent expressions. This routine handles
-- front end vs back end overflow checks (in the front end case it expands
-- the necessary check). Note that divide is handled separately using

2
gcc/ada/debug.adb
View File

@ -129,7 +129,7 @@ package body Debug is
-- d.I SCIL generation mode
-- d.J Disable parallel SCIL generation mode
-- d.K Alfa detection only mode for gnat2why
-- d.L Depend on back end for limited types in conditional expressions
-- d.L Depend on back end for limited types in if and case expressions
-- d.M
-- d.N Add node to all entities
-- d.O Dump internal SCO tables

2
gcc/ada/einfo.ads
View File

@ -3681,7 +3681,7 @@ package Einfo is
-- Status_Flag_Or_Transient_Decl (Node15)
-- Present in variables and constants. Applies to objects that require
-- special treatment by the finalization machinery. Such examples are
-- extended return results, conditional expression results and objects
-- extended return results, if and case expression results and objects
-- inside N_Expression_With_Actions nodes. The attribute contains the
-- entity of a flag which specifies particular behavior over a region
-- of code or the declaration of a "hook" object.

14
gcc/ada/exp_attr.adb
View File

@ -3324,13 +3324,13 @@ package body Exp_Attr is
-- Furthermore, (-value - 1) can be expressed as -(value + 1)
-- which we can compute using the integer base type.
-- Once this is done we analyze the conditional expression without
-- range checks, because we know everything is in range, and we
-- want to prevent spurious warnings on either branch.
-- Once this is done we analyze the if expression without range
-- checks, because we know everything is in range, and we want
-- to prevent spurious warnings on either branch.
else
Rewrite (N,
Make_Conditional_Expression (Loc,
Make_If_Expression (Loc,
Expressions => New_List (
Make_Op_Ge (Loc,
Left_Opnd => Duplicate_Subexpr (Arg),
@ -3500,7 +3500,7 @@ package body Exp_Attr is
Right_Opnd => Y_Addr);
Rewrite (N,
Make_Conditional_Expression (Loc,
Make_If_Expression (Loc,
New_List (
Cond,
@ -5643,8 +5643,8 @@ package body Exp_Attr is
Analyze_And_Resolve (N, Standard_Boolean);
-- For record types, we build a big conditional expression, applying
-- Valid or Valid_Scalars as appropriate to all relevant components.
-- For record types, we build a big if expression, applying Valid or
-- Valid_Scalars as appropriate to all relevant components.
elsif (Is_Record_Type (Ptyp) or else Has_Discriminants (Ptyp))
and then not No_Scalar_Parts (Ptyp)

2
gcc/ada/exp_ch2.adb
View File

@ -177,7 +177,7 @@ package body Exp_Ch2 is
if Nkind (CV) in N_Subexpr then
Val := CV;
-- Case of Current_Value is a conditional expression reference
-- Case of Current_Value is an if expression reference
else
Get_Current_Value_Condition (N, Op, Val);

700
gcc/ada/exp_ch4.adb
View File

@ -3391,7 +3391,7 @@ package body Exp_Ch4 is
Low_Bound := Opnd_Low_Bound (1);
-- OK, we don't know the lower bound, we have to build a horrible
-- conditional expression node of the form
-- if expression node of the form
-- if Cond1'Length /= 0 then
-- Opnd1 low bound
@ -3422,7 +3422,7 @@ package body Exp_Ch4 is
else
return
Make_Conditional_Expression (Loc,
Make_If_Expression (Loc,
Expressions => New_List (
Make_Op_Ne (Loc,
@ -3476,7 +3476,7 @@ package body Exp_Ch4 is
if Result_May_Be_Null then
Low_Bound :=
Make_Conditional_Expression (Loc,
Make_If_Expression (Loc,
Expressions => New_List (
Make_Op_Eq (Loc,
Left_Opnd => New_Copy (Aggr_Length (NN)),
@ -3485,7 +3485,7 @@ package body Exp_Ch4 is
Low_Bound));
High_Bound :=
Make_Conditional_Expression (Loc,
Make_If_Expression (Loc,
Expressions => New_List (
Make_Op_Eq (Loc,
Left_Opnd => New_Copy (Aggr_Length (NN)),
@ -4630,8 +4630,8 @@ package body Exp_Ch4 is
end;
-- We set the allocator as analyzed so that when we analyze
-- the conditional expression node, we do not get an unwanted
-- recursive expansion of the allocator expression.
-- the if expression node, we do not get an unwanted recursive
-- expansion of the allocator expression.
Set_Analyzed (N, True);
Nod := Relocate_Node (N);
@ -4918,348 +4918,6 @@ package body Exp_Ch4 is
Analyze_And_Resolve (N, Typ);
end Expand_N_Case_Expression;
-------------------------------------
-- Expand_N_Conditional_Expression --
-------------------------------------
-- Deal with limited types and condition actions
procedure Expand_N_Conditional_Expression (N : Node_Id) is
function Create_Alternative
(Loc : Source_Ptr;
Temp_Id : Entity_Id;
Flag_Id : Entity_Id;
Expr : Node_Id) return List_Id;
-- Build the statements of a "then" or "else" conditional expression
-- alternative. Temp_Id is the conditional expression result, Flag_Id
-- is a finalization flag created to service expression Expr.
function Is_Controlled_Function_Call (Expr : Node_Id) return Boolean;
-- Determine if expression Expr is a rewritten controlled function call
------------------------
-- Create_Alternative --
------------------------
function Create_Alternative
(Loc : Source_Ptr;
Temp_Id : Entity_Id;
Flag_Id : Entity_Id;
Expr : Node_Id) return List_Id
is
Result : constant List_Id := New_List;
begin
-- Generate:
-- Fnn := True;
if Present (Flag_Id)
and then not Is_Controlled_Function_Call (Expr)
then
Append_To (Result,
Make_Assignment_Statement (Loc,
Name => New_Reference_To (Flag_Id, Loc),
Expression => New_Reference_To (Standard_True, Loc)));
end if;
-- Generate:
-- Cnn := <expr>'Unrestricted_Access;
Append_To (Result,
Make_Assignment_Statement (Loc,
Name => New_Reference_To (Temp_Id, Loc),
Expression =>
Make_Attribute_Reference (Loc,
Prefix => Relocate_Node (Expr),
Attribute_Name => Name_Unrestricted_Access)));
return Result;
end Create_Alternative;
---------------------------------
-- Is_Controlled_Function_Call --
---------------------------------
function Is_Controlled_Function_Call (Expr : Node_Id) return Boolean is
begin
return
Nkind (Original_Node (Expr)) = N_Function_Call
and then Needs_Finalization (Etype (Expr));
end Is_Controlled_Function_Call;
-- Local variables
Loc : constant Source_Ptr := Sloc (N);
Cond : constant Node_Id := First (Expressions (N));
Thenx : constant Node_Id := Next (Cond);
Elsex : constant Node_Id := Next (Thenx);
Typ : constant Entity_Id := Etype (N);
Actions : List_Id;
Cnn : Entity_Id;
Decl : Node_Id;
Expr : Node_Id;
New_If : Node_Id;
New_N : Node_Id;
begin
-- Fold at compile time if condition known. We have already folded
-- static conditional expressions, but it is possible to fold any
-- case in which the condition is known at compile time, even though
-- the result is non-static.
-- Note that we don't do the fold of such cases in Sem_Elab because
-- it can cause infinite loops with the expander adding a conditional
-- expression, and Sem_Elab circuitry removing it repeatedly.
if Compile_Time_Known_Value (Cond) then
if Is_True (Expr_Value (Cond)) then
Expr := Thenx;
Actions := Then_Actions (N);
else
Expr := Elsex;
Actions := Else_Actions (N);
end if;
Remove (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).
Set_Is_Static_Expression (N, False);
return;
end if;
<<Skip_Optimization>>
-- If the type is limited or unconstrained, we expand as follows to
-- avoid any possibility of improper copies.
-- Note: it may be possible to avoid this special processing if the
-- back end uses its own mechanisms for handling by-reference types ???
-- type Ptr is access all Typ;
-- Cnn : Ptr;
-- if cond then
-- <<then actions>>
-- Cnn := then-expr'Unrestricted_Access;
-- else
-- <<else actions>>
-- Cnn := else-expr'Unrestricted_Access;
-- end if;
-- and replace the conditional expression by a reference to Cnn.all.
-- This special case can be skipped if the back end handles limited
-- types properly and ensures that no incorrect copies are made.
if Is_By_Reference_Type (Typ)
and then not Back_End_Handles_Limited_Types
then
declare
Flag_Id : Entity_Id;
Ptr_Typ : Entity_Id;
begin
Flag_Id := Empty;
-- At least one of the conditional expression alternatives uses a
-- controlled function to provide the result. Create a status flag
-- to signal the finalization machinery that Cnn needs special
-- handling.
if Is_Controlled_Function_Call (Thenx)
or else
Is_Controlled_Function_Call (Elsex)
then
Flag_Id := Make_Temporary (Loc, 'F');
Insert_Action (N,
Make_Object_Declaration (Loc,
Defining_Identifier => Flag_Id,
Object_Definition =>
New_Reference_To (Standard_Boolean, Loc),
Expression =>
New_Reference_To (Standard_False, Loc)));
end if;
-- Generate:
-- type Ann is access all Typ;
Ptr_Typ := Make_Temporary (Loc, 'A');
Insert_Action (N,
Make_Full_Type_Declaration (Loc,
Defining_Identifier => Ptr_Typ,
Type_Definition =>
Make_Access_To_Object_Definition (Loc,
All_Present => True,
Subtype_Indication => New_Reference_To (Typ, Loc))));
-- Generate:
-- Cnn : Ann;
Cnn := Make_Temporary (Loc, 'C', N);
Set_Ekind (Cnn, E_Variable);
Set_Status_Flag_Or_Transient_Decl (Cnn, Flag_Id);
Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Cnn,
Object_Definition => New_Occurrence_Of (Ptr_Typ, Loc));
New_If :=
Make_Implicit_If_Statement (N,
Condition => Relocate_Node (Cond),
Then_Statements =>
Create_Alternative (Sloc (Thenx), Cnn, Flag_Id, Thenx),
Else_Statements =>
Create_Alternative (Sloc (Elsex), Cnn, Flag_Id, Elsex));
New_N :=
Make_Explicit_Dereference (Loc,
Prefix => New_Occurrence_Of (Cnn, Loc));
end;
-- For other types, we only need to expand if there are other actions
-- associated with either branch.
elsif Present (Then_Actions (N)) or else Present (Else_Actions (N)) then
-- We have two approaches to handling this. If we are allowed to use
-- N_Expression_With_Actions, then we can just wrap the actions into
-- the appropriate expression.
if Use_Expression_With_Actions then
if Present (Then_Actions (N)) then
Rewrite (Thenx,
Make_Expression_With_Actions (Sloc (Thenx),
Actions => Then_Actions (N),
Expression => Relocate_Node (Thenx)));
Set_Then_Actions (N, No_List);
Analyze_And_Resolve (Thenx, Typ);
end if;
if Present (Else_Actions (N)) then
Rewrite (Elsex,
Make_Expression_With_Actions (Sloc (Elsex),
Actions => Else_Actions (N),
Expression => Relocate_Node (Elsex)));
Set_Else_Actions (N, No_List);
Analyze_And_Resolve (Elsex, Typ);
end if;
return;
-- if we can't use N_Expression_With_Actions nodes, then we insert
-- the following sequence of actions (using Insert_Actions):
-- Cnn : typ;
-- if cond then
-- <<then actions>>
-- Cnn := then-expr;
-- else
-- <<else actions>>
-- Cnn := else-expr
-- end if;
-- and replace the conditional expression by a reference to Cnn
else
Cnn := Make_Temporary (Loc, 'C', N);
Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Cnn,
Object_Definition => New_Occurrence_Of (Typ, Loc));
New_If :=
Make_Implicit_If_Statement (N,
Condition => Relocate_Node (Cond),
Then_Statements => New_List (
Make_Assignment_Statement (Sloc (Thenx),
Name => New_Occurrence_Of (Cnn, Sloc (Thenx)),
Expression => Relocate_Node (Thenx))),
Else_Statements => New_List (
Make_Assignment_Statement (Sloc (Elsex),
Name => New_Occurrence_Of (Cnn, Sloc (Elsex)),
Expression => Relocate_Node (Elsex))));
Set_Assignment_OK (Name (First (Then_Statements (New_If))));
Set_Assignment_OK (Name (First (Else_Statements (New_If))));
New_N := New_Occurrence_Of (Cnn, Loc);
end if;
-- If no actions then no expansion needed, gigi will handle it using
-- the same approach as a C conditional expression.
else
-- If Do_Overflow_Check is set it means we have a signed intger type
-- in MINIMIZED or ELIMINATED mode, so we apply an overflow check to
-- the if expression (to make sure that overflow checking is properly
-- handled for dependent expressions).
if Do_Overflow_Check (N) then
Apply_Arithmetic_Overflow_Check (N);
end if;
return;
end if;
-- Fall through here for either the limited expansion, or the case of
-- inserting actions for non-limited types. In both these cases, we must
-- move the SLOC of the parent If statement to the newly created one and
-- change it to the SLOC of the expression which, after expansion, will
-- correspond to what is being evaluated.
if Present (Parent (N))
and then Nkind (Parent (N)) = N_If_Statement
then
Set_Sloc (New_If, Sloc (Parent (N)));
Set_Sloc (Parent (N), Loc);
end if;
-- Make sure Then_Actions and Else_Actions are appropriately moved
-- to the new if statement.
if Present (Then_Actions (N)) then
Insert_List_Before
(First (Then_Statements (New_If)), Then_Actions (N));
end if;
if Present (Else_Actions (N)) then
Insert_List_Before
(First (Else_Statements (New_If)), Else_Actions (N));
end if;
Insert_Action (N, Decl);
Insert_Action (N, New_If);
Rewrite (N, New_N);
Analyze_And_Resolve (N, Typ);
end Expand_N_Conditional_Expression;
-----------------------------------
-- Expand_N_Explicit_Dereference --
-----------------------------------
@ -5427,6 +5085,348 @@ package body Exp_Ch4 is
end loop;
end Expand_N_Expression_With_Actions;
----------------------------
-- Expand_N_If_Expression --
----------------------------
-- Deal with limited types and condition actions
procedure Expand_N_If_Expression (N : Node_Id) is
function Create_Alternative
(Loc : Source_Ptr;
Temp_Id : Entity_Id;
Flag_Id : Entity_Id;
Expr : Node_Id) return List_Id;
-- Build the statements of a "then" or "else" dependent expression
-- alternative. Temp_Id is the if expression result, Flag_Id is a
-- finalization flag created to service expression Expr.
function Is_Controlled_Function_Call (Expr : Node_Id) return Boolean;
-- Determine if expression Expr is a rewritten controlled function call
------------------------
-- Create_Alternative --
------------------------
function Create_Alternative
(Loc : Source_Ptr;
Temp_Id : Entity_Id;
Flag_Id : Entity_Id;
Expr : Node_Id) return List_Id
is
Result : constant List_Id := New_List;
begin
-- Generate:
-- Fnn := True;
if Present (Flag_Id)
and then not Is_Controlled_Function_Call (Expr)
then
Append_To (Result,
Make_Assignment_Statement (Loc,
Name => New_Reference_To (Flag_Id, Loc),
Expression => New_Reference_To (Standard_True, Loc)));
end if;
-- Generate:
-- Cnn := <expr>'Unrestricted_Access;
Append_To (Result,
Make_Assignment_Statement (Loc,
Name => New_Reference_To (Temp_Id, Loc),
Expression =>
Make_Attribute_Reference (Loc,
Prefix => Relocate_Node (Expr),
Attribute_Name => Name_Unrestricted_Access)));
return Result;
end Create_Alternative;
---------------------------------
-- Is_Controlled_Function_Call --
---------------------------------
function Is_Controlled_Function_Call (Expr : Node_Id) return Boolean is
begin
return
Nkind (Original_Node (Expr)) = N_Function_Call
and then Needs_Finalization (Etype (Expr));
end Is_Controlled_Function_Call;
-- Local variables
Loc : constant Source_Ptr := Sloc (N);
Cond : constant Node_Id := First (Expressions (N));
Thenx : constant Node_Id := Next (Cond);
Elsex : constant Node_Id := Next (Thenx);
Typ : constant Entity_Id := Etype (N);
Actions : List_Id;
Cnn : Entity_Id;
Decl : Node_Id;
Expr : Node_Id;
New_If : Node_Id;
New_N : Node_Id;
begin
-- Fold at compile time if condition known. We have already folded
-- static if expressions, but it is possible to fold any case in which
-- the condition is known at compile time, even though the result is
-- non-static.
-- Note that we don't do the fold of such cases in Sem_Elab because
-- it can cause infinite loops with the expander adding a conditional
-- expression, and Sem_Elab circuitry removing it repeatedly.
if Compile_Time_Known_Value (Cond) then
if Is_True (Expr_Value (Cond)) then
Expr := Thenx;
Actions := Then_Actions (N);
else
Expr := Elsex;
Actions := Else_Actions (N);
end if;
Remove (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
-- if expressions were folded in Sem_Eval).
Set_Is_Static_Expression (N, False);
return;
end if;
<<Skip_Optimization>>
-- If the type is limited or unconstrained, we expand as follows to
-- avoid any possibility of improper copies.
-- Note: it may be possible to avoid this special processing if the
-- back end uses its own mechanisms for handling by-reference types ???
-- type Ptr is access all Typ;
-- Cnn : Ptr;
-- if cond then
-- <<then actions>>
-- Cnn := then-expr'Unrestricted_Access;
-- else
-- <<else actions>>
-- Cnn := else-expr'Unrestricted_Access;
-- end if;
-- and replace the if expression by a reference to Cnn.all.
-- This special case can be skipped if the back end handles limited
-- types properly and ensures that no incorrect copies are made.
if Is_By_Reference_Type (Typ)
and then not Back_End_Handles_Limited_Types
then
declare
Flag_Id : Entity_Id;
Ptr_Typ : Entity_Id;
begin
Flag_Id := Empty;
-- At least one of the if expression dependent expressions uses a
-- controlled function to provide the result. Create a status flag
-- to signal the finalization machinery that Cnn needs special
-- handling.
if Is_Controlled_Function_Call (Thenx)
or else
Is_Controlled_Function_Call (Elsex)
then
Flag_Id := Make_Temporary (Loc, 'F');
Insert_Action (N,
Make_Object_Declaration (Loc,
Defining_Identifier => Flag_Id,
Object_Definition =>
New_Reference_To (Standard_Boolean, Loc),
Expression =>
New_Reference_To (Standard_False, Loc)));
end if;
-- Generate:
-- type Ann is access all Typ;
Ptr_Typ := Make_Temporary (Loc, 'A');
Insert_Action (N,
Make_Full_Type_Declaration (Loc,
Defining_Identifier => Ptr_Typ,
Type_Definition =>
Make_Access_To_Object_Definition (Loc,
All_Present => True,
Subtype_Indication => New_Reference_To (Typ, Loc))));
-- Generate:
-- Cnn : Ann;
Cnn := Make_Temporary (Loc, 'C', N);
Set_Ekind (Cnn, E_Variable);
Set_Status_Flag_Or_Transient_Decl (Cnn, Flag_Id);
Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Cnn,
Object_Definition => New_Occurrence_Of (Ptr_Typ, Loc));
New_If :=
Make_Implicit_If_Statement (N,
Condition => Relocate_Node (Cond),
Then_Statements =>
Create_Alternative (Sloc (Thenx), Cnn, Flag_Id, Thenx),
Else_Statements =>
Create_Alternative (Sloc (Elsex), Cnn, Flag_Id, Elsex));
New_N :=
Make_Explicit_Dereference (Loc,
Prefix => New_Occurrence_Of (Cnn, Loc));
end;
-- For other types, we only need to expand if there are other actions
-- associated with either branch.
elsif Present (Then_Actions (N)) or else Present (Else_Actions (N)) then
-- We have two approaches to handling this. If we are allowed to use
-- N_Expression_With_Actions, then we can just wrap the actions into
-- the appropriate expression.
if Use_Expression_With_Actions then
if Present (Then_Actions (N)) then
Rewrite (Thenx,
Make_Expression_With_Actions (Sloc (Thenx),
Actions => Then_Actions (N),
Expression => Relocate_Node (Thenx)));
Set_Then_Actions (N, No_List);
Analyze_And_Resolve (Thenx, Typ);
end if;
if Present (Else_Actions (N)) then
Rewrite (Elsex,
Make_Expression_With_Actions (Sloc (Elsex),
Actions => Else_Actions (N),
Expression => Relocate_Node (Elsex)));
Set_Else_Actions (N, No_List);
Analyze_And_Resolve (Elsex, Typ);
end if;
return;
-- if we can't use N_Expression_With_Actions nodes, then we insert
-- the following sequence of actions (using Insert_Actions):
-- Cnn : typ;
-- if cond then
-- <<then actions>>
-- Cnn := then-expr;
-- else
-- <<else actions>>
-- Cnn := else-expr
-- end if;
-- and replace the if expression by a reference to Cnn
else
Cnn := Make_Temporary (Loc, 'C', N);
Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Cnn,
Object_Definition => New_Occurrence_Of (Typ, Loc));
New_If :=
Make_Implicit_If_Statement (N,
Condition => Relocate_Node (Cond),
Then_Statements => New_List (
Make_Assignment_Statement (Sloc (Thenx),
Name => New_Occurrence_Of (Cnn, Sloc (Thenx)),
Expression => Relocate_Node (Thenx))),
Else_Statements => New_List (
Make_Assignment_Statement (Sloc (Elsex),
Name => New_Occurrence_Of (Cnn, Sloc (Elsex)),
Expression => Relocate_Node (Elsex))));
Set_Assignment_OK (Name (First (Then_Statements (New_If))));
Set_Assignment_OK (Name (First (Else_Statements (New_If))));
New_N := New_Occurrence_Of (Cnn, Loc);
end if;
-- If no actions then no expansion needed, gigi will handle it using
-- the same approach as a C conditional expression.
else
-- If Do_Overflow_Check is set it means we have a signed intger type
-- in MINIMIZED or ELIMINATED mode, so we apply an overflow check to
-- the if expression (to make sure that overflow checking is properly
-- handled for dependent expressions).
if Do_Overflow_Check (N) then
Apply_Arithmetic_Overflow_Check (N);
end if;
return;
end if;
-- Fall through here for either the limited expansion, or the case of
-- inserting actions for non-limited types. In both these cases, we must
-- move the SLOC of the parent If statement to the newly created one and
-- change it to the SLOC of the expression which, after expansion, will
-- correspond to what is being evaluated.
if Present (Parent (N))
and then Nkind (Parent (N)) = N_If_Statement
then
Set_Sloc (New_If, Sloc (Parent (N)));
Set_Sloc (Parent (N), Loc);
end if;
-- Make sure Then_Actions and Else_Actions are appropriately moved
-- to the new if statement.
if Present (Then_Actions (N)) then
Insert_List_Before
(First (Then_Statements (New_If)), Then_Actions (N));
end if;
if Present (Else_Actions (N)) then
Insert_List_Before
(First (Else_Statements (New_If)), Else_Actions (N));
end if;
Insert_Action (N, Decl);
Insert_Action (N, New_If);
Rewrite (N, New_N);
Analyze_And_Resolve (N, Typ);
end Expand_N_If_Expression;
-----------------
-- Expand_N_In --
-----------------
@ -7918,7 +7918,7 @@ package body Exp_Ch4 is
((not LOK) or else (Llo = LLB))
then
Rewrite (N,
Make_Conditional_Expression (Loc,
Make_If_Expression (Loc,
Expressions => New_List (
Make_Op_Eq (Loc,
Left_Opnd => Duplicate_Subexpr (Right),
@ -8552,7 +8552,7 @@ package body Exp_Ch4 is
if Lneg and Rneg then
Rewrite (N,
Make_Conditional_Expression (Loc,
Make_If_Expression (Loc,
Expressions => New_List (
Make_Op_Eq (Loc,
Left_Opnd => Duplicate_Subexpr (Right),

4
gcc/ada/exp_ch4.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- 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- --
@ -32,9 +32,9 @@ package Exp_Ch4 is
procedure Expand_N_Allocator (N : Node_Id);
procedure Expand_N_And_Then (N : Node_Id);
procedure Expand_N_Case_Expression (N : Node_Id);
procedure Expand_N_Conditional_Expression (N : Node_Id);
procedure Expand_N_Explicit_Dereference (N : Node_Id);
procedure Expand_N_Expression_With_Actions (N : Node_Id);
procedure Expand_N_If_Expression (N : Node_Id);
procedure Expand_N_In (N : Node_Id);
procedure Expand_N_Indexed_Component (N : Node_Id);
procedure Expand_N_Not_In (N : Node_Id);

17
gcc/ada/exp_ch6.adb
View File

@ -4049,7 +4049,10 @@ package body Exp_Ch6 is
Context := Parent (N);
while Present (Context) loop
if Nkind (Context) = N_Conditional_Expression then
-- The following could use a comment (and why is N_Case_Expression
-- not treated in a similar manner ???
if Nkind (Context) = N_If_Expression then
exit;
-- Stop the search when reaching any statement because we have
@ -4092,13 +4095,15 @@ package body Exp_Ch6 is
Remove_Side_Effects (N);
-- The function call is part of a conditional expression alternative.
-- The temporary result must live as long as the conditional expression
-- itself, otherwise it will be finalized too early. Mark the transient
-- as processed to avoid untimely finalization.
-- The function call is part of an if expression dependent expression.
-- The temporary result must live as long as the if expression itself,
-- otherwise it will be finalized too early. Mark the transient as
-- processed to avoid untimely finalization.
-- Why no special handling for case expressions here ???
if Present (Context)
and then Nkind (Context) = N_Conditional_Expression
and then Nkind (Context) = N_If_Expression
and then Nkind (N) = N_Explicit_Dereference
then
Set_Is_Processed_Transient (Entity (Prefix (N)));

4
gcc/ada/exp_ch7.adb
View File

@ -1892,8 +1892,8 @@ package body Exp_Ch7 is
then
Processing_Actions (Has_No_Init => True);
-- Process intermediate results of conditional expression with
-- one of the alternatives using a controlled function call.
-- Process intermediate results of an if expression with one
-- of the alternatives using a controlled function call.
elsif Is_Access_Type (Obj_Typ)
and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))

6
gcc/ada/exp_ch9.adb
View File

@ -10194,7 +10194,7 @@ package body Exp_Ch9 is
if Present (Condition (Alt)) then
Expr :=
Make_Conditional_Expression (Eloc, New_List (
Make_If_Expression (Eloc, New_List (
Condition (Alt),
Entry_Index_Expression (Eloc, Eent, Index, Scope (Eent)),
New_Reference_To (RTE (RE_Null_Task_Entry), Eloc)));
@ -10582,7 +10582,7 @@ package body Exp_Ch9 is
-- In the above declaration, null-body is True if the corresponding
-- accept has no body, and false otherwise. The entry is either the
-- entry index expression if there is no guard, or if a guard is
-- present, then a conditional expression of the form:
-- present, then an if expression of the form:
-- (if guard then entry-index else Null_Task_Entry)
@ -10753,7 +10753,7 @@ package body Exp_Ch9 is
-- Simple_Mode; otherwise use Terminate_Mode.
if Present (Condition (Terminate_Alt)) then
Select_Mode := Make_Conditional_Expression (Loc,
Select_Mode := Make_If_Expression (Loc,
New_List (Condition (Terminate_Alt),
New_Reference_To (RTE (RE_Terminate_Mode), Loc),
New_Reference_To (RTE (RE_Simple_Mode), Loc)));

18
gcc/ada/exp_imgv.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2012, Free Software Foundation, Inc. --
-- --
-- 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- --
@ -1063,9 +1063,9 @@ package body Exp_Imgv is
-- for depending on the element type for typI.
-- Finally if Discard_Names is in effect for an enumeration type, then
-- a special conditional expression is built that yields the space needed
-- for the decimal representation of the largest pos value in the subtype.
-- See code below for details.
-- a special if expression is built that yields the space needed for the
-- decimal representation of the largest pos value in the subtype. See
-- code below for details.
procedure Expand_Width_Attribute (N : Node_Id; Attr : Atype := Normal) is
Loc : constant Source_Ptr := Sloc (N);
@ -1134,7 +1134,7 @@ package body Exp_Imgv is
elsif Is_Real_Type (Rtyp) then
Rewrite (N,
Make_Conditional_Expression (Loc,
Make_If_Expression (Loc,
Expressions => New_List (
Make_Op_Gt (Loc,
@ -1214,8 +1214,8 @@ package body Exp_Imgv is
Prefix => New_Occurrence_Of (Ptyp, Loc),
Attribute_Name => Name_Last))))));
-- OK, now we need to build the conditional expression. First
-- get the value of M, the largest possible value needed.
-- OK, now we need to build the if expression. First get the
-- value of M, the largest possible value needed.
P := UI_To_Int
(Enumeration_Pos (Entity (Type_High_Bound (Rtyp))));
@ -1238,7 +1238,7 @@ package body Exp_Imgv is
K := K - 1;
Cexpr :=
Make_Conditional_Expression (Loc,
Make_If_Expression (Loc,
Expressions => New_List (
Make_Op_Lt (Loc,
Left_Opnd => New_Occurrence_Of (Tnn, Loc),
@ -1252,7 +1252,7 @@ package body Exp_Imgv is
Rewrite (N,
Convert_To (Typ,
Make_Conditional_Expression (Loc,
Make_If_Expression (Loc,
Expressions => New_List (
Make_Op_Eq (Loc,
Left_Opnd =>

6
gcc/ada/exp_intr.adb
View File

@ -603,7 +603,7 @@ package body Exp_Intr is
-- end if;
Rewrite (N,
Make_Conditional_Expression (Loc,
Make_If_Expression (Loc,
Expressions => New_List (
Make_Op_Lt (Loc,
Left_Opnd => Duplicate_Subexpr (Opnd),
@ -611,7 +611,7 @@ package body Exp_Intr is
New_Occurrence_Of (Standard_True, Loc),
Make_Conditional_Expression (Loc,
Make_If_Expression (Loc,
Expressions => New_List (
Make_Op_Gt (Loc,
Left_Opnd => Duplicate_Subexpr_No_Checks (Opnd),
@ -1311,7 +1311,7 @@ package body Exp_Intr is
Obj := Make_Explicit_Dereference (Loc, Relocate_Node (Arg));
Rewrite (N,
Make_Conditional_Expression (Loc,
Make_If_Expression (Loc,
Expressions => New_List (
Make_Op_Eq (Loc,
Left_Opnd => New_Copy_Tree (Arg),

26
gcc/ada/exp_util.adb
View File

@ -3293,11 +3293,11 @@ package body Exp_Util is
return;
end if;
-- Then or Else operand of conditional expression. Add actions to
-- Then_Actions or Else_Actions field as appropriate. The actions
-- will be moved further out when the conditional is expanded.
-- Then or Else dependent expression of an if expression. Add
-- actions to Then_Actions or Else_Actions field as appropriate.
-- The actions will be moved further out when the if is expanded.
when N_Conditional_Expression =>
when N_If_Expression =>
declare
ThenX : constant Node_Id := Next (First (Expressions (P)));
ElseX : constant Node_Id := Next (ThenX);
@ -3311,9 +3311,9 @@ package body Exp_Util is
null;
-- Actions belong to the then expression, temporarily place
-- them as Then_Actions of the conditional expr. They will
-- be moved to the proper place later when the conditional
-- expression is expanded.
-- them as Then_Actions of the if expression. They will be
-- moved to the proper place later when the if expression
-- is expanded.
elsif N = ThenX then
if Present (Then_Actions (P)) then
@ -3326,10 +3326,10 @@ package body Exp_Util is
return;
-- Actions belong to the else expression, temporarily
-- place them as Else_Actions of the conditional expr.
-- They will be moved to the proper place later when
-- the conditional expression is expanded.
-- Actions belong to the else expression, temporarily place
-- them as Else_Actions of the if expression. They will be
-- moved to the proper place later when the if expression
-- is expanded.
elsif N = ElseX then
if Present (Else_Actions (P)) then
@ -7187,8 +7187,8 @@ package body Exp_Util is
then
return True;
-- Processing for intermediate results of conditional expressions
-- where one of the alternatives uses a controlled function call.
-- Processing for intermediate results of if expressions where
-- one of the alternatives uses a controlled function call.
elsif Is_Access_Type (Obj_Typ)
and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))

4
gcc/ada/exp_util.ads
View File

@ -72,8 +72,8 @@ package Exp_Util is
-- For actions appearing in the then or else expression of a conditional
-- expression, these actions are similarly placed in the node, using the
-- Then_Actions or Else_Actions field as appropriate. Once again the
-- expansion of the N_Conditional_Expression node rewrites the node so
-- that the actions can be normally positioned.
-- expansion of the N_If_Expression node rewrites the node so that the
-- actions can be positioned normally.
-- Basically what we do is to climb up to the tree looking for the
-- proper insertion point, as described by one of the above cases,

8
gcc/ada/expander.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- 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- --
@ -182,9 +182,6 @@ package body Expander is
when N_Conditional_Entry_Call =>
Expand_N_Conditional_Entry_Call (N);
when N_Conditional_Expression =>
Expand_N_Conditional_Expression (N);
when N_Delay_Relative_Statement =>
Expand_N_Delay_Relative_Statement (N);
@ -248,6 +245,9 @@ package body Expander is
when N_Identifier =>
Expand_N_Identifier (N);
when N_If_Expression =>
Expand_N_If_Expression (N);
when N_Indexed_Component =>
Expand_N_Indexed_Component (N);

227
gcc/ada/gcc-interface/Make-lang.in
View File

@ -1257,29 +1257,33 @@ ada/checks.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
ada/eval_fat.ads ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch2.ads \
ada/exp_ch4.ads ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_dist.ads \
ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb \
ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \
ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/gnatvsn.ads \
ada/hostparm.ads ada/inline.ads ada/itypes.ads ada/lib.ads ada/lib.adb \
ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/namet.ads \
ada/exp_ch4.ads ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_disp.ads \
ada/exp_dist.ads ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads \
ada/exp_util.adb ada/fname.ads ada/fname-uf.ads ada/freeze.ads \
ada/get_targ.ads ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads \
ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads ada/itypes.ads \
ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \
ada/lib-sort.adb ada/lib-util.ads ada/lib-xref.ads ada/namet.ads \
ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
ada/opt.adb ada/output.ads ada/restrict.ads ada/restrict.adb \
ada/rident.ads ada/rtsfind.ads ada/rtsfind.adb ada/sem.ads \
ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch3.ads ada/sem_ch6.ads \
ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_dist.ads ada/sem_eval.ads \
ada/opt.adb ada/output.ads ada/put_alfa.ads ada/restrict.ads \
ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/rtsfind.adb \
ada/scans.ads ada/sem.ads ada/sem_attr.ads ada/sem_aux.ads \
ada/sem_cat.ads ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch7.ads \
ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads ada/sem_eval.ads \
ada/sem_eval.adb ada/sem_prag.ads ada/sem_res.ads ada/sem_type.ads \
ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
ada/sinput.ads ada/snames.ads ada/sprint.ads ada/stand.ads \
ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
ada/urealp.ads ada/urealp.adb ada/validsw.ads ada/widechar.ads
ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads \
ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \
ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \
ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-exctab.ads \
ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/validsw.ads \
ada/widechar.ads
ada/comperr.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
@ -2486,22 +2490,23 @@ ada/lib-load.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
ada/einfo.adb ada/elists.ads ada/err_vars.ads ada/errout.ads \
ada/erroutc.ads ada/fname.ads ada/fname-uf.ads ada/gnat.ads \
ada/g-hesorg.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
ada/lib.adb ada/lib-list.adb ada/lib-load.ads ada/lib-load.adb \
ada/lib-sort.adb ada/namet.ads ada/nlists.ads ada/nmake.ads \
ada/nmake.adb ada/opt.ads ada/osint.ads ada/osint-c.ads ada/output.ads \
ada/par.ads ada/restrict.ads ada/rident.ads ada/scans.ads ada/scn.ads \
ada/scng.ads ada/scng.adb ada/sem_aux.ads ada/sinfo.ads ada/sinfo.adb \
ada/sinput.ads ada/sinput-l.ads ada/snames.ads ada/stand.ads \
ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
ada/s-traent.ads ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads \
ada/table.ads ada/table.adb ada/tbuild.ads ada/tbuild.adb \
ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uname.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/g-byorma.ads ada/g-hesorg.ads ada/hostparm.ads ada/interfac.ads \
ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \
ada/lib-load.adb ada/lib-sort.adb ada/namet.ads ada/nlists.ads \
ada/nmake.ads ada/nmake.adb ada/opt.ads ada/osint.ads ada/osint-c.ads \
ada/output.ads ada/par.ads ada/restrict.ads ada/rident.ads \
ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem_aux.ads \
ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
ada/sinput-l.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
ada/style.ads ada/styleg.ads ada/styleg.adb ada/stylesw.ads \
ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-imenne.ads \
ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads ada/table.ads \
ada/table.adb ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
ada/types.ads ada/uintp.ads ada/uname.ads ada/unchconv.ads \
ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/lib-util.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/hostparm.ads \
@ -3116,21 +3121,21 @@ ada/sem_aggr.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/put_alfa.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \
ada/scans.ads ada/sem.ads ada/sem_aggr.ads ada/sem_aggr.adb \
ada/sem_attr.ads ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch13.ads \
ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads \
ada/sem_eval.ads ada/sem_eval.adb ada/sem_prag.ads ada/sem_res.ads \
ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \
ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \
ada/sprint.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
ada/style.ads ada/styleg.ads ada/styleg.adb ada/stylesw.ads \
ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \
ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
ada/targparm.ads ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \
ada/widechar.ads
ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_dim.ads \
ada/sem_disp.ads ada/sem_eval.ads ada/sem_eval.adb ada/sem_prag.ads \
ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \
ada/stringt.adb ada/style.ads ada/styleg.ads ada/styleg.adb \
ada/stylesw.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
ada/urealp.ads ada/validsw.ads ada/widechar.ads
ada/sem_attr.o : ada/ada.ads ada/a-charac.ads ada/a-chlat1.ads \
ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads ada/alloc.ads \
@ -3611,26 +3616,32 @@ ada/sem_ch9.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/sem_dim.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
ada/einfo.adb ada/elists.ads ada/err_vars.ads ada/errout.ads \
ada/erroutc.ads ada/exp_dist.ads ada/exp_tss.ads ada/fname.ads \
ada/fname-uf.ads ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads \
ada/hostparm.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
ada/lib-load.ads ada/lib-sort.adb ada/namet.ads ada/nlists.ads \
ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/rtsfind.adb \
ada/sem.ads ada/sem_aux.ads ada/sem_ch7.ads ada/sem_dim.ads \
ada/sem_dim.adb ada/sem_dist.ads ada/sem_eval.ads ada/sem_res.ads \
ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
ada/snames.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb \
ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-strhas.ads \
ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
ada/table.ads ada/table.adb ada/tbuild.ads ada/tbuild.adb \
ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uname.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
ada/einfo.ads ada/einfo.adb ada/elists.ads ada/err_vars.ads \
ada/errout.ads ada/erroutc.ads ada/exp_ch11.ads ada/exp_disp.ads \
ada/exp_dist.ads ada/exp_tss.ads ada/exp_util.ads ada/fname.ads \
ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
ada/g-byorma.ads ada/g-hesorg.ads ada/g-htable.ads ada/hostparm.ads \
ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \
ada/lib-sort.adb ada/lib-util.ads ada/lib-xref.ads ada/namet.ads \
ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
ada/output.ads ada/put_alfa.ads ada/restrict.ads ada/rident.ads \
ada/rtsfind.ads ada/rtsfind.adb ada/scans.ads ada/sem.ads \
ada/sem_attr.ads ada/sem_aux.ads ada/sem_ch7.ads ada/sem_ch8.ads \
ada/sem_dim.ads ada/sem_dim.adb ada/sem_disp.ads ada/sem_dist.ads \
ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
ada/sem_util.adb ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
ada/stringt.adb ada/style.ads ada/styleg.ads ada/styleg.adb \
ada/stylesw.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
ada/s-htable.adb ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
ada/s-strhas.ads ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
ada/types.ads ada/uintp.ads ada/uname.ads ada/unchconv.ads \
ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/sem_disp.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
@ -3685,27 +3696,26 @@ ada/sem_elab.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_ch11.ads \
ada/exp_disp.ads ada/exp_tss.ads ada/exp_util.ads ada/expander.ads \
ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \
ada/gnat.ads ada/g-byorma.ads ada/g-hesorg.ads ada/g-htable.ads \
ada/hostparm.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
ada/lib-load.ads ada/lib-sort.adb ada/lib-util.ads ada/lib-xref.ads \
ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
ada/opt.ads ada/output.ads ada/put_alfa.ads ada/restrict.ads \
ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/scans.ads \
ada/sem.ads ada/sem_attr.ads ada/sem_aux.ads ada/sem_cat.ads \
ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_elab.ads \
ada/sem_elab.adb ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads \
ada/sem_util.ads ada/sem_util.adb ada/sinfo.ads ada/sinfo.adb \
ada/sinput.ads ada/sinput.adb ada/snames.ads ada/stand.ads \
ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
ada/stylesw.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
ada/widechar.ads
ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/hostparm.ads \
ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \
ada/lib-sort.adb ada/lib-util.ads ada/lib-xref.ads ada/namet.ads \
ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
ada/output.ads ada/put_alfa.ads ada/restrict.ads ada/restrict.adb \
ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/sem.ads \
ada/sem_attr.ads ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch7.ads \
ada/sem_ch8.ads ada/sem_disp.ads ada/sem_elab.ads ada/sem_elab.adb \
ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
ada/sem_util.adb ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
ada/snames.ads ada/stand.ads ada/stringt.ads ada/style.ads \
ada/styleg.ads ada/styleg.adb ada/stylesw.ads ada/system.ads \
ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
ada/types.ads ada/uintp.ads ada/uname.ads ada/unchconv.ads \
ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/sem_elim.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
@ -4054,22 +4064,23 @@ ada/sinput-d.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/sinput-l.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/fname.ads \
ada/gnat.ads ada/g-byorma.ads ada/g-dyntab.ads ada/g-dyntab.adb \
ada/g-hesorg.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
ada/namet.ads ada/nlists.ads ada/opt.ads ada/osint.ads ada/output.ads \
ada/prep.ads ada/prepcomp.ads ada/restrict.ads ada/rident.ads \
ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sinfo.ads \
ada/einfo.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
ada/exp_tss.ads ada/fname.ads ada/gnat.ads ada/g-byorma.ads \
ada/g-dyntab.ads ada/g-dyntab.adb ada/g-hesorg.ads ada/hostparm.ads \
ada/interfac.ads ada/lib.ads ada/namet.ads ada/nlists.ads ada/nmake.ads \
ada/opt.ads ada/osint.ads ada/output.ads ada/prep.ads ada/prepcomp.ads \
ada/restrict.ads ada/rident.ads ada/scans.ads ada/scn.ads ada/scng.ads \
ada/scng.adb ada/sem_aux.ads ada/sem_util.ads ada/sinfo.ads \
ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/sinput-l.ads \
ada/sinput-l.adb ada/snames.ads ada/stringt.ads ada/style.ads \
ada/styleg.ads ada/styleg.adb ada/stylesw.ads ada/system.ads \
ada/s-crc32.ads ada/s-exctab.ads ada/s-imenne.ads ada/s-memory.ads \
ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
ada/s-utf_32.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
ada/unchdeal.ads ada/urealp.ads ada/widechar.ads ada/nmake.ads
ada/sinput-l.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
ada/style.ads ada/styleg.ads ada/styleg.adb ada/stylesw.ads \
ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-imenne.ads \
ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads ada/table.ads \
ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/sinput.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \

2
gcc/ada/gcc-interface/trans.c
View File

@ -5977,7 +5977,7 @@ gnat_to_gnu (Node_Id gnat_node)
}
break;
case N_Conditional_Expression:
case N_If_Expression:
{
tree gnu_cond = gnat_to_gnu (First (Expressions (gnat_node)));
tree gnu_true = gnat_to_gnu (Next (First (Expressions (gnat_node))));

2
gcc/ada/gnat1drv.adb
View File

@ -381,7 +381,7 @@ procedure Gnat1drv is
-- Set switch indicating if back end can handle limited types, and
-- guarantee that no incorrect copies are made (e.g. in the context
-- of a conditional expression).
-- of an if or case expression).
-- Debug flag -gnatd.L decisively sets usage on

12
gcc/ada/layout.adb
View File

@ -1964,11 +1964,11 @@ package body Layout is
pragma Warnings (Off, SO_Ref);
RM_Siz_Expr : Node_Id := Empty;
-- Expression for the evolving RM_Siz value. This is typically a
-- conditional expression which involves tests of discriminant values
-- that are formed as references to the entity V. At the end of
-- scanning all the components, a suitable function is constructed
-- in which V is the parameter.
-- Expression for the evolving RM_Siz value. This is typically an if
-- expression which involves tests of discriminant values that are
-- formed as references to the entity V. At the end of scanning all
-- the components, a suitable function is constructed in which V is
-- the parameter.
-----------------------
-- Local Subprograms --
@ -2212,7 +2212,7 @@ package body Layout is
end if;
RM_Siz_Expr :=
Make_Conditional_Expression (Loc,
Make_If_Expression (Loc,
Expressions =>
New_List
(Dtest, Bits_To_SU (RM_SizV), RM_Siz_Expr));

7
gcc/ada/opt.ads
View File

@ -230,11 +230,12 @@ package Opt is
Back_End_Handles_Limited_Types : Boolean;
-- This flag is set true if the back end can properly handle limited or
-- other by reference types, and avoid copies. If this flag is False, then
-- the front end does special expansion for conditional expressions to make
-- the front end does special expansion for if/case expressions to make
-- sure that no copy occurs. If the flag is True, then the expansion for
-- conditional expressions relies on the back end properly handling things.
-- if and case expressions relies on the back end properly handling things.
-- Currently the default is False for all cases (set in gnat1drv). The
-- default can be modified using -gnatd.L (sets the flag True).
-- default can be modified using -gnatd.L (sets the flag True). This is
-- used to test the possibility of having the backend handle this.
Bind_Alternate_Main_Name : Boolean := False;
-- GNATBIND

70
gcc/ada/par-ch4.adb
View File

@ -553,7 +553,7 @@ package body Ch4 is
-- case of a name which can be extended in the normal manner.
-- This case is handled by LP_State_Name or LP_State_Expr.
-- Note: conditional expressions (without an extra level of
-- Note: if and case expressions (without an extra level of
-- parentheses) are permitted in this context).
-- (..., identifier => expression , ...)
@ -1233,21 +1233,21 @@ package body Ch4 is
Lparen_Sloc := Token_Ptr;
T_Left_Paren;
-- Conditional expression case
-- If expression
if Token = Tok_If then
Expr_Node := P_Conditional_Expression;
Expr_Node := P_If_Expression;
T_Right_Paren;
return Expr_Node;
-- Case expression case
-- Case expression
elsif Token = Tok_Case then
Expr_Node := P_Case_Expression;
T_Right_Paren;
return Expr_Node;
-- Quantified expression case
-- Quantified expression
elsif Token = Tok_For then
Expr_Node := P_Quantified_Expression;
@ -1258,12 +1258,12 @@ package body Ch4 is
-- is distinctly unpleasant, but it saves a lot of fiddling in scanning
-- out the discrete choice list.
-- Deal with expression and extension aggregate cases first
-- Deal with expression and extension aggregates first
elsif Token /= Tok_Others then
Save_Scan_State (Scan_State); -- at start of expression
-- Deal with (NULL RECORD) case
-- Deal with (NULL RECORD)
if Token = Tok_Null then
Scan; -- past NULL
@ -1287,7 +1287,7 @@ package body Ch4 is
Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
end if;
-- Extension aggregate case
-- Extension aggregate
if Token = Tok_With then
if Nkind (Expr_Node) = N_Attribute_Reference
@ -1329,7 +1329,7 @@ package body Ch4 is
Expr_Node := Empty;
end if;
-- Expression case
-- Expression
elsif Token = Tok_Right_Paren or else Token in Token_Class_Eterm then
if Nkind (Expr_Node) = N_Attribute_Reference
@ -1350,13 +1350,13 @@ package body Ch4 is
T_Right_Paren; -- past right paren (error message if none)
return Expr_Node;
-- Normal aggregate case
-- Normal aggregate
else
Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
end if;
-- Others case
-- Others
else
Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
@ -2454,7 +2454,7 @@ package body Ch4 is
when Tok_Pragma =>
P_Pragmas_Misplaced;
-- Deal with IF (possible unparenthesized conditional expression)
-- Deal with IF (possible unparenthesized if expression)
when Tok_If =>
@ -2462,7 +2462,7 @@ package body Ch4 is
-- the start of a new line, then we consider we have a missing
-- operand. If in Ada 2012 and the IF is not properly indented
-- for a statement, we prefer to issue a message about an ill-
-- parenthesized conditional expression.
-- parenthesized if expression.
if Token_Is_At_Start_Of_Line
and then not
@ -2473,13 +2473,12 @@ package body Ch4 is
Error_Msg_AP ("missing operand");
return Error;
-- If this looks like a conditional expression, then treat it
-- that way with an error message.
-- If this looks like an if expression, then treat it that way
-- with an error message.
elsif Ada_Version >= Ada_2012 then
Error_Msg_SC
("conditional expression must be parenthesized");
return P_Conditional_Expression;
Error_Msg_SC ("if expression must be parenthesized");
return P_If_Expression;
-- Otherwise treat as misused identifier
@ -2974,21 +2973,21 @@ package body Ch4 is
return Case_Alt_Node;
end P_Case_Expression_Alternative;
------------------------------
-- P_Conditional_Expression --
------------------------------
---------------------
-- P_If_Expression --
---------------------
function P_Conditional_Expression return Node_Id is
function P_If_Expression return Node_Id is
Exprs : constant List_Id := New_List;
Loc : constant Source_Ptr := Token_Ptr;
Expr : Node_Id;
State : Saved_Scan_State;
begin
Inside_Conditional_Expression := Inside_Conditional_Expression + 1;
Inside_If_Expression := Inside_If_Expression + 1;
if Token = Tok_If and then Ada_Version < Ada_2012 then
Error_Msg_SC ("|conditional expression is an Ada 2012 feature");
Error_Msg_SC ("|if expression is an Ada 2012 feature");
Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
end if;
@ -3017,7 +3016,7 @@ package body Ch4 is
-- Scan out ELSIF sequence if present
if Token = Tok_Elsif then
Expr := P_Conditional_Expression;
Expr := P_If_Expression;
Set_Is_Elsif (Expr);
Append_To (Exprs, Expr);
@ -3039,8 +3038,7 @@ package body Ch4 is
-- If we have an END IF, diagnose as not needed
if Token = Tok_End then
Error_Msg_SC
("`END IF` not allowed at end of conditional expression");
Error_Msg_SC ("`END IF` not allowed at end of if expression");
Scan; -- past END
if Token = Tok_If then
@ -3048,14 +3046,14 @@ package body Ch4 is
end if;
end if;
Inside_Conditional_Expression := Inside_Conditional_Expression - 1;
Inside_If_Expression := Inside_If_Expression - 1;
-- Return the Conditional_Expression node
-- Return the If_Expression node
return
Make_Conditional_Expression (Loc,
Make_If_Expression (Loc,
Expressions => Exprs);
end P_Conditional_Expression;
end P_If_Expression;
-----------------------
-- P_Membership_Test --
@ -3113,18 +3111,16 @@ package body Ch4 is
Result := P_Case_Expression;
if not (Lparen and then Token = Tok_Right_Paren) then
Error_Msg_N
("case expression must be parenthesized!", Result);
Error_Msg_N ("case expression must be parenthesized!", Result);
end if;
-- Conditional expression
-- If expression
elsif Token = Tok_If then
Result := P_Conditional_Expression;
Result := P_If_Expression;
if not (Lparen and then Token = Tok_Right_Paren) then
Error_Msg_N
("conditional expression must be parenthesized!", Result);
Error_Msg_N ("if expression must be parenthesized!", Result);
end if;
-- Quantified expression

18
gcc/ada/par.adb
View File

@ -694,17 +694,12 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
-- keyword, and returns pointing to the terminating right parent,
-- semicolon, or comma, but does not consume this terminating token.
function P_Conditional_Expression return Node_Id;
-- Scans out a conditional expression. Called with Token pointing to
-- the IF keyword, and returns pointing to the terminating right paren,
-- semicolon or comma, but does not consume this terminating token.
function P_Expression_If_OK return Node_Id;
-- Scans out an expression allowing an unparenthesized case expression,
-- conditional expression, or quantified expression to appear without
-- enclosing parentheses. However, if such an expression is not preceded
-- by a left paren, and followed by a right paren, an error message will
-- be output noting that parenthesization is required.
-- if expression, or quantified expression to appear without enclosing
-- parentheses. However, if such an expression is not preceded by a left
-- paren, and followed by a right paren, an error message will be output
-- noting that parenthesization is required.
function P_Expression_No_Right_Paren return Node_Id;
-- Scans out an expression in contexts where the expression cannot be
@ -718,6 +713,11 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
-- followed by a right paren, an error message will be output noting
-- that parenthesization is required.
function P_If_Expression return Node_Id;
-- Scans out an if expression. Called with Token pointing to the
-- IF keyword, and returns pointing to the terminating right paren,
-- semicolon or comma, but does not consume this terminating token.
function P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id;
-- This routine scans out a qualified expression when the caller has
-- already scanned out the name and apostrophe of the construct.

13
gcc/ada/par_sco.adb
View File

@ -112,9 +112,9 @@ package body Par_SCO is
-- If N is Empty, has no effect. Otherwise scans the tree for the node N,
-- to output any decisions it contains. T is one of IEGPWX (for context of
-- expression: if/exit when/entry guard/pragma/while/expression). If T is
-- other than X, the node N is the conditional expression involved, and a
-- decision is always present (at the very least a simple decision is
-- present at the top level).
-- other than X, the node N is the if expression involved, and a decision
-- is always present (at the very least a simple decision is present at the
-- top level).
procedure Process_Decisions
(L : List_Id;
@ -614,12 +614,15 @@ package body Par_SCO is
-- Case expression
-- Really hard to believe this is correct given the special
-- handling for if expressions below ???
when N_Case_Expression =>
return OK; -- ???
-- Conditional expression, processed like an if statement
-- If expression, processed like an if statement
when N_Conditional_Expression =>
when N_If_Expression =>
declare
Cond : constant Node_Id := First (Expressions (N));
Thnx : constant Node_Id := Next (Cond);

6
gcc/ada/scans.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- 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- --
@ -464,8 +464,8 @@ package Scans is
-- Is it really right for this to be a Name rather than a String, what
-- about the case of Wide_Wide_Characters???
Inside_Conditional_Expression : Nat := 0;
-- This is a counter that is set non-zero while scanning out a conditional
Inside_If_Expression : Nat := 0;
-- This is a counter that is set non-zero while scanning out an if
-- expression (incremented on entry, decremented on exit). It is used to
-- disconnect format checks that normally apply to keywords THEN, ELSE etc.

4
gcc/ada/scng.adb
View File

@ -2742,13 +2742,13 @@ package body Scng is
end if;
-- Check THEN/ELSE style rules. These do not apply to AND THEN
-- or OR ELSE, and do not apply in conditional expressions.
-- or OR ELSE, and do not apply in if expressions.
if (Token = Tok_Then and then Prev_Token /= Tok_And)
or else
(Token = Tok_Else and then Prev_Token /= Tok_Or)
then
if Inside_Conditional_Expression = 0 then
if Inside_If_Expression = 0 then
Style.Check_Separate_Stmt_Lines;
end if;
end if;

2
gcc/ada/scos.ads
View File

@ -252,7 +252,7 @@ package SCOs is
-- E decision in EXIT WHEN statement
-- G decision in entry guard
-- I decision in IF statement or conditional expression
-- I decision in IF statement or if expression
-- P decision in pragma Assert/Check/Pre_Condition/Post_Condition
-- W decision in WHILE iteration scheme
-- X decision appearing in some other expression context

6
gcc/ada/sem.adb
View File

@ -168,9 +168,6 @@ package body Sem is
when N_Component_Declaration =>
Analyze_Component_Declaration (N);
when N_Conditional_Expression =>
Analyze_Conditional_Expression (N);
when N_Conditional_Entry_Call =>
Analyze_Conditional_Entry_Call (N);
@ -279,6 +276,9 @@ package body Sem is
when N_Identifier =>
Analyze_Identifier (N);
when N_If_Expression =>
Analyze_If_Expression (N);
when N_If_Statement =>
Analyze_If_Statement (N);

26
gcc/ada/sem_ch3.adb
View File

@ -17029,18 +17029,7 @@ package body Sem_Ch3 is
when N_Attribute_Reference =>
return Attribute_Name (Original_Node (Exp)) = Name_Input;
-- For a conditional expression, all dependent expressions must be
-- legal constructs.
when N_Conditional_Expression =>
declare
Then_Expr : constant Node_Id :=
Next (First (Expressions (Original_Node (Exp))));
Else_Expr : constant Node_Id := Next (Then_Expr);
begin
return OK_For_Limited_Init_In_05 (Typ, Then_Expr)
and then OK_For_Limited_Init_In_05 (Typ, Else_Expr);
end;
-- For a case expression, all dependent expressions must be legal
when N_Case_Expression =>
declare
@ -17059,6 +17048,19 @@ package body Sem_Ch3 is
return True;
end;
-- For an if expression, all dependent expressions must be legal
when N_If_Expression =>
declare
Then_Expr : constant Node_Id :=
Next (First (Expressions (Original_Node (Exp))));
Else_Expr : constant Node_Id := Next (Then_Expr);
begin
return OK_For_Limited_Init_In_05 (Typ, Then_Expr)
and then
OK_For_Limited_Init_In_05 (Typ, Else_Expr);
end;
when others =>
return False;
end case;

146
gcc/ada/sem_ch4.adb
View File

@ -1570,79 +1570,6 @@ package body Sem_Ch4 is
Operator_Check (N);
end Analyze_Concatenation_Rest;
------------------------------------
-- Analyze_Conditional_Expression --
------------------------------------
procedure Analyze_Conditional_Expression (N : Node_Id) is
Condition : constant Node_Id := First (Expressions (N));
Then_Expr : constant Node_Id := Next (Condition);
Else_Expr : Node_Id;
begin
-- Defend against error of missing expressions from previous error
if No (Then_Expr) then
return;
end if;
Check_SPARK_Restriction ("conditional expression is not allowed", N);
Else_Expr := Next (Then_Expr);
if Comes_From_Source (N) then
Check_Compiler_Unit (N);
end if;
Analyze_Expression (Condition);
Analyze_Expression (Then_Expr);
if Present (Else_Expr) then
Analyze_Expression (Else_Expr);
end if;
-- If then expression not overloaded, then that decides the type
if not Is_Overloaded (Then_Expr) then
Set_Etype (N, Etype (Then_Expr));
-- Case where then expression is overloaded
else
declare
I : Interp_Index;
It : Interp;
begin
Set_Etype (N, Any_Type);
-- Shouldn't the following statement be down in the ELSE of the
-- following loop? ???
Get_First_Interp (Then_Expr, I, It);
-- if no Else_Expression the conditional must be boolean
if No (Else_Expr) then
Set_Etype (N, Standard_Boolean);
-- Else_Expression Present. For each possible intepretation of
-- the Then_Expression, add it only if the Else_Expression has
-- a compatible type.
else
while Present (It.Nam) loop
if Has_Compatible_Type (Else_Expr, It.Typ) then
Add_One_Interp (N, It.Typ, It.Typ);
end if;
Get_Next_Interp (I, It);
end loop;
end if;
end;
end if;
end Analyze_Conditional_Expression;
-------------------------
-- Analyze_Equality_Op --
-------------------------
@ -1981,6 +1908,79 @@ package body Sem_Ch4 is
Set_Etype (N, Etype (Expression (N)));
end Analyze_Expression_With_Actions;
---------------------------
-- Analyze_If_Expression --
---------------------------
procedure Analyze_If_Expression (N : Node_Id) is
Condition : constant Node_Id := First (Expressions (N));
Then_Expr : constant Node_Id := Next (Condition);
Else_Expr : Node_Id;
begin
-- Defend against error of missing expressions from previous error
if No (Then_Expr) then
return;
end if;
Check_SPARK_Restriction ("if expression is not allowed", N);
Else_Expr := Next (Then_Expr);
if Comes_From_Source (N) then
Check_Compiler_Unit (N);
end if;
Analyze_Expression (Condition);
Analyze_Expression (Then_Expr);
if Present (Else_Expr) then
Analyze_Expression (Else_Expr);
end if;
-- If then expression not overloaded, then that decides the type
if not Is_Overloaded (Then_Expr) then
Set_Etype (N, Etype (Then_Expr));
-- Case where then expression is overloaded
else
declare
I : Interp_Index;
It : Interp;
begin
Set_Etype (N, Any_Type);
-- Shouldn't the following statement be down in the ELSE of the
-- following loop? ???
Get_First_Interp (Then_Expr, I, It);
-- if no Else_Expression the conditional must be boolean
if No (Else_Expr) then
Set_Etype (N, Standard_Boolean);
-- Else_Expression Present. For each possible intepretation of
-- the Then_Expression, add it only if the Else_Expression has
-- a compatible type.
else
while Present (It.Nam) loop
if Has_Compatible_Type (Else_Expr, It.Typ) then
Add_One_Interp (N, It.Typ, It.Typ);
end if;
Get_Next_Interp (I, It);
end loop;
end if;
end;
end if;
end Analyze_If_Expression;
------------------------------------
-- Analyze_Indexed_Component_Form --
------------------------------------

2
gcc/ada/sem_ch4.ads
View File

@ -33,10 +33,10 @@ package Sem_Ch4 is
procedure Analyze_Case_Expression (N : Node_Id);
procedure Analyze_Comparison_Op (N : Node_Id);
procedure Analyze_Concatenation (N : Node_Id);
procedure Analyze_Conditional_Expression (N : Node_Id);
procedure Analyze_Equality_Op (N : Node_Id);
procedure Analyze_Explicit_Dereference (N : Node_Id);
procedure Analyze_Expression_With_Actions (N : Node_Id);
procedure Analyze_If_Expression (N : Node_Id);
procedure Analyze_Logical_Op (N : Node_Id);
procedure Analyze_Membership_Op (N : Node_Id);
procedure Analyze_Mod (N : Node_Id);

8
gcc/ada/sem_ch6.adb
View File

@ -8659,10 +8659,6 @@ package body Sem_Ch6 is
and then
FCE (Expression (E1), Expression (E2));
when N_Conditional_Expression =>
return
FCL (Expressions (E1), Expressions (E2));
when N_Explicit_Dereference =>
return
FCE (Prefix (E1), Prefix (E2));
@ -8682,6 +8678,10 @@ package body Sem_Ch6 is
FCL (Parameter_Associations (E1),
Parameter_Associations (E2));
when N_If_Expression =>
return
FCL (Expressions (E1), Expressions (E2));
when N_Indexed_Component =>
return
FCE (Prefix (E1), Prefix (E2))

9
gcc/ada/sem_elab.adb
View File

@ -1188,7 +1188,7 @@ package body Sem_Elab is
-- Nothing to do if this is a call already rewritten for elab checking
elsif Nkind (Parent (N)) = N_Conditional_Expression then
elsif Nkind (Parent (N)) = N_If_Expression then
return;
-- Nothing to do if inside a generic template
@ -2935,7 +2935,8 @@ package body Sem_Elab is
-- the context of the call has already been analyzed, an insertion
-- will not work if it depends on subsequent expansion (e.g. a call in
-- a branch of a short-circuit). In that case we replace the call with
-- a conditional expression, or with a Raise if it is unconditional.
-- an if expression, or with a Raise if it is unconditional.
-- Unfortunately this does not work if the call has a dynamic size,
-- because gigi regards it as a dynamic-sized temporary. If such a call
-- appears in a short-circuit expression, the elaboration check will be
@ -2972,14 +2973,14 @@ package body Sem_Elab is
Reloc_N := Relocate_Node (N);
Save_Interps (N, Reloc_N);
Rewrite (N,
Make_Conditional_Expression (Loc,
Make_If_Expression (Loc,
Expressions => New_List (C, Reloc_N, R)));
end if;
Analyze_And_Resolve (N, Typ);
-- If the original call requires a range check, so does the
-- conditional expression.
-- if expression.
if Chk then
Enable_Range_Check (N);

130
gcc/ada/sem_eval.adb
View File

@ -1872,15 +1872,74 @@ package body Sem_Eval is
end;
end Eval_Concatenation;
---------------------------------
-- Eval_Conditional_Expression --
---------------------------------
----------------------
-- Eval_Entity_Name --
----------------------
-- We can fold to a static expression if the condition and both constituent
-- This procedure is used for identifiers and expanded names other than
-- named numbers (see Eval_Named_Integer, Eval_Named_Real. These are
-- static if they denote a static constant (RM 4.9(6)) or if the name
-- denotes an enumeration literal (RM 4.9(22)).
procedure Eval_Entity_Name (N : Node_Id) is
Def_Id : constant Entity_Id := Entity (N);
Val : Node_Id;
begin
-- Enumeration literals are always considered to be constants
-- and cannot raise constraint error (RM 4.9(22)).
if Ekind (Def_Id) = E_Enumeration_Literal then
Set_Is_Static_Expression (N);
return;
-- A name is static if it denotes a static constant (RM 4.9(5)), and
-- we also copy Raise_Constraint_Error. Notice that even if non-static,
-- it does not violate 10.2.1(8) here, since this is not a variable.
elsif Ekind (Def_Id) = E_Constant then
-- Deferred constants must always be treated as nonstatic
-- outside the scope of their full view.
if Present (Full_View (Def_Id))
and then not In_Open_Scopes (Scope (Def_Id))
then
Val := Empty;
else
Val := Constant_Value (Def_Id);
end if;
if Present (Val) then
Set_Is_Static_Expression
(N, Is_Static_Expression (Val)
and then Is_Static_Subtype (Etype (Def_Id)));
Set_Raises_Constraint_Error (N, Raises_Constraint_Error (Val));
if not Is_Static_Expression (N)
and then not Is_Generic_Type (Etype (N))
then
Validate_Static_Object_Name (N);
end if;
return;
end if;
end if;
-- Fall through if the name is not static
Validate_Static_Object_Name (N);
end Eval_Entity_Name;
------------------------
-- Eval_If_Expression --
------------------------
-- We can fold to a static expression if the condition and both dependent
-- expressions are static. Otherwise, the only required processing is to do
-- the check for non-static context for the then and else expressions.
procedure Eval_Conditional_Expression (N : Node_Id) is
procedure Eval_If_Expression (N : Node_Id) is
Condition : constant Node_Id := First (Expressions (N));
Then_Expr : constant Node_Id := Next (Condition);
Else_Expr : constant Node_Id := Next (Then_Expr);
@ -1949,66 +2008,7 @@ package body Sem_Eval is
end if;
Set_Is_Static_Expression (N, Rstat);
end Eval_Conditional_Expression;
----------------------
-- Eval_Entity_Name --
----------------------
-- This procedure is used for identifiers and expanded names other than
-- named numbers (see Eval_Named_Integer, Eval_Named_Real. These are
-- static if they denote a static constant (RM 4.9(6)) or if the name
-- denotes an enumeration literal (RM 4.9(22)).
procedure Eval_Entity_Name (N : Node_Id) is
Def_Id : constant Entity_Id := Entity (N);
Val : Node_Id;
begin
-- Enumeration literals are always considered to be constants
-- and cannot raise constraint error (RM 4.9(22)).
if Ekind (Def_Id) = E_Enumeration_Literal then
Set_Is_Static_Expression (N);
return;
-- A name is static if it denotes a static constant (RM 4.9(5)), and
-- we also copy Raise_Constraint_Error. Notice that even if non-static,
-- it does not violate 10.2.1(8) here, since this is not a variable.
elsif Ekind (Def_Id) = E_Constant then
-- Deferred constants must always be treated as nonstatic
-- outside the scope of their full view.
if Present (Full_View (Def_Id))
and then not In_Open_Scopes (Scope (Def_Id))
then
Val := Empty;
else
Val := Constant_Value (Def_Id);
end if;
if Present (Val) then
Set_Is_Static_Expression
(N, Is_Static_Expression (Val)
and then Is_Static_Subtype (Etype (Def_Id)));
Set_Raises_Constraint_Error (N, Raises_Constraint_Error (Val));
if not Is_Static_Expression (N)
and then not Is_Generic_Type (Etype (N))
then
Validate_Static_Object_Name (N);
end if;
return;
end if;
end if;
-- Fall through if the name is not static
Validate_Static_Object_Name (N);
end Eval_Entity_Name;
end Eval_If_Expression;
----------------------------
-- Eval_Indexed_Component --

4
gcc/ada/sem_eval.ads
View File

@ -296,8 +296,8 @@ package Sem_Eval is
procedure Eval_Case_Expression (N : Node_Id);
procedure Eval_Character_Literal (N : Node_Id);
procedure Eval_Concatenation (N : Node_Id);
procedure Eval_Conditional_Expression (N : Node_Id);
procedure Eval_Entity_Name (N : Node_Id);
procedure Eval_If_Expression (N : Node_Id);
procedure Eval_Indexed_Component (N : Node_Id);
procedure Eval_Integer_Literal (N : Node_Id);
procedure Eval_Logical_Op (N : Node_Id);
@ -439,7 +439,7 @@ private
pragma Inline (Eval_Actual);
pragma Inline (Eval_Allocator);
pragma Inline (Eval_Character_Literal);
pragma Inline (Eval_Conditional_Expression);
pragma Inline (Eval_If_Expression);
pragma Inline (Eval_Indexed_Component);
pragma Inline (Eval_Named_Integer);
pragma Inline (Eval_Named_Real);

190
gcc/ada/sem_res.adb
View File

@ -178,11 +178,11 @@ package body Sem_Res is
procedure Resolve_Case_Expression (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Character_Literal (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Comparison_Op (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Conditional_Expression (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Entity_Name (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Equality_Op (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Explicit_Dereference (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Expression_With_Actions (N : Node_Id; Typ : Entity_Id);
procedure Resolve_If_Expression (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Indexed_Component (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Integer_Literal (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Logical_Op (N : Node_Id; Typ : Entity_Id);
@ -834,7 +834,7 @@ package body Sem_Res is
N_And_Then,
N_Case_Expression,
N_Case_Statement,
N_Conditional_Expression,
N_If_Expression,
N_If_Statement)
then
return False;
@ -2342,7 +2342,7 @@ package body Sem_Res is
elsif Nkind (N) = N_Character_Literal then
Set_Etype (N, Expr_Type);
elsif Nkind (N) = N_Conditional_Expression then
elsif Nkind (N) = N_If_Expression then
Set_Etype (N, Expr_Type);
-- AI05-0139-2: Expression is overloaded because type has
@ -2744,9 +2744,6 @@ package body Sem_Res is
when N_Character_Literal
=> Resolve_Character_Literal (N, Ctx_Type);
when N_Conditional_Expression
=> Resolve_Conditional_Expression (N, Ctx_Type);
when N_Expanded_Name
=> Resolve_Entity_Name (N, Ctx_Type);
@ -2765,6 +2762,9 @@ package body Sem_Res is
when N_Identifier
=> Resolve_Entity_Name (N, Ctx_Type);
when N_If_Expression
=> Resolve_If_Expression (N, Ctx_Type);
when N_Indexed_Component
=> Resolve_Indexed_Component (N, Ctx_Type);
@ -6128,75 +6128,6 @@ package body Sem_Res is
Eval_Relational_Op (N);
end Resolve_Comparison_Op;
------------------------------------
-- Resolve_Conditional_Expression --
------------------------------------
procedure Resolve_Conditional_Expression (N : Node_Id; Typ : Entity_Id) is
Condition : constant Node_Id := First (Expressions (N));
Then_Expr : constant Node_Id := Next (Condition);
Else_Expr : Node_Id := Next (Then_Expr);
Else_Typ : Entity_Id;
Then_Typ : Entity_Id;
begin
Resolve (Condition, Any_Boolean);
Resolve (Then_Expr, Typ);
Then_Typ := Etype (Then_Expr);
-- When the "then" expression is of a scalar type different from the
-- result type, then insert a conversion to ensure the generation of
-- a constraint check.
if Is_Scalar_Type (Then_Typ)
and then Then_Typ /= Typ
then
Rewrite (Then_Expr, Convert_To (Typ, Then_Expr));
Analyze_And_Resolve (Then_Expr, Typ);
end if;
-- If ELSE expression present, just resolve using the determined type
if Present (Else_Expr) then
Resolve (Else_Expr, Typ);
Else_Typ := Etype (Else_Expr);
if Is_Scalar_Type (Else_Typ)
and then Else_Typ /= Typ
then
Rewrite (Else_Expr, Convert_To (Typ, Else_Expr));
Analyze_And_Resolve (Else_Expr, Typ);
end if;
-- If no ELSE expression is present, root type must be Standard.Boolean
-- and we provide a Standard.True result converted to the appropriate
-- Boolean type (in case it is a derived boolean type).
elsif Root_Type (Typ) = Standard_Boolean then
Else_Expr :=
Convert_To (Typ, New_Occurrence_Of (Standard_True, Sloc (N)));
Analyze_And_Resolve (Else_Expr, Typ);
Append_To (Expressions (N), Else_Expr);
else
Error_Msg_N ("can only omit ELSE expression in Boolean case", N);
Append_To (Expressions (N), Error);
end if;
Set_Etype (N, Typ);
Eval_Conditional_Expression (N);
-- If we still have a conditional expression, and overflow checks are
-- enabled in MINIMIZED or ELIMINATED modes, then set Do_Overflow_Check
-- to ensure that we handle overflow for dependent expressions.
if Nkind (N) = N_Conditional_Expression
and then Overflow_Check_Mode (Typ) in Minimized_Or_Eliminated
then
Set_Do_Overflow_Check (N);
end if;
end Resolve_Conditional_Expression;
-----------------------------------------
-- Resolve_Discrete_Subtype_Indication --
-----------------------------------------
@ -6863,12 +6794,12 @@ package body Sem_Res is
R : constant Node_Id := Right_Opnd (N);
T : Entity_Id := Find_Unique_Type (L, R);
procedure Check_Conditional_Expression (Cond : Node_Id);
-- The resolution rule for conditional expressions requires that each
-- such must have a unique type. This means that if several dependent
-- expressions are of a non-null anonymous access type, and the context
-- does not impose an expected type (as can be the case in an equality
-- operation) the expression must be rejected.
procedure Check_If_Expression (Cond : Node_Id);
-- The resolution rule for if expressions requires that each such must
-- have a unique type. This means that if several dependent expressions
-- are of a non-null anonymous access type, and the context does not
-- impose an expected type (as can be the case in an equality operation)
-- the expression must be rejected.
function Find_Unique_Access_Type return Entity_Id;
-- In the case of allocators, make a last-ditch attempt to find a single
@ -6876,27 +6807,26 @@ package body Sem_Res is
-- dubious, and of no interest to any real code, but c48008a makes it
-- all worthwhile.
----------------------------------
-- Check_Conditional_Expression --
----------------------------------
-------------------------
-- Check_If_Expression --
-------------------------
procedure Check_Conditional_Expression (Cond : Node_Id) is
procedure Check_If_Expression (Cond : Node_Id) is
Then_Expr : Node_Id;
Else_Expr : Node_Id;
begin
if Nkind (Cond) = N_Conditional_Expression then
if Nkind (Cond) = N_If_Expression then
Then_Expr := Next (First (Expressions (Cond)));
Else_Expr := Next (Then_Expr);
if Nkind (Then_Expr) /= N_Null
and then Nkind (Else_Expr) /= N_Null
then
Error_Msg_N
("cannot determine type of conditional expression", Cond);
Error_Msg_N ("cannot determine type of if expression", Cond);
end if;
end if;
end Check_Conditional_Expression;
end Check_If_Expression;
-----------------------------
-- Find_Unique_Access_Type --
@ -6972,9 +6902,11 @@ package body Sem_Res is
return;
end if;
-- Conditional expressions must have a single type, and if the
-- context does not impose one the dependent expressions cannot
-- be anonymous access types.
-- If expressions must have a single type, and if the context does
-- not impose one the dependent expressions cannot be anonymous
-- access types.
-- Why no similar processing for case expressions???
elsif Ada_Version >= Ada_2012
and then Ekind_In (Etype (L), E_Anonymous_Access_Type,
@ -6982,8 +6914,8 @@ package body Sem_Res is
and then Ekind_In (Etype (R), E_Anonymous_Access_Type,
E_Anonymous_Access_Subprogram_Type)
then
Check_Conditional_Expression (L);
Check_Conditional_Expression (R);
Check_If_Expression (L);
Check_If_Expression (R);
end if;
Resolve (L, T);
@ -6994,6 +6926,7 @@ package body Sem_Res is
-- operands have equal static bounds.
if Is_Array_Type (T) then
-- Protect call to Matching_Static_Array_Bounds to avoid costly
-- operation if not needed.
@ -7208,6 +7141,75 @@ package body Sem_Res is
Set_Etype (N, Typ);
end Resolve_Expression_With_Actions;
---------------------------
-- Resolve_If_Expression --
---------------------------
procedure Resolve_If_Expression (N : Node_Id; Typ : Entity_Id) is
Condition : constant Node_Id := First (Expressions (N));
Then_Expr : constant Node_Id := Next (Condition);
Else_Expr : Node_Id := Next (Then_Expr);
Else_Typ : Entity_Id;
Then_Typ : Entity_Id;
begin
Resolve (Condition, Any_Boolean);
Resolve (Then_Expr, Typ);
Then_Typ := Etype (Then_Expr);
-- When the "then" expression is of a scalar type different from the
-- result type, then insert a conversion to ensure the generation of
-- a constraint check.
if Is_Scalar_Type (Then_Typ)
and then Then_Typ /= Typ
then
Rewrite (Then_Expr, Convert_To (Typ, Then_Expr));
Analyze_And_Resolve (Then_Expr, Typ);
end if;
-- If ELSE expression present, just resolve using the determined type
if Present (Else_Expr) then
Resolve (Else_Expr, Typ);
Else_Typ := Etype (Else_Expr);
if Is_Scalar_Type (Else_Typ)
and then Else_Typ /= Typ
then
Rewrite (Else_Expr, Convert_To (Typ, Else_Expr));
Analyze_And_Resolve (Else_Expr, Typ);
end if;
-- If no ELSE expression is present, root type must be Standard.Boolean
-- and we provide a Standard.True result converted to the appropriate
-- Boolean type (in case it is a derived boolean type).
elsif Root_Type (Typ) = Standard_Boolean then
Else_Expr :=
Convert_To (Typ, New_Occurrence_Of (Standard_True, Sloc (N)));
Analyze_And_Resolve (Else_Expr, Typ);
Append_To (Expressions (N), Else_Expr);
else
Error_Msg_N ("can only omit ELSE expression in Boolean case", N);
Append_To (Expressions (N), Error);
end if;
Set_Etype (N, Typ);
Eval_If_Expression (N);
-- If we still have a if expression, and overflow checks are enabled in
-- MINIMIZED or ELIMINATED modes, then set Do_Overflow_Check to ensure
-- that we handle overflow for dependent expressions.
if Nkind (N) = N_If_Expression
and then Overflow_Check_Mode (Typ) in Minimized_Or_Eliminated
then
Set_Do_Overflow_Check (N);
end if;
end Resolve_If_Expression;
-------------------------------
-- Resolve_Indexed_Component --
-------------------------------

8
gcc/ada/sem_util.adb
View File

@ -2250,9 +2250,9 @@ package body Sem_Util is
Msgs := False;
exit;
-- Conditional expression
-- If expression
elsif Nkind (P) = N_Conditional_Expression then
elsif Nkind (P) = N_If_Expression then
declare
Cond : constant Node_Id := First (Expressions (P));
Texp : constant Node_Id := Next (Cond);
@ -12146,13 +12146,15 @@ package body Sem_Util is
begin
Desc := N;
-- Seems dubious that case expressions are not handled here ???
P := Parent (N);
while Present (P) loop
if Nkind (P) = N_If_Statement
or else Nkind (P) = N_Case_Statement
or else (Nkind (P) in N_Short_Circuit
and then Desc = Right_Opnd (P))
or else (Nkind (P) = N_Conditional_Expression
or else (Nkind (P) = N_If_Expression
and then Desc /= First (Expressions (P)))
or else Nkind (P) = N_Exception_Handler
or else Nkind (P) = N_Selective_Accept

20
gcc/ada/sinfo.adb
View File

@ -928,7 +928,7 @@ package body Sinfo is
or else NT (N).Nkind in N_Op
or else NT (N).Nkind = N_Attribute_Reference
or else NT (N).Nkind = N_Case_Expression
or else NT (N).Nkind = N_Conditional_Expression
or else NT (N).Nkind = N_If_Expression
or else NT (N).Nkind = N_Type_Conversion);
return Flag17 (N);
end Do_Overflow_Check;
@ -1008,7 +1008,7 @@ package body Sinfo is
(N : Node_Id) return List_Id is
begin
pragma Assert (False
or else NT (N).Nkind = N_Conditional_Expression);
or else NT (N).Nkind = N_If_Expression);
return List3 (N);
end Else_Actions;
@ -1247,8 +1247,8 @@ package body Sinfo is
pragma Assert (False
or else NT (N).Nkind = N_Aggregate
or else NT (N).Nkind = N_Attribute_Reference
or else NT (N).Nkind = N_Conditional_Expression
or else NT (N).Nkind = N_Extension_Aggregate
or else NT (N).Nkind = N_If_Expression
or else NT (N).Nkind = N_Indexed_Component);
return List1 (N);
end Expressions;
@ -1745,7 +1745,7 @@ package body Sinfo is
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Conditional_Expression);
or else NT (N).Nkind = N_If_Expression);
return Flag13 (N);
end Is_Elsif;
@ -2990,7 +2990,7 @@ package body Sinfo is
(N : Node_Id) return List_Id is
begin
pragma Assert (False
or else NT (N).Nkind = N_Conditional_Expression);
or else NT (N).Nkind = N_If_Expression);
return List2 (N);
end Then_Actions;
@ -4001,7 +4001,7 @@ package body Sinfo is
or else NT (N).Nkind in N_Op
or else NT (N).Nkind = N_Attribute_Reference
or else NT (N).Nkind = N_Case_Expression
or else NT (N).Nkind = N_Conditional_Expression
or else NT (N).Nkind = N_If_Expression
or else NT (N).Nkind = N_Type_Conversion);
Set_Flag17 (N, Val);
end Set_Do_Overflow_Check;
@ -4081,7 +4081,7 @@ package body Sinfo is
(N : Node_Id; Val : List_Id) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Conditional_Expression);
or else NT (N).Nkind = N_If_Expression);
Set_List3 (N, Val); -- semantic field, no parent set
end Set_Else_Actions;
@ -4311,8 +4311,8 @@ package body Sinfo is
pragma Assert (False
or else NT (N).Nkind = N_Aggregate
or else NT (N).Nkind = N_Attribute_Reference
or else NT (N).Nkind = N_Conditional_Expression
or else NT (N).Nkind = N_Extension_Aggregate
or else NT (N).Nkind = N_If_Expression
or else NT (N).Nkind = N_Indexed_Component);
Set_List1_With_Parent (N, Val);
end Set_Expressions;
@ -4809,7 +4809,7 @@ package body Sinfo is
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Conditional_Expression);
or else NT (N).Nkind = N_If_Expression);
Set_Flag13 (N, Val);
end Set_Is_Elsif;
@ -6054,7 +6054,7 @@ package body Sinfo is
(N : Node_Id; Val : List_Id) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Conditional_Expression);
or else NT (N).Nkind = N_If_Expression);
Set_List2 (N, Val); -- semantic field, no parent set
end Set_Then_Actions;

53
gcc/ada/sinfo.ads
View File

@ -824,7 +824,7 @@ package Sinfo is
-- attribute references which use this flag are Pred and Succ, where it
-- means that the result should be checked for going outside the base
-- range. Note that this flag is not set for modular types. This flag is
-- also set on conditional expression nodes if we are operating in either
-- also set on if and case expression nodes if we are operating in either
-- MINIMIZED or ELIMINATED overflow checking mode (to make sure that we
-- properly process overflow checking for dependent expressions).
@ -908,12 +908,12 @@ package Sinfo is
-- boolean is required.
-- Else_Actions (List3-Sem)
-- This field is present in conditional expression nodes. During code
-- This field is present in if expression nodes. During code
-- expansion we use the Insert_Actions procedure (in Exp_Util) to insert
-- actions at an appropriate place in the tree to get elaborated at the
-- right time. For conditional expressions, we have to be sure that the
-- actions for the Else branch are only elaborated if the condition is
-- False. The Else_Actions field is used as a temporary parking place for
-- right time. For if expressions, we have to be sure that the actions
-- for the Else branch are only elaborated if the condition is False.
-- The Else_Actions field is used as a temporary parking place for
-- these actions. The final tree is always rewritten to eliminate the
-- need for this field, so in the tree passed to Gigi, this field is
-- always set to No_List.
@ -1761,12 +1761,12 @@ package Sinfo is
-- do size validation for.
-- Then_Actions (List3-Sem)
-- This field is present in conditional expression nodes. During code
-- expansion we use the Insert_Actions procedure (in Exp_Util) to insert
-- actions at an appropriate place in the tree to get elaborated at the
-- right time. For conditional expressions, we have to be sure that the
-- actions for the Then branch are only elaborated if the condition is
-- True. The Then_Actions field is used as a temporary parking place for
-- This field is present in if expression nodes. During code expansion
-- we use the Insert_Actions procedure (in Exp_Util) to insert actions
-- at an appropriate place in the tree to get elaborated at the right
-- time. For if expressions, we have to be sure that the actions for
-- for the Then branch are only elaborated if the condition is True.
-- The Then_Actions field is used as a temporary parking place for
-- these actions. The final tree is always rewritten to eliminate the
-- need for this field, so in the tree passed to Gigi, this field is
-- always set to No_List.
@ -3885,15 +3885,9 @@ package Sinfo is
-- Note: if we have (IF x1 THEN x2 ELSIF x3 THEN x4 ELSE x5) then it
-- is represented as (IF x1 THEN x2 ELSE (IF x3 THEN x4 ELSE x5)) and
-- the Is_Elsif flag is set on the inner conditional expression.
-- the Is_Elsif flag is set on the inner if expression.
-- Note: to be consistent with the grammar, the following node should
-- really be named N_If_Expression, but historically it was always
-- N_Conditional_Expression, so it would be a bit of an earthquake
-- to change, and actually conditional expression seems a bit clearer
-- than if expression in typical contexts, so we decide to leave it!
-- N_Conditional_Expression
-- N_If_Expression
-- Sloc points to IF or ELSIF keyword
-- Expressions (List1)
-- Then_Actions (List2-Sem)
@ -6952,11 +6946,6 @@ package Sinfo is
-- reconstructed tree printed by Sprint, and the node descriptions here
-- show this syntax.
-- Note: Case_Expression and Conditional_Expression is in this section for
-- historical reasons, since they were initially extensions. Now that they
-- are an official part of Ada 2012, we should move them to the appropriate
-- section of this package. ???
--------------
-- Contract --
--------------
@ -7639,12 +7628,6 @@ package Sinfo is
N_And_Then,
N_Or_Else,
-- N_Subexpr, N_Has_Etype
N_Conditional_Expression,
N_Explicit_Dereference,
N_Expression_With_Actions,
-- N_Subexpr, N_Has_Etype, N_Subprogram_Call
N_Function_Call,
@ -7652,6 +7635,9 @@ package Sinfo is
-- N_Subexpr, N_Has_Etype
N_Explicit_Dereference,
N_Expression_With_Actions,
N_If_Expression,
N_Indexed_Component,
N_Integer_Literal,
N_Null,
@ -11586,7 +11572,7 @@ package Sinfo is
4 => True, -- Pragmas_Before (List4)
5 => False), -- unused
N_Conditional_Expression =>
N_If_Expression =>
(1 => True, -- Expressions (List1)
2 => False, -- Then_Actions (List2-Sem)
3 => False, -- Else_Actions (List3-Sem)
@ -12454,6 +12440,9 @@ package Sinfo is
-- should refer to N_Simple_Return_Statement.
N_Parameterized_Expression : constant Node_Kind := N_Expression_Function;
-- Old name for expression functions (used during Ada 2012 transition)
-- Old name for expression function (used during Ada 2012 transition)
N_Conditional_Expression : Node_Kind renames N_If_Expression;
-- Old name for if expression (used during Ada 2012 transition)
end Sinfo;

42
gcc/ada/sprint.adb
View File

@ -1320,27 +1320,6 @@ package body Sprint is
Sprint_Indented_List (Else_Statements (Node));
Write_Indent_Str ("end select;");
when N_Conditional_Expression =>
declare
Condition : constant Node_Id := First (Expressions (Node));
Then_Expr : constant Node_Id := Next (Condition);
begin
Write_Str_With_Col_Check_Sloc ("(if ");
Sprint_Node (Condition);
Write_Str_With_Col_Check (" then ");
-- Defense against junk here!
if Present (Then_Expr) then
Sprint_Node (Then_Expr);
Write_Str_With_Col_Check (" else ");
Sprint_Node (Next (Then_Expr));
end if;
Write_Char (')');
end;
when N_Constrained_Array_Definition =>
Write_Str_With_Col_Check_Sloc ("array ");
Sprint_Paren_Comma_List (Discrete_Subtype_Definitions (Node));
@ -1978,6 +1957,27 @@ package body Sprint is
Set_Debug_Sloc;
Write_Id (Node);
when N_If_Expression =>
declare
Condition : constant Node_Id := First (Expressions (Node));
Then_Expr : constant Node_Id := Next (Condition);
begin
Write_Str_With_Col_Check_Sloc ("(if ");
Sprint_Node (Condition);
Write_Str_With_Col_Check (" then ");
-- Defense against junk here!
if Present (Then_Expr) then
Sprint_Node (Then_Expr);
Write_Str_With_Col_Check (" else ");
Sprint_Node (Next (Then_Expr));
end if;
Write_Char (')');
end;
when N_If_Statement =>
Write_Indent_Str_Sloc ("if ");
Sprint_Node (Condition (Node));

1
gcc/ada/sprint.ads
View File

@ -48,7 +48,6 @@ package Sprint is
-- Allocator new xxx [storage_pool = xxx]
-- Cleanup action at end procedure name;
-- Conditional expression (if expr then expr else expr)
-- Conversion wi Float_Truncate target^(source)
-- Convert wi Conversion_OK target?(source)
-- Convert wi Rounded_Result target@(source)

4
gcc/ada/style.ads
View File

@ -190,8 +190,8 @@ package Style is
procedure Check_Xtra_Parens (Loc : Source_Ptr)
renames Style_Inst.Check_Xtra_Parens;
-- Called after scanning a conditional expression that has at least one
-- level of parentheses around the entire expression.
-- Called after scanning an if, case or quantified expression that has at
-- least one level of parentheses around the entire expression.
function Mode_In_Check return Boolean
renames Style_Inst.Mode_In_Check;

4
gcc/ada/styleg.ads
View File

@ -151,8 +151,8 @@ package Styleg is
-- Called after scanning a vertical bar to check spacing
procedure Check_Xtra_Parens (Loc : Source_Ptr);
-- Called after scanning a conditional expression that has at least one
-- level of parentheses around the entire expression.
-- Called after scanning an if, case, or quantified expression that has at
-- least one level of parentheses around the entire expression.
function Mode_In_Check return Boolean;
pragma Inline (Mode_In_Check);

4
gcc/ada/stylesw.ads
View File

@ -268,8 +268,8 @@ package Stylesw is
Style_Check_Xtra_Parens : Boolean := False;
-- This can be set True by using the -gnatyx switch. If true, then it is
-- not allowed to enclose entire conditional expressions in parentheses
-- (C style).
-- not allowed to enclose entire expressions in tests in parentheses
-- (C style), e.g. if (x = y) then ... is not allowed.
Style_Max_Line_Length : Int := 0;
-- Value used to check maximum line length. Gets reset as a result of

1
gcc/ada/types.h
View File

@ -384,3 +384,4 @@ typedef Int Mechanism_Type;
#define SE_Object_Too_Large 34
#define LAST_REASON_CODE 34