Commit b46be8a2 by Robert Dewar Committed by Arnaud Charlet

scng.adb: Minor reformattting

2009-07-07  Robert Dewar  <dewar@adacore.com>

	* scng.adb: Minor reformattting

	* par-ch2.adb (Scan_Pragma_Argument_Association): Pragma argument
	association allows conditional expression without parens.

	* par-ch4.adb (P_Name): Attribute arguments can be conditional
	expressions without enclosing parentheses, and also as parameters,
	indexing expressions etc.
	(P_Conditional_Expression): New procedure
	(P_Expression_If_OK): New procedure

	* par.adb (P_Conditional_Expression): New procedure
	(P_Expression_If_OK): New procedure

	* sem_ch4.adb (Analyze_Conditional_Expression): Allow for two argument
	form of conditional expression.

	* sem_res.adb (Resolve_Conditional_Expression): Deal with supplying
	missing True argument if ELSE argument missing.

	* sinfo.adb (Is_Elsif): New flag

	* sinfo.ads (N_Conditional_Expression): This node is now a syntactic
	part of the language, and the documentation is modified accordingly.
	(Is_Elsif): New flag

From-SVN: r149316
parent f062f8f2
2009-07-07 Robert Dewar <dewar@adacore.com>
* scng.adb: Minor reformattting
* par-ch2.adb (Scan_Pragma_Argument_Association): Pragma argument
association allows conditional expression without parens.
* par-ch4.adb (P_Name): Attribute arguments can be conditional
expressions without enclosing parentheses, and also as parameters,
indexing expressions etc.
(P_Conditional_Expression): New procedure
(P_Expression_If_OK): New procedure
* par.adb (P_Conditional_Expression): New procedure
(P_Expression_If_OK): New procedure
* sem_ch4.adb (Analyze_Conditional_Expression): Allow for two argument
form of conditional expression.
* sem_res.adb (Resolve_Conditional_Expression): Deal with supplying
missing True argument if ELSE argument missing.
* sinfo.adb (Is_Elsif): New flag
* sinfo.ads (N_Conditional_Expression): This node is now a syntactic
part of the language, and the documentation is modified accordingly.
(Is_Elsif): New flag
2009-07-06 Olivier Hainque <hainque@adacore.com>
* gcc-interface/trans.c (Handled_Sequence_Of_Statements_to_gnu,
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2009, 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- --
......@@ -506,7 +506,11 @@ package body Ch2 is
("|pragma argument identifier required here (RM 2.8(4))");
end if;
Set_Expression (Association, P_Expression);
if Id_Present then
Set_Expression (Association, P_Expression);
else
Set_Expression (Association, P_Expression_If_OK);
end if;
end Scan_Pragma_Argument_Association;
end Ch2;
......@@ -79,9 +79,7 @@ package body Ch4 is
-- Called to place complaint about bad range attribute at the given
-- source location. Terminates by raising Error_Resync.
function P_Range_Attribute_Reference
(Prefix_Node : Node_Id)
return Node_Id;
function P_Range_Attribute_Reference (Prefix_Node : Node_Id) return Node_Id;
-- Scan a range attribute reference. The caller has scanned out the
-- prefix. The current token is known to be an apostrophe and the
-- following token is known to be RANGE.
......@@ -454,7 +452,7 @@ package body Ch4 is
Scan; -- past left paren
loop
Discard_Junk_Node (P_Expression);
Discard_Junk_Node (P_Expression_If_OK);
exit when not Comma_Present;
end loop;
......@@ -519,7 +517,7 @@ package body Ch4 is
loop
declare
Expr : constant Node_Id := P_Expression;
Expr : constant Node_Id := P_Expression_If_OK;
begin
if Token = Tok_Arrow then
......@@ -558,6 +556,9 @@ 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
-- parentheses) are permitted in this context).
-- (..., identifier => expression , ...)
-- If there is at least one occurrence of identifier => (but
......@@ -583,7 +584,7 @@ package body Ch4 is
-- Here we have an expression after all
Expr_Node := P_Expression_Or_Range_Attribute;
Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
-- Check cases of discrete range for a slice
......@@ -707,7 +708,7 @@ package body Ch4 is
-- Here we have an expression after all, so stay in this state
Expr_Node := P_Expression;
Expr_Node := P_Expression_If_OK;
goto LP_State_Expr;
-- LP_State_Call corresponds to the situation in which at least
......@@ -728,8 +729,7 @@ package body Ch4 is
-- Deal with => (allow := as erroneous substitute)
if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
Arg_Node :=
New_Node (N_Parameter_Association, Prev_Token_Ptr);
Arg_Node := New_Node (N_Parameter_Association, Prev_Token_Ptr);
Set_Selector_Name (Arg_Node, Ident_Node);
T_Arrow;
Set_Explicit_Actual_Parameter (Arg_Node, P_Expression);
......@@ -744,8 +744,7 @@ package body Ch4 is
else
Prefix_Node := Name_Node;
Name_Node :=
New_Node (N_Function_Call, Sloc (Prefix_Node));
Name_Node := New_Node (N_Function_Call, Sloc (Prefix_Node));
Set_Name (Name_Node, Prefix_Node);
Set_Parameter_Associations (Name_Node, Arg_List);
T_Right_Paren;
......@@ -776,7 +775,7 @@ package body Ch4 is
("positional parameter association " &
"not allowed after named one");
Expr_Node := P_Expression;
Expr_Node := P_Expression_If_OK;
-- Leaving the '>' in an association is not unusual, so suggest
-- a possible fix.
......@@ -1101,7 +1100,7 @@ package body Ch4 is
if Token = Tok_Left_Paren then
Scan; -- past left paren
Set_Expressions (Attr_Node, New_List (P_Expression));
Set_Expressions (Attr_Node, New_List (P_Expression_If_OK));
T_Right_Paren;
end if;
......@@ -1204,13 +1203,20 @@ package body Ch4 is
Lparen_Sloc := Token_Ptr;
T_Left_Paren;
-- Conditional expression case
if Token = Tok_If then
Expr_Node := P_Conditional_Expression;
T_Right_Paren;
return Expr_Node;
-- Note: the mechanism used here of rescanning the initial expression
-- 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
if Token /= Tok_Others then
elsif Token /= Tok_Others then
Save_Scan_State (Scan_State); -- at start of expression
-- Deal with (NULL RECORD) case
......@@ -1243,7 +1249,7 @@ package body Ch4 is
return Aggregate_Node;
end if;
Expr_Node := P_Expression_Or_Range_Attribute;
Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
-- Extension aggregate case
......@@ -1413,7 +1419,7 @@ package body Ch4 is
Expr_Node := Empty;
else
Save_Scan_State (Scan_State); -- at start of expression
Expr_Node := P_Expression_Or_Range_Attribute;
Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
end if;
end loop;
......@@ -1598,6 +1604,19 @@ package body Ch4 is
end P_Expression;
-- This function is identical to the normal P_Expression, except that it
-- also permits the appearence of a conditional expression without the
-- usual surrounding parentheses.
function P_Expression_If_OK return Node_Id is
begin
if Token = Tok_If then
return P_Conditional_Expression;
else
return P_Expression;
end if;
end P_Expression_If_OK;
-- This function is identical to the normal P_Expression, except that it
-- checks that the expression scan did not stop on a right paren. It is
-- called in all contexts where a right parenthesis cannot legitimately
-- follow an expression.
......@@ -1688,6 +1707,17 @@ package body Ch4 is
end if;
end P_Expression_Or_Range_Attribute;
-- Version that allows a non-parenthesized conditional expression
function P_Expression_Or_Range_Attribute_If_OK return Node_Id is
begin
if Token = Tok_If then
return P_Conditional_Expression;
else
return P_Expression_Or_Range_Attribute;
end if;
end P_Expression_Or_Range_Attribute_If_OK;
-------------------
-- 4.4 Relation --
-------------------
......@@ -2332,6 +2362,32 @@ package body Ch4 is
when Tok_Pragma =>
P_Pragmas_Misplaced;
-- Deal with IF (possible unparenthesized conditional expression)
when Tok_If =>
-- If this looks like a real if, defined as an IF appearing at
-- the start of a new line, then we consider we have a missing
-- operand.
if Token_Is_At_Start_Of_Line then
Error_Msg_AP ("missing operand");
return Error;
-- If this looks like a conditional expression, then treat it
-- that way with an error messasge.
elsif Extensions_Allowed then
Error_Msg_SC
("conditional expression must be parenthesized");
return P_Conditional_Expression;
-- Otherwise treat as misused identifier
else
return P_Identifier;
end if;
-- Anything else is illegal as the first token of a primary, but
-- we test for a reserved identifier so that it is treated nicely
......@@ -2600,4 +2656,86 @@ package body Ch4 is
return Alloc_Node;
end P_Allocator;
------------------------------
-- P_Conditional_Expression --
------------------------------
function P_Conditional_Expression return Node_Id is
Exprs : constant List_Id := New_List;
Loc : constant Source_Ptr := Scan_Ptr;
Expr : Node_Id;
State : Saved_Scan_State;
begin
Inside_Conditional_Expression := Inside_Conditional_Expression + 1;
if Token = Tok_If and then not Extensions_Allowed then
Error_Msg_SC ("conditional expression is an Ada extension");
Error_Msg_SC ("\use -gnatX switch to compile this unit");
end if;
Scan; -- past IF or ELSIF
Append_To (Exprs, P_Expression_No_Right_Paren);
TF_Then;
Append_To (Exprs, P_Expression);
-- We now have scanned out IF expr THEN expr
-- Check for common error of semicolon before the ELSE
if Token = Tok_Semicolon then
Save_Scan_State (State);
Scan; -- past semicolon
if Token = Tok_Else or else Token = Tok_Elsif then
Error_Msg_SP ("|extra "";"" ignored");
else
Restore_Scan_State (State);
end if;
end if;
-- Scan out ELSIF sequence if present
if Token = Tok_Elsif then
Expr := P_Conditional_Expression;
Set_Is_Elsif (Expr);
Append_To (Exprs, Expr);
-- Scan out ELSE phrase if present
elsif Token = Tok_Else then
-- Scan out ELSE expression
Scan; -- Past ELSE
Append_To (Exprs, P_Expression);
-- Two expression case (implied True, filled in during semantics)
else
null;
end if;
-- 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");
Scan; -- past END
if Token = Tok_If then
Scan; -- past IF;
end if;
end if;
Inside_Conditional_Expression := Inside_Conditional_Expression - 1;
-- Return the Conditional_Expression node
return
Make_Conditional_Expression (Loc,
Expressions => Exprs);
end P_Conditional_Expression;
end Ch4;
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2009, 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- --
......@@ -664,7 +664,6 @@ is
package Ch4 is
function P_Aggregate return Node_Id;
function P_Expression return Node_Id;
function P_Expression_No_Right_Paren return Node_Id;
function P_Expression_Or_Range_Attribute return Node_Id;
function P_Function_Name return Node_Id;
function P_Name return Node_Id;
......@@ -673,9 +672,25 @@ is
function P_Simple_Expression return Node_Id;
function P_Simple_Expression_Or_Range_Attribute return Node_Id;
function P_Qualified_Expression
(Subtype_Mark : Node_Id)
return Node_Id;
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 in a context where a conditional expression
-- is permitted to appear without surrounding parentheses.
function P_Expression_No_Right_Paren return Node_Id;
-- Scans out an expression in contexts where the expression cannot be
-- terminated by a right paren (gives better error recovery if an errant
-- right paren is found after the expression).
function P_Expression_Or_Range_Attribute_If_OK return Node_Id;
-- Scans out an expression or range attribute where a conditional
-- expression is permitted to appear without surrounding parentheses.
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.
end Ch4;
......@@ -1131,6 +1146,7 @@ is
function Token_Is_At_End_Of_Line return Boolean;
-- Determines if the current token is the last token on the line
end Util;
--------------
......
......@@ -2412,11 +2412,16 @@ package body Scng is
Style.Non_Lower_Case_Keyword;
end if;
-- Check THEN/ELSE style rules. These do not apply to AND THEN
-- or OR ELSE, and do not apply in conditional expressions.
if (Token = Tok_Then and then Prev_Token /= Tok_And)
or else
(Token = Tok_Else and then Prev_Token /= Tok_Or)
then
Style.Check_Separate_Stmt_Lines;
if Inside_Conditional_Expression = 0 then
Style.Check_Separate_Stmt_Lines;
end if;
end if;
end if;
......@@ -2550,7 +2555,6 @@ package body Scng is
else
exit Tabs_Loop;
end if;
end loop Tabs_Loop;
return Start_Column;
......
......@@ -1237,10 +1237,19 @@ package body Sem_Ch4 is
Condition : constant Node_Id := First (Expressions (N));
Then_Expr : constant Node_Id := Next (Condition);
Else_Expr : constant Node_Id := Next (Then_Expr);
begin
if Comes_From_Source (N) then
Check_Compiler_Unit (N);
end if;
Analyze_Expression (Condition);
Analyze_Expression (Then_Expr);
Analyze_Expression (Else_Expr);
if Present (Else_Expr) then
Analyze_Expression (Else_Expr);
end if;
Set_Etype (N, Etype (Then_Expr));
end Analyze_Conditional_Expression;
......
......@@ -3990,7 +3990,7 @@ package body Sem_Res is
null;
elsif (Is_Class_Wide_Type (Etype (Expression (E)))
or else Is_Class_Wide_Type (Etype (E)))
or else Is_Class_Wide_Type (Etype (E)))
and then Base_Type (Etype (Expression (E))) /= Base_Type (Etype (E))
then
Wrong_Type (Expression (E), Etype (E));
......@@ -5530,11 +5530,32 @@ package body Sem_Res is
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 : constant Node_Id := Next (Then_Expr);
Else_Expr : Node_Id := Next (Then_Expr);
begin
Resolve (Condition, Standard_Boolean);
Resolve (Condition, Any_Boolean);
Resolve (Then_Expr, Typ);
Resolve (Else_Expr, Typ);
-- If ELSE expression present, just resolve using the determined type
if Present (Else_Expr) then
Resolve (Else_Expr, Typ);
-- 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);
end Resolve_Conditional_Expression;
......
......@@ -1605,6 +1605,14 @@ package body Sinfo is
return Flag18 (N);
end Is_Dynamic_Coextension;
function Is_Elsif
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Conditional_Expression);
return Flag13 (N);
end Is_Elsif;
function Is_Entry_Barrier_Function
(N : Node_Id) return Boolean is
begin
......@@ -4393,6 +4401,14 @@ package body Sinfo is
Set_Flag18 (N, Val);
end Set_Is_Dynamic_Coextension;
procedure Set_Is_Elsif
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Conditional_Expression);
Set_Flag13 (N, Val);
end Set_Is_Elsif;
procedure Set_Is_Entry_Barrier_Function
(N : Node_Id; Val : Boolean := True) is
begin
......
......@@ -6438,6 +6438,11 @@ package Sinfo is
-- reconstructed tree printed by Sprint, and the node descriptions here
-- show this syntax.
-- Note: Conditional_Expression is in this section for historical reasons.
-- We will move it to its appropriate place when it is officially approved
-- as an extension (and then we will know what the exact grammar and place
-- in the Reference Manual is!)
----------------------------
-- Conditional Expression --
----------------------------
......@@ -6452,18 +6457,33 @@ package Sinfo is
-- No_List in the tree passed to Gigi. These fields are used only
-- for temporary processing purposes in the expander.
-- Sprint syntax: (if expr then expr else expr)
-- The Ada language does not permit conditional expressions, however
-- this is under discussion as a possible extension by the ARG, and we
-- have implemented a form of this capability in GNAT under control of
-- the -X switch. The syntax is:
-- CONDITIONAL_EXPRESSION ::=
-- if EXPRESSION then EXPRESSION
-- {elsif EXPRESSION then EXPRESSION}
-- [else EXPRESSION]
-- And we add the additional constructs
-- PRIMARY ::= ( CONDITIONAL_EXPRESION )
-- PRAGMA_ARGUMENT_ASSOCIATION ::= CONDITIONAL_EXPRESSION
-- 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.
-- N_Conditional_Expression
-- Sloc points to related node
-- Sloc points to IF or ELSIF keyword
-- Expressions (List1)
-- Then_Actions (List2-Sem)
-- Else_Actions (List3-Sem)
-- Is_Elsif (Flag13) (set if comes from ELSIF)
-- plus fields for expression
-- Note: in the case where a debug source file is generated, the Sloc
-- for this node points to the IF keyword in the Sprint file output.
-------------------
-- Expanded_Name --
-------------------
......@@ -7956,6 +7976,9 @@ package Sinfo is
function Is_Dynamic_Coextension
(N : Node_Id) return Boolean; -- Flag18
function Is_Elsif
(N : Node_Id) return Boolean; -- Flag13
function Is_Entry_Barrier_Function
(N : Node_Id) return Boolean; -- Flag8
......@@ -8844,6 +8867,9 @@ package Sinfo is
procedure Set_Is_Dynamic_Coextension
(N : Node_Id; Val : Boolean := True); -- Flag18
procedure Set_Is_Elsif
(N : Node_Id; Val : Boolean := True); -- Flag13
procedure Set_Is_Entry_Barrier_Function
(N : Node_Id; Val : Boolean := True); -- Flag8
......@@ -11042,6 +11068,7 @@ package Sinfo is
pragma Inline (Is_Component_Right_Opnd);
pragma Inline (Is_Controlling_Actual);
pragma Inline (Is_Dynamic_Coextension);
pragma Inline (Is_Elsif);
pragma Inline (Is_Entry_Barrier_Function);
pragma Inline (Is_Expanded_Build_In_Place_Call);
pragma Inline (Is_Folded_In_Parser);
......@@ -11334,6 +11361,7 @@ package Sinfo is
pragma Inline (Set_Is_Component_Right_Opnd);
pragma Inline (Set_Is_Controlling_Actual);
pragma Inline (Set_Is_Dynamic_Coextension);
pragma Inline (Set_Is_Elsif);
pragma Inline (Set_Is_Entry_Barrier_Function);
pragma Inline (Set_Is_Expanded_Build_In_Place_Call);
pragma Inline (Set_Is_Folded_In_Parser);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment