diff options
author | Robert Dewar <dewar@adacore.com> | 2009-07-07 10:36:25 +0000 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2009-07-07 12:36:25 +0200 |
commit | b46be8a2b70f416b8c12697885b5c7a315a3aeba (patch) | |
tree | 11684252ac8961c0cd28bf14e54a318aa0ed8157 /gcc | |
parent | f062f8f2307ae66bdeb176260841bd09a8765beb (diff) | |
download | gcc-b46be8a2b70f416b8c12697885b5c7a315a3aeba.zip gcc-b46be8a2b70f416b8c12697885b5c7a315a3aeba.tar.gz gcc-b46be8a2b70f416b8c12697885b5c7a315a3aeba.tar.bz2 |
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
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 28 | ||||
-rw-r--r-- | gcc/ada/par-ch2.adb | 8 | ||||
-rw-r--r-- | gcc/ada/par-ch4.adb | 170 | ||||
-rw-r--r-- | gcc/ada/par.adb | 26 | ||||
-rw-r--r-- | gcc/ada/scng.adb | 8 | ||||
-rw-r--r-- | gcc/ada/sem_ch4.adb | 11 | ||||
-rw-r--r-- | gcc/ada/sem_res.adb | 29 | ||||
-rw-r--r-- | gcc/ada/sinfo.adb | 16 | ||||
-rw-r--r-- | gcc/ada/sinfo.ads | 38 |
9 files changed, 299 insertions, 35 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5e76c14..455f0a5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,31 @@ +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, diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb index 5e174ee..e96c379 100644 --- a/gcc/ada/par-ch2.adb +++ b/gcc/ada/par-ch2.adb @@ -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; diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index af91f16..38eccb1 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -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; diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index 6a047db..769e3e4 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -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; -------------- diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index e7d9edc..30da224 100644 --- a/gcc/ada/scng.adb +++ b/gcc/ada/scng.adb @@ -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; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 06d0752..6303dd1 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -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; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 47b88c3..95f3c9b 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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; diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 30ba980..866dd5f 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -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 diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 7325b76..7f04e88 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -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); |